(*  Title:      HOL/ex/While_Combinator_Example.thy
    Author:     Tobias Nipkow
    Copyright   2000 TU Muenchen
*)

section {* An application of the While combinator *}

theory While_Combinator_Example
imports "~~/src/HOL/Library/While_Combinator"
begin

text {* Computation of the @{term lfp} on finite sets via
  iteration. *}

theorem lfp_conv_while:
  "[| mono f; finite U; f U = U |] ==>
    lfp f = fst (while (\<lambda>(A, fA). A \<noteq> fA) (\<lambda>(A, fA). (fA, f fA)) ({}, f {}))"
apply (rule_tac P = "\<lambda>(A, B). (A \<subseteq> U \<and> B = f A \<and> A \<subseteq> B \<and> B \<subseteq> lfp f)" and
                r = "((Pow U \<times> UNIV) \<times> (Pow U \<times> UNIV)) \<inter>
                     inv_image finite_psubset (op - U o fst)" in while_rule)
   apply (subst lfp_unfold)
    apply assumption
   apply (simp add: monoD)
  apply (subst lfp_unfold)
   apply assumption
  apply clarsimp
  apply (blast dest: monoD)
 apply (fastforce intro!: lfp_lowerbound)
 apply (blast intro: wf_finite_psubset Int_lower2 [THEN [2] wf_subset])
apply (clarsimp simp add: finite_psubset_def order_less_le)
apply (blast dest: monoD)
done

subsection {* Example *}

text{* Cannot use @{thm[source]set_eq_subset} because it leads to
looping because the antisymmetry simproc turns the subset relationship
back into equality. *}

theorem "P (lfp (\<lambda>N::int set. {0} \<union> {(n + 2) mod 6 | n. n \<in> N})) =
  P {0, 4, 2}"
proof -
  have seteq: "!!A B. (A = B) = ((!a : A. a:B) & (!b:B. b:A))"
    by blast
  have aux: "!!f A B. {f n | n. A n \<or> B n} = {f n | n. A n} \<union> {f n | n. B n}"
    apply blast
    done
  show ?thesis
    apply (subst lfp_conv_while [where ?U = "{0, 1, 2, 3, 4, 5}"])
       apply (rule monoI)
      apply blast
     apply simp
    apply (simp add: aux set_eq_subset)
    txt {* The fixpoint computation is performed purely by rewriting: *}
    apply (simp add: while_unfold aux seteq del: subset_empty)
    done
qed

end


(*  Title:      HOL/ex/Adhoc_Overloading_Examples.thy
    Author:     Christian Sternagel
*)

section \<open>Ad Hoc Overloading\<close>

theory Adhoc_Overloading_Examples
imports
  Main
  "~~/src/HOL/Library/Infinite_Set"
  "~~/src/Tools/Adhoc_Overloading"
begin

text \<open>Adhoc overloading allows to overload a constant depending on
its type. Typically this involves to introduce an uninterpreted
constant (used for input and output) and then add some variants (used
internally).\<close>

subsection \<open>Plain Ad Hoc Overloading\<close>

text \<open>Consider the type of first-order terms.\<close>
datatype ('a, 'b) "term" =
  Var 'b |
  Fun 'a "('a, 'b) term list"

text \<open>The set of variables of a term might be computed as follows.\<close>
fun term_vars :: "('a, 'b) term \<Rightarrow> 'b set" where
  "term_vars (Var x) = {x}" |
  "term_vars (Fun f ts) = \<Union>set (map term_vars ts)"

text \<open>However, also for \emph{rules} (i.e., pairs of terms) and term
rewrite systems (i.e., sets of rules), the set of variables makes
sense. Thus we introduce an unspecified constant \<open>vars\<close>.\<close>

consts vars :: "'a \<Rightarrow> 'b set"

text \<open>Which is then overloaded with variants for terms, rules, and TRSs.\<close>
adhoc_overloading
  vars term_vars

value "vars (Fun ''f'' [Var 0, Var 1])"

fun rule_vars :: "('a, 'b) term \<times> ('a, 'b) term \<Rightarrow> 'b set" where
  "rule_vars (l, r) = vars l \<union> vars r"

adhoc_overloading
  vars rule_vars

value "vars (Var 1, Var 0)"

definition trs_vars :: "(('a, 'b) term \<times> ('a, 'b) term) set \<Rightarrow> 'b set" where
  "trs_vars R = \<Union>(rule_vars ` R)"

adhoc_overloading
  vars trs_vars

value "vars {(Var 1, Var 0)}"

text \<open>Sometimes it is necessary to add explicit type constraints
before a variant can be determined.\<close>
(*value "vars R" (*has multiple instances*)*)
value "vars (R :: (('a, 'b) term \<times> ('a, 'b) term) set)"

text \<open>It is also possible to remove variants.\<close>
no_adhoc_overloading
  vars term_vars rule_vars

(*value "vars (Var 1)" (*does not have an instance*)*)

text \<open>As stated earlier, the overloaded constant is only used for
input and output. Internally, always a variant is used, as can be
observed by the configuration option \<open>show_variants\<close>.\<close>

adhoc_overloading
  vars term_vars

declare [[show_variants]]

term "vars (Var 1)" (*which yields: "term_vars (Var 1)"*)

subsection \<open>Adhoc Overloading inside Locales\<close>

text \<open>As example we use permutations that are parametrized over an
atom type @{typ "'a"}.\<close>

definition perms :: "('a \<Rightarrow> 'a) set" where
  "perms = {f. bij f \<and> finite {x. f x \<noteq> x}}"

typedef 'a perm = "perms :: ('a \<Rightarrow> 'a) set"
  by standard (auto simp: perms_def)

text \<open>First we need some auxiliary lemmas.\<close>
lemma permsI [Pure.intro]:
  assumes "bij f" and "MOST x. f x = x"
  shows "f \<in> perms"
  using assms by (auto simp: perms_def) (metis MOST_iff_finiteNeg)

lemma perms_imp_bij:
  "f \<in> perms \<Longrightarrow> bij f"
  by (simp add: perms_def)

lemma perms_imp_MOST_eq:
  "f \<in> perms \<Longrightarrow> MOST x. f x = x"
  by (simp add: perms_def) (metis MOST_iff_finiteNeg)

lemma id_perms [simp]:
  "id \<in> perms"
  "(\<lambda>x. x) \<in> perms"
  by (auto simp: perms_def bij_def)

lemma perms_comp [simp]:
  assumes f: "f \<in> perms" and g: "g \<in> perms"
  shows "(f \<circ> g) \<in> perms"
  apply (intro permsI bij_comp)
  apply (rule perms_imp_bij [OF g])
  apply (rule perms_imp_bij [OF f])
  apply (rule MOST_rev_mp [OF perms_imp_MOST_eq [OF g]])
  apply (rule MOST_rev_mp [OF perms_imp_MOST_eq [OF f]])
  by simp

lemma perms_inv:
  assumes f: "f \<in> perms"
  shows "inv f \<in> perms"
  apply (rule permsI)
  apply (rule bij_imp_bij_inv)
  apply (rule perms_imp_bij [OF f])
  apply (rule MOST_mono [OF perms_imp_MOST_eq [OF f]])
  apply (erule subst, rule inv_f_f)
  apply (rule bij_is_inj [OF perms_imp_bij [OF f]])
  done

lemma bij_Rep_perm: "bij (Rep_perm p)"
  using Rep_perm [of p] unfolding perms_def by simp

instantiation perm :: (type) group_add
begin

definition "0 = Abs_perm id"
definition "- p = Abs_perm (inv (Rep_perm p))"
definition "p + q = Abs_perm (Rep_perm p \<circ> Rep_perm q)"
definition "(p1::'a perm) - p2 = p1 + - p2"

lemma Rep_perm_0: "Rep_perm 0 = id"
  unfolding zero_perm_def by (simp add: Abs_perm_inverse)

lemma Rep_perm_add:
  "Rep_perm (p1 + p2) = Rep_perm p1 \<circ> Rep_perm p2"
  unfolding plus_perm_def by (simp add: Abs_perm_inverse Rep_perm)

lemma Rep_perm_uminus:
  "Rep_perm (- p) = inv (Rep_perm p)"
  unfolding uminus_perm_def by (simp add: Abs_perm_inverse perms_inv Rep_perm)

instance
  apply standard
  unfolding Rep_perm_inject [symmetric]
  unfolding minus_perm_def
  unfolding Rep_perm_add
  unfolding Rep_perm_uminus
  unfolding Rep_perm_0
  apply (simp_all add: o_assoc inv_o_cancel [OF bij_is_inj [OF bij_Rep_perm]])
  done

end

lemmas Rep_perm_simps =
  Rep_perm_0
  Rep_perm_add
  Rep_perm_uminus

section \<open>Permutation Types\<close>

text \<open>We want to be able to apply permutations to arbitrary types. To
this end we introduce a constant \<open>PERMUTE\<close> together with
convenient infix syntax.\<close>

consts PERMUTE :: "'a perm \<Rightarrow> 'b \<Rightarrow> 'b" (infixr "\<bullet>" 75)

text \<open>Then we add a locale for types @{typ 'b} that support
appliciation of permutations.\<close>
locale permute =
  fixes permute :: "'a perm \<Rightarrow> 'b \<Rightarrow> 'b"
  assumes permute_zero [simp]: "permute 0 x = x"
    and permute_plus [simp]: "permute (p + q) x = permute p (permute q x)"
begin

adhoc_overloading
  PERMUTE permute

end

text \<open>Permuting atoms.\<close>
definition permute_atom :: "'a perm \<Rightarrow> 'a \<Rightarrow> 'a" where
  "permute_atom p a = (Rep_perm p) a"

adhoc_overloading
  PERMUTE permute_atom

interpretation atom_permute: permute permute_atom
  by standard (simp_all add: permute_atom_def Rep_perm_simps)

text \<open>Permuting permutations.\<close>
definition permute_perm :: "'a perm \<Rightarrow> 'a perm \<Rightarrow> 'a perm" where
  "permute_perm p q = p + q - p"

adhoc_overloading
  PERMUTE permute_perm

interpretation perm_permute: permute permute_perm
  apply standard
  unfolding permute_perm_def
  apply simp
  apply (simp only: diff_conv_add_uminus minus_add add.assoc)
  done

text \<open>Permuting functions.\<close>
locale fun_permute =
  dom: permute perm1 + ran: permute perm2
  for perm1 :: "'a perm \<Rightarrow> 'b \<Rightarrow> 'b"
  and perm2 :: "'a perm \<Rightarrow> 'c \<Rightarrow> 'c"
begin

adhoc_overloading
  PERMUTE perm1 perm2

definition permute_fun :: "'a perm \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> ('b \<Rightarrow> 'c)" where
  "permute_fun p f = (\<lambda>x. p \<bullet> (f (-p \<bullet> x)))"

adhoc_overloading
  PERMUTE permute_fun

end

sublocale fun_permute \<subseteq> permute permute_fun
  by (unfold_locales, auto simp: permute_fun_def)
     (metis dom.permute_plus minus_add)

lemma "(Abs_perm id :: nat perm) \<bullet> Suc 0 = Suc 0"
  unfolding permute_atom_def
  by (metis Rep_perm_0 id_apply zero_perm_def)

interpretation atom_fun_permute: fun_permute permute_atom permute_atom
  by (unfold_locales)

adhoc_overloading
  PERMUTE atom_fun_permute.permute_fun

lemma "(Abs_perm id :: 'a perm) \<bullet> id = id"
  unfolding atom_fun_permute.permute_fun_def
  unfolding permute_atom_def
  by (metis Rep_perm_0 id_def inj_imp_inv_eq inj_on_id uminus_perm_def zero_perm_def)

end


theory Debruijn
  imports "../02Typed/Type" "../00Utils/Environment" "../00Utils/Iteration"
begin

datatype dexpr =
  DVar nat
  | DConst nat
  | DLam ty dexpr
  | DApp dexpr dexpr

inductive typecheckd :: "ty list \<Rightarrow> dexpr \<Rightarrow> ty \<Rightarrow> bool" (infix "\<turnstile>\<^sub>d _ :" 50) where
  tcd_var [simp]: "lookup \<Gamma> x = Some t \<Longrightarrow> \<Gamma> \<turnstile>\<^sub>d DVar x : t"
| tcd_const [simp]: "\<Gamma> \<turnstile>\<^sub>d DConst k : Base"
| tcd_lam [simp]: "insert_at 0 t\<^sub>1 \<Gamma> \<turnstile>\<^sub>d e : t\<^sub>2 \<Longrightarrow> \<Gamma> \<turnstile>\<^sub>d DLam t\<^sub>1 e : Arrow t\<^sub>1 t\<^sub>2"
| tcd_app [simp]: "\<Gamma> \<turnstile>\<^sub>d e\<^sub>1 : Arrow t\<^sub>1 t\<^sub>2 \<Longrightarrow> \<Gamma> \<turnstile>\<^sub>d e\<^sub>2 : t\<^sub>1 \<Longrightarrow> \<Gamma> \<turnstile>\<^sub>d DApp e\<^sub>1 e\<^sub>2 : t\<^sub>2"

inductive_cases [elim]: "\<Gamma> \<turnstile>\<^sub>d DVar x : t"
inductive_cases [elim]: "\<Gamma> \<turnstile>\<^sub>d DConst k : t"
inductive_cases [elim]: "\<Gamma> \<turnstile>\<^sub>d DLam t' e : t"
inductive_cases [elim]: "\<Gamma> \<turnstile>\<^sub>d DApp e\<^sub>1 e\<^sub>2 : t"

primrec vald :: "dexpr \<Rightarrow> bool" where
  "vald (DVar x) = False"
| "vald (DConst k) = True"
| "vald (DLam t e) = True"
| "vald (DApp e\<^sub>1 e\<^sub>2) = False"

primrec incrd :: "nat \<Rightarrow> dexpr \<Rightarrow> dexpr" where
  "incrd x (DVar y) = DVar (incr x y)"
| "incrd x (DConst k) = DConst k"
| "incrd x (DLam t e) = DLam t (incrd (Suc x) e)"
| "incrd x (DApp e\<^sub>1 e\<^sub>2) = DApp (incrd x e\<^sub>1) (incrd x e\<^sub>2)"

primrec substd :: "nat \<Rightarrow> dexpr \<Rightarrow> dexpr \<Rightarrow> dexpr" where
  "substd x e' (DVar y) = (if x = y then e' else DVar (decr x y))"
| "substd x e' (DConst k) = DConst k"
| "substd x e' (DLam t e) = DLam t (substd (Suc x) (incrd 0 e') e)"
| "substd x e' (DApp e\<^sub>1 e\<^sub>2) = DApp (substd x e' e\<^sub>1) (substd x e' e\<^sub>2)"

inductive evald :: "dexpr \<Rightarrow> dexpr \<Rightarrow> bool" (infix "\<leadsto>\<^sub>d" 50) where
  evd_app1 [simp]: "e\<^sub>1 \<leadsto>\<^sub>d e\<^sub>1' \<Longrightarrow> DApp e\<^sub>1 e\<^sub>2 \<leadsto>\<^sub>d DApp e\<^sub>1' e\<^sub>2"
| evd_app2 [simp]: "vald e\<^sub>1 \<Longrightarrow> e\<^sub>2 \<leadsto>\<^sub>d e\<^sub>2' \<Longrightarrow> DApp e\<^sub>1 e\<^sub>2 \<leadsto>\<^sub>d DApp e\<^sub>1 e\<^sub>2'"
| evd_app3 [simp]: "vald e\<^sub>2 \<Longrightarrow> DApp (DLam t e\<^sub>1) e\<^sub>2 \<leadsto>\<^sub>d substd 0 e\<^sub>2 e\<^sub>1"

lemma tc_postpend [simp]: "\<Gamma> \<turnstile>\<^sub>d e : t \<Longrightarrow> (\<Gamma> @ \<Gamma>') \<turnstile>\<^sub>d e : t"
  by (induction \<Gamma> e t rule: typecheckd.induct) simp_all

lemma [simp]: "iter (\<leadsto>\<^sub>d) e\<^sub>2 e\<^sub>2' \<Longrightarrow> vald e\<^sub>1 \<Longrightarrow> iter (\<leadsto>\<^sub>d) (DApp e\<^sub>1 e\<^sub>2) (DApp e\<^sub>1 e\<^sub>2')"
proof (induction e\<^sub>2 e\<^sub>2' rule: iter.induct)
  case (iter_step e\<^sub>2 e\<^sub>2' e\<^sub>2'')
  hence "DApp e\<^sub>1 e\<^sub>2 \<leadsto>\<^sub>d DApp e\<^sub>1 e\<^sub>2'" by simp
  moreover from iter_step have "iter (\<leadsto>\<^sub>d) (DApp e\<^sub>1 e\<^sub>2') (DApp e\<^sub>1 e\<^sub>2'')" by simp
  ultimately show ?case by simp
qed simp_all

lemma [simp]: "y \<le> x \<Longrightarrow> incrd y (incrd x e) = incrd (Suc x) (incrd y e)"
  by (induction e arbitrary: x y) simp_all

lemma [simp]: "vald e \<Longrightarrow> vald (incrd x e)"
  by (induction e) simp_all

lemma [simp]: "\<Gamma> \<turnstile>\<^sub>d e : t \<Longrightarrow> x \<ge> length \<Gamma> \<Longrightarrow> incrd x e = e"
proof (induction \<Gamma> e t arbitrary: x rule: typecheckd.induct)
  case (tcd_var \<Gamma> y t)
  moreover hence "y < length \<Gamma>" by simp
  ultimately have "y < x" by linarith
  thus ?case by (simp add: incr_min)
qed simp_all

lemma [simp]: "y \<le> x \<Longrightarrow> incrd y (substd x e' e) = substd (Suc x) (incrd y e') (incrd y e)"
  by (induction e arbitrary: x y e') (simp_all add: incr_le incr_lemma)

lemma [simp]: "substd x e' (incrd x e) = e"
  by (induction e arbitrary: x e') (simp_all, metis incr_not_eq)

lemma [simp]: "substd 0 e' e = DVar x \<Longrightarrow> vald e' \<Longrightarrow> e = DVar (Suc x)"
proof (induction e)
  case (DVar y)
  thus ?case by (induction y) simp_all
qed simp_all

lemma [simp]: "vald (substd 0 e' e) \<Longrightarrow> vald e' \<Longrightarrow> vald e \<or> e = DVar 0"
  by (induction e) (simp_all split: if_splits)

lemma [simp]: "y \<le> x \<Longrightarrow>
  substd x e\<^sub>1 (substd y e\<^sub>2 e) = substd y (substd x e\<^sub>1 e\<^sub>2) (substd (Suc x) (incrd y e\<^sub>1) e)"
proof (induction e arbitrary: x y e\<^sub>1 e\<^sub>2)
  case (DVar z)
  thus ?case
  proof (cases "y = z")
    case False
    with DVar show ?thesis
    proof (cases "x = decr y z")
      case True note TXD = True
      with DVar False show ?thesis
      proof (cases "y = decr y z")
        case True
        with False have "z = Suc y" by simp
        with TXD show ?thesis by auto
      qed simp_all
    qed auto
  qed simp_all
qed simp_all

lemma canonical_based [dest]: "\<Gamma> \<turnstile>\<^sub>d e : Base \<Longrightarrow> vald e \<Longrightarrow> \<exists>k. e = DConst k"
  by (induction \<Gamma> e Base rule: typecheckd.induct) simp_all

lemma canonical_arrowd [dest]: "\<Gamma> \<turnstile>\<^sub>d e : Arrow t\<^sub>1 t\<^sub>2 \<Longrightarrow> vald e \<Longrightarrow>
    \<exists>e'. e = DLam t\<^sub>1 e' \<and> insert_at 0 t\<^sub>1 \<Gamma> \<turnstile>\<^sub>d e' : t\<^sub>2"
  by (induction \<Gamma> e "Arrow t\<^sub>1 t\<^sub>2" rule: typecheckd.induct) simp_all

theorem progressd: "[] \<turnstile>\<^sub>d e : t \<Longrightarrow> vald e \<or> (\<exists>e'. e \<leadsto>\<^sub>d e')"
proof (induction "[] :: ty list" e t rule: typecheckd.induct)
  case (tcd_app e\<^sub>1 t\<^sub>1 t\<^sub>2 e\<^sub>2)
  thus ?case
  proof (cases "vald e\<^sub>1")
    case True note T = True
    thus ?thesis
    proof (cases "vald e\<^sub>2")
      case True
      with tcd_app T show ?thesis by (metis canonical_arrowd evd_app3)
    next
      case False
      with tcd_app T show ?thesis by (metis evd_app2)
    qed
  next
    case False
    with tcd_app show ?thesis by (metis evd_app1)
  qed
qed simp_all

lemma [simp]: "\<Gamma> \<turnstile>\<^sub>d e : t \<Longrightarrow> x \<le> length \<Gamma> \<Longrightarrow> insert_at x t' \<Gamma> \<turnstile>\<^sub>d incrd x e : t"
proof (induction \<Gamma> e t arbitrary: x rule: typecheckd.induct)
  case (tcd_app \<Gamma> e\<^sub>1 t\<^sub>1 t\<^sub>2 e\<^sub>2)
  hence "insert_at x t' \<Gamma> \<turnstile>\<^sub>d (incrd x e\<^sub>1) : Arrow t\<^sub>1 t\<^sub>2" by simp
  moreover from tcd_app have "insert_at x t' \<Gamma> \<turnstile>\<^sub>d (incrd x e\<^sub>2) : t\<^sub>1" by simp
  ultimately show ?case by simp
qed fastforce+

lemma [simp]: "\<Gamma> \<turnstile>\<^sub>d e : t \<Longrightarrow> x \<ge> length \<Gamma> \<Longrightarrow> \<Gamma> \<turnstile>\<^sub>d incrd x e : t"
proof (induction e arbitrary: \<Gamma> x t)
  case (DVar y)
  hence X: "lookup \<Gamma> y = Some t" by fastforce
  hence "y < length \<Gamma>" by simp
  with DVar have "x > y" by simp
  with X have "lookup \<Gamma> (incr x y) = Some t" using incr_min by (simp, linarith)
  then show ?case by simp
qed fastforce+

lemma [simp]: "\<Gamma> \<turnstile>\<^sub>d e : t \<Longrightarrow> x \<ge> length \<Gamma> \<Longrightarrow> substd x e' e = e"
proof (induction \<Gamma> e t arbitrary: x e' rule: typecheckd.induct)
  case (tcd_var \<Gamma> y t)
  hence "y < length \<Gamma>" by simp
  with tcd_var have "y < x" by linarith
  with tcd_var show ?case by auto
qed simp_all

lemma [simp]: "insert_at x t' \<Gamma> \<turnstile>\<^sub>d e : t \<Longrightarrow> x \<le> length \<Gamma> \<Longrightarrow> \<Gamma> \<turnstile>\<^sub>d e' : t' \<Longrightarrow>
  \<Gamma> \<turnstile>\<^sub>d substd x e' e : t"
proof (induction "insert_at x t' \<Gamma>" e t arbitrary: \<Gamma> x e' rule: typecheckd.induct)
  case (tcd_var y t)
  moreover have "x \<le> length \<Gamma> \<Longrightarrow> x \<noteq> y \<Longrightarrow> lookup \<Gamma> (decr x y) = lookup (insert_at x t' \<Gamma>) y"
    by simp
  ultimately show ?case by fastforce
qed fastforce+

theorem preservationd [simp]: "e \<leadsto>\<^sub>d e' \<Longrightarrow> \<Gamma> \<turnstile>\<^sub>d e : t \<Longrightarrow> \<Gamma> \<turnstile>\<^sub>d e' : t"
  by (induction e e' arbitrary: t rule: evald.induct) fastforce+

lemma val_no_evald: "e \<leadsto>\<^sub>d e' \<Longrightarrow> vald e \<Longrightarrow> False"
  by (induction e e' rule: evald.induct) simp_all

theorem determinismd: "e \<leadsto>\<^sub>d e' \<Longrightarrow> e \<leadsto>\<^sub>d e'' \<Longrightarrow> e' = e''"
proof (induction e e' arbitrary: e'' rule: evald.induct)
case (evd_app1 e\<^sub>1 e\<^sub>1' e\<^sub>2)
  from evd_app1(3, 1, 2) show ?case
    by (induction "DApp e\<^sub>1 e\<^sub>2" e'' rule: evald.induct)
       (metis, metis val_no_evald, metis val_no_evald vald.simps(3))
next
  case (evd_app2 e\<^sub>1 e\<^sub>2 e\<^sub>2')
  from evd_app2(4, 1, 2, 3) show ?case
    by (induction "DApp e\<^sub>1 e\<^sub>2" e'' rule: evald.induct)
       (metis val_no_evald, metis, metis val_no_evald)
next
  case (evd_app3 e\<^sub>2 t e\<^sub>1)
  from evd_app3(2, 1) show ?case
    by (induction "DApp (DLam t e\<^sub>1) e\<^sub>2" e'' rule: evald.induct)
       (metis val_no_evald vald.simps(3), metis val_no_evald, metis)
qed

lemma evald_backwards: "iter (\<leadsto>\<^sub>d) e v \<Longrightarrow> vald v \<Longrightarrow> e \<leadsto>\<^sub>d e' \<Longrightarrow> iter (\<leadsto>\<^sub>d) e' v"
  by (induction e v rule: iter.induct) (metis val_no_evald, metis determinismd)

end


(*<*)
(*
   Title:  Theory BitBoolTS.thy
   Author: Maria Spichkova <maria.spichkova at rmit.edu.au>, 2013
*)
(*>*)

header {*  Properties of time-synchronous streams of types bool and bit *}

theory BitBoolTS
imports Main stream
begin

datatype bit = Zero | One

primrec
   negation :: "bit \<Rightarrow> bit"
where
  "negation Zero = One" |
  "negation One = Zero"

lemma ts_bit_stream_One:
  assumes h1:"ts x"
         and h2:"x i \<noteq> [Zero]"
  shows "x i = [One]"
proof -
  from h1 have sg1:"length (x i) = Suc 0"
    by (simp add: ts_def)
  from this and h2 show ?thesis
  proof (cases "x i")
    assume Nil:"x i = []"
    from this and sg1 show ?thesis by simp
  next
  fix a l assume Cons:"x i = a # l"
    from this and sg1 and h2 show ?thesis
    proof (cases "a")
      assume "a = Zero"
      from this and sg1 and h2 and Cons show ?thesis by auto
    next
      assume "a = One"
      from this and sg1 and Cons show ?thesis by auto
    qed
  qed
qed

lemma ts_bit_stream_Zero:
  assumes h1:"ts x"
         and h2:"x i \<noteq> [One]"
  shows "x i = [Zero]"
proof -
  from h1 have sg1:"length (x i) = Suc 0"
    by (simp add: ts_def)
  from this and h2 show ?thesis
  proof (cases "x i")
    assume Nil:"x i = []"
    from this and sg1 show ?thesis by simp
  next
  fix a l assume Cons:"x i = a # l"
    from this and sg1 and h2 show ?thesis
    proof (cases "a")
      assume "a = Zero"
      from this and sg1 and Cons show ?thesis by auto
    next
      assume "a = One"
      from this and sg1 and h2 and Cons show ?thesis by auto
    qed
  qed
qed

lemma ts_bool_True:
  assumes h1:"ts x"
         and h2:"x i \<noteq> [False]"
  shows "x i = [True]"
proof -
  from h1 have sg1:"length (x i) = Suc 0"
    by (simp add: ts_def)
  from this and h2 show ?thesis
  proof (cases "x i")
    assume Nil:"x i = []"
    from this and sg1 show ?thesis by simp
  next
  fix a l assume Cons:"x i = a # l"
    from this and sg1 have "x i = [a]" by simp
    from this and h2 show ?thesis by auto
  qed
qed

lemma ts_bool_True_False:
  fixes x::"bool istream"
  assumes "ts x"
  shows "x i = [True] \<or> x i = [False]"
proof (cases "x i = [True]")
  assume "x i = [True]"
  from this and assms show ?thesis by simp
next
  assume "x i \<noteq> [True]"
  from this and assms show ?thesis by (simp add: ts_bool_False)
qed

end


theory "Coincidence"
imports
  "Lib"
  "Syntax"
  "Denotational_Semantics"
  "Static_Semantics"
  "HOL.Finite_Set"
begin
section \<open>Static Semantics Properties\<close>

subsection Auxiliaries

text \<open>The state interpolating \<open>stateinterpol \<nu> \<omega> S\<close> between \<open>\<nu>\<close> and \<open>\<omega>\<close> that is \<open>\<nu>\<close> on \<open>S\<close> and \<open>\<omega>\<close> elsewhere\<close>

definition stateinterpol:: "state \<Rightarrow> state \<Rightarrow> variable set \<Rightarrow> state"
  where
  "stateinterpol \<nu> \<omega> S = (\<lambda>x. if (x\<in>S) then \<nu>(x) else \<omega>(x))"

definition statediff:: "state \<Rightarrow> state \<Rightarrow> variable set"
  where "statediff \<nu> \<omega> = {x. \<nu>(x)\<noteq>\<omega>(x)}"

lemma nostatediff: "x\<notin>statediff \<nu> \<omega> \<Longrightarrow> \<nu>(x)=\<omega>(x)"
  by (simp add: statediff_def)

lemma stateinterpol_empty: "stateinterpol \<nu> \<omega> {} = \<omega>"
proof
  fix x
  have empty: "\<And>x. \<not>(x\<in>{})" by auto
  show "\<And>x. stateinterpol \<nu> \<omega> {} x = \<omega> x" using empty by (simp add: stateinterpol_def)
qed

lemma stateinterpol_left [simp]: "x\<in>S \<Longrightarrow> (stateinterpol \<nu> \<omega> S)(x)=\<nu>(x)"
  by (simp add: stateinterpol_def)

lemma stateinterpol_right [simp]: "x\<notin>S \<Longrightarrow> (stateinterpol \<nu> \<omega> S)(x)=\<omega>(x)"
  by (simp add: stateinterpol_def)

lemma Vagree_stateinterpol [simp]: "Vagree (stateinterpol \<nu> \<omega> S) \<nu> S"
  and "Vagree (stateinterpol \<nu> \<omega> S) \<omega> (-S)"
  unfolding Vagree_def by auto

lemma Vagree_ror: "Vagree \<nu> \<nu>' (V\<inter>W) \<Longrightarrow> (\<exists>\<omega>. (Vagree \<nu> \<omega> V \<and> Vagree \<omega> \<nu>' W))"
proof -
  assume "Vagree \<nu> \<nu>' (V\<inter>W)"
  hence "\<forall>x. x\<in>V\<inter>W \<longrightarrow> \<nu>(x)=\<nu>'(x)" by (simp add: Vagree_def)
  let ?w="stateinterpol \<nu> \<nu>' V"
  have l: "Vagree \<nu> ?w V" by (simp add: Vagree_def)
  have r: "Vagree ?w \<nu>' W \<and> Vagree ?w \<nu>' W" by (simp add: Vagree_def stateinterpol_def \<open>\<forall>x. x\<in>V\<inter>W \<longrightarrow> \<nu> x = \<nu>' x\<close>)
  have "Vagree \<nu> ?w V \<and> Vagree ?w \<nu>' W" using l and r by blast
  thus ?thesis by auto
qed

text \<open>Remark 8 \<^url>\<open>https://doi.org/10.1007/978-3-319-94205-6_15\<close> about simple properties of projections\<close>

lemma restrictto_extends [simp]: "restrictto X V \<supseteq> X"
  by (auto simp add: restrictto_def)

lemma restrictto_compose [simp]: "restrictto (restrictto X V) W = restrictto X (V\<inter>W)"
proof
  show "restrictto (restrictto X V) W \<subseteq> restrictto X (V\<inter>W)"
    by (auto simp add: restrictto_def Vagree_def)
next
  show "restrictto X (V\<inter>W) \<subseteq> restrictto (restrictto X V) W"
  (*by (smt Vagree_ror mem_Collect_eq restrictto_def subsetI)*)
  proof - (* sledgehammer *)
  obtain rr :: "(variable \<Rightarrow> real) set \<Rightarrow> (variable \<Rightarrow> real) set \<Rightarrow> variable \<Rightarrow> real" where
  "\<forall>x0 x1. (\<exists>v2. v2 \<in> x1 \<and> v2 \<notin> x0) = (rr x0 x1 \<in> x1 \<and> rr x0 x1 \<notin> x0)"
  by moura
  then have f1: "\<forall>F Fa. rr Fa F \<in> F \<and> rr Fa F \<notin> Fa \<or> F \<subseteq> Fa"
  by (meson subsetI)
  obtain rra :: "(variable \<Rightarrow> real) \<Rightarrow> variable set \<Rightarrow> (variable \<Rightarrow> real) set \<Rightarrow> variable \<Rightarrow> real" where
  "\<forall>x0 x1 x2. (\<exists>v3. v3 \<in> x2 \<and> Vagree v3 x0 x1) = (rra x0 x1 x2 \<in> x2 \<and> Vagree (rra x0 x1 x2) x0 x1)"
  by moura
  then have f2: "\<forall>F V f. (f \<notin> {f. \<exists>fa. fa \<in> F \<and> Vagree fa f V} \<or> rra f V F \<in> F \<and> Vagree (rra f V F) f V) \<and> (f \<in> {f. \<exists>fa. fa \<in> F \<and> Vagree fa f V} \<or> (\<forall>fa. fa \<notin> F \<or> \<not> Vagree fa f V))"
  by blast
  moreover
  { assume "\<exists>f. f \<in> X \<and> Vagree f (v4_1 W V (rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)}) (rra (rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)}) (V \<inter> W) X)) V"
    moreover
    { assume "\<exists>f. f \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree f (rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)}) W"
      then have "rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)} \<notin> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)} \<or> rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)} \<in> {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W}"
      by blast
      then have "{f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)} \<subseteq> {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W}"
      using f1 by meson }
    ultimately have "(\<not> Vagree (rra (rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)}) (V \<inter> W) X) (v4_1 W V (rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)}) (rra (rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)}) (V \<inter> W) X)) V \<or> \<not> Vagree (v4_1 W V (rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)}) (rra (rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)}) (V \<inter> W) X)) (rr {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W} {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)}) W) \<or> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)} \<subseteq> {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W}"
    using f2 by meson }
  ultimately have "{f. \<exists>fa. fa \<in> X \<and> Vagree fa f (V \<inter> W)} \<subseteq> {f. \<exists>fa. fa \<in> {f. \<exists>fa. fa \<in> X \<and> Vagree fa f V} \<and> Vagree fa f W}"
  using f1 by (meson Vagree_ror)
  then show ?thesis
  using restrictto_def by presburger
  qed
qed

lemma restrictto_antimon [simp]: "W\<supseteq>V \<Longrightarrow> restrictto X W \<subseteq> restrictto X V"
proof -
  assume "W\<supseteq>V"
  then have "\<exists>U. V=W\<inter>U" by auto
  then obtain U where "V=W\<inter>U" by auto
  hence "restrictto X V = restrictto (restrictto X W) U" by simp
  hence "restrictto X V \<supseteq> restrictto X W" using restrictto_extends by blast
  thus ?thesis by auto
qed

lemma restrictto_empty [simp]: "X\<noteq>{} \<Longrightarrow> restrictto X {} = worlds"
  by (auto simp add: restrictto_def worlds_def)

lemma selectlike_shrinks [simp]: "selectlike X \<nu> V \<subseteq> X"
  by (auto simp add: selectlike_def)

lemma selectlike_compose [simp]: "selectlike (selectlike X \<nu> V) \<nu> W = selectlike X \<nu> (V\<union>W)"
  by (auto simp add: selectlike_def)

lemma selectlike_antimon [simp]: "W\<supseteq>V \<Longrightarrow> selectlike X \<nu> W \<subseteq> selectlike X \<nu> V"
  by (auto simp add: selectlike_def)

lemma selectlike_empty [simp]: "selectlike X \<nu> {} = X"
  by (auto simp add: selectlike_def)

lemma selectlike_self [simp]: "(\<nu> \<in> selectlike X \<nu> V) = (\<nu>\<in>X)"
  by (auto simp add: selectlike_def)

lemma selectlike_complement [simp]: "selectlike (-X) \<nu> V \<subseteq> -selectlike X \<nu> V"
  by (auto simp add: selectlike_def)

lemma selectlike_union: "selectlike (X\<union>Y) \<nu> V = selectlike X \<nu> V \<union> selectlike Y \<nu> V"
  by (auto simp add: selectlike_def)

lemma selectlike_Sup: "selectlike (Sup M) \<nu> V = Sup {selectlike X \<nu> V | X. X\<in>M}"
  using selectlike_def by auto

lemma selectlike_equal_cond: "(selectlike X \<nu> V = selectlike Y \<nu> V) = (\<forall>\<mu>. Uvariation \<mu> \<nu> (-V) \<longrightarrow> (\<mu>\<in>X) = (\<mu>\<in>Y))"
  unfolding selectlike_def using Uvariation_Vagree by auto

lemma selectlike_equal_cocond: "(selectlike X \<nu> (-V) = selectlike Y \<nu> (-V)) = (\<forall>\<mu>. Uvariation \<mu> \<nu> V \<longrightarrow> (\<mu>\<in>X) = (\<mu>\<in>Y))"
  using selectlike_equal_cond[where V=\<open>-V\<close>] by simp

lemma selectlike_equal_cocond_rule: "(\<And>\<mu>. Uvariation \<mu> \<nu> (-V) \<Longrightarrow> (\<mu>\<in>X) = (\<mu>\<in>Y))
  \<Longrightarrow> (selectlike X \<nu> V = selectlike Y \<nu> V)"
  using selectlike_equal_cond[where V=\<open>V\<close>] by simp

lemma selectlike_equal_cocond_corule: "(\<And>\<mu>. Uvariation \<mu> \<nu> V \<Longrightarrow> (\<mu>\<in>X) = (\<mu>\<in>Y))
  \<Longrightarrow> (selectlike X \<nu> (-V) = selectlike Y \<nu> (-V))"
  using selectlike_equal_cond[where V=\<open>-V\<close>] by simp

lemma co_selectlike: "-(selectlike X \<nu> V) = (-X) \<union> {\<omega>. \<not>Vagree \<omega> \<nu> V}"
  unfolding selectlike_def by auto

lemma selectlike_co_selectlike: "selectlike (-(selectlike X \<nu> V)) \<nu> V = selectlike (-X) \<nu> V"
  unfolding selectlike_def by auto

lemma selectlike_Vagree: "Vagree \<nu> \<omega> V \<Longrightarrow> selectlike X \<nu> V = selectlike X \<omega> V"
  using Vagree_def selectlike_def by auto

lemma similar_selectlike_mem: "Vagree \<nu> \<omega> V \<Longrightarrow> (\<nu>\<in>selectlike X \<omega> V) = (\<nu>\<in>X)"
  unfolding selectlike_def using Vagree_sym_rel by blast

(* also see nonBVG_rule *)
lemma BVG_nonelem [simp] :"(x\<notin>BVG \<alpha>) = (\<forall>I \<omega> X. (\<omega> \<in> game_sem I \<alpha> X) = (\<omega> \<in> game_sem I \<alpha> (selectlike X \<omega> {x})))"
  using BVG_elem monotone selectlike_shrinks
  by (metis subset_iff)

text \<open>\<open>statediff\<close> interoperability\<close>

lemma Vagree_statediff [simp]: "Vagree \<omega> \<omega>' S \<Longrightarrow> statediff \<omega> \<omega>' \<subseteq> -S"
  by (auto simp add: Vagree_def statediff_def)

lemma stateinterpol_diff [simp]: "stateinterpol \<nu> \<omega> (statediff \<nu> \<omega>) = \<nu>"
proof
  fix x
  show sp: "(stateinterpol \<nu> \<omega> (statediff \<nu> \<omega>))(x) = \<nu>(x)"
  proof (cases "x\<in>statediff \<nu> \<omega>")
    case True
    then show ?thesis by simp
  next
    case False
    then show ?thesis by (simp add: stateinterpol_def nostatediff)
  qed
qed

lemma stateinterpol_insert: "Vagree (stateinterpol v w S) (stateinterpol v w (insert z S)) (-{z})"
   by (simp add: Vagree_def stateinterpol_def)

lemma stateinterpol_FVT [simp]: "z\<notin>FVT(t) \<Longrightarrow> term_sem I t (stateinterpol \<omega> \<omega>' S) = term_sem I t (stateinterpol \<omega> \<omega>' (insert z S))"
proof -
  assume a: "z\<notin>FVT(t)"
  have fvc: "\<And>v. \<And>w. Vagree v w (-{z}) \<Longrightarrow> (term_sem I t v = term_sem I t w)" using a by (simp add: FVT_def)
  then show "term_sem I t (stateinterpol \<omega> \<omega>' S) = term_sem I t (stateinterpol \<omega> \<omega>' (insert z S))"
    using fvc and stateinterpol_insert by blast
qed

subsection \<open>Coincidence Lemmas\<close>

paragraph \<open>Coincidence for Terms\<close>

text \<open>Lemma 10 \<^url>\<open>https://doi.org/10.1007/978-3-319-94205-6_15\<close>\<close>

theorem coincidence_term: "Vagree \<omega> \<omega>' (FVT \<theta>) \<Longrightarrow> term_sem I \<theta> \<omega> = term_sem I \<theta> \<omega>'"
proof -
  assume a: "Vagree \<omega> \<omega>' (FVT \<theta>)"
  have isS: "statediff \<omega> \<omega>' \<subseteq> -FVT(\<theta>)" using a and Vagree_statediff by simp
  have gen: "S\<subseteq>-FVT(\<theta>) \<Longrightarrow> (term_sem I \<theta> \<omega>' = term_sem I \<theta> (stateinterpol \<omega> \<omega>' S))" if "finite S" for S
    using that
  proof (induction S)
    case empty
    show ?case by (simp add: stateinterpol_empty)
  next
    case (insert z S)
    thus ?case by auto
    qed
  from isS have finS: "finite (statediff \<omega> \<omega>')" using allvars_finite by (metis FVT_finite UNIV_def finite_compl rev_finite_subset)
  show ?thesis using gen[where S=\<open>statediff \<omega> \<omega>'\<close>, OF finS, OF isS] by simp
qed

corollary coincidence_term_cor: "Uvariation \<omega> \<omega>' U \<Longrightarrow> (FVT \<theta>)\<inter>U={} \<Longrightarrow> term_sem I \<theta> \<omega> = term_sem I \<theta> \<omega>'"
using coincidence_term Uvariation_Vagree
  by (metis Vagree_antimon disjoint_eq_subset_Compl double_compl)

lemma stateinterpol_FVF [simp]: "z\<notin>FVF(e) \<Longrightarrow>
  ((stateinterpol \<omega> \<omega>' S) \<in> fml_sem I e \<longleftrightarrow> (stateinterpol \<omega> \<omega>' (insert z S)) \<in> fml_sem I e)"
proof -
  assume a: "z\<notin>FVF(e)"
  have agr: "Vagree (stateinterpol \<omega> \<omega>' S) (stateinterpol \<omega> \<omega>' (insert z S)) (-{z})" by (simp add: Vagree_def stateinterpol_def)
  have fvc: "\<And>v. \<And>w. (Vagree v w (-{z}) \<Longrightarrow> (v\<in>fml_sem I e \<Longrightarrow> w\<in>fml_sem I e))" using a by (simp add: FVF_def)
  then have fvce: "\<And>v. \<And>w. (Vagree v w (-{z}) \<Longrightarrow> ((v\<in>fml_sem I e) = (w\<in>fml_sem I e)))"  using Vagree_sym_rel by blast
  then show "(stateinterpol \<omega> \<omega>' S) \<in> fml_sem I e \<longleftrightarrow> (stateinterpol \<omega> \<omega>' (insert z S)) \<in> fml_sem I e"
    using agr by simp
qed

paragraph \<open>Coincidence for Formulas\<close>

text \<open>Lemma 11 \<^url>\<open>https://doi.org/10.1007/978-3-319-94205-6_15\<close>\<close>

theorem coincidence_formula: "Vagree \<omega> \<omega>' (FVF \<phi>) \<Longrightarrow> (\<omega> \<in> fml_sem I \<phi> \<longleftrightarrow> \<omega>' \<in> fml_sem I \<phi>)"
proof -
  assume a: "Vagree \<omega> \<omega>' (FVF \<phi>)"
  have isS: "statediff \<omega> \<omega>' \<subseteq> -FVF(\<phi>)" using a and Vagree_statediff by simp
  have gen: "S\<subseteq>-FVF(\<phi>) \<Longrightarrow> (\<omega>' \<in> fml_sem I \<phi> \<longleftrightarrow> (stateinterpol \<omega> \<omega>' S) \<in> fml_sem I \<phi>)" if "finite S" for S
    using that
  proof (induction S)
    case empty
    show ?case by (simp add: stateinterpol_empty)
  next
    case (insert z S)
    thus ?case by auto
  qed
  from isS have finS: "finite (statediff \<omega> \<omega>')" using allvars_finite by (metis FVF_finite UNIV_def finite_compl rev_finite_subset)
  show ?thesis using gen[where S=\<open>statediff \<omega> \<omega>'\<close>, OF finS, OF isS] by simp
qed

corollary coincidence_formula_cor: "Uvariation \<omega> \<omega>' U \<Longrightarrow> (FVF \<phi>)\<inter>U={} \<Longrightarrow> (\<omega> \<in> fml_sem I \<phi> \<longleftrightarrow> \<omega>' \<in> fml_sem I \<phi>)"
  using coincidence_formula Uvariation_Vagree
  by (metis Uvariation_def disjoint_eq_subset_Compl inf.commute subsetCE)

paragraph \<open>Coincidence for Games\<close>

text \<open>\<open>Cignorabimus \<alpha> V\<close> is the set of all sets of variables that can be ignored for the coincidence game lemma\<close>
definition Cignorabimus:: "game \<Rightarrow> variable set \<Rightarrow> variable set set"
  where
"Cignorabimus \<alpha> V = {M. \<forall>I.\<forall>\<omega>.\<forall>\<omega>'.\<forall>X. (Vagree \<omega> \<omega>' (-M) \<longrightarrow> (\<omega>\<in>game_sem I \<alpha> (restrictto X V)) \<longrightarrow> (\<omega>'\<in>game_sem I \<alpha> (restrictto X V)))}"

lemma Cignorabimus_finite [simp]: "finite (Cignorabimus \<alpha> V)"
  unfolding Cignorabimus_def using finite_powerset[OF allvars_finite] finite_subset using Finite_Set.finite_subset by fastforce

lemma Cignorabimus_equiv [simp]: "Cignorabimus \<alpha> V = {M. \<forall>I.\<forall>\<omega>.\<forall>\<omega>'.\<forall>X. (Vagree \<omega> \<omega>' (-M) \<longrightarrow> (\<omega>\<in>game_sem I \<alpha> (restrictto X V)) = (\<omega>'\<in>game_sem I \<alpha> (restrictto X V)))}"
  unfolding Cignorabimus_def by (metis (no_types, lifting) Vagree_sym_rel)

lemma Cignorabimus_antimon [simp]: "M \<in> Cignorabimus \<alpha> V \<and> N\<subseteq>M \<Longrightarrow> N \<in> Cignorabimus \<alpha> V"
  unfolding Cignorabimus_def
  using Vagree_antimon by blast

lemma coempty: "-{}=allvars"
  by simp

lemma Cignorabimus_empty [simp]: "{} \<in> Cignorabimus \<alpha> V"
  unfolding Cignorabimus_def using coempty Vagree_univ
  by simp

text \<open>Cignorabimus contains nonfree variables\<close>
lemma Cignorabimus_init: "V\<supseteq>FVG(\<alpha>) \<Longrightarrow> x\<notin>V \<Longrightarrow> {x}\<in>Cignorabimus \<alpha> V"
proof-
  assume "V\<supseteq>FVG(\<alpha>)"
  assume a0: "x\<notin>V"
  hence a1: "x\<notin>FVG(\<alpha>)" using \<open>FVG \<alpha> \<subseteq> V\<close> by blast
  hence "\<And>I v w. Vagree v w (-{x}) \<Longrightarrow> (v \<in> game_sem I \<alpha> (restrictto X (-{x})) \<longleftrightarrow> w \<in> game_sem I \<alpha> (restrictto X (-{x})))"
  by (metis (mono_tags, lifting) CollectI FVG_def Vagree_sym_rel)
  show "{x}\<in>Cignorabimus \<alpha> V"
  proof-
    {
      fix I \<omega> \<omega>' X
      have "Vagree \<omega> \<omega>' (-{x}) \<longrightarrow> (\<omega>\<in>game_sem I \<alpha> (restrictto X V)) \<longrightarrow> (\<omega>'\<in>game_sem I \<alpha> (restrictto X V))"
      proof
        assume a2: "Vagree \<omega> \<omega>' (-{x})"
        show "(\<omega>\<in>game_sem I \<alpha> (restrictto X V)) \<longrightarrow> (\<omega>'\<in>game_sem I \<alpha> (restrictto X V))"
        proof
          assume "\<omega>\<in>game_sem I \<alpha> (restrictto X V)"
          hence "\<omega>\<in>game_sem I \<alpha> (restrictto (restrictto X V) (-{x}))" by (simp add: Int_absorb2 \<open>x\<notin>V\<close>)
          hence "\<omega>'\<in>game_sem I \<alpha> (restrictto (restrictto X V) (-{x}))" using FVG_def a1 a2 by blast
          hence "\<omega>'\<in>game_sem I \<alpha> (restrictto X (V\<inter>-{x}))" by simp
          show "\<omega>'\<in>game_sem I \<alpha> (restrictto X V)" using a0
            by (metis Int_absorb2 \<open>\<omega>' \<in> game_sem I \<alpha> (restrictto X (V \<inter> - {x}))\<close> subset_Compl_singleton)
        qed
      qed
    }
    thus ?thesis
      unfolding Cignorabimus_def
      by auto
  qed
qed

text \<open>Cignorabimus is closed under union\<close>
lemma Cignorabimus_union: "M\<in>Cignorabimus \<alpha> V \<Longrightarrow> N\<in>Cignorabimus \<alpha> V \<Longrightarrow> (M\<union>N)\<in>Cignorabimus \<alpha> V"
proof-
  assume a1: "M\<in>Cignorabimus \<alpha> V"
  assume a2: "N\<in>Cignorabimus \<alpha> V"
  show "(M\<union>N)\<in>Cignorabimus \<alpha> V" (*using a1 a2 unfolding Cignorabimus_def *)
  proof-
    {
      fix I \<omega> \<omega>' X
    assume a3: "Vagree \<omega> \<omega>' (-(M\<union>N))"
    have h1: "\<And>I \<omega> \<omega>'.\<And>X. (Vagree \<omega> \<omega>' (-M) \<Longrightarrow>  (\<omega>\<in>game_sem I \<alpha> (restrictto X V)) \<Longrightarrow> (\<omega>'\<in>game_sem I \<alpha> (restrictto X V)))" using a1 by simp
    have h2: "\<And>I \<omega> \<omega>'.\<And>X. (Vagree \<omega> \<omega>' (-N) \<Longrightarrow>  (\<omega>\<in>game_sem I \<alpha> (restrictto X V)) \<Longrightarrow> (\<omega>'\<in>game_sem I \<alpha> (restrictto X V)))" using a2 by simp
    let ?s = "stateinterpol \<omega>' \<omega> M"
    have v1: "Vagree \<omega> ?s (-(M\<union>N))" using a3 by (simp add: Vagree_def)
    have v2: "Vagree ?s \<omega>' (-(M\<union>N))" using a3 by (simp add: Vagree_def)
    have r1: "\<omega>\<in>game_sem I \<alpha> (restrictto X V) \<Longrightarrow> ?s\<in>game_sem I \<alpha> (restrictto X V)"
      by (metis ComplD Vagree_def h1 stateinterpol_right)
    have r2: "?s\<in>game_sem I \<alpha> (restrictto X V) \<Longrightarrow> \<omega>'\<in>game_sem I \<alpha> (restrictto X V)"
      by (metis Vagree_ror compl_sup h1 h2 v2)
    have res: "\<omega>\<in>game_sem I \<alpha> (restrictto X V) \<Longrightarrow> \<omega>'\<in>game_sem I \<alpha> (restrictto X V)" using r1 r2 by blast
    }
    thus ?thesis
      unfolding Cignorabimus_def
      by auto
  qed
qed

lemma powersetup_induct [case_names Base Cup]:
   "\<And>C. (\<And>M. M\<in>C \<Longrightarrow> P M) \<Longrightarrow>
    (\<And>S. (\<And>M. M\<in>S \<Longrightarrow> P M) \<Longrightarrow> P (\<Union>S)) \<Longrightarrow>
     P (\<Union>C)"
  by simp

lemma Union_insert: "\<Union>(insert x S) = x\<union>\<Union>S"
  by simp

lemma powerset2up_induct [case_names Finite Nonempty Base Cup]:
   "(finite C) \<Longrightarrow> (C\<noteq>{}) \<Longrightarrow> (\<And>M. M\<in>C \<Longrightarrow> P M) \<Longrightarrow>
    (\<And>M N. P M \<Longrightarrow> P N \<Longrightarrow> P (M\<union>N)) \<Longrightarrow>
     P (\<Union>C)"
proof (induction rule: finite_induct)
  case empty
  then show ?case by simp
next
  case (insert x F)
  then show ?case by force
qed

lemma Cignorabimus_step: "(\<And>M. M\<in>S \<Longrightarrow> M\<in>Cignorabimus \<alpha> V) \<Longrightarrow> (\<Union>S)\<in>Cignorabimus \<alpha> V"
proof (cases "S={}")
  case True
  then show ?thesis using Cignorabimus_empty by simp
next
  case nonem: False
  then show "\<Union>S\<in>Cignorabimus \<alpha> V" if "\<And>M. M\<in>S \<Longrightarrow> M\<in>Cignorabimus \<alpha> V" and nonemp:"S\<noteq>{}" for S
  proof (induction rule: powerset2up_induct)
    case Finite
    then show ?case using Cignorabimus_finite by (meson infinite_super subset_eq that(1))
  next
    case Nonempty
    then show ?case using nonemp by simp
  next
    case (Base M)
    then show ?case using that by simp
  next
    case (Cup S)
    then show ?case using that Cignorabimus_union by blast
  qed
qed

text \<open>Lemma 12 \<^url>\<open>https://doi.org/10.1007/978-3-319-94205-6_15\<close>\<close>

theorem coincidence_game: "Vagree \<omega> \<omega>' V \<Longrightarrow> V\<supseteq>FVG(\<alpha>) \<Longrightarrow> (\<omega> \<in> game_sem I \<alpha> (restrictto X V)) = (\<omega>' \<in> game_sem I \<alpha> (restrictto X V))"
proof-
  assume a1: "Vagree \<omega> \<omega>' V"
  assume a2: "V \<supseteq> FVG \<alpha>"
  have base: "{x}\<in>Cignorabimus \<alpha> V" if a3: "x\<notin>V" and a4: "V \<supseteq> FVG \<alpha>" for x V
    using a3 and a4 and Cignorabimus_init by simp
  have h: "-V = \<Union>{xx. \<exists>x. xx={x} \<and> x\<notin>V}" by auto (* finite *)
  have "(-V)\<in>Cignorabimus \<alpha> V" using a2 base h using Cignorabimus_step
  (*by (smt Cignorabimus_step mem_Collect_eq)*)
  proof - (*sledgehammer*)
    have f1: "\<forall>v V. v \<in> V \<or> \<not> FVG \<alpha> \<subseteq> V \<or> {v} \<in> Cignorabimus \<alpha> V"
      using base by satx
    obtain VV :: "variable set \<Rightarrow> game \<Rightarrow> variable set set \<Rightarrow> variable set" where
      f2: "\<forall>x0 x1 x2. (\<exists>v3. v3 \<in> x2 \<and> v3 \<notin> Cignorabimus x1 x0) = (VV x0 x1 x2 \<in> x2 \<and> VV x0 x1 x2 \<notin> Cignorabimus x1 x0)"
      by moura
    obtain vv :: "variable set \<Rightarrow> variable" where
      f3: "((\<nexists>v. VV V \<alpha> {{v} |v. v \<notin> V} = {v} \<and> v \<notin> V) \<or> VV V \<alpha> {{v} |v. v \<notin> V} = {vv (VV V \<alpha> {{v} |v. v \<notin> V})} \<and> vv (VV V \<alpha> {{v} |v. v \<notin> V}) \<notin> V) \<and> ((\<exists>v. VV V \<alpha> {{v} |v. v \<notin> V} = {v} \<and> v \<notin> V) \<or> (\<forall>v. VV V \<alpha> {{v} |v. v \<notin> V} \<noteq> {v} \<or> v \<in> V))"
      by moura
    moreover
    { assume "{vv (VV V \<alpha> {{v} |v. v \<notin> V})} \<in> Cignorabimus \<alpha> V"
      then have "(VV V \<alpha> {{v} |v. v \<notin> V} \<noteq> {vv (VV V \<alpha> {{v} |v. v \<notin> V})} \<or> vv (VV V \<alpha> {{v} |v. v \<notin> V}) \<in> V) \<or> VV V \<alpha> {{v} |v. v \<notin> V} \<notin> {{v} |v. v \<notin> V} \<or> VV V \<alpha> {{v} |v. v \<notin> V} \<in> Cignorabimus \<alpha> V"
        by metis
      then have "(\<exists>v. VV V \<alpha> {{v} |v. v \<notin> V} = {v} \<and> v \<notin> V) \<longrightarrow> VV V \<alpha> {{v} |v. v \<notin> V} \<notin> {{v} |v. v \<notin> V} \<or> VV V \<alpha> {{v} |v. v \<notin> V} \<in> Cignorabimus \<alpha> V"
        using f3 by blast }
    ultimately have "VV V \<alpha> {{v} |v. v \<notin> V} \<notin> {{v} |v. v \<notin> V} \<or> VV V \<alpha> {{v} |v. v \<notin> V} \<in> Cignorabimus \<alpha> V"
      using f1 a2 by blast
    then have "\<Union>{{v} |v. v \<notin> V} \<in> Cignorabimus \<alpha> V"
      using f2 by (meson Cignorabimus_step)
    then show ?thesis
      using h by presburger
  qed
  from this show ?thesis by (simp add: a1)
qed

corollary coincidence_game_cor: "Uvariation \<omega> \<omega>' U \<Longrightarrow> U\<inter>FVG(\<alpha>)={} \<Longrightarrow> (\<omega> \<in> game_sem I \<alpha> (restrictto X (-U))) = (\<omega>' \<in> game_sem I \<alpha> (restrictto X (-U)))"
  using coincidence_game Uvariation_Vagree
  by (metis Uvariation_Vagree coincidence_game compl_le_swap1 disjoint_eq_subset_Compl double_compl)

subsection \<open>Bound Effect Lemmas\<close>

text \<open>\<open>Bignorabimus \<alpha> V\<close> is the set of all sets of variables that can be ignored for boundeffect\<close>
definition Bignorabimus:: "game \<Rightarrow> variable set set"
  where
  "Bignorabimus \<alpha> = {M. \<forall>I.\<forall>\<omega>.\<forall>X. \<omega>\<in>game_sem I \<alpha> X \<longleftrightarrow> \<omega>\<in>game_sem I \<alpha> (selectlike X \<omega> M)}"

lemma Bignorabimus_finite [simp]: "finite (Bignorabimus \<alpha>)"
  unfolding Bignorabimus_def using finite_powerset[OF allvars_finite] finite_subset using Finite_Set.finite_subset by fastforce

lemma Bignorabimus_single [simp]: "game_sem I \<alpha> (selectlike X \<omega> M) \<subseteq> game_sem I \<alpha> X"
  by (meson monotone selectlike_shrinks subsetCE)

lemma Bignorabimus_equiv [simp]: "Bignorabimus \<alpha> = {M. \<forall>I.\<forall>\<omega>.\<forall>X. (\<omega>\<in>game_sem I \<alpha> X \<longrightarrow> \<omega>\<in>game_sem I \<alpha> (selectlike X \<omega> M))}"
  (*by (smt Bignorabimus_def Bignorabimus_single Collect_cong subsetCE)*)
proof - (*sledgehammer transformed*)
  obtain VV :: "(variable set \<Rightarrow> bool) \<Rightarrow> (variable set \<Rightarrow> bool) \<Rightarrow> variable set" where
    f1: "\<forall>p pa. (\<not> p (VV pa p)) = pa (VV pa p) \<or> Collect p = Collect pa"
    by (metis (no_types) Collect_cong)
  obtain rr :: "variable set \<Rightarrow> game \<Rightarrow> variable \<Rightarrow> real" and ii :: "variable set \<Rightarrow> game \<Rightarrow> interp" and FF :: "variable set \<Rightarrow> game \<Rightarrow> (variable \<Rightarrow> real) set" where
    f2: "\<forall>x0 x1. (\<exists>v2 v3 v4. (v3 \<in> game_sem v2 x1 v4) \<noteq> (v3 \<in> game_sem v2 x1 (selectlike v4 v3 x0))) = ((rr x0 x1 \<in> game_sem (ii x0 x1) x1 (FF x0 x1)) \<noteq> (rr x0 x1 \<in> game_sem (ii x0 x1) x1 (selectlike (FF x0 x1) (rr x0 x1) x0)))"
    by moura
    have fact: "{V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))} = {V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)}"
        using f1 by (metis (no_types, hide_lams) Bignorabimus_single subsetCE)
  have f3: "rr (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha> \<notin> game_sem (ii (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) \<alpha> (selectlike (FF (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) (rr (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)))) \<or> rr (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha> \<in> game_sem (ii (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) \<alpha> (FF (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>)"
    using Bignorabimus_single by blast
  have f4: "(\<not> (\<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)))))) \<or> (\<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))))))) \<and> ((\<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)))))) \<or> (rr (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha> \<notin> game_sem (ii (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) \<alpha> (FF (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>)) = (rr (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha> \<in> game_sem (ii (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) \<alpha> (selectlike (FF (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) (rr (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))))))"
    using f2 by blast
  have "rr (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha> \<in> game_sem (ii (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) \<alpha> (FF (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) \<longrightarrow> (\<exists>i f F. f \<in> game_sem i \<alpha> F \<and> f \<notin> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))))) \<or> rr (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha> \<in> game_sem (ii (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) \<alpha> (selectlike (FF (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) (rr (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))) \<alpha>) (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))))"
    by blast
  moreover
  { assume "\<exists>i f F. f \<in> game_sem i \<alpha> F \<and> f \<notin> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))))"
    then have "\<not> (\<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)))))"
      by blast
    moreover
    { assume "(\<not> (\<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)))))) \<noteq> (\<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))))))"
      then have "{V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))} = {V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)}"
        using fact by simp }
    ultimately have "(\<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)))))) \<or> {V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))} = {V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)}"
      by satx }
  moreover
  { assume "\<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)))))"
    then have "(\<not> (\<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)))))) \<noteq> (\<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f (VV (\<lambda>V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))) (\<lambda>V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V))))))"
      by blast
    then have "{V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))} = {V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)}"
      using fact by simp}
  ultimately have "{V. \<forall>i f F. (f \<in> game_sem i \<alpha> F) = (f \<in> game_sem i \<alpha> (selectlike F f V))} = {V. \<forall>i f F. f \<in> game_sem i \<alpha> F \<longrightarrow> f \<in> game_sem i \<alpha> (selectlike F f V)}"
    using f4 f3 by satx
  then show ?thesis
    using Bignorabimus_def by presburger
qed

lemma Bignorabimus_empty [simp]: "{} \<in> Bignorabimus \<alpha>"
  unfolding Bignorabimus_def using coempty selectlike_empty
  by simp

lemma Bignorabimus_init: "x\<notin>BVG(\<alpha>) \<Longrightarrow> {x}\<in>Bignorabimus \<alpha>"
  unfolding Bignorabimus_def BVG_def
proof-
  assume "x \<notin> {x. \<exists>I \<omega> X. \<omega> \<in> game_sem I \<alpha> X \<and> \<omega> \<notin> game_sem I \<alpha> (selectlike X \<omega> {x})}"
  hence "\<not>(\<exists>I \<omega> X. \<omega> \<in> game_sem I \<alpha> X \<and> \<omega> \<notin> game_sem I \<alpha> (selectlike X \<omega> {x}))" by simp
  hence "\<forall>I \<omega> X. (\<omega> \<in> game_sem I \<alpha> X) = (\<omega> \<in> game_sem I \<alpha> (selectlike X \<omega> {x}))" using Bignorabimus_single by blast
  thus "{x} \<in> {M. \<forall>I \<omega> X. (\<omega> \<in> game_sem I \<alpha> X) = (\<omega> \<in> game_sem I \<alpha> (selectlike X \<omega> M))}" by simp
qed

text \<open>Bignorabimus is closed under union\<close>
lemma Bignorabimus_union: "M\<in>Bignorabimus \<alpha> \<Longrightarrow> N\<in>Bignorabimus \<alpha> \<Longrightarrow> (M\<union>N)\<in>Bignorabimus \<alpha>"
proof -
  assume a1: "M\<in>Bignorabimus \<alpha>"
  assume a2: "N\<in>Bignorabimus \<alpha>"
  have h1: "\<forall>I.\<forall>\<omega>.\<forall>X. (\<omega>\<in>game_sem I \<alpha> X) \<longleftrightarrow> (\<omega>\<in>game_sem I \<alpha> (selectlike X \<omega> M))" using a1
    using Bignorabimus_equiv Bignorabimus_single by blast
  have h2: "\<forall>I.\<forall>\<omega>.\<forall>X. (\<omega>\<in>game_sem I \<alpha> X) \<longleftrightarrow> (\<omega>\<in>game_sem I \<alpha> (selectlike X \<omega> N))" using a2
    using Bignorabimus_equiv Bignorabimus_single by blast
  have c: "\<forall>I.\<forall>\<omega>.\<forall>X. (\<omega>\<in>game_sem I \<alpha> X) \<longleftrightarrow> (\<omega>\<in>game_sem I \<alpha> (selectlike X \<omega> (M\<union>N)))" by (metis h1 h2 selectlike_compose)
  then show "(M\<union>N)\<in>Bignorabimus \<alpha>" unfolding Bignorabimus_def using c by fastforce
qed

lemma Bignorabimus_step: "(\<And>M. M\<in>S \<Longrightarrow> M\<in>Bignorabimus \<alpha>) \<Longrightarrow> (\<Union>S)\<in>Bignorabimus \<alpha>"
proof (cases "S={}")
  case True
  then show ?thesis using Bignorabimus_empty by simp
next
  case nonem: False
  then show "\<Union>S\<in>Bignorabimus \<alpha>" if "\<And>M. M\<in>S \<Longrightarrow> M\<in>Bignorabimus \<alpha>" and nonemp:"S\<noteq>{}" for S
  proof (induction rule: powerset2up_induct)
    case Finite
    then show ?case using Bignorabimus_finite by (meson infinite_super subset_eq that(1))
  next
    case Nonempty
    then show ?case using nonemp by simp
  next
    case (Base M)
    then show ?case using that by simp
  next
    case (Cup S)
    then show ?case using that Bignorabimus_union by blast
  qed
qed

text \<open>Lemma 13 \<^url>\<open>https://doi.org/10.1007/978-3-319-94205-6_15\<close>\<close>

theorem boundeffect: "(\<omega> \<in> game_sem I \<alpha> X) = (\<omega> \<in> game_sem I \<alpha> (selectlike X \<omega> (-BVG(\<alpha>))))"
proof-
  have base: "{x}\<in>Bignorabimus \<alpha>" if a3: "x\<notin>BVG \<alpha>" for x using a3 and Bignorabimus_init by simp
  have h: "-BVG \<alpha> = \<Union>{xx. \<exists>x. xx={x} \<and> x\<notin>BVG \<alpha>}" by blast (* finite *)
  have "(-BVG \<alpha>)\<in>Bignorabimus \<alpha>" using base h
  (*by (smt Bignorabimus_step mem_Collect_eq)*)
  proof - (*sledgehammer*)
    obtain VV :: "game \<Rightarrow> variable set set \<Rightarrow> variable set" where
      f1: "\<forall>x0 x1. (\<exists>v2. v2 \<in> x1 \<and> v2 \<notin> Bignorabimus x0) = (VV x0 x1 \<in> x1 \<and> VV x0 x1 \<notin> Bignorabimus x0)"
      by moura
    have "VV \<alpha> {{v} |v. v \<notin> BVG \<alpha>} \<notin> {{v} |v. v \<notin> BVG \<alpha>} \<or> VV \<alpha> {{v} |v. v \<notin> BVG \<alpha>} \<in> Bignorabimus \<alpha>"
      by fastforce
    then have "\<Union>{{v} |v. v \<notin> BVG \<alpha>} \<in> Bignorabimus \<alpha>"
      using f1 by (meson Bignorabimus_step)
    then show ?thesis
      using h by presburger
  qed
  from this show ?thesis using Bignorabimus_def by blast
qed

corollary boundeffect_cor: "V\<inter>BVG(\<alpha>)={} \<Longrightarrow> (\<omega> \<in> game_sem I \<alpha> X) = (\<omega> \<in> game_sem I \<alpha> (selectlike X \<omega> V))"
  using boundeffect
  by (metis disjoint_eq_subset_Compl selectlike_compose sup.absorb_iff2)

subsection \<open>Static Analysis Observations\<close>

lemma BVG_equiv: "game_equiv \<alpha> \<beta> \<Longrightarrow> BVG(\<alpha>) = BVG(\<beta>)"
proof-
  assume a: "game_equiv \<alpha> \<beta>"
  show "BVG(\<alpha>) = BVG(\<beta>)" unfolding BVG_def using game_equiv_subst_eq[OF a] by metis
qed

lemmas union_or = Set.Un_iff

lemma not_union_or: "(x\<notin>A\<union>B) = (x\<notin>A \<and> x\<notin>B)"
  by simp

lemma repv_selectlike_self: "(repv \<omega> x d \<in> selectlike X \<omega> {x}) = (d=\<omega>(x) \<and> \<omega> \<in> X)"
  unfolding selectlike_def using Vagree_repv_self Vagree_sym
  by (metis (no_types, lifting) mem_Collect_eq repv_self)

lemma repv_selectlike_other: "x\<noteq>y \<Longrightarrow> (repv \<omega> x d \<in> selectlike X \<omega> {y}) = (repv \<omega> x d \<in> X)"
proof
  assume a: "x\<noteq>y"
  then have h: "{y}\<subseteq>-{x}" by simp
  show "(repv \<omega> x d \<in> selectlike X \<omega> {y}) \<Longrightarrow> (repv \<omega> x d \<in> X)" using a selectlike_def Vagree_repv[of \<omega> x d]
  by auto
  show "(repv \<omega> x d \<in> X) \<Longrightarrow> (repv \<omega> x d \<in> selectlike X \<omega> {y})"
  using selectlike_def[where X=X and \<nu>=\<omega> and V=\<open>-{x}\<close>] Vagree_repv[where \<omega>=\<omega> and x=x and d=d]
  selectlike_antimon[where X=X and \<nu>=\<omega> and V=\<open>{y}\<close> and W=\<open>-{x}\<close>, OF h] Vagree_sym[where \<nu>=\<open>repv \<omega> x d\<close> and V=\<open>-{x}\<close>]
  by auto
qed

lemma repv_selectlike_other_converse: "x\<noteq>y \<Longrightarrow> (repv \<omega> x d \<in> X) = (repv \<omega> x d \<in> selectlike X \<omega> {y})"
  using repv_selectlike_other HOL.eq_commute by blast

lemma BVG_assign_other: "x\<noteq>y \<Longrightarrow> y\<notin>BVG(Assign x \<theta>)"
  using repv_selectlike_other_converse[where x=x and y=y] by simp

lemma BVG_assign_meta: "(\<And>I \<omega>. term_sem I \<theta> \<omega> = \<omega>(x)) \<Longrightarrow> BVG(Assign x \<theta>) = {}"
  and "term_sem I \<theta> \<omega> \<noteq> \<omega>(x) \<Longrightarrow> BVG(Assign x \<theta>) = {x}"
  (*using repv_selectlike_self BVG_assign_other BVG_def BVG_elem*)
proof-
  have fact: "BVG(Assign x \<theta>) \<subseteq> {x}" using BVG_assign_other by (metis singleton_iff subsetI)
  from fact show "(\<And>I \<omega>. term_sem I \<theta> \<omega> = \<omega>(x)) \<Longrightarrow> BVG(Assign x \<theta>) = {}" using BVG_def by simp
  have h2: "\<exists>I \<omega>. term_sem I \<theta> \<omega> \<noteq> \<omega>(x) \<Longrightarrow> x \<in> BVG(Assign x \<theta>)" using repv_selectlike_self by auto
  from fact show "term_sem I \<theta> \<omega> \<noteq> \<omega>(x) \<Longrightarrow> BVG(Assign x \<theta>) = {x}" using BVG_elem h2 by blast
qed

lemma BVG_assign: "BVG(Assign x \<theta>) = (if (\<forall>I \<omega>. term_sem I \<theta> \<omega> = \<omega>(x)) then {} else {x})"
using repv_selectlike_self repv_selectlike_other BVG_assign_other
proof-
  have c0: "BVG(Assign x \<theta>) \<subseteq> {x}" using BVG_assign_other by (metis singletonI subsetI)
  have c1: "\<forall>I \<omega>. term_sem I \<theta> \<omega> = \<omega>(x) \<Longrightarrow> BVG(Assign x \<theta>) = {}" using BVG_assign_other by auto
  have h2: "\<exists>I \<omega>. term_sem I \<theta> \<omega> \<noteq> \<omega>(x) \<Longrightarrow> x \<in> BVG(Assign x \<theta>)" using repv_selectlike_self by auto
  have c2: "\<exists>I \<omega>. term_sem I \<theta> \<omega> \<noteq> \<omega>(x) \<Longrightarrow> BVG(Assign x \<theta>) = {x}" using c0 h2 by blast
  from c1 and c2 show ?thesis by simp
qed

lemma BVG_ODE_other: "y\<noteq>RVar x \<Longrightarrow> y\<noteq>DVar x \<Longrightarrow> y\<notin>BVG(ODE x \<theta>)"
  (*using nonBVG_rule selectlike_equal_cocond_rule solves_ODE_def*)
proof-
  assume yx: "y\<noteq>RVar x"
  assume yxp: "y\<noteq>DVar x"
  show "y\<notin>BVG(ODE x \<theta>)"
  proof (rule nonBVG_inc_rule)
    fix I \<omega> X
    assume "\<omega> \<in> game_sem I (ODE x \<theta>) X"
    then have "\<exists>F T. Vagree \<omega> (F(0)) (-{DVar x}) \<and> F(T) \<in> X \<and> solves_ODE I F x \<theta>" by simp
    then obtain F T where "Vagree \<omega> (F(0)) (-{DVar x}) \<and> F(T) \<in> X \<and> solves_ODE I F x \<theta>" by blast
    then have "Vagree \<omega> (F(0)) (-{DVar x}) \<and> F(T) \<in> (selectlike X \<omega> {y}) \<and> solves_ODE I F x \<theta>"
    using yx yxp solves_Vagree Vagree_def similar_selectlike_mem by auto
    then have "\<exists>F T. Vagree \<omega> (F(0)) (-{DVar x}) \<and> F(T) \<in> (selectlike X \<omega> {y}) \<and> solves_ODE I F x \<theta>" by blast
    then show "\<omega> \<in> game_sem I (ODE x \<theta>) (selectlike X \<omega> {y})" by simp
  qed
qed

text \<open>This result could be strengthened to a conditional equality based on the RHS values\<close>

lemma BVG_ODE: "BVG(ODE x \<theta>) \<subseteq> {RVar x,DVar x}"
  using BVG_ODE_other by blast

lemma BVG_test: "BVG(Test \<phi>) = {}"
  unfolding BVG_def game_sem.simps by auto

lemma BVG_choice: "BVG(Choice \<alpha> \<beta>) \<subseteq> BVG(\<alpha>) \<union> BVG(\<beta>)"
  unfolding BVG_def game_sem.simps using not_union_or by auto
(*proof-
  have f1: "\<And>\<omega> I X. (\<omega> \<in> game_sem I \<alpha> X \<union> game_sem I \<beta> X) =
  (\<omega> \<in> game_sem I \<alpha> X \<or> \<omega> \<in> game_sem I \<beta> X)" by (rule union_or)
  have f2: "\<And>\<omega> I X. (\<omega> \<notin> game_sem I \<alpha> (selectlike X \<omega> {x}) \<union> game_sem I \<beta> (selectlike X \<omega> {x})) =
  (\<omega> \<notin> game_sem I \<alpha> (selectlike X \<omega> {x}) \<and> \<omega> \<notin> game_sem I \<beta> (selectlike X \<omega> {x}))" by (rule not_union_or)
  let ?lhs = "{x. \<exists>I \<omega> X.
           \<omega> \<in> game_sem I \<alpha> X \<union> game_sem I \<beta> X \<and>
           \<omega> \<notin> game_sem I \<alpha> (selectlike X \<omega> {x}) \<union> game_sem I \<beta> (selectlike X \<omega> {x})}"
  let ?rhs = "{x. \<exists>I \<omega> X. \<omega> \<in> game_sem I \<alpha> X \<and> \<omega> \<notin> game_sem I \<alpha> (selectlike X \<omega> {x})} \<union>
       {x. \<exists>I \<omega> X. \<omega> \<in> game_sem I \<beta> X \<and> \<omega> \<notin> game_sem I \<beta> (selectlike X \<omega> {x})}"
  show "?lhs\<subseteq>?rhs" using f1 f2 by auto
qed*)

lemma BVG_compose: "BVG(Compose \<alpha> \<beta>) \<subseteq> BVG(\<alpha>) \<union> BVG(\<beta>)"
  (*unfolding BVG_def game_sem.simps using game_union union_or not_union_or selectlike_shrinks monotone selectlike_compose*)
proof
  fix x
  assume a: "x\<in>BVG(Compose \<alpha> \<beta>)"
  show "x \<in> BVG \<alpha> \<union> BVG \<beta>"
  proof (rule ccontr)
    assume "x\<notin>BVG \<alpha> \<union> BVG(\<beta>)"
    then have n\<beta>: "x\<notin>BVG(\<beta>)"
    and n\<alpha>: "x\<notin>BVG(\<alpha>)" by simp_all
    from a have "\<exists>I.\<exists>\<omega>.\<exists>X. \<omega> \<in> game_sem I (Compose \<alpha> \<beta>) X \<and> \<omega> \<notin> game_sem I (Compose \<alpha> \<beta>) (selectlike X \<omega> {x})" by simp
    then obtain I \<omega> X where adef: "\<omega> \<in> game_sem I (Compose \<alpha> \<beta>) X \<and> \<omega> \<notin> game_sem I (Compose \<alpha> \<beta>) (selectlike X \<omega> {x})" by blast
    from adef have a1: "\<omega> \<in> game_sem I \<alpha> (game_sem I \<beta> X)" by simp
    from adef have a2: "\<omega> \<notin> game_sem I \<alpha> (game_sem I \<beta> (selectlike X \<omega> {x}))" by simp
    let ?Y = "selectlike X \<omega> {x}"
    from n\<alpha> have n\<alpha>c: "\<And>I \<omega> X. (\<omega> \<in> game_sem I \<alpha> X) = (\<omega> \<in> game_sem I \<alpha> (selectlike X \<omega> {x}))" using BVG_nonelem by simp
    from n\<beta> have n\<beta>c: "\<And>I \<omega> X. (\<omega> \<in> game_sem I \<beta> X) = (\<omega> \<in> game_sem I \<beta> (selectlike X \<omega> {x}))" using BVG_nonelem by simp
    have c1: "\<omega> \<in> game_sem I \<alpha> (selectlike (game_sem I \<beta> X) \<omega> {x})" using a1 n\<alpha>c[where I=I and \<omega>=\<omega> and X=\<open>game_sem I \<beta> X\<close>] by blast
    have c2: "\<omega> \<notin> game_sem I \<alpha> (selectlike (game_sem I \<beta> ?Y) \<omega> {x})" using a2 n\<alpha>c[where I=I and \<omega>=\<omega> and X=\<open>game_sem I \<beta> ?Y\<close>] by blast
    from c2 have c3: "\<omega> \<notin> game_sem I \<alpha> (selectlike (game_sem I \<beta> X) \<omega> {x})" using n\<beta> selectlike_Vagree
    proof-
      have "selectlike (game_sem I \<beta> ?Y) \<omega> {x} = selectlike (game_sem I \<beta> X) \<omega> {x}" using n\<beta> by (rule select_nonBV)
      thus ?thesis using c2 by simp
    qed
    show "False" using c1 c3 n\<beta>c[where I=I] by auto
  qed
qed

text \<open>The converse inclusion does not hold generally, because
   \<open>BVG(x := x+1; x:= x-1) = {} \<noteq> BVG(x := x+1) \<union> BVG(x := x-1) = {x}\<close>\<close>

lemma "BVG(Compose (Assign x (Plus (Var x) (Number 1))) (Assign x (Plus (Var x) (Number (-1)))))
    \<noteq> BVG(Assign x (Plus (Var x) (Number 1))) \<union> BVG(Assign x (Plus (Var x) (Number (-1))))"
    unfolding BVG_def selectlike_def repv_def Vagree_def by auto

lemma BVG_loop: "BVG(Loop \<alpha>) \<subseteq> BVG(\<alpha>)"
proof
  fix x
  assume a: "x\<in>BVG(Loop \<alpha>)"
  show "x \<in> BVG(\<alpha>)"
  proof (rule ccontr)
    assume "\<not> (x \<in> BVG(\<alpha>))"
    then have n\<alpha>: "x\<notin>BVG \<alpha>" by simp
    from n\<alpha> have n\<alpha>c: "\<And>I \<omega> X. (\<omega> \<in> game_sem I \<alpha> X) = (\<omega> \<in> game_sem I \<alpha> (selectlike X \<omega> {x}))" using BVG_nonelem by simp
    have "x\<notin>BVG(Loop \<alpha>)" (*using BVG_nonelem*)
    proof (rule nonBVG_rule)
      fix I \<omega> X
      let ?f = "\<lambda>Z. X \<union> game_sem I \<alpha> Z"
      let ?g = "\<lambda>Y. (selectlike X \<omega> {x}) \<union> game_sem I \<alpha> Y"
      let ?R = "\<lambda>Z Y. selectlike Z \<omega> {x} = selectlike Y \<omega> {x}"
      have "?R (lfp ?f) (lfp ?g)"
      proof (induction rule: lfp_lockstep_induct[where f=\<open>?f\<close> and g=\<open>?g\<close> and R=\<open>?R\<close>])
        case monof
        then show ?case using game_sem_loop_fixpoint_mono by simp
      next
        case monog
        then show ?case using game_sem_loop_fixpoint_mono by simp
      next
        case (step A B)
        then have IH: "selectlike A \<omega> {x} = selectlike B \<omega> {x}" by simp
        then show ?case
        (* using selectlike_union n\<alpha> select_nonBV IH by (smt insert_absorb2 insert_def selectlike_compose singleton_conv smt_solver=cvc4)  *)
        proof-
          have "selectlike (X \<union> game_sem I \<alpha> A) \<omega> {x} = selectlike X \<omega> {x} \<union> selectlike (game_sem I \<alpha> A) \<omega> {x}" using selectlike_union by simp
          also have "... = selectlike X \<omega> {x} \<union> selectlike (game_sem I \<alpha> (selectlike A \<omega> {x})) \<omega> {x}" using n\<alpha> select_nonBV by blast
          also have "... = selectlike X \<omega> {x} \<union> selectlike (game_sem I \<alpha> (selectlike B \<omega> {x})) \<omega> {x}" using IH by simp
          also have "... = selectlike (selectlike X \<omega> {x} \<union> game_sem I \<alpha> B) \<omega> {x}" using selectlike_union n\<alpha> select_nonBV by auto
          finally show "selectlike (X \<union> game_sem I \<alpha> A) \<omega> {x} = selectlike (selectlike X \<omega> {x} \<union> game_sem I \<alpha> B) \<omega> {x}" .
        qed
        next
        case (union M)
        then have IH: "\<forall>(A,B)\<in>M. selectlike A \<omega> {x} = selectlike B \<omega> {x}" .
        then show ?case
        using fst_proj_mem[where M=M] snd_proj_mem[where M=M]
        selectlike_Sup[where \<nu>=\<omega> and V=\<open>{x}\<close>] sup_corr_eq_chain by simp
        (*proof-
          have "selectlike (\<Union>fst_proj M) \<omega> {x} = \<Union>{selectlike A \<omega> {x} | A. A\<in>fst_proj M}" using selectlike_Sup by simp
          also have "... = \<Union>{selectlike B \<omega> {x} | B. B\<in>snd_proj M}" using sup_corr_eq_chain[OF IH] by simp
          also have "... = selectlike (\<Union>snd_proj M) \<omega> {x}" using selectlike_Sup by simp
          finally show "selectlike (\<Union>fst_proj M) \<omega> {x} = selectlike (\<Union>snd_proj M) \<omega> {x}" .
        qed*)
      qed
      from this show "(\<omega> \<in> game_sem I (Loop \<alpha>) X) = (\<omega> \<in> game_sem I (Loop \<alpha>) (selectlike X \<omega> {x}))"
      by (metis (mono_tags) game_sem.simps(6) lfp_def selectlike_self)
      (*by (simp add: selectlike_self game_sem_loop_back)*)
    qed
  then show "False" using a by blast
  qed
qed

lemma BVG_dual: "BVG(Dual \<alpha>) \<subseteq> BVG(\<alpha>)"
  (*unfolding game_sem.simps using BVG_elem selectlike_co_selectlike co_selectlike selectlike_complement selectlike_antimon*)
proof
  fix x
  assume a: "x\<in>BVG(Dual \<alpha>)"
  show "x\<in>BVG \<alpha>"
  proof-
    from a have "\<exists>I.\<exists>\<omega>.\<exists>X. \<omega> \<in> game_sem I (Dual \<alpha>) X \<and> \<omega> \<notin> game_sem I (Dual \<alpha>) (selectlike X \<omega> {x})" by simp
    then obtain I \<omega> X where adef: "\<omega> \<in> game_sem I (Dual \<alpha>) X \<and> \<omega> \<notin> game_sem I (Dual \<alpha>) (selectlike X \<omega> {x})" by blast
    from adef have a1: "\<omega> \<notin> game_sem I \<alpha> (- X)" by simp
    from adef have a2: "\<omega> \<in> game_sem I \<alpha> (- selectlike X \<omega> {x})" by simp
    let ?Y = "- selectlike X \<omega> {x}"
    have f1: "\<omega> \<in> game_sem I \<alpha> ?Y" by (rule a2)
    have f2: "\<omega> \<notin> game_sem I \<alpha> (selectlike ?Y \<omega> {x})" using a1 selectlike_co_selectlike
    by (metis (no_types, lifting) selectlike_shrinks monotone dual_order.trans subset_Compl_singleton)
    show "x\<in>BVG(\<alpha>)" using f1 f2 by auto
  qed
qed

end


theory T4
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


theory prop_08
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun drop :: "Nat => 'a list => 'a list" where
  "drop (Z) y = y"
  | "drop (S z) (Nil2) = Nil2"
  | "drop (S z) (Cons2 x2 x3) = drop z x3"
  (*hipster drop *)
lemma lemma_a [thy_expl]: "drop x3 Nil2 = Nil2"
by (hipster_induct_schemes drop.simps)

lemma lemma_aa [thy_expl]: "drop (S Z) (drop x3 y3) = drop (S x3) y3"
by (hipster_induct_schemes drop.simps)

lemma lemma_ab []: "drop (S z) (drop x3 y3) = drop z (drop (S x3) y3)"
by (metis thy_expl drop.simps list.exhaust)

  theorem x0 :
    "(drop x (drop y z)) = (drop y (drop x z))"
    by (hipster_induct_schemes drop.simps list.exhaust)

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_sort_nat_NStoogeSortCount
  imports "../../Test_Base"
begin

datatype ('a, 'b) pair = pair2 "'a" "'b"

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun reverse :: "'a list => 'a list" where
  "reverse (nil2) = nil2"
| "reverse (cons2 z xs) = x (reverse xs) (cons2 z (nil2))"

fun plus :: "Nat => Nat => Nat" where
  "plus (Z) z = z"
| "plus (S z2) z = S (plus z2 z)"

fun minus :: "Nat => Nat => Nat" where
  "minus (Z) z = Z"
| "minus (S z2) (S y2) = minus z2 y2"

(*fun did not finish the proof*)
function third :: "Nat => Nat" where
  "third y =
   (if (y = (S (S Z))) then Z else
      (if (y = (S Z)) then Z else
         (case y of
            Z => Z
            | S z => plus (S Z) (third (minus y (S (S (S Z))))))))"
  by pat_completeness auto

fun length :: "'a list => Nat" where
  "length (nil2) = Z"
| "length (cons2 z l) = plus (S Z) (length l)"

fun le :: "Nat => Nat => bool" where
  "le (Z) z = True"
| "le (S z2) (Z) = False"
| "le (S z2) (S x2) = le z2 x2"

fun sort2 :: "Nat => Nat => Nat list" where
  "sort2 y z =
   (if le y z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun take :: "Nat => 'a list => 'a list" where
  "take y z =
   (if le y Z then nil2 else
      (case z of
         nil2 => nil2
         | cons2 z2 xs => (case y of S x2 => cons2 z2 (take x2 xs))))"

fun drop :: "Nat => 'a list => 'a list" where
  "drop y z =
   (if le y Z then z else
      (case z of
         nil2 => nil2
         | cons2 z2 xs1 => (case y of S x2 => drop x2 xs1)))"

fun splitAt :: "Nat => 'a list =>
              (('a list), ('a list)) pair" where
  "splitAt y z = pair2 (take y z) (drop y z)"

function nstooge1sort2 :: "Nat list => Nat list"
  and nstoogesort :: "Nat list => Nat list"
  and nstooge1sort1 :: "Nat list => Nat list" where
  "nstooge1sort2 y =
   (case splitAt (third (length y)) (reverse y) of
      pair2 ys2 zs2 => x (nstoogesort zs2) (reverse ys2))"
| "nstoogesort (nil2) = nil2"
| "nstoogesort (cons2 z (nil2)) = cons2 z (nil2)"
| "nstoogesort (cons2 z (cons2 y2 (nil2))) = sort2 z y2"
| "nstoogesort (cons2 z (cons2 y2 (cons2 x3 x4))) =
     nstooge1sort2
       (nstooge1sort1 (nstooge1sort2 (cons2 z (cons2 y2 (cons2 x3 x4)))))"
| "nstooge1sort1 y =
     (case splitAt (third (length y)) y of
        pair2 ys2 zs1 => x ys2 (nstoogesort zs1))"
  by pat_completeness auto

fun count :: "'a => 'a list => Nat" where
  "count y (nil2) = Z"
| "count y (cons2 z2 ys) =
     (if (y = z2) then plus (S Z) (count y ys) else count y ys)"

theorem property0 :
  "((count y (nstoogesort xs)) = (count y xs))"
  oops

end


theory Ex043
  imports Main
begin

theorem "\<lbrakk>A \<and> B ; \<not>A \<or> C \<rbrakk> \<Longrightarrow> \<not>((A \<and> B) \<longrightarrow> \<not>C)"
proof -
  assume a:"A \<and> B"
  and b:"\<not>A \<or> C"
  from a have A by (rule conjE)
  from a have B by (rule conjE)
  {
    assume "(A \<and> B) \<longrightarrow> \<not>C"
    from this and a have "\<not>C" by (rule mp)
    {
      assume "\<not>A"
      with \<open>A\<close> have False by contradiction
    }
    note tmp=this
    {
      assume C
      with \<open>\<not>C\<close> have False by contradiction
    }
    from b and tmp and this have False by (rule disjE)
  }
  thus ?thesis by (rule notI)
qed


theory Szip_smap
  imports Main "$HIPSTER_HOME/IsaHipster"
begin

setup Tactic_Data.set_coinduct_sledgehammer
codatatype (sset: 'a) Stream =
  SCons (shd: 'a) (stl: "'a Stream")
datatype ('a, 'b) Pair2 = Pair2 'a 'b
primcorec szip :: "'a Stream \<Rightarrow> 'b Stream \<Rightarrow> (('a, 'b) Pair2) Stream" where
  "shd (szip s1 s2) = Pair2 (shd s1) (shd s2)"
| "stl (szip s1 s2) = szip (stl s1) (stl s2)"

primcorec smap :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a Stream \<Rightarrow> 'b Stream" where
  "smap f xs = SCons (f (shd xs)) (smap f (stl xs))"

fun map_prod2 :: "('a \<Rightarrow> 'c) \<Rightarrow> ('b \<Rightarrow> 'd) \<Rightarrow> ('a,'b) Pair2 \<Rightarrow> ('c,'d) Pair2" where
"map_prod2 f g (Pair2 a b) = Pair2 (f a) (g b)"

datatype 'a Lst =
  Emp
  | Cons "'a" "'a Lst"

fun obsStream :: "int \<Rightarrow> 'a Stream \<Rightarrow> 'a Lst" where
"obsStream n s = (if (n \<le> 0) then Emp else Cons (shd s) (obsStream (n - 1) (stl s)))"

(* hipster_obs Stream Lst obsStream szip smap map_prod2
Proving: map_prod2 z z (Pair22 y x2) = Pair22 (z y) (z x2)
Undefined fact: "Szip_smap.Pair2.coinduct_strong" *)
theorem szip_smap:
 "szip (smap f xs) (smap g ys) = smap (map_prod2 f g) (szip xs ys)"
by hipster_coinduct_sledgehammer
end


theory COFEs
imports NonExpansive
begin

subsection \<open> COFE \<close>
typedef (overloaded) 't chain = "{c::(nat \<Rightarrow> 't::ofe). \<forall>n m. n\<le>m \<longrightarrow> n_equiv n (c m) (c n)}"
  using ofe_eq_limit by force
setup_lifting type_definition_chain
lemmas [simp] = Rep_chain_inverse Rep_chain_inject
lemmas [simp, intro!] = Rep_chain[unfolded mem_Collect_eq]

class cofe = ofe +
  fixes lim :: "('a::ofe) chain \<Rightarrow> 'a"
  assumes core_compl: "n_equiv n (lim c) (Rep_chain c n)"

definition discrete_lim :: "('a::discrete chain) \<Rightarrow> 'a" where
  "discrete_lim c = Rep_chain c 0"

lemma discrete_cofe: "n_equiv n (discrete_lim c) (Rep_chain c n)"
  unfolding discrete_lim_def by transfer (metis d_equiv nat_le_linear)

subsubsection \<open>Banach's fixed-point\<close>

definition fixpoint_chain :: "('a::ofe,'a) contr \<Rightarrow> 'a chain" where
  "fixpoint_chain f = Abs_chain (\<lambda>n. Nat.compower (Rep_contr f) (Suc n) (SOME (x::'a). True))"

definition fixpoint :: "('a::cofe,'a) contr \<Rightarrow> 'a" where
  "fixpoint f = lim (fixpoint_chain f)"

lemma fp_chain:"(\<lambda>n. Nat.compower (Rep_contr (f::('a::cofe,'a) contr)) (Suc n) x) \<in>
  {c. \<forall>n m. n\<le>m \<longrightarrow> n_equiv n (c m) (c n)}"
  apply auto apply transfer
  subgoal for n m f x
proof (induction n arbitrary: m)
  case 0
  then show ?case by (auto intro: contractiveE)
next
  case (Suc n)
  then have "n \<le> (m-1)" by simp
  then obtain m' where m': "m' = m-1" by simp
  then have f_m': "f ((f^^m') x) = (f^^m) x" apply auto
    by (metis One_nat_def Suc.prems(1) Suc_le_D comp_def diff_Suc_1 funpow.simps(2))
  from m' \<open>n\<le>(m-1)\<close> have "n\<le>m'" by simp
  show ?case apply (rule contractive_Suc[OF Suc(3)])
  using Suc(1)[OF \<open>n\<le>m'\<close> Suc(3)] by (auto simp: f_m')
qed
done

lemma fixpoint_unfold: "ofe_eq (fixpoint f) (Rep_contr f (fixpoint f))"
apply (auto simp: ofe_limit fixpoint_def)
subgoal for n
apply (induction n)
subgoal
  apply (subst ofe_trans_eqL[OF core_compl])
  apply (auto simp: fixpoint_chain_def Abs_chain_inverse[OF fp_chain, simplified])
  using Rep_contr contractive_zero by blast
subgoal for n'
  unfolding ofe_trans_eqL[OF core_compl]
  apply (auto simp: fixpoint_chain_def Abs_chain_inverse[OF fp_chain, simplified])
  by (auto simp: ofe_trans_eqR[OF core_compl] Abs_chain_inverse[OF fp_chain, simplified] ofe_refl
    intro!: contractive_Suc[of "Rep_contr f"])
  done
done

lemma fixpoint_unique: "ofe_eq x (Rep_contr f x) \<Longrightarrow> ofe_eq x (fixpoint f)"
apply (auto simp: ofe_limit)
subgoal for n
proof (induction n)
  case 0
  then have x0: "n_equiv 0 x (Rep_contr f x)" by simp
  show ?case
    by (auto simp: fixpoint_def fixpoint_chain_def ofe_trans_eqR[OF core_compl]
      Abs_chain_inverse[OF fp_chain, simplified] ofe_trans_eqL[OF x0] intro:
      contractive_zero)
next
  case (Suc n)
  then have IH: "n_equiv n x (fixpoint f)" by simp
  from Suc(2) have x_Sn: "n_equiv (Suc n) x (Rep_contr f x)" by simp
  show ?case apply (auto simp: ofe_trans_eqL[OF x_Sn] ofe_trans_eqR[OF ofe_eq_equiv[OF fixpoint_unfold]])
  apply (rule contractive_Suc[of "Rep_contr f"])
  by (auto simp: IH)
qed
done

subsection \<open>COFE instances\<close>

subsubsection \<open>Unit type cofe\<close>
instantiation unit :: cofe begin
definition lim_unit :: "unit chain \<Rightarrow> unit" where [simp]: "lim_unit _ = ()"
instance by standard (simp add: n_equiv_unit_def)
end

subsubsection \<open>Option type cofe\<close>
lift_definition option_chain :: "'a::ofe option chain \<Rightarrow> 'a \<Rightarrow> 'a chain" is
  "\<lambda>c x n. case c n of Some y \<Rightarrow> y | None \<Rightarrow> x"
  by (auto simp: ofe_refl n_equiv_option_def split: option.splits) fastforce+

instantiation option :: (cofe) cofe begin
definition lim_option :: "'a option chain \<Rightarrow> 'a option" where
  "lim_option c \<equiv> case (Rep_chain c 0) of Some x \<Rightarrow> Some (lim (option_chain c x)) | None \<Rightarrow> None"
instance proof
  fix c :: "'a option chain" and n
  have base: "n_equiv 0 (Rep_chain c n) (Rep_chain c 0)" by transfer auto
  from core_compl have step: "n_equiv n (lim (option_chain c x)) (Rep_chain (option_chain c x) n)" for x .
  show "n_equiv n (lim c) (Rep_chain c n)" unfolding lim_option_def
  apply (cases "Rep_chain c 0")
  apply simp_all
  apply (metis base n_equiv_option_def option.distinct(1))
  by (smt (verit) base step n_equiv_option_def option.simps(5) option_chain.rep_eq)
qed
end

subsubsection \<open>Later type ofe\<close>
lift_definition later_chain :: "'a::ofe later chain \<Rightarrow> 'a chain" is
  "\<lambda>c n. later_car (Rep_chain c (Suc n))"
  by transfer (metis Suc_le_mono add_diff_cancel_left' n_equiv_later_def nat.discI plus_1_eq_Suc)

instantiation later :: (cofe) cofe begin
definition lim_later :: "'a later chain \<Rightarrow> 'a later" where
  "lim_later c = Next (lim (later_chain c))"
instance proof
  fix c :: "'a later chain" and n
  from core_compl[of n] show "n_equiv n (lim c) (Rep_chain c n)"
    apply (simp add: n_equiv_later_def lim_later_def)
    by (smt (verit, ccfv_threshold) Suc_pred bot_nat_0.not_eq_extremum core_compl later_chain.rep_eq)
qed
end

subsubsection \<open>Product type COFE\<close>
lift_definition chain_map :: "('a::ofe -n> 'b::ofe) \<Rightarrow> 'a chain \<Rightarrow> 'b chain" is
  "\<lambda>f c n. f (Rep_chain c n)" by transfer (simp add: non_expansive_def)

lift_definition ne_fst :: "('a::ofe\<times>'b::ofe)-n>'a" is "\<lambda>(a,_). a" by (rule non_expansiveI) auto
lift_definition ne_snd :: "('a::ofe\<times>'b::ofe)-n>'b" is "\<lambda>(_,b). b" by (rule non_expansiveI) auto

instantiation prod :: (cofe,cofe) cofe begin
definition lim_prod :: "('a \<times> 'b) chain \<Rightarrow> 'a \<times> 'b" where
  "lim_prod c = (lim (chain_map ne_fst c), lim (chain_map ne_snd c))"
instance proof
  fix c :: "('a\<times>'b) chain" and n
  have "n_equiv n (lim (chain_map ne_fst c)) (Rep_chain (chain_map ne_fst c) n)"
    "n_equiv n (lim (chain_map ne_snd c)) (Rep_chain (chain_map ne_snd c) n)"
    using core_compl by auto
  then show "n_equiv n (lim c) (Rep_chain c n)"
  apply (simp add: lim_prod_def ne_fst.rep_eq ne_snd.rep_eq chain_map_def)
  by (smt (z3) Abs_chain_inverse Rep_chain case_prod_conv mem_Collect_eq n_equiv_prod.elims(2) n_equiv_prod.elims(3))
qed
end

subsubsection \<open>Non expansive function COFE\<close>
lift_definition ne_chain :: "('a::ofe,'b::ofe) ne chain \<Rightarrow> 'a \<Rightarrow> 'b chain" is
  "\<lambda>c x n. Rep_ne (c n) x" apply transfer unfolding non_expansive_def by auto

instantiation ne :: (ofe,cofe) cofe begin
lift_definition lim_ne :: "('a, 'b) ne chain \<Rightarrow> ('a, 'b) ne" is
  "\<lambda>c x. lim (ne_chain c x)"
  by (metis (no_types, lifting) Rep_ne core_compl mem_Collect_eq ne_chain.rep_eq non_expansive_def
    ofe_sym ofe_trans)
instance apply standard apply (simp add: n_equiv_ne_def lim_ne.rep_eq ne_chain_def)
  by (smt (verit, best) Abs_chain_inverse Rep_chain core_compl mem_Collect_eq ne_chain.rep_eq)
end

subsubsection \<open>Function COFE\<close>
lift_definition fun_chain :: "('a \<Rightarrow> 'b::ofe) chain \<Rightarrow> 'a \<Rightarrow> 'b chain" is
  "\<lambda>(c::nat\<Rightarrow>('a\<Rightarrow>'b)) x n. c n x" by (simp add: n_equiv_fun_def)

instantiation "fun" :: (type,cofe) cofe begin
definition lim_fun :: "('a \<Rightarrow> 'b) chain \<Rightarrow> 'a \<Rightarrow> 'b" where
  "lim_fun c x = lim (fun_chain c x)"
instance apply standard apply (simp add: n_equiv_fun_def lim_fun_def fun_chain_def)
using core_compl by (smt (verit, best) Abs_chain_inverse fun_chain.rep_eq mem_Collect_eq ofe_mono ofe_sym ofe_trans)
end
end


theory Common
  imports Main "HOL-Library.LaTeXsugar"
begin

sledgehammer_params [timeout=60,provers= cvc4 vampire z3 e spass]

definition \<open>restrict f X x \<equiv> if x \<in> X then Some (f x) else None\<close>

lemma restrict_dom[simp]: \<open>dom (restrict f X) = X\<close>
  apply (auto simp: restrict_def)
  subgoal for x y
    by (cases \<open>x \<in> X\<close> ; simp)?
  done

lemma restrict_ran[simp]: \<open>ran (restrict f X) = f ` X\<close>
  by (auto simp: restrict_def ran_def)

lemma restrict_in_dom[simp]: \<open>restrict f X x = Some (f x)\<close> if \<open>x \<in> X\<close>
  using that by (auto simp: restrict_def)

lemma restrict_notin_dom[simp]: \<open>restrict f X x = None\<close> if \<open>x \<notin> X\<close>
  using that by (auto simp: restrict_def)

lemma restrict_inj_on[simp]: \<open>inj_on (restrict f X) X \<longleftrightarrow> inj_on f X\<close>
  by (auto intro!: inj_onI elim!: inj_onD)

end