(* Author: Tobias Nipkow *)

subsection "Abstract Interpretation"

theory Abs_Int0
imports Abs_Int_init
begin

subsubsection "Orderings"

text\<open>The basic type classes \<^class>\<open>order\<close>, \<^class>\<open>semilattice_sup\<close> and \<^class>\<open>order_top\<close> are
defined in \<^theory>\<open>Main\<close>, more precisely in theories \<^theory>\<open>HOL.Orderings\<close> and \<^theory>\<open>HOL.Lattices\<close>.
If you view this theory with jedit, just click on the names to get there.\<close>

class semilattice_sup_top = semilattice_sup + order_top

instance "fun" :: (type, semilattice_sup_top) semilattice_sup_top ..

instantiation option :: (order)order
begin

fun less_eq_option where
"Some x \<le> Some y = (x \<le> y)" |
"None \<le> y = True" |
"Some _ \<le> None = False"

definition less_option where "x < (y::'a option) = (x \<le> y \<and> \<not> y \<le> x)"

lemma le_None[simp]: "(x \<le> None) = (x = None)"
by (cases x) simp_all

lemma Some_le[simp]: "(Some x \<le> u) = (\<exists>y. u = Some y \<and> x \<le> y)"
by (cases u) auto

instance
proof (standard, goal_cases)
  case 1 show ?case by(rule less_option_def)
next
  case (2 x) show ?case by(cases x, simp_all)
next
  case (3 x y z) thus ?case by(cases z, simp, cases y, simp, cases x, auto)
next
  case (4 x y) thus ?case by(cases y, simp, cases x, auto)
qed

end

instantiation option :: (sup)sup
begin

fun sup_option where
"Some x \<squnion> Some y = Some(x \<squnion> y)" |
"None \<squnion> y = y" |
"x \<squnion> None = x"

lemma sup_None2[simp]: "x \<squnion> None = x"
by (cases x) simp_all

instance ..

end

instantiation option :: (semilattice_sup_top)semilattice_sup_top
begin

definition top_option where "\<top> = Some \<top>"

instance
proof (standard, goal_cases)
  case (4 a) show ?case by(cases a, simp_all add: top_option_def)
next
  case (1 x y) thus ?case by(cases x, simp, cases y, simp_all)
next
  case (2 x y) thus ?case by(cases y, simp, cases x, simp_all)
next
  case (3 x y z) thus ?case by(cases z, simp, cases y, simp, cases x, simp_all)
qed

end

instantiation option :: (order)order_bot
begin

definition bot_option :: "'a option" where
"\<bottom> = None"

instance
proof (standard, goal_cases)
  case 1 thus ?case by(auto simp: bot_option_def)
qed

end

definition bot :: "com \<Rightarrow> 'a option acom" where
"bot c = annotate (\<lambda>p. None) c"

lemma bot_least: "strip C = c \<Longrightarrow> bot c \<le> C"
by(auto simp: bot_def less_eq_acom_def)

lemma strip_bot[simp]: "strip(bot c) = c"
by(simp add: bot_def)

subsubsection "Pre-fixpoint iteration"

definition pfp :: "(('a::order) \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a option" where
"pfp f = while_option (\<lambda>x. \<not> f x \<le> x) f"

lemma pfp_pfp: assumes "pfp f x0 = Some x" shows "f x \<le> x"
using while_option_stop[OF assms[simplified pfp_def]] by simp

lemma while_least:
fixes q :: "'a::order"
assumes "\<forall>x\<in>L.\<forall>y\<in>L. x \<le> y \<longrightarrow> f x \<le> f y" and "\<forall>x. x \<in> L \<longrightarrow> f x \<in> L"
and "\<forall>x \<in> L. b \<le> x" and "b \<in> L" and "f q \<le> q" and "q \<in> L"
and "while_option P f b = Some p"
shows "p \<le> q"
using while_option_rule[OF _  assms(7)[unfolded pfp_def],
                        where P = "%x. x \<in> L \<and> x \<le> q"]
by (metis assms(1-6) order_trans)

lemma pfp_bot_least:
assumes "\<forall>x\<in>{C. strip C = c}.\<forall>y\<in>{C. strip C = c}. x \<le> y \<longrightarrow> f x \<le> f y"
and "\<forall>C. C \<in> {C. strip C = c} \<longrightarrow> f C \<in> {C. strip C = c}"
and "f C' \<le> C'" "strip C' = c" "pfp f (bot c) = Some C"
shows "C \<le> C'"
by(rule while_least[OF assms(1,2) _ _ assms(3) _ assms(5)[unfolded pfp_def]])
  (simp_all add: assms(4) bot_least)

lemma pfp_inv:
  "pfp f x = Some y \<Longrightarrow> (\<And>x. P x \<Longrightarrow> P(f x)) \<Longrightarrow> P x \<Longrightarrow> P y"
unfolding pfp_def by (blast intro: while_option_rule)

lemma strip_pfp:
assumes "\<And>x. g(f x) = g x" and "pfp f x0 = Some x" shows "g x = g x0"
using pfp_inv[OF assms(2), where P = "%x. g x = g x0"] assms(1) by simp

subsubsection "Abstract Interpretation"

definition \<gamma>_fun :: "('a \<Rightarrow> 'b set) \<Rightarrow> ('c \<Rightarrow> 'a) \<Rightarrow> ('c \<Rightarrow> 'b)set" where
"\<gamma>_fun \<gamma> F = {f. \<forall>x. f x \<in> \<gamma>(F x)}"

fun \<gamma>_option :: "('a \<Rightarrow> 'b set) \<Rightarrow> 'a option \<Rightarrow> 'b set" where
"\<gamma>_option \<gamma> None = {}" |
"\<gamma>_option \<gamma> (Some a) = \<gamma> a"

text\<open>The interface for abstract values:\<close>

locale Val_semilattice =
fixes \<gamma> :: "'av::semilattice_sup_top \<Rightarrow> val set"
  assumes mono_gamma: "a \<le> b \<Longrightarrow> \<gamma> a \<le> \<gamma> b"
  and gamma_Top[simp]: "\<gamma> \<top> = UNIV"
fixes num' :: "val \<Rightarrow> 'av"
and plus' :: "'av \<Rightarrow> 'av \<Rightarrow> 'av"
  assumes gamma_num': "i \<in> \<gamma>(num' i)"
  and gamma_plus': "i1 \<in> \<gamma> a1 \<Longrightarrow> i2 \<in> \<gamma> a2 \<Longrightarrow> i1+i2 \<in> \<gamma>(plus' a1 a2)"

type_synonym 'av st = "(vname \<Rightarrow> 'av)"

text\<open>The for-clause (here and elsewhere) only serves the purpose of fixing
the name of the type parameter \<^typ>\<open>'av\<close> which would otherwise be renamed to
\<^typ>\<open>'a\<close>.\<close>

locale Abs_Int_fun = Val_semilattice where \<gamma>=\<gamma>
  for \<gamma> :: "'av::semilattice_sup_top \<Rightarrow> val set"
begin

fun aval' :: "aexp \<Rightarrow> 'av st \<Rightarrow> 'av" where
"aval' (N i) S = num' i" |
"aval' (V x) S = S x" |
"aval' (Plus a1 a2) S = plus' (aval' a1 S) (aval' a2 S)"

definition "asem x e S = (case S of None \<Rightarrow> None | Some S \<Rightarrow> Some(S(x := aval' e S)))"

definition "step' = Step asem (\<lambda>b S. S)"

lemma strip_step'[simp]: "strip(step' S C) = strip C"
by(simp add: step'_def)

definition AI :: "com \<Rightarrow> 'av st option acom option" where
"AI c = pfp (step' \<top>) (bot c)"

abbreviation \<gamma>\<^sub>s :: "'av st \<Rightarrow> state set"
where "\<gamma>\<^sub>s == \<gamma>_fun \<gamma>"

abbreviation \<gamma>\<^sub>o :: "'av st option \<Rightarrow> state set"
where "\<gamma>\<^sub>o == \<gamma>_option \<gamma>\<^sub>s"

abbreviation \<gamma>\<^sub>c :: "'av st option acom \<Rightarrow> state set acom"
where "\<gamma>\<^sub>c == map_acom \<gamma>\<^sub>o"

lemma gamma_s_Top[simp]: "\<gamma>\<^sub>s \<top> = UNIV"
by(simp add: top_fun_def \<gamma>_fun_def)

lemma gamma_o_Top[simp]: "\<gamma>\<^sub>o \<top> = UNIV"
by (simp add: top_option_def)

lemma mono_gamma_s: "f1 \<le> f2 \<Longrightarrow> \<gamma>\<^sub>s f1 \<subseteq> \<gamma>\<^sub>s f2"
by(auto simp: le_fun_def \<gamma>_fun_def dest: mono_gamma)

lemma mono_gamma_o:
  "S1 \<le> S2 \<Longrightarrow> \<gamma>\<^sub>o S1 \<subseteq> \<gamma>\<^sub>o S2"
by(induction S1 S2 rule: less_eq_option.induct)(simp_all add: mono_gamma_s)

lemma mono_gamma_c: "C1 \<le> C2 \<Longrightarrow> \<gamma>\<^sub>c C1 \<le> \<gamma>\<^sub>c C2"
by (simp add: less_eq_acom_def mono_gamma_o size_annos anno_map_acom size_annos_same[of C1 C2])

text\<open>Correctness:\<close>

lemma aval'_correct: "s \<in> \<gamma>\<^sub>s S \<Longrightarrow> aval a s \<in> \<gamma>(aval' a S)"
by (induct a) (auto simp: gamma_num' gamma_plus' \<gamma>_fun_def)

lemma in_gamma_update: "\<lbrakk> s \<in> \<gamma>\<^sub>s S; i \<in> \<gamma> a \<rbrakk> \<Longrightarrow> s(x := i) \<in> \<gamma>\<^sub>s(S(x := a))"
by(simp add: \<gamma>_fun_def)

lemma gamma_Step_subcomm:
  assumes "\<And>x e S. f1 x e (\<gamma>\<^sub>o S) \<subseteq> \<gamma>\<^sub>o (f2 x e S)"  "\<And>b S. g1 b (\<gamma>\<^sub>o S) \<subseteq> \<gamma>\<^sub>o (g2 b S)"
  shows "Step f1 g1 (\<gamma>\<^sub>o S) (\<gamma>\<^sub>c C) \<le> \<gamma>\<^sub>c (Step f2 g2 S C)"
by (induction C arbitrary: S) (auto simp: mono_gamma_o assms)

lemma step_step': "step (\<gamma>\<^sub>o S) (\<gamma>\<^sub>c C) \<le> \<gamma>\<^sub>c (step' S C)"
unfolding step_def step'_def
by(rule gamma_Step_subcomm)
  (auto simp: aval'_correct in_gamma_update asem_def split: option.splits)

lemma AI_correct: "AI c = Some C \<Longrightarrow> CS c \<le> \<gamma>\<^sub>c C"
proof(simp add: CS_def AI_def)
  assume 1: "pfp (step' \<top>) (bot c) = Some C"
  have pfp': "step' \<top> C \<le> C" by(rule pfp_pfp[OF 1])
  have 2: "step (\<gamma>\<^sub>o \<top>) (\<gamma>\<^sub>c C) \<le> \<gamma>\<^sub>c C"  \<comment> \<open>transfer the pfp'\<close>
  proof(rule order_trans)
    show "step (\<gamma>\<^sub>o \<top>) (\<gamma>\<^sub>c C) \<le> \<gamma>\<^sub>c (step' \<top> C)" by(rule step_step')
    show "... \<le> \<gamma>\<^sub>c C" by (metis mono_gamma_c[OF pfp'])
  qed
  have 3: "strip (\<gamma>\<^sub>c C) = c" by(simp add: strip_pfp[OF _ 1] step'_def)
  have "lfp c (step (\<gamma>\<^sub>o \<top>)) \<le> \<gamma>\<^sub>c C"
    by(rule lfp_lowerbound[simplified,where f="step (\<gamma>\<^sub>o \<top>)", OF 3 2])
  thus "lfp c (step UNIV) \<le> \<gamma>\<^sub>c C" by simp
qed

end

subsubsection "Monotonicity"

locale Abs_Int_fun_mono = Abs_Int_fun +
assumes mono_plus': "a1 \<le> b1 \<Longrightarrow> a2 \<le> b2 \<Longrightarrow> plus' a1 a2 \<le> plus' b1 b2"
begin

lemma mono_aval': "S \<le> S' \<Longrightarrow> aval' e S \<le> aval' e S'"
by(induction e)(auto simp: le_fun_def mono_plus')

lemma mono_update: "a \<le> a' \<Longrightarrow> S \<le> S' \<Longrightarrow> S(x := a) \<le> S'(x := a')"
by(simp add: le_fun_def)

lemma mono_step': "S1 \<le> S2 \<Longrightarrow> C1 \<le> C2 \<Longrightarrow> step' S1 C1 \<le> step' S2 C2"
unfolding step'_def
by(rule mono2_Step)
  (auto simp: mono_update mono_aval' asem_def split: option.split)

lemma mono_step'_top: "C \<le> C' \<Longrightarrow> step' \<top> C \<le> step' \<top> C'"
by (metis mono_step' order_refl)

lemma AI_least_pfp: assumes "AI c = Some C" "step' \<top> C' \<le> C'" "strip C' = c"
shows "C \<le> C'"
by(rule pfp_bot_least[OF _ _ assms(2,3) assms(1)[unfolded AI_def]])
  (simp_all add: mono_step'_top)

end

instantiation acom :: (type) vars
begin

definition "vars_acom = vars o strip"

instance ..

end

lemma finite_Cvars: "finite(vars(C::'a acom))"
by(simp add: vars_acom_def)

subsubsection "Termination"

lemma pfp_termination:
fixes x0 :: "'a::order" and m :: "'a \<Rightarrow> nat"
assumes mono: "\<And>x y. I x \<Longrightarrow> I y \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
and m: "\<And>x y. I x \<Longrightarrow> I y \<Longrightarrow> x < y \<Longrightarrow> m x > m y"
and I: "\<And>x y. I x \<Longrightarrow> I(f x)" and "I x0" and "x0 \<le> f x0"
shows "\<exists>x. pfp f x0 = Some x"
proof(simp add: pfp_def, rule wf_while_option_Some[where P = "%x. I x & x \<le> f x"])
  show "wf {(y,x). ((I x \<and> x \<le> f x) \<and> \<not> f x \<le> x) \<and> y = f x}"
    by(rule wf_subset[OF wf_measure[of m]]) (auto simp: m I)
next
  show "I x0 \<and> x0 \<le> f x0" using \<open>I x0\<close> \<open>x0 \<le> f x0\<close> by blast
next
  fix x assume "I x \<and> x \<le> f x" thus "I(f x) \<and> f x \<le> f(f x)"
    by (blast intro: I mono)
qed

lemma le_iff_le_annos: "C1 \<le> C2 \<longleftrightarrow>
  strip C1 = strip C2 \<and> (\<forall> i<size(annos C1). annos C1 ! i \<le> annos C2 ! i)"
by(simp add: less_eq_acom_def anno_def)

locale Measure1_fun =
fixes m :: "'av::top \<Rightarrow> nat"
fixes h :: "nat"
assumes h: "m x \<le> h"
begin

definition m_s :: "'av st \<Rightarrow> vname set \<Rightarrow> nat" ("m\<^sub>s") where
"m_s S X = (\<Sum> x \<in> X. m(S x))"

lemma m_s_h: "finite X \<Longrightarrow> m_s S X \<le> h * card X"
by(simp add: m_s_def) (metis mult.commute of_nat_id sum_bounded_above[OF h])

fun m_o :: "'av st option \<Rightarrow> vname set \<Rightarrow> nat" ("m\<^sub>o") where
"m_o (Some S) X = m_s S X" |
"m_o None X = h * card X + 1"

lemma m_o_h: "finite X \<Longrightarrow> m_o opt X \<le> (h*card X + 1)"
by(cases opt)(auto simp add: m_s_h le_SucI dest: m_s_h)

definition m_c :: "'av st option acom \<Rightarrow> nat" ("m\<^sub>c") where
"m_c C = sum_list (map (\<lambda>a. m_o a (vars C)) (annos C))"

text\<open>Upper complexity bound:\<close>
lemma m_c_h: "m_c C \<le> size(annos C) * (h * card(vars C) + 1)"
proof-
  let ?X = "vars C" let ?n = "card ?X" let ?a = "size(annos C)"
  have "m_c C = (\<Sum>i<?a. m_o (annos C ! i) ?X)"
    by(simp add: m_c_def sum_list_sum_nth atLeast0LessThan)
  also have "\<dots> \<le> (\<Sum>i<?a. h * ?n + 1)"
    apply(rule sum_mono) using m_o_h[OF finite_Cvars] by simp
  also have "\<dots> = ?a * (h * ?n + 1)" by simp
  finally show ?thesis .
qed

end

locale Measure_fun = Measure1_fun where m=m
  for m :: "'av::semilattice_sup_top \<Rightarrow> nat" +
assumes m2: "x < y \<Longrightarrow> m x > m y"
begin

text\<open>The predicates \<open>top_on_ty a X\<close> that follow describe that any abstract
state in \<open>a\<close> maps all variables in \<open>X\<close> to \<^term>\<open>\<top>\<close>.
This is an important invariant for the termination proof where we argue that only
the finitely many variables in the program change. That the others do not change
follows because they remain \<^term>\<open>\<top>\<close>.\<close>

fun top_on_st :: "'av st \<Rightarrow> vname set \<Rightarrow> bool" ("top'_on\<^sub>s") where
"top_on_st S X = (\<forall>x\<in>X. S x = \<top>)"

fun top_on_opt :: "'av st option \<Rightarrow> vname set \<Rightarrow> bool" ("top'_on\<^sub>o") where
"top_on_opt (Some S) X = top_on_st S X" |
"top_on_opt None X = True"

definition top_on_acom :: "'av st option acom \<Rightarrow> vname set \<Rightarrow> bool" ("top'_on\<^sub>c") where
"top_on_acom C X = (\<forall>a \<in> set(annos C). top_on_opt a X)"

lemma top_on_top: "top_on_opt \<top> X"
by(auto simp: top_option_def)

lemma top_on_bot: "top_on_acom (bot c) X"
by(auto simp add: top_on_acom_def bot_def)

lemma top_on_post: "top_on_acom C X \<Longrightarrow> top_on_opt (post C) X"
by(simp add: top_on_acom_def post_in_annos)

lemma top_on_acom_simps:
  "top_on_acom (SKIP {Q}) X = top_on_opt Q X"
  "top_on_acom (x ::= e {Q}) X = top_on_opt Q X"
  "top_on_acom (C1;;C2) X = (top_on_acom C1 X \<and> top_on_acom C2 X)"
  "top_on_acom (IF b THEN {P1} C1 ELSE {P2} C2 {Q}) X =
   (top_on_opt P1 X \<and> top_on_acom C1 X \<and> top_on_opt P2 X \<and> top_on_acom C2 X \<and> top_on_opt Q X)"
  "top_on_acom ({I} WHILE b DO {P} C {Q}) X =
   (top_on_opt I X \<and> top_on_acom C X \<and> top_on_opt P X \<and> top_on_opt Q X)"
by(auto simp add: top_on_acom_def)

lemma top_on_sup:
  "top_on_opt o1 X \<Longrightarrow> top_on_opt o2 X \<Longrightarrow> top_on_opt (o1 \<squnion> o2) X"
apply(induction o1 o2 rule: sup_option.induct)
apply(auto)
done

lemma top_on_Step: fixes C :: "'av st option acom"
assumes "!!x e S. \<lbrakk>top_on_opt S X; x \<notin> X; vars e \<subseteq> -X\<rbrakk> \<Longrightarrow> top_on_opt (f x e S) X"
        "!!b S. top_on_opt S X \<Longrightarrow> vars b \<subseteq> -X \<Longrightarrow> top_on_opt (g b S) X"
shows "\<lbrakk> vars C \<subseteq> -X; top_on_opt S X; top_on_acom C X \<rbrakk> \<Longrightarrow> top_on_acom (Step f g S C) X"
proof(induction C arbitrary: S)
qed (auto simp: top_on_acom_simps vars_acom_def top_on_post top_on_sup assms)

lemma m1: "x \<le> y \<Longrightarrow> m x \<ge> m y"
by(auto simp: le_less m2)

lemma m_s2_rep: assumes "finite(X)" and "S1 = S2 on -X" and "\<forall>x. S1 x \<le> S2 x" and "S1 \<noteq> S2"
shows "(\<Sum>x\<in>X. m (S2 x)) < (\<Sum>x\<in>X. m (S1 x))"
proof-
  from assms(3) have 1: "\<forall>x\<in>X. m(S1 x) \<ge> m(S2 x)" by (simp add: m1)
  from assms(2,3,4) have "\<exists>x\<in>X. S1 x < S2 x"
    by(simp add: fun_eq_iff) (metis Compl_iff le_neq_trans)
  hence 2: "\<exists>x\<in>X. m(S1 x) > m(S2 x)" by (metis m2)
  from sum_strict_mono_ex1[OF \<open>finite X\<close> 1 2]
  show "(\<Sum>x\<in>X. m (S2 x)) < (\<Sum>x\<in>X. m (S1 x))" .
qed

lemma m_s2: "finite(X) \<Longrightarrow> S1 = S2 on -X \<Longrightarrow> S1 < S2 \<Longrightarrow> m_s S1 X > m_s S2 X"
apply(auto simp add: less_fun_def m_s_def)
apply(simp add: m_s2_rep le_fun_def)
done

lemma m_o2: "finite X \<Longrightarrow> top_on_opt o1 (-X) \<Longrightarrow> top_on_opt o2 (-X) \<Longrightarrow>
  o1 < o2 \<Longrightarrow> m_o o1 X > m_o o2 X"
proof(induction o1 o2 rule: less_eq_option.induct)
  case 1 thus ?case by (auto simp: m_s2 less_option_def)
next
  case 2 thus ?case by(auto simp: less_option_def le_imp_less_Suc m_s_h)
next
  case 3 thus ?case by (auto simp: less_option_def)
qed

lemma m_o1: "finite X \<Longrightarrow> top_on_opt o1 (-X) \<Longrightarrow> top_on_opt o2 (-X) \<Longrightarrow>
  o1 \<le> o2 \<Longrightarrow> m_o o1 X \<ge> m_o o2 X"
by(auto simp: le_less m_o2)

lemma m_c2: "top_on_acom C1 (-vars C1) \<Longrightarrow> top_on_acom C2 (-vars C2) \<Longrightarrow>
  C1 < C2 \<Longrightarrow> m_c C1 > m_c C2"
proof(auto simp add: le_iff_le_annos size_annos_same[of C1 C2] vars_acom_def less_acom_def)
  let ?X = "vars(strip C2)"
  assume top: "top_on_acom C1 (- vars(strip C2))"  "top_on_acom C2 (- vars(strip C2))"
  and strip_eq: "strip C1 = strip C2"
  and 0: "\<forall>i<size(annos C2). annos C1 ! i \<le> annos C2 ! i"
  hence 1: "\<forall>i<size(annos C2). m_o (annos C1 ! i) ?X \<ge> m_o (annos C2 ! i) ?X"
    apply (auto simp: all_set_conv_all_nth vars_acom_def top_on_acom_def)
    by (metis (lifting, no_types) finite_cvars m_o1 size_annos_same2)
  fix i assume i: "i < size(annos C2)" "\<not> annos C2 ! i \<le> annos C1 ! i"
  have topo1: "top_on_opt (annos C1 ! i) (- ?X)"
    using i(1) top(1) by(simp add: top_on_acom_def size_annos_same[OF strip_eq])
  have topo2: "top_on_opt (annos C2 ! i) (- ?X)"
    using i(1) top(2) by(simp add: top_on_acom_def size_annos_same[OF strip_eq])
  from i have "m_o (annos C1 ! i) ?X > m_o (annos C2 ! i) ?X" (is "?P i")
    by (metis 0 less_option_def m_o2[OF finite_cvars topo1] topo2)
  hence 2: "\<exists>i < size(annos C2). ?P i" using \<open>i < size(annos C2)\<close> by blast
  have "(\<Sum>i<size(annos C2). m_o (annos C2 ! i) ?X)
         < (\<Sum>i<size(annos C2). m_o (annos C1 ! i) ?X)"
    apply(rule sum_strict_mono_ex1) using 1 2 by (auto)
  thus ?thesis
    by(simp add: m_c_def vars_acom_def strip_eq sum_list_sum_nth atLeast0LessThan size_annos_same[OF strip_eq])
qed

end

locale Abs_Int_fun_measure =
  Abs_Int_fun_mono where \<gamma>=\<gamma> + Measure_fun where m=m
  for \<gamma> :: "'av::semilattice_sup_top \<Rightarrow> val set" and m :: "'av \<Rightarrow> nat"
begin

lemma top_on_step': "top_on_acom C (-vars C) \<Longrightarrow> top_on_acom (step' \<top> C) (-vars C)"
unfolding step'_def
by(rule top_on_Step)
  (auto simp add: top_option_def asem_def split: option.splits)

lemma AI_Some_measure: "\<exists>C. AI c = Some C"
unfolding AI_def
apply(rule pfp_termination[where I = "\<lambda>C. top_on_acom C (- vars C)" and m="m_c"])
apply(simp_all add: m_c2 mono_step'_top bot_least top_on_bot)
using top_on_step' apply(auto simp add: vars_acom_def)
done

end

text\<open>Problem: not executable because of the comparison of abstract states,
i.e. functions, in the pre-fixpoint computation.\<close>

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               November 2004               |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |                October 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2009-2       |
            |                October 2010  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2016         |
            |                    May 2016  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory RS
imports Norm_seq
begin

(*****************************************************************

         1. Definition of Restriction Spaces (RS)
         2. RS ==> MS
         3. Metric Fixed point induction
         4.

 *****************************************************************)

(*
  It was defined by ("_ .|. _" [55,56] 55) until Isabelle 2007,
  but it was changed because it caused many syntactic ambiguity
  in Isabelle 2008.
*)

(******** X-symbols ********)
(*
notation (xsymbols) restriction ("_ \<down> _" [84,900] 84)

Isabelle 2005
syntax (output)
  "_restriction" :: "'a::ms0 => nat => 'a::ms0"  ("_ .|. _" [55,56] 55)

syntax (xsymbols)
  "_restriction" :: "'a::ms0 => nat => 'a::ms0"  ("_ \<down> _" [55,56] 55)

translations
  "x \<down> n"  == "x .|. n"
*)

(**********************************************************
                  restriction space (rs)
 **********************************************************)

(* isabelle2009-1
consts
  restriction :: "'a::ms0 => nat => 'a::ms0"  ("_ .|. _" [84,900] 84)

axclass rs < ms0
  zero_eq_rs: "ALL (x::'a::ms0) (y::'a::ms0). x .|. 0 = y .|. 0"
  min_rs    : "ALL (x::'a::ms0) (m::nat) (n::nat).
                     (x .|. m) .|. n = x .|. (min m n)"
  diff_rs   : "ALL (x::'a::ms0) (y::'a::ms0).
                     (x ~= y) --> (EX n. x .|. n ~= y .|. n)"
*)

class rs0 =
fixes restriction :: "'a => nat => 'a"  ("_ .|. _" [84,900] 84)

(* class rs = rs0 + ms0 + *)

class rs = rs0 +
assumes
  zero_eq_rs: "ALL x y. x .|. 0 = y .|. 0"
assumes
  min_rs    : "ALL x m n.
                     (x .|. m) .|. n = x .|. (min m n)"
assumes
  diff_rs   : "ALL x y.
                     (x ~= y) --> (EX n. x .|. n ~= y .|. n)"

declare zero_eq_rs [simp]

lemma diff_rs_Suc:
  "ALL n (x::'a::rs) y. x .|. n ~= y .|. n --> (EX m. n = Suc m) "
apply (rule allI)
apply (induct_tac n)
by (auto)

(**********************************************************
            restriction space --> metric space
 **********************************************************)

definition
  distance_nat_set :: "('a::rs * 'a::rs) => nat set"
  where
  distance_nat_set_def :
     "distance_nat_set xy ==
      {n. ((fst xy) .|. n) = ((snd xy) .|. n)}"

definition
  distance_nat     :: "('a::rs * 'a::rs) => nat"
  where
  distance_nat_def :
     "distance_nat xy == MAX (distance_nat_set xy)"

definition
  distance_rs_set  :: "('a::rs * 'a::rs) => real set"
  where
  distance_rs_set_def :
     "distance_rs_set xy == {(1/2)^n |n. n:distance_nat_set xy}"

(*
defs (overloaded)
  distance_rs_def : "distance xy == GLB (distance_rs_set xy)"
*)

definition
  distance_rs :: "('a::rs * 'a::rs) => real"
  where
  distance_rs_def: "distance_rs xy == GLB (distance_rs_set xy)"

(**********************************************************
             complete restriction space (crs)
 **********************************************************)

class ms0_rs =  ms0 + rs +
assumes
  to_distance_rs: "distance (xy::('a::{ms0,rs}) * 'a) = distance_rs xy"

class ms_rs =  ms + ms0_rs
class cms_rs = cms + ms_rs

(**********************************************************
                        RS lemmas
 **********************************************************)

(*** contraposition of diff_rs ***)

lemma contra_diff_rs:
    "[| ALL n. (x::'a::rs) .|. n = y .|. n |] ==> (x = y)"
apply (erule contrapos_pp)
by (simp add: diff_rs)

(*** diff_rs inv ***)

lemma contra_diff_rs_inv:
    "[| (x::'a::rs) .|. n ~= y .|. n |] ==> (x ~= y)"
apply (auto)
done

(*** zero distance ***)

lemma distance_rs_zero[simp]:
  "distance_rs ((x::'a::rs), x) = 0"
apply (simp add: distance_rs_def distance_rs_set_def)
apply (simp add: distance_nat_set_def)
by (simp add: zero_GLB_pow)

(*---------------------------*
 |       equal-preserv       |
 *---------------------------*)

lemma rest_equal_preserve:
  "[| (x::'a::rs) .|. n = y .|. n ; m <= n |] ==> x .|. m = y .|. m"
apply (insert min_rs)
apply (drule_tac x="x" in spec)
apply (drule_tac x="n" in spec)
apply (drule_tac x="m" in spec)
apply (insert min_rs)
apply (drule_tac x="y" in spec)
apply (drule_tac x="n" in spec)
apply (drule_tac x="m" in spec)
by (simp add: min_is)

lemma rest_equal_preserve_Suc:
  "(x::'a::rs) .|. Suc n = y .|. Suc n ==> x .|. n = y .|. n"
apply (rule rest_equal_preserve)
by (auto)

lemma rest_nonequal_preserve:
  "[| (x::'a::rs) .|. m ~= y .|. m ; m <= n |] ==> x .|. n ~= y .|. n"
apply (erule contrapos_pp)
apply (simp)
apply (rule rest_equal_preserve)
by (simp_all)

(*---------------------------*
 |  distance_nat_set hasMAX  |
 *---------------------------*)

lemma distance_nat_set_hasMAX :
  "(x::'a::rs) ~= y ==> (distance_nat_set (x,y)) hasMAX"
apply (insert EX_MIN_nat[of "{m. x .|. m ~= y .|. m}"])
apply (simp add: diff_rs)
apply (erule exE)
apply (simp add: isMIN_def)

apply (insert diff_rs_Suc)
apply (drule_tac x="n" in spec)
apply (drule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
apply (simp)
apply (erule exE)

 (* m must be the max *)

apply (simp add: hasMAX_def)
apply (rule_tac x="m" in exI)
apply (simp add: distance_nat_set_def isMAX_def)

apply (case_tac "x .|. m = y .|. m")
 apply (simp add: isUB_def)
 apply (intro allI impI)

 apply (simp add: isLB_def)
 apply (erule conjE)
 apply (case_tac "Suc m <= ya")
 apply (rotate_tac 3)
 apply (erule contrapos_pp)

 apply (rule rest_nonequal_preserve)
 apply (simp_all)
 apply (force)

      (* x .|. m ~= y .|. m *)  (* --> contradict for MIN *)
 apply (simp add: isLB_def)
 apply (erule conjE)
 apply (drule_tac x="m" in spec)
 apply (simp)
done

(*---------------------------*
 |     isMAX <--> isGLB      |
 *---------------------------*)

lemma to_distance_rsMAX_isGLB:
 "n isMAX distance_nat_set ((x::'a::rs), y)
  ==> (1/2)^n isGLB distance_rs_set (x, y)"
apply (simp add: distance_rs_set_def)
apply (simp add: isGLB_def isLB_def)
apply (rule conjI)

 (* LB *)
 apply (intro allI impI)
 apply (simp add: isMAX_def isUB_def)
 apply (elim conjE exE)
 apply (drule_tac x="na" in spec)
 apply (simp add: power_decreasing)

 (* GLB *)
 apply (intro allI impI)
 apply (drule_tac x="(1 / 2) ^ n" in spec)
 apply (drule mp)
 apply (rule_tac x="n" in exI, simp_all)
 apply (simp add: isMAX_def)
done

(*---------------------------*
 |    distance_set hasGLB    |
 *---------------------------*)

lemma distance_rs_set_hasGLB :
  "(distance_rs_set ((x::'a::rs),y)) hasGLB"
apply (simp add: hasGLB_def)

apply (case_tac "x = y")
apply (simp add: distance_rs_set_def)
apply (simp add: distance_nat_set_def)
apply (rule_tac x="0" in exI)
apply (simp add: zero_isGLB_pow)

apply (insert distance_nat_set_hasMAX[of x y])
apply (simp add: hasMAX_def)
apply (erule exE)
apply (rule_tac x="(1/2)^xa" in exI)
by (simp add: to_distance_rsMAX_isGLB)

(*---------------------------*
 |       MAX <--> GLB        |
 *---------------------------*)

lemma distance_rs_nat_lm:
  "[| (x::'a::rs) ~= y ; distance_nat (x,y) = n ; distance_rs (x,y) = r |]
   ==> r = (1 / 2) ^ n"
apply (simp add: distance_nat_def MAX_iff distance_nat_set_hasMAX)
apply (simp add: distance_rs_def  GLB_iff distance_rs_set_hasGLB)
apply (insert to_distance_rsMAX_isGLB[of n x y])
by (simp add: GLB_unique)

lemma distance_iff1:
  "(x::'a::rs) ~= y
   ==> distance_rs (x,y) = (1 / 2) ^ (distance_nat (x,y))"
by (simp add: distance_rs_nat_lm)

lemma distance_iff2:
  "(y::'a::rs) ~= x
   ==> distance_rs (x,y) = (1 / 2) ^ (distance_nat (x,y))"
apply (rule distance_iff1)
by (force)

lemmas distance_iff = distance_iff1 distance_iff2

(*---------------------------*
 |       less than 1B        |
 *---------------------------*)

lemma distance_rs_less_one:
  "distance_rs ((x::'a::rs), y) <= 1"
apply (case_tac "x=y", simp)
apply (simp add: distance_iff)
apply (rule order_trans)
apply (subgoal_tac "(1 / 2) ^ distance_nat (x, y) <= (1 / 2) ^ 0")
apply (assumption)
apply (rule power_decreasing)
apply (simp_all)
done

(*---------------------------*
 |      distance_nat iff     |
 *---------------------------*)

lemma isMAX_distance_nat1 :
  "(x::'a::rs) ~= y ==> (n isMAX distance_nat_set (x,y)) = (distance_nat (x,y) = n)"
apply (simp add: distance_nat_def)
by (simp add: distance_nat_set_hasMAX MAX_iff)

lemmas distance_nat_isMAX1 = isMAX_distance_nat1[THEN sym]

lemma distance_nat_isMAX_sym1:
  "(x::'a::rs) ~= y ==> (n = distance_nat (x,y)) = (n isMAX distance_nat_set (x,y))"
by (auto simp add: isMAX_distance_nat1)

lemma isMAX_distance_nat2 :
  "(y::'a::rs) ~= x ==> (n isMAX distance_nat_set (x,y)) = (distance_nat (x,y) = n)"
apply (rule isMAX_distance_nat1)
by (auto)

lemmas distance_nat_isMAX2 = isMAX_distance_nat2[THEN sym]

lemma distance_nat_isMAX_sym2:
  "(y::'a::rs) ~= x ==> (n = distance_nat (x,y)) = (n isMAX distance_nat_set (x,y))"
by (auto simp add: isMAX_distance_nat2)

lemmas distance_nat_iff = distance_nat_isMAX1 distance_nat_isMAX_sym1
                          distance_nat_isMAX2 distance_nat_isMAX_sym2

(*** for insert ***)

lemma distance_nat_is:
  "(x::'a::rs) ~= y ==> distance_nat (x,y) isMAX distance_nat_set (x,y)"
apply (insert distance_nat_isMAX1[of x y "distance_nat (x,y)"])
by (simp)

(*============================================================*
 |                                                            |
 |         (restriction space ==> metric space)               |
 |                                                            |
 |    instance x :: (type) rs ==> instance x :: (type) ms     |
 |                                                            |
 |               by  positive_rs                              |
 |                   diagonal_rs                              |
 |                   symmetry_rs                              |
 |                   triangle_inequality_rs                   |
 |                                                            |
 *============================================================*)

(*** positive_rs ***)

lemma positive_rs[simp]: "0 <= distance_rs (x::'a::rs,y)"
apply (case_tac "x = y")
by (simp_all add: distance_iff)
(*
in Isabelle2007
by (simp_all add: distance_iff zero_le_power)
*)

(*** diagonal_rs ***)

lemma diagonal_rs_only_if: "(distance_rs((x::'a::rs),y) = 0) ==> (x = y)"
apply (case_tac "x = y", simp)
by (simp add: distance_iff)

lemma diagonal_rs: "(distance_rs((x::'a::rs),y) = 0) = (x = y)"
apply (rule iffI)
apply (simp add: diagonal_rs_only_if)
by (simp)

lemma diagonal_rs_neq: "((x::'a::rs) ~= y) ==> 0 < distance_rs((x::'a::rs), y)"
apply (case_tac "distance_rs(x, y) = 0")
apply (simp add: diagonal_rs)
apply (insert positive_rs[of x y])
apply (simp (no_asm_simp))
done

(*** symmetry_rs ***)

lemma symmetry_nat_lm:
  "[| (x::'a::rs) ~= y;
      distance_nat (x,y) = n; distance_nat (y,x) = m |] ==> n = m"
apply (simp add: distance_nat_iff)
apply (rule MAX_unique)
apply (simp)
by (simp add: isMAX_def isUB_def distance_nat_set_def)

lemma symmetry_nat:
  "(x::'a::rs) ~= y ==> distance_nat (x,y) = distance_nat (y,x)"
by (simp add: symmetry_nat_lm)

lemma symmetry_rs: "distance_rs((x::'a::rs),y) = distance_rs(y,x)"
apply (case_tac "x = y", simp)
apply (simp add: distance_iff)
by (insert symmetry_nat[of x y], simp)

(*** triangle_inequality_rs ***)

lemma triangle_inequality_nat_lm:
  "[| (x::'a::rs) ~= y ; y ~= z ; x ~= z ;
      distance_nat (x,z) = n1 ;
      distance_nat (x,y) = n2 ;
      distance_nat (y,z) = n3 |]
   ==> min n2 n3 <= n1"
apply (simp add: distance_nat_iff)
apply (simp add: distance_nat_set_def)
apply (simp add: isMAX_def)

apply (subgoal_tac "min n3 n2 = min n2 n3")
apply (subgoal_tac "x .|. min n2 n3 = z .|. min n3 n2")
apply (simp add: isUB_def)

(* FOR x .|. min n2 n3 = z .|. min n3 n2 *)

apply (insert min_rs)
apply (frule_tac x="x" in spec)
apply (frule_tac x="y" in spec)
apply (frule_tac x="y" in spec)
apply (drule_tac x="z" in spec)

apply (drule_tac x="n2" in spec)
apply (drule_tac x="n2" in spec)
apply (drule_tac x="n3" in spec)
apply (drule_tac x="n3" in spec)

apply (drule_tac x="n3" in spec)
apply (drule_tac x="n3" in spec)
apply (drule_tac x="n2" in spec)
apply (drule_tac x="n2" in spec)
apply (simp)

by (simp add: min_def)

lemma triangle_inequality_nat:
  "[| (x::'a::rs) ~= y ; y ~= z ; x ~= z |]
   ==> min (distance_nat (x,y)) (distance_nat (y,z)) <= distance_nat (x,z)"
by (simp add: triangle_inequality_nat_lm)

lemma triangle_inequality_neq:
  "[| (x::'a::rs) ~= y ; y ~= z ; x ~= z |]
   ==> distance_rs (x,z) <= max (distance_rs (x,y)) (distance_rs (y,z))"
apply (simp add: distance_iff)
apply (insert triangle_inequality_nat[of x y z], simp)

apply (case_tac "distance_nat (x, y) <= distance_nat (y, z)")
 apply (simp add: min_is)
 apply (subgoal_tac "((1::real) / 2) ^ distance_nat (y, z)
                  <= (1 / 2) ^ distance_nat (x, y)")
 apply (simp add: max_is)
 apply (simp add: power_decreasing)
 apply (simp add: power_decreasing)

 (* ~ distance_nat (x, y) <= distance_nat (y, z) *)
 apply (simp add: min_is)
 apply (subgoal_tac "((1::real) / 2) ^ distance_nat (x, y)
                  <= (1 / 2) ^ distance_nat (y, z)")
 apply (simp add: max_is)
 apply (simp add: power_decreasing)
 apply (simp add: power_decreasing)
done

lemma triangle_inequality_max:
  "distance_rs ((x::'a::rs),z) <= max (distance_rs (x,y)) (distance_rs (y,z))"
apply (case_tac "x = y", simp add: max_is)
apply (case_tac "y = z", simp add: max_is)
apply (case_tac "x = z", simp add: max_def)
by (simp add: triangle_inequality_neq)

(*** triangle_inequality ***)

lemma triangle_inequality_rs:
  "distance_rs ((x::'a::rs),z) <= distance_rs (x,y) + distance_rs (y,z)"

apply (insert triangle_inequality_max[of x z y])
apply (subgoal_tac "max (distance_rs (x, y)) (distance_rs (y, z))
                      <= distance_rs (x, y) + distance_rs (y, z)")
apply (blast intro: order_trans)
by (simp)

(**********************************************************
                 .|. <--> distance_nat
 **********************************************************)

(*---------------------------*
 |  distance_nat satisfies   |
 *---------------------------*)

lemma distance_nat_rest:
  "[| (x::'a::rs) ~= y ; distance_nat (x, y) = n |]
    ==> x .|. n = y .|. n"
apply (simp add: distance_nat_iff)
apply (simp add: isMAX_def)
by (simp add: distance_nat_set_def)

(*---------------------------*
 |    distance_nat is max    |
 *---------------------------*)

lemma distance_nat_rest_Suc:
  "[| (x::'a::rs) ~= y ; distance_nat (x, y) = n |]
    ==> x .|. (Suc n) ~= y .|. (Suc n)"
apply (simp add: distance_nat_iff)
apply (simp add: isMAX_def isUB_def)
apply (simp add: distance_nat_set_def)
apply (case_tac "x .|. Suc n ~=
                 y .|. Suc n", simp)
apply (erule conjE)
apply (drule_tac x="Suc n" in spec)
by (simp)

(*---------------------------*
 |     distance_nat_le       |
 *---------------------------*)

(* 1 only if *)

lemma distance_nat_le_1_only_if:
  "[| (x::'a::rs) ~= y ; x .|. n = y .|. n |] ==> n <= distance_nat (x,y)"
apply (insert distance_nat_is[of x y])
apply (simp add: isMAX_def isUB_def)
apply (erule conjE)
apply (drule_tac x="n" in spec)
apply (drule mp)

apply (simp add: distance_nat_set_def)
by (simp)

(* 1 if *)

lemma distance_nat_le_1_if:
  "[| (x::'a::rs) ~= y ; n <= distance_nat (x,y) |] ==> x .|. n = y .|. n"
apply (insert distance_nat_is[of x y])
apply (simp add: isMAX_def isUB_def)
apply (erule conjE)
apply (simp add: distance_nat_set_def)
apply (rule rest_equal_preserve)
by (simp_all)

(* 1 iff *)

lemma distance_nat_le_1:
  "(x::'a::rs) ~= y ==> (x .|. n = y .|. n) = (n <= distance_nat (x,y))"
apply (rule iffI)
apply (simp add: distance_nat_le_1_only_if)
apply (simp add: distance_nat_le_1_if)
done

(* 2 iff *)

lemma distance_nat_le_2:
  "(x::'a::rs) ~= y
   ==> (x .|. n ~= y .|. n) = (distance_nat (x,y) < n)"
by (auto simp add: distance_nat_le_1)

(*---------------------------*
 |    distance_nat_less      |
 *---------------------------*)

(* 1 only if *)

lemma distance_nat_less_1_only_if:
  "(x::'a::rs) ~= y
   ==> (x::'a::rs) .|. (Suc n) = y .|. (Suc n) ==> n < distance_nat (x,y)"
by (simp add: distance_nat_le_1)

(* 1 if *)

lemma distance_nat_less_1_if:
  "(x::'a::rs) ~= y
   ==> n < distance_nat (x,y) ==> x .|. (Suc n) = y .|. (Suc n)"
apply (insert distance_nat_is[of x y], simp)
apply (simp add: isMAX_def distance_nat_set_def)
apply (rule rest_equal_preserve[of x "distance_nat (x, y)" y "Suc n"])
by (simp_all)

(* 1 iff *)

lemma distance_nat_less_1:
  "(x::'a::rs) ~= y
   ==> (x .|. (Suc n) = y .|. (Suc n)) = (n < distance_nat (x,y)) "
apply (intro allI iffI)
apply (simp add: distance_nat_less_1_only_if)
apply (simp add: distance_nat_less_1_if)
done

(* 2 iff *)

lemma distance_nat_less_2:
  "(x::'a::rs) ~= y
   ==> (x .|. (Suc n) ~= y .|. (Suc n)) = (distance_nat (x,y) <= n)"
by (auto simp add: distance_nat_less_1)

(**********************************************************
                   .|. <--> distance
 **********************************************************)

(*---------------------------*
 |      distance_rs_le       |
 *---------------------------*)

(* 1 only if *)

lemma distance_rs_le_1_only_if:
  "(x::'a::rs) .|. n = y .|. n ==> distance_rs(x,y) <= (1/2)^n"
(*
Isabelle 2007
apply (case_tac "x = y", simp add: zero_le_power)
*)
apply (case_tac "x = y", simp)
apply (simp add: distance_iff)
apply (simp add: distance_nat_le_1)
by (simp add: power_decreasing)

(* 1 if *)

lemma distance_rs_le_1_if:
  "distance_rs((x::'a::rs),y) <= (1/2)^n ==> x .|. n = y .|. n"
apply (case_tac "x = y", simp)
apply (simp add: distance_iff)
apply (simp add: distance_nat_le_1)
apply (rule rev_power_decreasing)
by (simp_all)

(* 1 iff *)

lemma distance_rs_le_1:
  "((x::'a::rs) .|. n = y .|. n) = (distance_rs(x,y) <= (1/2)^n)"
apply (rule iffI)
apply (simp add: distance_rs_le_1_only_if)
apply (simp add: distance_rs_le_1_if)
done

(* 2 iff *)

lemma distance_rs_le_2:
  "((x::'a::rs) .|. n ~= y .|. n) = ((1/2)^n < distance_rs(x,y))"
by (auto simp add: distance_rs_le_1)

(*****************************
       distance_rs_less
 *****************************)

(* 1 only if *)

lemma distance_rs_less_1_only_if:
  "(x::'a::rs) .|. (Suc n) = y .|. (Suc n) ==> distance_rs(x,y) < (1/2)^n"
apply (case_tac "x = y", simp)
apply (simp add: distance_rs_le_1)
apply (subgoal_tac "distance_rs (x, y) < distance_rs (x, y) * 2")
apply (simp)
apply (simp)
by (simp add: diagonal_rs_neq)

(* 1 if *)

lemma distance_rs_less_1_if:
  "distance_rs((x::'a::rs),y) < (1/2)^n ==> x .|. (Suc n) = y .|. (Suc n)"
apply (case_tac "x = y", simp)
apply (simp add: distance_iff)
apply (simp add: distance_nat_less_1)
apply (rule rev_power_decreasing_strict)
by (simp_all)

(* 1 iff *)

lemma distance_rs_less_1:
  "((x::'a::rs) .|. (Suc n) = y .|. (Suc n)) = (distance_rs(x,y) < (1/2)^n)"
apply (intro allI iffI)
apply (simp add: distance_rs_less_1_only_if)
apply (simp add: distance_rs_less_1_if)
done

(* 2 iff *)

lemma distance_rs_less_2:
  "((x::'a::rs) .|. (Suc n) ~= y .|. (Suc n)) = ((1/2)^n <= distance_rs(x,y))"
by (auto simp add: distance_rs_less_1)

(*********************************************************************
                   for constructiveness of prefix
 *********************************************************************)

lemma contra_diff_rs_Suc:
      "[| ALL n. (x::'a::rs) .|. (Suc n) = y .|. (Suc n) |] ==> (x = y)"
apply (erule contrapos_pp)
apply (simp)
apply (insert diff_rs)
apply (drule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
apply (simp)
apply (erule exE)
apply (rule_tac x="n" in exI)

apply (rule rest_nonequal_preserve)
by (auto)

(*---------------------------*
 |    for contractiveness    |
 *---------------------------*)

lemma rest_Suc_dist_half:
  "[| ALL n. ((x1::'a::rs) .|. n = x2 .|. n) =
             ((y1::'a::rs) .|. (Suc n) = y2 .|. (Suc n)) |]
   ==> (1/2) * distance_rs(x1,x2) = distance_rs(y1,y2)"

apply (case_tac "x1 = x2")
 apply (simp)
 apply (subgoal_tac "y1 = y2")  (* ...1 *)
 apply (simp)

 (* 1 *)
 apply (rule contra_diff_rs_Suc, simp)

 (* x1 ~= x2 *)
  apply (case_tac "y1 = y2", simp)
  apply (rotate_tac 1)
  apply (erule contrapos_np)
  apply (rule contra_diff_rs, simp)

 (* x1 ~= x2 & y1 ~= y2 *)
 apply (simp add: distance_iff)

 apply (subgoal_tac
        "distance_nat (y1, y2) = Suc (distance_nat (x1, x2))") (* ... 2 *)
 apply (simp)
 apply (rule order_antisym)

  (* <= *)
  apply (insert nat_zero_or_Suc)
  apply (rotate_tac -1)
  apply (drule_tac x="distance_nat (y1, y2)" in spec)
  apply (erule disjE, simp)
  apply (erule exE, simp)

  apply (simp add: distance_nat_le_1)

  (* => *)
  apply (simp add: distance_nat_le_1)
  apply (drule_tac x="distance_nat (x1, x2)" in spec)
  apply (simp)
done

(*********************************************************************
                  rest_to_dist_pair (fun and pair)
 *********************************************************************)

lemma rest_to_dist_pair:
  "[| xps ~= {} ;
      (ALL n. (ALL x:(xps::(('a::rs) * ('a::rs)) set).
      (fst x) .|. n = (snd x) .|. n) --> ((y1::'b::rs) .|. n = y2 .|. n)) |]
   ==> (EX x. x:xps & distance_rs(y1,y2) <= distance_rs((fst x), (snd x)))"
apply (case_tac "y1 = y2", force)
      (* y1 ~= y2 *)
apply (insert distance_nat_is[of y1 y2], simp)

apply (simp add: distance_iff)
apply (drule_tac x="Suc (distance_nat (y1, y2))" in spec)
apply (simp add: distance_nat_rest_Suc)
apply (erule bexE)
apply (rule_tac x="fst x" in exI)
apply (rule_tac x="snd x" in exI)
apply (simp add: distance_rs_less_2)
done

(*** two sets (e.g. for domT and domF) ***)

lemma rest_to_dist_pair_two:
  "[| xps ~= {} ; yps ~= {} ;
      (ALL n.
       (ALL x:(xps::(('a::rs) * ('a::rs)) set). (fst x) .|. n = (snd x) .|. n) &
       (ALL y:(yps::(('b::rs) * ('b::rs)) set). (fst y) .|. n = (snd y) .|. n)
       --> ((z1::'c::rs) .|. n = z2 .|. n)) |]
   ==> (EX x. x:xps & distance_rs(z1,z2) <= distance_rs((fst x), (snd x))) |
       (EX y. y:yps & distance_rs(z1,z2) <= distance_rs((fst y), (snd y)))"
apply (case_tac "z1 = z2", force)
      (* z1 ~= z2 *)
apply (insert distance_nat_is[of z1 z2], simp)

apply (simp add: distance_iff)
apply (drule_tac x="Suc (distance_nat (z1, z2))" in spec)
apply (simp add: distance_nat_rest_Suc)
apply (elim bexE disjE)

 apply (rule disjI1)
 apply (rule_tac x="fst x" in exI)
 apply (rule_tac x="snd x" in exI)
 apply (simp add: distance_rs_less_2)

 apply (rule disjI2)
 apply (rule_tac x="fst y" in exI)
 apply (rule_tac x="snd y" in exI)
 apply (simp add: distance_rs_less_2)
done

(************************************************************
           .|. <--> distance lemma (different types)
 ************************************************************)

(*** subset ***)

lemma rest_distance_subset:
  "[| ALL n. ((x::'a::rs) .|. n = y .|. n) --> ((X::'b::rs) .|. n = Y .|. n) |]
   ==> distance_rs(X, Y) <= distance_rs(x, y)"
apply (case_tac "X = Y", simp)
apply (case_tac "x = y", simp)
apply (insert contra_diff_rs[of X Y], simp)  (* contradiction *)

      (* x ~= y & X ~= Y *)
apply (simp add: distance_rs_le_1)
apply (simp add: distance_iff)
done

(*** eq ***)

lemma rest_distance_eq:
  "[| ALL n. ((x::'a::rs) .|. n = y .|. n) = ((X::'b::rs) .|. n = Y .|. n) |]
   ==> distance_rs(x, y) = distance_rs(X, Y)"
apply (rule order_antisym)
by (simp_all add: rest_distance_subset)

(*----------------------------------------------------------*
 |                                                          |
 |                  distance = distance_rs                   |
 |                                                          |
 *----------------------------------------------------------*)

(*********************************************************************
                             Limit (ms_rs)
 *********************************************************************)

(*---------------------------*
 |  mini_number_cauchy_rest  |
 *---------------------------*)

lemma mini_number_cauchy_rest:
  "[| ALL (xy::('a::ms_rs * 'a::ms_rs)). distance xy = distance_rs xy ;
      normal (xs::'a::ms_rs infinite_seq) |]
   ==> (ALL n m. k <= n & k <= m --> (xs n) .|. k = (xs m) .|. k)"
apply (intro allI impI)
apply (simp add: normal_def)
apply (drule_tac x="n" in spec)
apply (drule_tac x="m" in spec)

apply (simp add: distance_rs_le_1)
apply (subgoal_tac "((1::real) / 2) ^ min n m <= (1 / 2) ^ k")
apply (simp)
by (simp add: power_decreasing)

(*---------------------------*
 |        rest_Limit         |
 *---------------------------*)

lemma rest_Limit:
  "[| ALL (xy::('a::ms_rs * 'a::ms_rs)). distance xy = distance_rs xy ;
      ALL n. y .|. n = (xs n) .|. n |]
   ==> (xs::'a::ms_rs infinite_seq) convergeTo y"
apply (simp add: convergeTo_def)
apply (intro allI impI)

apply (subgoal_tac "EX n. ((1::real) / 2) ^ n < eps")  (* ... 1 *)
apply (erule exE)
apply (rule_tac x="n" in exI)
apply (intro allI impI)
apply (rename_tac eps N n)

apply (drule_tac x="n" in spec)
apply (simp add: distance_rs_le_1)

apply (subgoal_tac "((1::real) / 2) ^ n <= (1 / 2) ^ N")  (* ... 2 *)
apply (simp)

(* 2 *)
apply (simp add: power_decreasing)

(* 1 *)
apply (simp add: pow_convergence)
done

(*----------------------------------------------------------*
 |                                                          |
 |              Metric Fixed point induction                |
 |                                                          |
 |               constructive & continuous                  |
 |                                                          |
 *----------------------------------------------------------*)

definition
  constructive_rs :: "('a::ms_rs => 'b::ms_rs) => bool"
  where
  constructive_rs_def :
     "constructive_rs f ==
        (ALL x y n. x .|. n = y .|. n
                    --> (f x) .|. (Suc n) = (f y) .|. (Suc n))"
definition
  continuous_rs   :: "('a::ms_rs => bool) => bool"
  where
  continuous_rs_def :
     "continuous_rs R ==
          (ALL x. ~ R x --> (EX n. ALL y. y .|. n = x .|. n --> ~ R y))"

(**********************************************************
              Construction --> Contraction
 **********************************************************)

lemma contst_to_contra_alpha:
  "[| ALL (xy::('a::ms_rs * 'a::ms_rs)). distance xy = distance_rs xy ;
      ALL (xy::('b::ms_rs * 'b::ms_rs)). distance xy = distance_rs xy ;
      constructive_rs (f::('a::ms_rs => 'b::ms_rs)) |]
   ==> contraction_alpha f (1/2)"
apply (simp add: contraction_alpha_def map_alpha_def)
apply (intro allI)

apply (case_tac "x=y", simp)
apply (case_tac "f x = f y", simp)

apply (simp add: distance_iff)
apply (simp add: constructive_rs_def)

apply (rotate_tac 1)
apply (drule_tac x="x" in spec)
apply (rotate_tac -1)
apply (drule_tac x="y" in spec)
apply (simp add: distance_nat_le_1)
apply (drule_tac x="distance_nat (x, y)" in spec)
apply (simp)

apply (subgoal_tac
      "((1::real)/2) ^ distance_nat (f x, f y)
    <= ((1::real)/2) ^ (Suc (distance_nat (x, y)))")  (* ... 1 *)
apply (simp)

      (* 1 *)
apply (rule power_decreasing)
by (simp_all)

(*** contractive ***)

lemma contst_to_contra:
  "[| ALL (xy::('a::ms_rs * 'a::ms_rs)). distance xy = distance_rs xy ;
      ALL (xy::('b::ms_rs * 'b::ms_rs)). distance xy = distance_rs xy ;
      constructive_rs (f::('a::ms_rs => 'b::ms_rs)) |]
   ==> contraction f"
apply (simp add: contraction_def)
apply (rule_tac x="1/2" in exI)
apply (simp add: contst_to_contra_alpha)
done

(**********************************************************
              Construction --> Contraction
 **********************************************************)

lemma contra_alpha_to_contst:
  "[| ALL (xy::('a::ms_rs * 'a::ms_rs)). distance xy = distance_rs xy ;
      ALL (xy::('b::ms_rs * 'b::ms_rs)). distance xy = distance_rs xy ;
     contraction_alpha (f::('a::ms_rs => 'b::ms_rs)) (1/2) |]
   ==> constructive_rs f"
apply (simp add: constructive_rs_def)
apply (intro allI impI)

apply (simp add: contraction_alpha_def map_alpha_def)
apply (rotate_tac 2)
apply (drule_tac x="x" in spec)
apply (rotate_tac -1)
apply (drule_tac x="y" in spec)

by (simp add: distance_rs_le_1)

(*========================================================*
 |            Metric Fixed Point Induction                |
 *========================================================*)

theorem cms_fixpoint_induction:
  "[| ALL (xy::('a::cms_rs * 'a::cms_rs)). distance xy = distance_rs xy ;
      ALL (xy::('b::ms_rs * 'b::ms_rs)). distance xy = distance_rs xy ;
      (R::'a::cms_rs => bool) x ; continuous_rs R ;
      constructive_rs f ; inductivefun R f |]
   ==> f hasUFP & R (UFP f)"
apply (insert Banach_thm[of f x])
apply (simp add: contst_to_contra)
apply (erule conjE)

      (* to use a contradiction *)
apply (case_tac "R (UFP f)", simp)

apply (simp add: continuous_rs_def)
apply (drule_tac x="UFP f" in spec, simp)
apply (erule exE)

apply (simp add: convergeTo_def)
apply (drule_tac x="(1/2)^n" in spec, simp)
apply (elim conjE exE)
apply (drule_tac x="na" in spec, simp)
apply (simp add: distance_rs_less_1[THEN sym])

apply (rotate_tac -2)
apply (drule_tac x="(f ^^ na) x" in spec)      (* isabelle 2009-1 *)
apply (drule mp)
apply (rule rest_equal_preserve_Suc, simp)

by (simp add: inductivefun_all_n)

theorem cms_fixpoint_induction_imp:
  "((ALL (xy::('a::cms_rs * 'a::cms_rs)). distance xy = distance_rs xy) &
    (ALL (xy::('b::ms_rs * 'b::ms_rs)). distance xy = distance_rs xy) &
    (R::'a::cms_rs => bool) x & continuous_rs R &
      constructive_rs f & inductivefun R f)
   --> f hasUFP & R (UFP f)"
by (auto simp add: cms_fixpoint_induction)

theorem cms_fixpoint_induction_R:
  "[| ALL (xy::('a::cms_rs * 'a::cms_rs)). distance xy = distance_rs xy ;
      ALL (xy::('b::ms_rs * 'b::ms_rs)). distance xy = distance_rs xy ;
     (R::'a::cms_rs => bool) x ; continuous_rs R ;
      constructive_rs f ; inductivefun R f |]
   ==> R (UFP f)"
by (simp add: cms_fixpoint_induction)

(*----------------------------------------------------------*
 |                                                          |
 |      !!!     order and restriction space     !!!         |
 |                                                          |
 *----------------------------------------------------------*)

class ms_rs_order0 = ms_rs + order

class ms_rs_order = ms_rs_order0 +
assumes  rs_order_iff:
    "ALL (x::'a::ms_rs_order0) y.
        (ALL n. x .|. n <= y .|. n) = (x <= y)"

(* class ms_rs_order = ms + rs_order *)

class cms_rs_order = cms_rs + ms_rs_order

lemma not_rs_orderI:
 "~ x .|. n <= y .|. n ==> ~ ((x::'a::ms_rs_order) <= y)"
apply (insert rs_order_iff)
apply (drule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
by (auto)

lemma rs_order_if:
 "((x::'a::ms_rs_order) <= y) ==> x .|. n <= y .|. n"
apply (insert rs_order_iff)
apply (drule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
by (auto)

(*----------------------------------------------------------*
 |                                                          |
 |       Fixed point induction for refinement (CMS)         |
 |                                                          |
 *----------------------------------------------------------*)

(************************************************************
             continuity lemma for refinement
 ************************************************************)

lemma continuous_rs_Ref_fun: "continuous_rs (Ref_fun (z::'a::ms_rs_order))"
apply (simp add: continuous_rs_def)
apply (intro allI impI)
apply (simp add: Ref_fun_def)
apply (simp)
apply (subgoal_tac "~ (ALL n. z .|. n <= x .|. n)")
apply (simp)
apply (elim conjE exE)
apply (rule_tac x="n" in exI)
apply (intro allI impI)
apply (rotate_tac -1)
apply (drule sym)
apply (rule not_rs_orderI)
apply (simp)

apply (simp add: rs_order_iff)
done

(************************************************************
         continuity lemma for (Reverse) refinement
 ************************************************************)

lemma continuous_rs_Rev_fun: "continuous_rs (Rev_fun (z::'a::ms_rs_order))"
apply (simp add: continuous_rs_def)
apply (intro allI impI)
apply (simp add: Rev_fun_def)

apply (subgoal_tac "~ (ALL n. x .|. n <= z .|. n)")
apply (simp)
apply (elim conjE exE)
apply (rule_tac x="n" in exI)
apply (intro allI impI)
apply (rotate_tac -1)
apply (drule sym)
apply (rule not_rs_orderI)
apply (simp)

apply (simp add: rs_order_iff)
done

(************************************************************
          Metric Fixed Point Induction for refinement
 ************************************************************)

theorem cms_fixpoint_induction_ref:
  "[| ALL (xy::('a::cms_rs_order * 'a::cms_rs_order)). distance xy = distance_rs xy ;
      ALL (xy::('b::ms_rs * 'b::ms_rs)). distance xy = distance_rs xy ;
      constructive_rs f ; mono f ; X <= f X ; Y = f Y |]
   ==> (X::'a::cms_rs_order) <= Y"
apply (insert cms_fixpoint_induction_imp[of "Ref_fun X" X f])
 apply (drule mp)
  apply (simp)
  apply (rule conjI)
  apply (blast)
  apply (simp add: continuous_rs_Ref_fun)
  apply (simp add: Ref_fun_def)

      (* inductiveness *)
  apply (simp add: inductivefun_def)
  apply (intro allI impI)
  apply (simp add: mono_def)
  apply (rotate_tac 3)
  apply (drule_tac x="X" in spec)
  apply (rotate_tac -1)
  apply (drule_tac x="x" in spec)
  apply (simp)

apply (insert UFP_is[of f])
apply (simp add: isUFP_def)
apply (simp add: Ref_fun_def)
done

(************************************************************
        Metric Fixed Point Induction for refinement (rev)
 ************************************************************)

theorem cms_fixpoint_induction_rev:
 "[| ALL (xy::('a::cms_rs_order * 'a::cms_rs_order)). distance xy = distance_rs xy ;
     ALL (xy::('b::ms_rs * 'b::ms_rs)). distance xy = distance_rs xy ;
     constructive_rs f ; mono f ; f X <= X ; Y = f Y |]
   ==> (Y::'a::cms_rs_order) <= X"
apply (insert cms_fixpoint_induction_imp[of "Rev_fun X" X f])

 apply (drule mp)
  apply (simp)
  apply (rule conjI)
  apply (blast)
  apply (simp add: continuous_rs_Rev_fun)
  apply (simp add: Rev_fun_def)

      (* inductiveness *)
  apply (simp add: inductivefun_def)
  apply (intro allI impI)
  apply (simp add: mono_def)
  apply (rotate_tac 3)
  apply (drule_tac x="x" in spec)
  apply (drule_tac x="X" in spec)
  apply (drule_tac x="X" in spec)
  apply (simp)

apply (insert UFP_is[of f], simp)
apply (simp add: isUFP_def)
apply (simp add: Rev_fun_def)
done

end


section \<open>Rewriting\<close>

theory Rewriting
  imports Regular_Tree_Relations.Term_Context
    Regular_Tree_Relations.Ground_Terms
    Utils
begin

subsection \<open>Type definitions and rewrite relation definitions\<close>
type_synonym 'f sig = "('f \<times> nat) set"
type_synonym ('f, 'v) rule = "('f, 'v) term \<times> ('f, 'v) term"
type_synonym ('f, 'v) trs  = "('f, 'v) rule set"

definition "sig_step \<F> \<R> = {(s, t). funas_term s \<subseteq> \<F> \<and> funas_term t \<subseteq> \<F> \<and> (s, t) \<in> \<R>}"

inductive_set rstep :: "_ \<Rightarrow> ('f, 'v) term rel" for R :: "('f, 'v) trs"
  where
    rstep: "\<And>C \<sigma> l r. (l, r) \<in> R \<Longrightarrow> s = C\<langle>l \<cdot> \<sigma>\<rangle> \<Longrightarrow> t = C\<langle>r \<cdot> \<sigma>\<rangle> \<Longrightarrow> (s, t) \<in> rstep R"

definition rstep_r_p_s :: "('f, 'v) trs \<Rightarrow> ('f, 'v) rule \<Rightarrow> pos \<Rightarrow> ('f, 'v) subst \<Rightarrow> ('f, 'v) trs" where
  "rstep_r_p_s R r p \<sigma> = {(s, t). p \<in> poss s \<and> p \<in> poss t \<and> r \<in> R \<and> ctxt_at_pos s p = ctxt_at_pos t p \<and>
     s[p \<leftarrow> (fst r \<cdot> \<sigma>)] = s \<and> t[p \<leftarrow> (snd r \<cdot> \<sigma>)] = t}"

text \<open>Rewriting steps below the root position.\<close>
definition nrrstep :: "('f, 'v) trs \<Rightarrow> ('f, 'v) trs" where
  "nrrstep R = {(s,t). \<exists>r i ps \<sigma>. (s,t) \<in> rstep_r_p_s R r (i#ps) \<sigma>}"

text \<open>Rewriting step at the root position.\<close>
definition rrstep :: "('f, 'v) trs \<Rightarrow> ('f, 'v) trs" where
  "rrstep R = {(s,t). \<exists>r \<sigma>. (s,t) \<in> rstep_r_p_s R r [] \<sigma>}"

text \<open>the parallel rewrite relation\<close>
inductive_set par_rstep :: "('f,'v)trs \<Rightarrow> ('f,'v)trs" for R :: "('f,'v)trs"
  where root_step[intro]: "(s,t) \<in> R \<Longrightarrow> (s \<cdot> \<sigma>,t \<cdot> \<sigma>) \<in> par_rstep R"
     |  par_step_fun[intro]: "\<lbrakk>\<And> i. i < length ts \<Longrightarrow> (ss ! i,ts ! i) \<in> par_rstep R\<rbrakk> \<Longrightarrow> length ss = length ts
             \<Longrightarrow> (Fun f ss, Fun f ts) \<in> par_rstep R"
     |  par_step_var[intro]: "(Var x, Var x) \<in> par_rstep R"

subsection \<open>Ground variants connecting to FORT\<close>

definition grrstep :: "('f, 'v) trs \<Rightarrow> 'f gterm rel" where
  "grrstep \<R> = inv_image (rrstep \<R>) term_of_gterm"

definition gnrrstep :: "('f, 'v) trs \<Rightarrow> 'f gterm rel" where
  "gnrrstep \<R> = inv_image (nrrstep \<R>) term_of_gterm"

definition grstep :: "('f, 'v) trs \<Rightarrow> 'f gterm rel" where
  "grstep \<R> = inv_image (rstep \<R>) term_of_gterm"

definition gpar_rstep :: "('f, 'v) trs \<Rightarrow> 'f gterm rel" where
  "gpar_rstep \<R> = inv_image (par_rstep \<R>) term_of_gterm"

text \<open>
  An alternative induction scheme that treats the rule-case, the
  substition-case, and the context-case separately.
\<close>
lemma rstep_induct [consumes 1, case_names rule subst ctxt]:
  assumes "(s, t) \<in> rstep R"
    and rule: "\<And>l r. (l, r) \<in> R \<Longrightarrow> P l r"
    and subst: "\<And>s t \<sigma>. P s t \<Longrightarrow> P (s \<cdot> \<sigma>) (t \<cdot> \<sigma>)"
    and ctxt: "\<And>s t C. P s t \<Longrightarrow> P (C\<langle>s\<rangle>) (C\<langle>t\<rangle>)"
  shows "P s t"
  using assms by (induct) auto

lemmas rstepI = rstep.intros [intro]

lemmas rstepE = rstep.cases [elim]

lemma rstep_ctxt [intro]: "(s, t) \<in> rstep R \<Longrightarrow> (C\<langle>s\<rangle>, C\<langle>t\<rangle>) \<in> rstep R"
  by (force simp flip: ctxt_ctxt_compose)

lemma rstep_rule [intro]: "(l, r) \<in> R \<Longrightarrow> (l, r) \<in> rstep R"
  using rstep.rstep [where C = \<box> and \<sigma> = Var and R = R] by simp

lemma rstep_subst [intro]: "(s, t) \<in> rstep R \<Longrightarrow> (s \<cdot> \<sigma>, t \<cdot> \<sigma>) \<in> rstep R"
  by (force simp flip: subst_subst_compose)

lemma nrrstep_def':
  "nrrstep R = {(s, t). \<exists>l r C \<sigma>. (l, r) \<in> R \<and> C \<noteq> \<box> \<and> s = C\<langle>l\<cdot>\<sigma>\<rangle> \<and> t = C\<langle>r\<cdot>\<sigma>\<rangle>}" (is "?Ls = ?Rs")
proof
  show "?Ls \<subseteq> ?Rs"
  proof (rule subrelI)
    fix s t assume "(s, t) \<in> ?Ls"
    then obtain l r i ps \<sigma> where step: "(s, t) \<in> rstep_r_p_s R (l, r) (i # ps) \<sigma>"
          unfolding nrrstep_def by best
    let ?C = "ctxt_at_pos s (i # ps)"
    from step have"i # ps \<in> poss s" and "(l, r) \<in> R" and "s = ?C\<langle>l\<cdot>\<sigma>\<rangle>" and "t = ?C\<langle>r\<cdot>\<sigma>\<rangle>"
      unfolding rstep_r_p_s_def Let_def by (auto simp flip: replace_term_at_replace_at_conv)
    moreover from \<open>i # ps \<in> poss s\<close> have "?C \<noteq> \<box>" by (induct s) auto
    ultimately show "(s, t) \<in> ?Rs" by auto
  qed
next
  show "?Rs \<subseteq> ?Ls"
  proof (rule subrelI)
    fix s t assume "(s, t) \<in> ?Rs"
    then obtain l r C \<sigma> where in_R: "(l, r) \<in> R" and "C \<noteq> \<box>"
      and s: "s = C\<langle>l\<cdot>\<sigma>\<rangle>" and t: "t = C\<langle>r\<cdot>\<sigma>\<rangle>" by auto
    from \<open>C \<noteq> \<box>\<close> obtain i p where ip: "hole_pos C = i # p" by (induct C) auto
    have "i # p \<in> poss s" unfolding s ip[symmetric] by simp
    then have C: "C = ctxt_at_pos s (i # p) "
      unfolding s ip[symmetric] by simp
    from \<open>i # p \<in> poss s\<close> in_R s t have "(s, t) \<in> rstep_r_p_s R (l, r) (i # p) \<sigma>"
      unfolding rstep_r_p_s_def C[symmetric] ip[symmetric] by simp
    then show "(s, t) \<in> nrrstep R" unfolding nrrstep_def by best
  qed
qed

lemma rrstep_def': "rrstep R = {(s, t). \<exists>l r \<sigma>. (l, r) \<in> R \<and> s = l\<cdot>\<sigma> \<and> t = r\<cdot>\<sigma>}"
  by (auto simp: rrstep_def rstep_r_p_s_def)

lemma rstep_imp_C_s_r:
  assumes "(s,t) \<in> rstep R"
  shows "\<exists>C \<sigma> l r. (l,r) \<in> R \<and> s = C\<langle>l\<cdot>\<sigma>\<rangle> \<and> t = C\<langle>r\<cdot>\<sigma>\<rangle>" using assms
  by (induct) auto

lemma rhs_wf:
  assumes R: "(l, r) \<in> R" and "funas_trs R \<subseteq> F"
  shows "funas_term r \<subseteq> F"
  using assms by (force simp: funas_trs_def)

abbreviation "linear_sys \<R> \<equiv> (\<forall> (l, r) \<in> \<R>. linear_term l \<and> linear_term r)"
abbreviation "const_subt c \<equiv> \<lambda> x. Fun c []"

end


(*
  Author: Jørgen Villadsen, DTU Compute, 2021
*)

theory SeCaV_Demo imports SeCaV begin

section \<open>Example 1\<close>

proposition \<open>p a b \<or> \<not> p a b\<close> by metis

text \<open>
  Predicate numbers
    0 = p
  Function numbers
    0 = a
    1 = b
  \<close>

lemma \<open>\<tturnstile>
  [
    Dis (Pre 0 [Fun 0 [], Fun 1 []]) (Neg (Pre 0 [Fun 0 [], Fun 1 []]))
  ]
  \<close>
proof -
  from AlphaDis have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 0 [], Fun 1 []],
      Neg (Pre 0 [Fun 0 [], Fun 1 []])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

section \<open>Example 2\<close>

proposition \<open>(\<forall>x y. p x y) \<longrightarrow> p a a\<close> by metis

text \<open>
  Predicate numbers
    0 = p
  Function numbers
    0 = a
  \<close>

lemma \<open>\<tturnstile>
  [
    Imp (Uni (Uni (Pre 0 [Var 1, Var 0]))) (Pre 0 [Fun 0 [], Fun 0 []])
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Uni (Uni (Pre 0 [Var 1, Var 0]))),
      Pre 0 [Fun 0 [], Fun 0 []]
    ]
    \<close>
    using that by simp
  with GammaUni[where t=\<open>Fun 0 []\<close>] have ?thesis if \<open>\<tturnstile>
    [
      Neg (Uni (Pre 0 [Fun 0 [], Var 0])),
      Pre 0 [Fun 0 [], Fun 0 []]
    ]
    \<close>
    using that by simp
  with GammaUni have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 [Fun 0 [], Fun 0 []]),
      Pre 0 [Fun 0 [], Fun 0 []]
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 0 [], Fun 0 []],
      Neg (Pre 0 [Fun 0 [], Fun 0 []])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

section \<open>Example 3\<close>

proposition \<open>(\<forall>x. p x \<longrightarrow> q x) \<longrightarrow> (\<exists>x. p x) \<longrightarrow> (\<exists>x. q x)\<close> by metis

text \<open>
  Predicate numbers
    0 = p
    1 = q
  Function numbers
    0 = a
  \<close>

lemma \<open>\<tturnstile>
  [
    Imp (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0]))) (Imp (Exi (Pre 0 [Var 0])) (Exi (Pre 1 [Var 0])))
  ]
  \<close>
proof -
  from AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0]))),
      Imp (Exi (Pre 0 [Var 0])) (Exi (Pre 1 [Var 0]))
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Imp (Exi (Pre 0 [Var 0])) (Exi (Pre 1 [Var 0])),
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0])))
    ]
    \<close>
    using that by simp
  with AlphaImp have ?thesis if \<open>\<tturnstile>
    [
      Neg (Exi (Pre 0 [Var 0])),
      Exi (Pre 1 [Var 0]),
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0])))
    ]
    \<close>
    using that by simp
  with DeltaExi have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 0 [Fun 0 []]),
      Exi (Pre 1 [Var 0]),
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0])))
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Neg (Uni (Imp (Pre 0 [Var 0]) (Pre 1 [Var 0]))),
      Neg (Pre 0 [Fun 0 []]),
      Exi (Pre 1 [Var 0])
    ]
    \<close>
    using that by simp
  with GammaUni have ?thesis if \<open>\<tturnstile>
    [
      Neg (Imp (Pre 0 [Fun 0 []]) (Pre 1 [Fun 0 []])),
      Neg (Pre 0 [Fun 0 []]),
      Exi (Pre 1 [Var 0])
    ]
    \<close>
    using that by simp
  with BetaImp have ?thesis if \<open>\<tturnstile>
    [
      Pre 0 [Fun 0 []],
      Neg (Pre 0 [Fun 0 []]),
      Exi (Pre 1 [Var 0])
    ]
    \<close> and \<open>\<tturnstile>
    [
      Neg (Pre 1 [Fun 0 []]),
      Neg (Pre 0 [Fun 0 []]),
      Exi (Pre 1 [Var 0])
    ]
    \<close>
    using that by simp
  with Basic have ?thesis if \<open>\<tturnstile>
    [
      Neg (Pre 1 [Fun 0 []]),
      Neg (Pre 0 [Fun 0 []]),
      Exi (Pre 1 [Var 0])
    ]
    \<close>
    using that by simp
  with Ext have ?thesis if \<open>\<tturnstile>
    [
      Exi (Pre 1 [Var 0]),
      Neg (Pre 1 [Fun 0 []])
    ]
    \<close>
    using that by simp
  with GammaExi have ?thesis if \<open>\<tturnstile>
    [
      Pre 1 [Fun 0 []],
      Neg (Pre 1 [Fun 0 []])
    ]
    \<close>
    using that by simp
  with Basic show ?thesis
    by simp
qed

end

(*

# "Example 1"

Dis p[a, b] (Neg p[a, b])

AlphaDis
  p[a, b]
  Neg p[a, b]
Basic

# "Example 2"

Imp (Uni (Uni (p[1, 0]))) p[a, a]

AlphaImp
  Neg (Uni (Uni p[1, 0]))
  p[a, a]
GammaUni[a]
  Neg (Uni p[a, 0])
  p[a, a]
GammaUni
  Neg p[a, a]
  p[a, a]
Ext
  p[a, a]
  Neg p[a, a]
Basic

# "Example 3"

Imp (Uni (Imp p[0] q[0])) (Imp (Exi p[0]) (Exi q[0]))

AlphaImp
  Neg (Uni (Imp p[0] q[0]))
  Imp (Exi p[0]) (Exi q[0])
Ext
  Imp (Exi p[0]) (Exi q[0])
  Neg (Uni (Imp p[0] q[0]))
AlphaImp
  Neg (Exi p[0])
  Exi q[0]
  Neg (Uni (Imp p[0] q[0]))
DeltaExi
  Neg p[a]
  Exi q[0]
  Neg (Uni (Imp p[0] q[0]))
Ext
  Neg (Uni (Imp p[0] q[0]))
  Neg p[a]
  Exi q[0]
GammaUni
  Neg (Imp p[a] q[a])
  Neg p[a]
  Exi q[0]
BetaImp
  p[a]
  Neg p[a]
  Exi q[0]
+
  Neg q[a]
  Neg p[a]
  Exi q[0]
Basic
  Neg q[a]
  Neg p[a]
  Exi q[0]
Ext
  Exi q[0]
  Neg q[a]
GammaExi
  q[a]
  Neg q[a]
Basic

*)


(*  Title:      perfect/HMLSL_Perfect.thy
    Author:     Sven Linker

Defines HMLSL with perfect sensors for cars. Cars can perceive both
the physical size and braking distance of all other cars.
*)

section\<open>HMLSL for Perfect Sensors\<close>
text \<open>
Within this section, we instantiate HMLSL for cars with
perfect sensors.
\<close>

theory HMLSL_Perfect
  imports "../HMLSL" "Perfect_Sensors"
begin

locale hmlsl_perfect = perfect_sensors + restriction
begin

interpretation hmlsl : hmlsl "perfect :: cars \<Rightarrow> traffic \<Rightarrow> cars \<Rightarrow> real"
proof unfold_locales

  fix e ts c
  show " 0 < perfect e ts c"
    by (metis less_add_same_cancel2 less_trans perfect_def traffic.psGeZero
        traffic.sdGeZero)
qed

notation hmlsl.re ("re'(_')")
notation hmlsl.cl("cl'(_')")
notation hmlsl.len ("len")

text \<open>
 The spatial atoms are independent of the perspective of the view.
Hence we can prove several lemmas on the relation between the hybrid modality
and the spatial atoms.
\<close>

lemma at_res1:"\<Turnstile>(re(c)) \<^bold>\<rightarrow> (\<^bold>\<forall>d. \<^bold>@d re(c))"
  by (metis (no_types, lifting) perfect_sensors.switch_length_stable
      restriction.switch_restrict_stable view.switch_def)

lemma at_res2:"\<Turnstile>(\<^bold>\<forall>d. \<^bold>@d re(c)) \<^bold>\<rightarrow> re(c)"
  using view.switch_refl by blast

lemma at_res:"\<Turnstile>re(c) \<^bold>\<leftrightarrow> (\<^bold>\<forall>d. \<^bold>@d re(c))"
  using at_res1 at_res2 by blast

lemma at_res_inst:"\<Turnstile> (\<^bold>@d re(c)) \<^bold>\<rightarrow>re(c)"
proof (rule allI|rule impI)+
  fix ts v
  assume assm:"ts,v \<Turnstile>( \<^bold>@d re(c))"
  obtain v' where v'_def:"(v=(d)> v') "
    using view.switch_always_exists by blast
  with assm have v':"ts,v' \<Turnstile> re(c)" by blast
  with v' show "ts,v \<Turnstile>re(c)"
    using restriction.switch_restrict_stable perfect_sensors.switch_length_stable v'_def
      view.switch_def
    by (metis (no_types, lifting) all_own_ext_eq_len_eq)
qed

lemma at_clm1:"\<Turnstile>cl(c) \<^bold>\<rightarrow> (\<^bold>\<forall>d. \<^bold>@d cl(c))"
  by (metis (no_types, lifting)  all_own_ext_eq_len_eq view.switch_def
      restriction.switch_restrict_stable)

lemma at_clm2:"\<Turnstile>(\<^bold>\<forall>d. \<^bold>@d cl(c)) \<^bold>\<rightarrow> cl(c)"
  using view.switch_def by auto

lemma at_clm:"\<Turnstile>cl(c) \<^bold>\<leftrightarrow> (\<^bold>\<forall>d. \<^bold>@d cl(c))"
  using at_clm1 at_clm2 by blast

lemma at_clm_inst:"\<Turnstile> (\<^bold>@d cl(c)) \<^bold>\<rightarrow>cl(c)"
proof (rule allI|rule impI)+
  fix ts v
  assume assm:"ts,v \<Turnstile>( \<^bold>@d cl(c))"
  obtain v' where v'_def:"(v=(d)> v') "
    using view.switch_always_exists by blast
  with assm have v':"ts,v' \<Turnstile> cl(c)" by blast
  with v' show "ts,v \<Turnstile>cl(c)"
    using restriction.switch_restrict_stable switch_length_stable v'_def view.switch_def
    by (metis (no_types, lifting) all_own_ext_eq_len_eq)
qed

text\<open>
With the definition of sensors, we can also express how the spatial situation
changes after the different transitions. In particular, we can prove
lemmas corresponding to the activity and stability rules of the
proof system for MLSL \cite{Linker2015a}.

Observe that we were not able to prove these rules for basic HMLSL, since
its generic sensor function allows for instantiations where the perceived length changes
during spatial transitions.
\<close>

lemma backwards_res_act:
  "(ts \<^bold>\<midarrow>r(c) \<^bold>\<rightarrow> ts') \<and> (ts',v \<Turnstile> re(c)) \<longrightarrow> (ts,v \<Turnstile> re(c) \<^bold>\<or> cl(c))"
proof
  assume assm:"(ts \<^bold>\<midarrow>r(c) \<^bold>\<rightarrow> ts') \<and> (ts',v \<Turnstile> re(c))"
  from assm have len_eq:"len v ts c = len v ts' c"
    using create_reservation_length_stable by blast
  have "res ts c \<sqsubseteq> res ts' c" using assm traffic.create_res_subseteq1 by blast
  hence restr_subs_res:"restrict v (res ts) c \<sqsubseteq> restrict v (res ts') c"
    by (simp add: restriction.restrict_view assm)
  have "clm ts c \<sqsubseteq> res ts' c" using assm traffic.create_res_subseteq2 by blast
  hence restr_subs_clm:"restrict v (clm ts) c \<sqsubseteq> restrict v (res ts') c"
    by (simp add: restriction.restrict_view assm)
  have "restrict v (res ts) c = \<emptyset> \<or> restrict v (res ts) c \<noteq> \<emptyset>" by simp
  then show " ts,v \<Turnstile> (re(c) \<^bold>\<or> cl(c))"
  proof
    assume restr_res_nonempty:"restrict v (res ts) c \<noteq> \<emptyset>"
    hence restrict_one:"|restrict v (res ts) c | = 1"
      using nat_int.card_non_empty_geq_one nat_int.card_subset_le dual_order.antisym
        restr_subs_res assm by fastforce
    have "restrict v (res ts ) c \<sqsubseteq> lan v"
      using restr_subs_res assm by auto
    hence "restrict v (res ts)c = lan v"
      using restriction.restrict_eq_lan_subs restrict_one assm by auto
    thus " ts,v \<Turnstile> (re(c) \<^bold>\<or> cl(c))"
      using assm len_eq by auto
  next
    assume restr_res_empty:"restrict v (res ts) c = \<emptyset>"
    then have clm_non_empty:" restrict v (clm ts) c \<noteq> \<emptyset>"
      by (metis assm inter_empty2 local.hmlsl.free_no_clm
          restriction.create_reservation_restrict_union restriction.restrict_def'
          un_empty_absorb1)
    hence restrict_one:"|restrict v (clm ts) c | = 1"
      using nat_int.card_non_empty_geq_one nat_int.card_subset_le dual_order.antisym
        restr_subs_clm assm by fastforce
    have "restrict v (clm ts ) c \<sqsubseteq> lan v"
      using restr_subs_clm assm by auto
    hence "restrict v (clm ts)c = lan v"
      using restriction.restrict_eq_lan_subs restrict_one assm by auto
    thus " ts,v \<Turnstile> (re(c) \<^bold>\<or> cl(c))"
      using assm len_eq by auto
  qed
qed

lemma backwards_res_act_somewhere:
  "(ts \<^bold>\<midarrow>r(c)\<^bold>\<rightarrow> ts') \<and> (ts',v \<Turnstile> \<^bold>\<langle>re(c)\<^bold>\<rangle>) \<longrightarrow> (ts,v \<Turnstile>\<^bold>\<langle> re(c) \<^bold>\<or> cl(c)\<^bold>\<rangle> )"
  using backwards_res_act by blast

lemma backwards_res_stab:
  "(ts \<^bold>\<midarrow>r(d) \<^bold>\<rightarrow> ts') \<and>  (d \<noteq>c) \<and> (ts',v \<Turnstile> re(c)) \<longrightarrow> (ts,v \<Turnstile> re(c))"
  using perfect_sensors.create_reservation_length_stable restriction.restrict_def'
    traffic.create_res_subseteq1_neq
  by auto

text\<open>
We now proceed to prove the \emph{reservation lemma}, which was
crucial in the manual safety proof \cite {Hilscher2011}.
\<close>
lemma reservation1: "\<Turnstile>(re(c) \<^bold>\<or> cl(c)) \<^bold>\<rightarrow> \<^bold>\<box>r(c) re(c)"
proof (rule allI| rule impI)+
  fix ts v ts'
  assume assm:"ts,v \<Turnstile>re(c) \<^bold>\<or> cl(c)" and ts'_def:"ts \<^bold>\<midarrow>r(c)\<^bold>\<rightarrow>ts'"
  from assm show "ts',v \<Turnstile>  re(c)"
  proof
    assume re:"ts,v \<Turnstile>re(c)"
    show ?thesis
      by (metis inf.absorb1 order_trans perfect_sensors.create_reservation_length_stable
          re restriction.restrict_def' restriction.restrict_subseteq
          traffic.create_res_subseteq1 ts'_def)
  next
    assume cl:"ts,v \<Turnstile>cl(c)"
    show ?thesis
      by (metis cl inf.absorb1 order_trans perfect_sensors.create_reservation_length_stable
          restriction.restrict_def' restriction.restrict_subseteq
          traffic.create_res_subseteq2 ts'_def)
  qed
qed

lemma reservation2: "\<Turnstile>(\<^bold>\<box>r(c) re(c)) \<^bold>\<rightarrow> (re(c) \<^bold>\<or> cl(c))"
  using backwards_res_act traffic.always_create_res by blast

lemma reservation:"\<Turnstile>(\<^bold>\<box>r(c) re(c)) \<^bold>\<leftrightarrow> (re(c) \<^bold>\<or> cl(c))"
  using reservation1 reservation2 by blast
end
end


theory Labeled_Hoare
imports
  "../../Case_Labeling"
  "HOL-Hoare.Hoare_Logic"
begin

subsection \<open>A labeling VCG for HOL/Hoare\<close>

context begin
  interpretation Labeling_Syntax .

  lemma LSeqRule:
    assumes "C\<langle>IC,CT,OC1: Valid P c1 Q\<rangle>"
      and "C\<langle>Suc OC1,CT,OC: Valid Q c2 R\<rangle>"
    shows "C\<langle>IC,CT,OC: Valid P (Seq c1 c2) R\<rangle>"
    using assms unfolding LABEL_simps by (rule SeqRule)

  lemma LSkipRule:
    assumes "V\<langle>(''weaken'', IC, []),CT: p \<subseteq> q\<rangle>"
    shows "C\<langle>IC,CT,IC: Valid p SKIP q\<rangle>"
    using assms unfolding LABEL_simps  by (rule SkipRule)

  lemmas LAbortRule = LSkipRule  \<comment> \<open>dummy version\<close>

  lemma LBasicRule:
    assumes "V\<langle>(''basic'', IC, []),CT: p \<subseteq> {s. f s \<in> q}\<rangle>"
    shows "C\<langle>IC,CT,IC: Valid p (Basic f) q\<rangle>"
    using assms unfolding LABEL_simps  by (rule BasicRule)

  lemma LCondRule:
    fixes IC CT defines "CT' \<equiv> (''cond'', IC, []) # CT "
    assumes "V\<langle>(''vc'', IC, []),(''cond'', IC, []) # CT: p \<subseteq> {s. (s \<in> b \<longrightarrow> s \<in> w) \<and> (s \<notin> b \<longrightarrow> s \<in> w')}\<rangle>"
      and "C\<langle>Suc IC,(''then'', IC, []) # (''cond'', IC, []) # CT,OC1: Valid w c1 q\<rangle>"
      and "C\<langle>Suc OC1,(''else'', Suc OC1, []) # (''cond'', IC, []) # CT,OC: Valid w' c2 q\<rangle>"
    shows "C\<langle>IC,CT,OC: Valid p (Cond b c1 c2) q\<rangle>"
    using assms(2-) unfolding LABEL_simps by (rule CondRule)

  lemma LWhileRule:
    fixes IC CT defines "CT' \<equiv> (''while'', IC, []) # CT"
    assumes "V\<langle>(''precondition'', IC, []),(''while'', IC, []) # CT: p \<subseteq> i\<rangle>"
      and "C\<langle>Suc IC,(''invariant'', Suc IC, []) # (''while'', IC, []) # CT,OC: Valid (i \<inter> b) c i\<rangle>"
      and "V\<langle>(''postcondition'', IC, []),(''while'', IC, []) # CT: i \<inter> - b \<subseteq> q\<rangle>"
    shows "C\<langle>IC,CT,OC: Valid p (While b i v c) q\<rangle>"
    using assms(2-) unfolding LABEL_simps  by (rule WhileRule)

  lemma LABELs_to_prems:
    "(C\<langle>IC, CT, OC: True\<rangle> \<Longrightarrow> P) \<Longrightarrow> C\<langle>IC, CT, OC: P\<rangle>"
    "(V\<langle>x, ct: True\<rangle> \<Longrightarrow> P) \<Longrightarrow> V\<langle>x, ct: P\<rangle>"
    unfolding LABEL_simps by simp_all

  lemma LABELs_to_concl:
    "C\<langle>IC, CT, OC: True\<rangle> \<Longrightarrow> C\<langle>IC, CT, OC: P\<rangle> \<Longrightarrow> P"
    "V\<langle>x, ct: True\<rangle> \<Longrightarrow> V\<langle>x, ct: P\<rangle> \<Longrightarrow> P"
    unfolding LABEL_simps .

end

ML_file \<open>labeled_hoare_tac.ML\<close>

method_setup labeled_vcg = \<open>
  Scan.succeed (fn ctxt => SIMPLE_METHOD' (Labeled_Hoare.hoare_tac ctxt (K all_tac)))\<close>
  "verification condition generator"

method_setup labeled_vcg_simp = \<open>
  Scan.succeed (fn ctxt => SIMPLE_METHOD' (Labeled_Hoare.hoare_tac ctxt (asm_full_simp_tac ctxt)))\<close>
  "verification condition generator"

method_setup casified_vcg = \<open>
  Scan.lift (Casify.casify_options casify_defs) >>
    (fn opt => fn ctxt => Util.SIMPLE_METHOD_CASES (
      HEADGOAL (Labeled_Hoare.hoare_tac ctxt (K all_tac))
      THEN_CONTEXT Casify.casify_tac opt))
\<close>

method_setup casified_vcg_simp = \<open>
  Scan.lift (Casify.casify_options casify_defs) >>
    (fn opt => fn ctxt => Util.SIMPLE_METHOD_CASES (
      HEADGOAL (Labeled_Hoare.hoare_tac ctxt (asm_full_simp_tac ctxt))
      THEN_CONTEXT Casify.casify_tac opt))
\<close>

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
section \<open>Typed Binary Relations\<close>
theory TBinary_Relations
  imports
    HOL_Basics.Restricted_Equality
    HOTG.Axioms
    Soft_Types.Soft_Types_HOL
begin

overloading
  eq_restrict_set \<equiv> "eq_restrict :: set \<Rightarrow> set \<Rightarrow> set \<Rightarrow> bool"
  eq_restrict_type \<equiv> "eq_restrict :: 'a type \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
begin
  definition "eq_restrict_set (A :: set) \<equiv> ((=\<^bsub>mem_of A\<^esub>) :: set \<Rightarrow> _)"
  definition "eq_restrict_type (T :: 'a type) \<equiv> ((=\<^bsub>type_pred T\<^esub>) :: 'a \<Rightarrow> _)"
end

lemma eq_restrict_set_eq_eq_restrict_pred [simp]:
  "(eq_restrict :: set \<Rightarrow> set \<Rightarrow> set \<Rightarrow> bool) A = (=\<^bsub>mem_of A\<^esub>)"
  unfolding eq_restrict_set_def by simp

lemma eq_restrict_set_iff_eq_restrict_pred [iff]:
  "(eq_restrict :: set \<Rightarrow> set \<Rightarrow> set \<Rightarrow> bool) A x y \<longleftrightarrow> x =\<^bsub>mem_of A\<^esub> y"
  by simp

lemma eq_restrict_type_eq_eq_restrict_pred [simp]:
  "(eq_restrict :: 'a type \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool) T = (=\<^bsub>type_pred T\<^esub>)"
  unfolding eq_restrict_type_def by simp

lemma eq_restrict_type_iff_eq_restrict_pred [iff]:
  "(eq_restrict :: 'a type \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool) T x y \<longleftrightarrow> x =\<^bsub>type_pred T\<^esub> y"
  by simp

end