(*  Title:      ZF/Constructible/Internalize.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
*)

theory Internalize imports L_axioms Datatype_absolute begin

subsection\<open>Internalized Forms of Data Structuring Operators\<close>

subsubsection\<open>The Formula @{term is_Inl}, Internalized\<close>

(*  is_Inl(M,a,z) == \<exists>zero[M]. empty(M,zero) & pair(M,zero,a,z) *)
definition
  Inl_fm :: "[i,i]=>i" where
    "Inl_fm(a,z) == Exists(And(empty_fm(0), pair_fm(0,succ(a),succ(z))))"

lemma Inl_type [TC]:
     "[| x \<in> nat; z \<in> nat |] ==> Inl_fm(x,z) \<in> formula"
by (simp add: Inl_fm_def)

lemma sats_Inl_fm [simp]:
   "[| x \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, Inl_fm(x,z), env) \<longleftrightarrow> is_Inl(##A, nth(x,env), nth(z,env))"
by (simp add: Inl_fm_def is_Inl_def)

lemma Inl_iff_sats:
      "[| nth(i,env) = x; nth(k,env) = z;
          i \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_Inl(##A, x, z) \<longleftrightarrow> sats(A, Inl_fm(i,k), env)"
by simp

theorem Inl_reflection:
     "REFLECTS[\<lambda>x. is_Inl(L,f(x),h(x)),
               \<lambda>i x. is_Inl(##Lset(i),f(x),h(x))]"
apply (simp only: is_Inl_def)
apply (intro FOL_reflections function_reflections)
done

subsubsection\<open>The Formula @{term is_Inr}, Internalized\<close>

(*  is_Inr(M,a,z) == \<exists>n1[M]. number1(M,n1) & pair(M,n1,a,z) *)
definition
  Inr_fm :: "[i,i]=>i" where
    "Inr_fm(a,z) == Exists(And(number1_fm(0), pair_fm(0,succ(a),succ(z))))"

lemma Inr_type [TC]:
     "[| x \<in> nat; z \<in> nat |] ==> Inr_fm(x,z) \<in> formula"
by (simp add: Inr_fm_def)

lemma sats_Inr_fm [simp]:
   "[| x \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, Inr_fm(x,z), env) \<longleftrightarrow> is_Inr(##A, nth(x,env), nth(z,env))"
by (simp add: Inr_fm_def is_Inr_def)

lemma Inr_iff_sats:
      "[| nth(i,env) = x; nth(k,env) = z;
          i \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_Inr(##A, x, z) \<longleftrightarrow> sats(A, Inr_fm(i,k), env)"
by simp

theorem Inr_reflection:
     "REFLECTS[\<lambda>x. is_Inr(L,f(x),h(x)),
               \<lambda>i x. is_Inr(##Lset(i),f(x),h(x))]"
apply (simp only: is_Inr_def)
apply (intro FOL_reflections function_reflections)
done

subsubsection\<open>The Formula @{term is_Nil}, Internalized\<close>

(* is_Nil(M,xs) == \<exists>zero[M]. empty(M,zero) & is_Inl(M,zero,xs) *)

definition
  Nil_fm :: "i=>i" where
    "Nil_fm(x) == Exists(And(empty_fm(0), Inl_fm(0,succ(x))))"

lemma Nil_type [TC]: "x \<in> nat ==> Nil_fm(x) \<in> formula"
by (simp add: Nil_fm_def)

lemma sats_Nil_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, Nil_fm(x), env) \<longleftrightarrow> is_Nil(##A, nth(x,env))"
by (simp add: Nil_fm_def is_Nil_def)

lemma Nil_iff_sats:
      "[| nth(i,env) = x; i \<in> nat; env \<in> list(A)|]
       ==> is_Nil(##A, x) \<longleftrightarrow> sats(A, Nil_fm(i), env)"
by simp

theorem Nil_reflection:
     "REFLECTS[\<lambda>x. is_Nil(L,f(x)),
               \<lambda>i x. is_Nil(##Lset(i),f(x))]"
apply (simp only: is_Nil_def)
apply (intro FOL_reflections function_reflections Inl_reflection)
done

subsubsection\<open>The Formula @{term is_Cons}, Internalized\<close>

(*  "is_Cons(M,a,l,Z) == \<exists>p[M]. pair(M,a,l,p) & is_Inr(M,p,Z)" *)
definition
  Cons_fm :: "[i,i,i]=>i" where
    "Cons_fm(a,l,Z) ==
       Exists(And(pair_fm(succ(a),succ(l),0), Inr_fm(0,succ(Z))))"

lemma Cons_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> Cons_fm(x,y,z) \<in> formula"
by (simp add: Cons_fm_def)

lemma sats_Cons_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, Cons_fm(x,y,z), env) \<longleftrightarrow>
       is_Cons(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: Cons_fm_def is_Cons_def)

lemma Cons_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==>is_Cons(##A, x, y, z) \<longleftrightarrow> sats(A, Cons_fm(i,j,k), env)"
by simp

theorem Cons_reflection:
     "REFLECTS[\<lambda>x. is_Cons(L,f(x),g(x),h(x)),
               \<lambda>i x. is_Cons(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: is_Cons_def)
apply (intro FOL_reflections pair_reflection Inr_reflection)
done

subsubsection\<open>The Formula @{term is_quasilist}, Internalized\<close>

(* is_quasilist(M,xs) == is_Nil(M,z) | (\<exists>x[M]. \<exists>l[M]. is_Cons(M,x,l,z))" *)

definition
  quasilist_fm :: "i=>i" where
    "quasilist_fm(x) ==
       Or(Nil_fm(x), Exists(Exists(Cons_fm(1,0,succ(succ(x))))))"

lemma quasilist_type [TC]: "x \<in> nat ==> quasilist_fm(x) \<in> formula"
by (simp add: quasilist_fm_def)

lemma sats_quasilist_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, quasilist_fm(x), env) \<longleftrightarrow> is_quasilist(##A, nth(x,env))"
by (simp add: quasilist_fm_def is_quasilist_def)

lemma quasilist_iff_sats:
      "[| nth(i,env) = x; i \<in> nat; env \<in> list(A)|]
       ==> is_quasilist(##A, x) \<longleftrightarrow> sats(A, quasilist_fm(i), env)"
by simp

theorem quasilist_reflection:
     "REFLECTS[\<lambda>x. is_quasilist(L,f(x)),
               \<lambda>i x. is_quasilist(##Lset(i),f(x))]"
apply (simp only: is_quasilist_def)
apply (intro FOL_reflections Nil_reflection Cons_reflection)
done

subsection\<open>Absoluteness for the Function @{term nth}\<close>

subsubsection\<open>The Formula @{term is_hd}, Internalized\<close>

(*   "is_hd(M,xs,H) ==
       (is_Nil(M,xs) \<longrightarrow> empty(M,H)) &
       (\<forall>x[M]. \<forall>l[M]. ~ is_Cons(M,x,l,xs) | H=x) &
       (is_quasilist(M,xs) | empty(M,H))" *)
definition
  hd_fm :: "[i,i]=>i" where
    "hd_fm(xs,H) ==
       And(Implies(Nil_fm(xs), empty_fm(H)),
           And(Forall(Forall(Or(Neg(Cons_fm(1,0,xs#+2)), Equal(H#+2,1)))),
               Or(quasilist_fm(xs), empty_fm(H))))"

lemma hd_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> hd_fm(x,y) \<in> formula"
by (simp add: hd_fm_def)

lemma sats_hd_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, hd_fm(x,y), env) \<longleftrightarrow> is_hd(##A, nth(x,env), nth(y,env))"
by (simp add: hd_fm_def is_hd_def)

lemma hd_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> is_hd(##A, x, y) \<longleftrightarrow> sats(A, hd_fm(i,j), env)"
by simp

theorem hd_reflection:
     "REFLECTS[\<lambda>x. is_hd(L,f(x),g(x)),
               \<lambda>i x. is_hd(##Lset(i),f(x),g(x))]"
apply (simp only: is_hd_def)
apply (intro FOL_reflections Nil_reflection Cons_reflection
             quasilist_reflection empty_reflection)
done

subsubsection\<open>The Formula @{term is_tl}, Internalized\<close>

(*     "is_tl(M,xs,T) ==
       (is_Nil(M,xs) \<longrightarrow> T=xs) &
       (\<forall>x[M]. \<forall>l[M]. ~ is_Cons(M,x,l,xs) | T=l) &
       (is_quasilist(M,xs) | empty(M,T))" *)
definition
  tl_fm :: "[i,i]=>i" where
    "tl_fm(xs,T) ==
       And(Implies(Nil_fm(xs), Equal(T,xs)),
           And(Forall(Forall(Or(Neg(Cons_fm(1,0,xs#+2)), Equal(T#+2,0)))),
               Or(quasilist_fm(xs), empty_fm(T))))"

lemma tl_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> tl_fm(x,y) \<in> formula"
by (simp add: tl_fm_def)

lemma sats_tl_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, tl_fm(x,y), env) \<longleftrightarrow> is_tl(##A, nth(x,env), nth(y,env))"
by (simp add: tl_fm_def is_tl_def)

lemma tl_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> is_tl(##A, x, y) \<longleftrightarrow> sats(A, tl_fm(i,j), env)"
by simp

theorem tl_reflection:
     "REFLECTS[\<lambda>x. is_tl(L,f(x),g(x)),
               \<lambda>i x. is_tl(##Lset(i),f(x),g(x))]"
apply (simp only: is_tl_def)
apply (intro FOL_reflections Nil_reflection Cons_reflection
             quasilist_reflection empty_reflection)
done

subsubsection\<open>The Operator @{term is_bool_of_o}\<close>

(*   is_bool_of_o :: "[i=>o, o, i] => o"
   "is_bool_of_o(M,P,z) == (P & number1(M,z)) | (~P & empty(M,z))" *)

text\<open>The formula @{term p} has no free variables.\<close>
definition
  bool_of_o_fm :: "[i, i]=>i" where
  "bool_of_o_fm(p,z) ==
    Or(And(p,number1_fm(z)),
       And(Neg(p),empty_fm(z)))"

lemma is_bool_of_o_type [TC]:
     "[| p \<in> formula; z \<in> nat |] ==> bool_of_o_fm(p,z) \<in> formula"
by (simp add: bool_of_o_fm_def)

lemma sats_bool_of_o_fm:
  assumes p_iff_sats: "P \<longleftrightarrow> sats(A, p, env)"
  shows
      "[|z \<in> nat; env \<in> list(A)|]
       ==> sats(A, bool_of_o_fm(p,z), env) \<longleftrightarrow>
           is_bool_of_o(##A, P, nth(z,env))"
by (simp add: bool_of_o_fm_def is_bool_of_o_def p_iff_sats [THEN iff_sym])

lemma is_bool_of_o_iff_sats:
  "[| P \<longleftrightarrow> sats(A, p, env); nth(k,env) = z; k \<in> nat; env \<in> list(A)|]
   ==> is_bool_of_o(##A, P, z) \<longleftrightarrow> sats(A, bool_of_o_fm(p,k), env)"
by (simp add: sats_bool_of_o_fm)

theorem bool_of_o_reflection:
     "REFLECTS [P(L), \<lambda>i. P(##Lset(i))] ==>
      REFLECTS[\<lambda>x. is_bool_of_o(L, P(L,x), f(x)),
               \<lambda>i x. is_bool_of_o(##Lset(i), P(##Lset(i),x), f(x))]"
apply (simp (no_asm) only: is_bool_of_o_def)
apply (intro FOL_reflections function_reflections, assumption+)
done

subsection\<open>More Internalizations\<close>

subsubsection\<open>The Operator @{term is_lambda}\<close>

text\<open>The two arguments of @{term p} are always 1, 0. Remember that
 @{term p} will be enclosed by three quantifiers.\<close>

(* is_lambda :: "[i=>o, i, [i,i]=>o, i] => o"
    "is_lambda(M, A, is_b, z) ==
       \<forall>p[M]. p \<in> z \<longleftrightarrow>
        (\<exists>u[M]. \<exists>v[M]. u\<in>A & pair(M,u,v,p) & is_b(u,v))" *)
definition
  lambda_fm :: "[i, i, i]=>i" where
  "lambda_fm(p,A,z) ==
    Forall(Iff(Member(0,succ(z)),
            Exists(Exists(And(Member(1,A#+3),
                           And(pair_fm(1,0,2), p))))))"

text\<open>We call @{term p} with arguments x, y by equating them with
  the corresponding quantified variables with de Bruijn indices 1, 0.\<close>

lemma is_lambda_type [TC]:
     "[| p \<in> formula; x \<in> nat; y \<in> nat |]
      ==> lambda_fm(p,x,y) \<in> formula"
by (simp add: lambda_fm_def)

lemma sats_lambda_fm:
  assumes is_b_iff_sats:
      "!!a0 a1 a2.
        [|a0\<in>A; a1\<in>A; a2\<in>A|]
        ==> is_b(a1, a0) \<longleftrightarrow> sats(A, p, Cons(a0,Cons(a1,Cons(a2,env))))"
  shows
      "[|x \<in> nat; y \<in> nat; env \<in> list(A)|]
       ==> sats(A, lambda_fm(p,x,y), env) \<longleftrightarrow>
           is_lambda(##A, nth(x,env), is_b, nth(y,env))"
by (simp add: lambda_fm_def is_lambda_def is_b_iff_sats [THEN iff_sym])

theorem is_lambda_reflection:
  assumes is_b_reflection:
    "!!f g h. REFLECTS[\<lambda>x. is_b(L, f(x), g(x), h(x)),
                     \<lambda>i x. is_b(##Lset(i), f(x), g(x), h(x))]"
  shows "REFLECTS[\<lambda>x. is_lambda(L, A(x), is_b(L,x), f(x)),
               \<lambda>i x. is_lambda(##Lset(i), A(x), is_b(##Lset(i),x), f(x))]"
apply (simp (no_asm_use) only: is_lambda_def)
apply (intro FOL_reflections is_b_reflection pair_reflection)
done

subsubsection\<open>The Operator @{term is_Member}, Internalized\<close>

(*    "is_Member(M,x,y,Z) ==
        \<exists>p[M]. \<exists>u[M]. pair(M,x,y,p) & is_Inl(M,p,u) & is_Inl(M,u,Z)" *)
definition
  Member_fm :: "[i,i,i]=>i" where
    "Member_fm(x,y,Z) ==
       Exists(Exists(And(pair_fm(x#+2,y#+2,1),
                      And(Inl_fm(1,0), Inl_fm(0,Z#+2)))))"

lemma is_Member_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> Member_fm(x,y,z) \<in> formula"
by (simp add: Member_fm_def)

lemma sats_Member_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, Member_fm(x,y,z), env) \<longleftrightarrow>
        is_Member(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: Member_fm_def is_Member_def)

lemma Member_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_Member(##A, x, y, z) \<longleftrightarrow> sats(A, Member_fm(i,j,k), env)"
by (simp add: sats_Member_fm)

theorem Member_reflection:
     "REFLECTS[\<lambda>x. is_Member(L,f(x),g(x),h(x)),
               \<lambda>i x. is_Member(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: is_Member_def)
apply (intro FOL_reflections pair_reflection Inl_reflection)
done

subsubsection\<open>The Operator @{term is_Equal}, Internalized\<close>

(*    "is_Equal(M,x,y,Z) ==
        \<exists>p[M]. \<exists>u[M]. pair(M,x,y,p) & is_Inr(M,p,u) & is_Inl(M,u,Z)" *)
definition
  Equal_fm :: "[i,i,i]=>i" where
    "Equal_fm(x,y,Z) ==
       Exists(Exists(And(pair_fm(x#+2,y#+2,1),
                      And(Inr_fm(1,0), Inl_fm(0,Z#+2)))))"

lemma is_Equal_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> Equal_fm(x,y,z) \<in> formula"
by (simp add: Equal_fm_def)

lemma sats_Equal_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, Equal_fm(x,y,z), env) \<longleftrightarrow>
        is_Equal(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: Equal_fm_def is_Equal_def)

lemma Equal_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_Equal(##A, x, y, z) \<longleftrightarrow> sats(A, Equal_fm(i,j,k), env)"
by (simp add: sats_Equal_fm)

theorem Equal_reflection:
     "REFLECTS[\<lambda>x. is_Equal(L,f(x),g(x),h(x)),
               \<lambda>i x. is_Equal(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: is_Equal_def)
apply (intro FOL_reflections pair_reflection Inl_reflection Inr_reflection)
done

subsubsection\<open>The Operator @{term is_Nand}, Internalized\<close>

(*    "is_Nand(M,x,y,Z) ==
        \<exists>p[M]. \<exists>u[M]. pair(M,x,y,p) & is_Inl(M,p,u) & is_Inr(M,u,Z)" *)
definition
  Nand_fm :: "[i,i,i]=>i" where
    "Nand_fm(x,y,Z) ==
       Exists(Exists(And(pair_fm(x#+2,y#+2,1),
                      And(Inl_fm(1,0), Inr_fm(0,Z#+2)))))"

lemma is_Nand_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> Nand_fm(x,y,z) \<in> formula"
by (simp add: Nand_fm_def)

lemma sats_Nand_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, Nand_fm(x,y,z), env) \<longleftrightarrow>
        is_Nand(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: Nand_fm_def is_Nand_def)

lemma Nand_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_Nand(##A, x, y, z) \<longleftrightarrow> sats(A, Nand_fm(i,j,k), env)"
by (simp add: sats_Nand_fm)

theorem Nand_reflection:
     "REFLECTS[\<lambda>x. is_Nand(L,f(x),g(x),h(x)),
               \<lambda>i x. is_Nand(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: is_Nand_def)
apply (intro FOL_reflections pair_reflection Inl_reflection Inr_reflection)
done

subsubsection\<open>The Operator @{term is_Forall}, Internalized\<close>

(* "is_Forall(M,p,Z) == \<exists>u[M]. is_Inr(M,p,u) & is_Inr(M,u,Z)" *)
definition
  Forall_fm :: "[i,i]=>i" where
    "Forall_fm(x,Z) ==
       Exists(And(Inr_fm(succ(x),0), Inr_fm(0,succ(Z))))"

lemma is_Forall_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> Forall_fm(x,y) \<in> formula"
by (simp add: Forall_fm_def)

lemma sats_Forall_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, Forall_fm(x,y), env) \<longleftrightarrow>
        is_Forall(##A, nth(x,env), nth(y,env))"
by (simp add: Forall_fm_def is_Forall_def)

lemma Forall_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> is_Forall(##A, x, y) \<longleftrightarrow> sats(A, Forall_fm(i,j), env)"
by (simp add: sats_Forall_fm)

theorem Forall_reflection:
     "REFLECTS[\<lambda>x. is_Forall(L,f(x),g(x)),
               \<lambda>i x. is_Forall(##Lset(i),f(x),g(x))]"
apply (simp only: is_Forall_def)
apply (intro FOL_reflections pair_reflection Inr_reflection)
done

subsubsection\<open>The Operator @{term is_and}, Internalized\<close>

(* is_and(M,a,b,z) == (number1(M,a)  & z=b) |
                       (~number1(M,a) & empty(M,z)) *)
definition
  and_fm :: "[i,i,i]=>i" where
    "and_fm(a,b,z) ==
       Or(And(number1_fm(a), Equal(z,b)),
          And(Neg(number1_fm(a)),empty_fm(z)))"

lemma is_and_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> and_fm(x,y,z) \<in> formula"
by (simp add: and_fm_def)

lemma sats_and_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, and_fm(x,y,z), env) \<longleftrightarrow>
        is_and(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: and_fm_def is_and_def)

lemma is_and_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_and(##A, x, y, z) \<longleftrightarrow> sats(A, and_fm(i,j,k), env)"
by simp

theorem is_and_reflection:
     "REFLECTS[\<lambda>x. is_and(L,f(x),g(x),h(x)),
               \<lambda>i x. is_and(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: is_and_def)
apply (intro FOL_reflections function_reflections)
done

subsubsection\<open>The Operator @{term is_or}, Internalized\<close>

(* is_or(M,a,b,z) == (number1(M,a)  & number1(M,z)) |
                     (~number1(M,a) & z=b) *)

definition
  or_fm :: "[i,i,i]=>i" where
    "or_fm(a,b,z) ==
       Or(And(number1_fm(a), number1_fm(z)),
          And(Neg(number1_fm(a)), Equal(z,b)))"

lemma is_or_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> or_fm(x,y,z) \<in> formula"
by (simp add: or_fm_def)

lemma sats_or_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, or_fm(x,y,z), env) \<longleftrightarrow>
        is_or(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: or_fm_def is_or_def)

lemma is_or_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_or(##A, x, y, z) \<longleftrightarrow> sats(A, or_fm(i,j,k), env)"
by simp

theorem is_or_reflection:
     "REFLECTS[\<lambda>x. is_or(L,f(x),g(x),h(x)),
               \<lambda>i x. is_or(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: is_or_def)
apply (intro FOL_reflections function_reflections)
done

subsubsection\<open>The Operator @{term is_not}, Internalized\<close>

(* is_not(M,a,z) == (number1(M,a)  & empty(M,z)) |
                     (~number1(M,a) & number1(M,z)) *)
definition
  not_fm :: "[i,i]=>i" where
    "not_fm(a,z) ==
       Or(And(number1_fm(a), empty_fm(z)),
          And(Neg(number1_fm(a)), number1_fm(z)))"

lemma is_not_type [TC]:
     "[| x \<in> nat; z \<in> nat |] ==> not_fm(x,z) \<in> formula"
by (simp add: not_fm_def)

lemma sats_is_not_fm [simp]:
   "[| x \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, not_fm(x,z), env) \<longleftrightarrow> is_not(##A, nth(x,env), nth(z,env))"
by (simp add: not_fm_def is_not_def)

lemma is_not_iff_sats:
      "[| nth(i,env) = x; nth(k,env) = z;
          i \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_not(##A, x, z) \<longleftrightarrow> sats(A, not_fm(i,k), env)"
by simp

theorem is_not_reflection:
     "REFLECTS[\<lambda>x. is_not(L,f(x),g(x)),
               \<lambda>i x. is_not(##Lset(i),f(x),g(x))]"
apply (simp only: is_not_def)
apply (intro FOL_reflections function_reflections)
done

lemmas extra_reflections =
    Inl_reflection Inr_reflection Nil_reflection Cons_reflection
    quasilist_reflection hd_reflection tl_reflection bool_of_o_reflection
    is_lambda_reflection Member_reflection Equal_reflection Nand_reflection
    Forall_reflection is_and_reflection is_or_reflection is_not_reflection

subsection\<open>Well-Founded Recursion!\<close>

subsubsection\<open>The Operator @{term M_is_recfun}\<close>

text\<open>Alternative definition, minimizing nesting of quantifiers around MH\<close>
lemma M_is_recfun_iff:
   "M_is_recfun(M,MH,r,a,f) \<longleftrightarrow>
    (\<forall>z[M]. z \<in> f \<longleftrightarrow>
     (\<exists>x[M]. \<exists>f_r_sx[M]. \<exists>y[M].
             MH(x, f_r_sx, y) & pair(M,x,y,z) &
             (\<exists>xa[M]. \<exists>sx[M]. \<exists>r_sx[M].
                pair(M,x,a,xa) & upair(M,x,x,sx) &
               pre_image(M,r,sx,r_sx) & restriction(M,f,r_sx,f_r_sx) &
               xa \<in> r)))"
apply (simp add: M_is_recfun_def)
apply (rule rall_cong, blast)
done

(* M_is_recfun :: "[i=>o, [i,i,i]=>o, i, i, i] => o"
   "M_is_recfun(M,MH,r,a,f) ==
     \<forall>z[M]. z \<in> f \<longleftrightarrow>
               2      1           0
new def     (\<exists>x[M]. \<exists>f_r_sx[M]. \<exists>y[M].
             MH(x, f_r_sx, y) & pair(M,x,y,z) &
             (\<exists>xa[M]. \<exists>sx[M]. \<exists>r_sx[M].
                pair(M,x,a,xa) & upair(M,x,x,sx) &
               pre_image(M,r,sx,r_sx) & restriction(M,f,r_sx,f_r_sx) &
               xa \<in> r)"
*)

text\<open>The three arguments of @{term p} are always 2, 1, 0 and z\<close>
definition
  is_recfun_fm :: "[i, i, i, i]=>i" where
  "is_recfun_fm(p,r,a,f) ==
   Forall(Iff(Member(0,succ(f)),
    Exists(Exists(Exists(
     And(p,
      And(pair_fm(2,0,3),
       Exists(Exists(Exists(
        And(pair_fm(5,a#+7,2),
         And(upair_fm(5,5,1),
          And(pre_image_fm(r#+7,1,0),
           And(restriction_fm(f#+7,0,4), Member(2,r#+7)))))))))))))))"

lemma is_recfun_type [TC]:
     "[| p \<in> formula; x \<in> nat; y \<in> nat; z \<in> nat |]
      ==> is_recfun_fm(p,x,y,z) \<in> formula"
by (simp add: is_recfun_fm_def)

lemma sats_is_recfun_fm:
  assumes MH_iff_sats:
      "!!a0 a1 a2 a3.
        [|a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A|]
        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,env)))))"
  shows
      "[|x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
       ==> sats(A, is_recfun_fm(p,x,y,z), env) \<longleftrightarrow>
           M_is_recfun(##A, MH, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: is_recfun_fm_def M_is_recfun_iff MH_iff_sats [THEN iff_sym])

lemma is_recfun_iff_sats:
  assumes MH_iff_sats:
      "!!a0 a1 a2 a3.
        [|a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A|]
        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,env)))))"
  shows
  "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
   ==> M_is_recfun(##A, MH, x, y, z) \<longleftrightarrow> sats(A, is_recfun_fm(p,i,j,k), env)"
by (simp add: sats_is_recfun_fm [OF MH_iff_sats])

text\<open>The additional variable in the premise, namely @{term f'}, is essential.
It lets @{term MH} depend upon @{term x}, which seems often necessary.
The same thing occurs in \<open>is_wfrec_reflection\<close>.\<close>
theorem is_recfun_reflection:
  assumes MH_reflection:
    "!!f' f g h. REFLECTS[\<lambda>x. MH(L, f'(x), f(x), g(x), h(x)),
                     \<lambda>i x. MH(##Lset(i), f'(x), f(x), g(x), h(x))]"
  shows "REFLECTS[\<lambda>x. M_is_recfun(L, MH(L,x), f(x), g(x), h(x)),
             \<lambda>i x. M_is_recfun(##Lset(i), MH(##Lset(i),x), f(x), g(x), h(x))]"
apply (simp (no_asm_use) only: M_is_recfun_def)
apply (intro FOL_reflections function_reflections
             restriction_reflection MH_reflection)
done

subsubsection\<open>The Operator @{term is_wfrec}\<close>

text\<open>The three arguments of @{term p} are always 2, 1, 0;
      @{term p} is enclosed by 5 quantifiers.\<close>

(* is_wfrec :: "[i=>o, i, [i,i,i]=>o, i, i] => o"
    "is_wfrec(M,MH,r,a,z) ==
      \<exists>f[M]. M_is_recfun(M,MH,r,a,f) & MH(a,f,z)" *)
definition
  is_wfrec_fm :: "[i, i, i, i]=>i" where
  "is_wfrec_fm(p,r,a,z) ==
    Exists(And(is_recfun_fm(p, succ(r), succ(a), 0),
           Exists(Exists(Exists(Exists(
             And(Equal(2,a#+5), And(Equal(1,4), And(Equal(0,z#+5), p)))))))))"

text\<open>We call @{term p} with arguments a, f, z by equating them with
  the corresponding quantified variables with de Bruijn indices 2, 1, 0.\<close>

text\<open>There's an additional existential quantifier to ensure that the
      environments in both calls to MH have the same length.\<close>

lemma is_wfrec_type [TC]:
     "[| p \<in> formula; x \<in> nat; y \<in> nat; z \<in> nat |]
      ==> is_wfrec_fm(p,x,y,z) \<in> formula"
by (simp add: is_wfrec_fm_def)

lemma sats_is_wfrec_fm:
  assumes MH_iff_sats:
      "!!a0 a1 a2 a3 a4.
        [|a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A; a4\<in>A|]
        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
  shows
      "[|x \<in> nat; y < length(env); z < length(env); env \<in> list(A)|]
       ==> sats(A, is_wfrec_fm(p,x,y,z), env) \<longleftrightarrow>
           is_wfrec(##A, MH, nth(x,env), nth(y,env), nth(z,env))"
apply (frule_tac x=z in lt_length_in_nat, assumption)
apply (frule lt_length_in_nat, assumption)
apply (simp add: is_wfrec_fm_def sats_is_recfun_fm is_wfrec_def MH_iff_sats [THEN iff_sym], blast)
done

lemma is_wfrec_iff_sats:
  assumes MH_iff_sats:
      "!!a0 a1 a2 a3 a4.
        [|a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A; a4\<in>A|]
        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
  shows
  "[|nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i \<in> nat; j < length(env); k < length(env); env \<in> list(A)|]
   ==> is_wfrec(##A, MH, x, y, z) \<longleftrightarrow> sats(A, is_wfrec_fm(p,i,j,k), env)"
by (simp add: sats_is_wfrec_fm [OF MH_iff_sats])

theorem is_wfrec_reflection:
  assumes MH_reflection:
    "!!f' f g h. REFLECTS[\<lambda>x. MH(L, f'(x), f(x), g(x), h(x)),
                     \<lambda>i x. MH(##Lset(i), f'(x), f(x), g(x), h(x))]"
  shows "REFLECTS[\<lambda>x. is_wfrec(L, MH(L,x), f(x), g(x), h(x)),
               \<lambda>i x. is_wfrec(##Lset(i), MH(##Lset(i),x), f(x), g(x), h(x))]"
apply (simp (no_asm_use) only: is_wfrec_def)
apply (intro FOL_reflections MH_reflection is_recfun_reflection)
done

subsection\<open>For Datatypes\<close>

subsubsection\<open>Binary Products, Internalized\<close>

definition
  cartprod_fm :: "[i,i,i]=>i" where
(* "cartprod(M,A,B,z) ==
        \<forall>u[M]. u \<in> z \<longleftrightarrow> (\<exists>x[M]. x\<in>A & (\<exists>y[M]. y\<in>B & pair(M,x,y,u)))" *)
    "cartprod_fm(A,B,z) ==
       Forall(Iff(Member(0,succ(z)),
                  Exists(And(Member(0,succ(succ(A))),
                         Exists(And(Member(0,succ(succ(succ(B)))),
                                    pair_fm(1,0,2)))))))"

lemma cartprod_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> cartprod_fm(x,y,z) \<in> formula"
by (simp add: cartprod_fm_def)

lemma sats_cartprod_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, cartprod_fm(x,y,z), env) \<longleftrightarrow>
        cartprod(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: cartprod_fm_def cartprod_def)

lemma cartprod_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> cartprod(##A, x, y, z) \<longleftrightarrow> sats(A, cartprod_fm(i,j,k), env)"
by (simp add: sats_cartprod_fm)

theorem cartprod_reflection:
     "REFLECTS[\<lambda>x. cartprod(L,f(x),g(x),h(x)),
               \<lambda>i x. cartprod(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: cartprod_def)
apply (intro FOL_reflections pair_reflection)
done

subsubsection\<open>Binary Sums, Internalized\<close>

(* "is_sum(M,A,B,Z) ==
       \<exists>A0[M]. \<exists>n1[M]. \<exists>s1[M]. \<exists>B1[M].
         3      2       1        0
       number1(M,n1) & cartprod(M,n1,A,A0) & upair(M,n1,n1,s1) &
       cartprod(M,s1,B,B1) & union(M,A0,B1,Z)"  *)
definition
  sum_fm :: "[i,i,i]=>i" where
    "sum_fm(A,B,Z) ==
       Exists(Exists(Exists(Exists(
        And(number1_fm(2),
            And(cartprod_fm(2,A#+4,3),
                And(upair_fm(2,2,1),
                    And(cartprod_fm(1,B#+4,0), union_fm(3,0,Z#+4)))))))))"

lemma sum_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> sum_fm(x,y,z) \<in> formula"
by (simp add: sum_fm_def)

lemma sats_sum_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, sum_fm(x,y,z), env) \<longleftrightarrow>
        is_sum(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: sum_fm_def is_sum_def)

lemma sum_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
       ==> is_sum(##A, x, y, z) \<longleftrightarrow> sats(A, sum_fm(i,j,k), env)"
by simp

theorem sum_reflection:
     "REFLECTS[\<lambda>x. is_sum(L,f(x),g(x),h(x)),
               \<lambda>i x. is_sum(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: is_sum_def)
apply (intro FOL_reflections function_reflections cartprod_reflection)
done

subsubsection\<open>The Operator @{term quasinat}\<close>

(* "is_quasinat(M,z) == empty(M,z) | (\<exists>m[M]. successor(M,m,z))" *)
definition
  quasinat_fm :: "i=>i" where
    "quasinat_fm(z) == Or(empty_fm(z), Exists(succ_fm(0,succ(z))))"

lemma quasinat_type [TC]:
     "x \<in> nat ==> quasinat_fm(x) \<in> formula"
by (simp add: quasinat_fm_def)

lemma sats_quasinat_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, quasinat_fm(x), env) \<longleftrightarrow> is_quasinat(##A, nth(x,env))"
by (simp add: quasinat_fm_def is_quasinat_def)

lemma quasinat_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; env \<in> list(A)|]
       ==> is_quasinat(##A, x) \<longleftrightarrow> sats(A, quasinat_fm(i), env)"
by simp

theorem quasinat_reflection:
     "REFLECTS[\<lambda>x. is_quasinat(L,f(x)),
               \<lambda>i x. is_quasinat(##Lset(i),f(x))]"
apply (simp only: is_quasinat_def)
apply (intro FOL_reflections function_reflections)
done

subsubsection\<open>The Operator @{term is_nat_case}\<close>
text\<open>I could not get it to work with the more natural assumption that
 @{term is_b} takes two arguments.  Instead it must be a formula where 1 and 0
 stand for @{term m} and @{term b}, respectively.\<close>

(* is_nat_case :: "[i=>o, i, [i,i]=>o, i, i] => o"
    "is_nat_case(M, a, is_b, k, z) ==
       (empty(M,k) \<longrightarrow> z=a) &
       (\<forall>m[M]. successor(M,m,k) \<longrightarrow> is_b(m,z)) &
       (is_quasinat(M,k) | empty(M,z))" *)
text\<open>The formula @{term is_b} has free variables 1 and 0.\<close>
definition
  is_nat_case_fm :: "[i, i, i, i]=>i" where
 "is_nat_case_fm(a,is_b,k,z) ==
    And(Implies(empty_fm(k), Equal(z,a)),
        And(Forall(Implies(succ_fm(0,succ(k)),
                   Forall(Implies(Equal(0,succ(succ(z))), is_b)))),
            Or(quasinat_fm(k), empty_fm(z))))"

lemma is_nat_case_type [TC]:
     "[| is_b \<in> formula;
         x \<in> nat; y \<in> nat; z \<in> nat |]
      ==> is_nat_case_fm(x,is_b,y,z) \<in> formula"
by (simp add: is_nat_case_fm_def)

lemma sats_is_nat_case_fm:
  assumes is_b_iff_sats:
      "!!a. a \<in> A ==> is_b(a,nth(z, env)) \<longleftrightarrow>
                      sats(A, p, Cons(nth(z,env), Cons(a, env)))"
  shows
      "[|x \<in> nat; y \<in> nat; z < length(env); env \<in> list(A)|]
       ==> sats(A, is_nat_case_fm(x,p,y,z), env) \<longleftrightarrow>
           is_nat_case(##A, nth(x,env), is_b, nth(y,env), nth(z,env))"
apply (frule lt_length_in_nat, assumption)
apply (simp add: is_nat_case_fm_def is_nat_case_def is_b_iff_sats [THEN iff_sym])
done

lemma is_nat_case_iff_sats:
  "[| (!!a. a \<in> A ==> is_b(a,z) \<longleftrightarrow>
                      sats(A, p, Cons(z, Cons(a,env))));
      nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i \<in> nat; j \<in> nat; k < length(env); env \<in> list(A)|]
   ==> is_nat_case(##A, x, is_b, y, z) \<longleftrightarrow> sats(A, is_nat_case_fm(i,p,j,k), env)"
by (simp add: sats_is_nat_case_fm [of A is_b])

text\<open>The second argument of @{term is_b} gives it direct access to @{term x},
  which is essential for handling free variable references.  Without this
  argument, we cannot prove reflection for @{term iterates_MH}.\<close>
theorem is_nat_case_reflection:
  assumes is_b_reflection:
    "!!h f g. REFLECTS[\<lambda>x. is_b(L, h(x), f(x), g(x)),
                     \<lambda>i x. is_b(##Lset(i), h(x), f(x), g(x))]"
  shows "REFLECTS[\<lambda>x. is_nat_case(L, f(x), is_b(L,x), g(x), h(x)),
               \<lambda>i x. is_nat_case(##Lset(i), f(x), is_b(##Lset(i), x), g(x), h(x))]"
apply (simp (no_asm_use) only: is_nat_case_def)
apply (intro FOL_reflections function_reflections
             restriction_reflection is_b_reflection quasinat_reflection)
done

subsection\<open>The Operator @{term iterates_MH}, Needed for Iteration\<close>

(*  iterates_MH :: "[i=>o, [i,i]=>o, i, i, i, i] => o"
   "iterates_MH(M,isF,v,n,g,z) ==
        is_nat_case(M, v, \<lambda>m u. \<exists>gm[M]. fun_apply(M,g,m,gm) & isF(gm,u),
                    n, z)" *)
definition
  iterates_MH_fm :: "[i, i, i, i, i]=>i" where
 "iterates_MH_fm(isF,v,n,g,z) ==
    is_nat_case_fm(v,
      Exists(And(fun_apply_fm(succ(succ(succ(g))),2,0),
                     Forall(Implies(Equal(0,2), isF)))),
      n, z)"

lemma iterates_MH_type [TC]:
     "[| p \<in> formula;
         v \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat |]
      ==> iterates_MH_fm(p,v,x,y,z) \<in> formula"
by (simp add: iterates_MH_fm_def)

lemma sats_iterates_MH_fm:
  assumes is_F_iff_sats:
      "!!a b c d. [| a \<in> A; b \<in> A; c \<in> A; d \<in> A|]
              ==> is_F(a,b) \<longleftrightarrow>
                  sats(A, p, Cons(b, Cons(a, Cons(c, Cons(d,env)))))"
  shows
      "[|v \<in> nat; x \<in> nat; y \<in> nat; z < length(env); env \<in> list(A)|]
       ==> sats(A, iterates_MH_fm(p,v,x,y,z), env) \<longleftrightarrow>
           iterates_MH(##A, is_F, nth(v,env), nth(x,env), nth(y,env), nth(z,env))"
apply (frule lt_length_in_nat, assumption)
apply (simp add: iterates_MH_fm_def iterates_MH_def sats_is_nat_case_fm
              is_F_iff_sats [symmetric])
apply (rule is_nat_case_cong)
apply (simp_all add: setclass_def)
done

lemma iterates_MH_iff_sats:
  assumes is_F_iff_sats:
      "!!a b c d. [| a \<in> A; b \<in> A; c \<in> A; d \<in> A|]
              ==> is_F(a,b) \<longleftrightarrow>
                  sats(A, p, Cons(b, Cons(a, Cons(c, Cons(d,env)))))"
  shows
  "[| nth(i',env) = v; nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i' \<in> nat; i \<in> nat; j \<in> nat; k < length(env); env \<in> list(A)|]
   ==> iterates_MH(##A, is_F, v, x, y, z) \<longleftrightarrow>
       sats(A, iterates_MH_fm(p,i',i,j,k), env)"
by (simp add: sats_iterates_MH_fm [OF is_F_iff_sats])

text\<open>The second argument of @{term p} gives it direct access to @{term x},
  which is essential for handling free variable references.  Without this
  argument, we cannot prove reflection for @{term list_N}.\<close>
theorem iterates_MH_reflection:
  assumes p_reflection:
    "!!f g h. REFLECTS[\<lambda>x. p(L, h(x), f(x), g(x)),
                     \<lambda>i x. p(##Lset(i), h(x), f(x), g(x))]"
 shows "REFLECTS[\<lambda>x. iterates_MH(L, p(L,x), e(x), f(x), g(x), h(x)),
               \<lambda>i x. iterates_MH(##Lset(i), p(##Lset(i),x), e(x), f(x), g(x), h(x))]"
apply (simp (no_asm_use) only: iterates_MH_def)
apply (intro FOL_reflections function_reflections is_nat_case_reflection
             restriction_reflection p_reflection)
done

subsubsection\<open>The Operator @{term is_iterates}\<close>

text\<open>The three arguments of @{term p} are always 2, 1, 0;
      @{term p} is enclosed by 9 (??) quantifiers.\<close>

(*    "is_iterates(M,isF,v,n,Z) ==
      \<exists>sn[M]. \<exists>msn[M]. successor(M,n,sn) & membership(M,sn,msn) &
       1       0       is_wfrec(M, iterates_MH(M,isF,v), msn, n, Z)"*)

definition
  is_iterates_fm :: "[i, i, i, i]=>i" where
  "is_iterates_fm(p,v,n,Z) ==
     Exists(Exists(
      And(succ_fm(n#+2,1),
       And(Memrel_fm(1,0),
              is_wfrec_fm(iterates_MH_fm(p, v#+7, 2, 1, 0),
                          0, n#+2, Z#+2)))))"

text\<open>We call @{term p} with arguments a, f, z by equating them with
  the corresponding quantified variables with de Bruijn indices 2, 1, 0.\<close>

lemma is_iterates_type [TC]:
     "[| p \<in> formula; x \<in> nat; y \<in> nat; z \<in> nat |]
      ==> is_iterates_fm(p,x,y,z) \<in> formula"
by (simp add: is_iterates_fm_def)

lemma sats_is_iterates_fm:
  assumes is_F_iff_sats:
      "!!a b c d e f g h i j k.
              [| a \<in> A; b \<in> A; c \<in> A; d \<in> A; e \<in> A; f \<in> A;
                 g \<in> A; h \<in> A; i \<in> A; j \<in> A; k \<in> A|]
              ==> is_F(a,b) \<longleftrightarrow>
                  sats(A, p, Cons(b, Cons(a, Cons(c, Cons(d, Cons(e, Cons(f,
                      Cons(g, Cons(h, Cons(i, Cons(j, Cons(k, env))))))))))))"
  shows
      "[|x \<in> nat; y < length(env); z < length(env); env \<in> list(A)|]
       ==> sats(A, is_iterates_fm(p,x,y,z), env) \<longleftrightarrow>
           is_iterates(##A, is_F, nth(x,env), nth(y,env), nth(z,env))"
apply (frule_tac x=z in lt_length_in_nat, assumption)
apply (frule lt_length_in_nat, assumption)
apply (simp add: is_iterates_fm_def is_iterates_def sats_is_nat_case_fm
              is_F_iff_sats [symmetric] sats_is_wfrec_fm sats_iterates_MH_fm)
done

lemma is_iterates_iff_sats:
  assumes is_F_iff_sats:
      "!!a b c d e f g h i j k.
              [| a \<in> A; b \<in> A; c \<in> A; d \<in> A; e \<in> A; f \<in> A;
                 g \<in> A; h \<in> A; i \<in> A; j \<in> A; k \<in> A|]
              ==> is_F(a,b) \<longleftrightarrow>
                  sats(A, p, Cons(b, Cons(a, Cons(c, Cons(d, Cons(e, Cons(f,
                      Cons(g, Cons(h, Cons(i, Cons(j, Cons(k, env))))))))))))"
  shows
  "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i \<in> nat; j < length(env); k < length(env); env \<in> list(A)|]
   ==> is_iterates(##A, is_F, x, y, z) \<longleftrightarrow>
       sats(A, is_iterates_fm(p,i,j,k), env)"
by (simp add: sats_is_iterates_fm [OF is_F_iff_sats])

text\<open>The second argument of @{term p} gives it direct access to @{term x},
  which is essential for handling free variable references.  Without this
  argument, we cannot prove reflection for @{term list_N}.\<close>
theorem is_iterates_reflection:
  assumes p_reflection:
    "!!f g h. REFLECTS[\<lambda>x. p(L, h(x), f(x), g(x)),
                     \<lambda>i x. p(##Lset(i), h(x), f(x), g(x))]"
 shows "REFLECTS[\<lambda>x. is_iterates(L, p(L,x), f(x), g(x), h(x)),
               \<lambda>i x. is_iterates(##Lset(i), p(##Lset(i),x), f(x), g(x), h(x))]"
apply (simp (no_asm_use) only: is_iterates_def)
apply (intro FOL_reflections function_reflections p_reflection
             is_wfrec_reflection iterates_MH_reflection)
done

subsubsection\<open>The Formula @{term is_eclose_n}, Internalized\<close>

(* is_eclose_n(M,A,n,Z) == is_iterates(M, big_union(M), A, n, Z) *)

definition
  eclose_n_fm :: "[i,i,i]=>i" where
  "eclose_n_fm(A,n,Z) == is_iterates_fm(big_union_fm(1,0), A, n, Z)"

lemma eclose_n_fm_type [TC]:
 "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> eclose_n_fm(x,y,z) \<in> formula"
by (simp add: eclose_n_fm_def)

lemma sats_eclose_n_fm [simp]:
   "[| x \<in> nat; y < length(env); z < length(env); env \<in> list(A)|]
    ==> sats(A, eclose_n_fm(x,y,z), env) \<longleftrightarrow>
        is_eclose_n(##A, nth(x,env), nth(y,env), nth(z,env))"
apply (frule_tac x=z in lt_length_in_nat, assumption)
apply (frule_tac x=y in lt_length_in_nat, assumption)
apply (simp add: eclose_n_fm_def is_eclose_n_def
                 sats_is_iterates_fm)
done

lemma eclose_n_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j < length(env); k < length(env); env \<in> list(A)|]
       ==> is_eclose_n(##A, x, y, z) \<longleftrightarrow> sats(A, eclose_n_fm(i,j,k), env)"
by (simp add: sats_eclose_n_fm)

theorem eclose_n_reflection:
     "REFLECTS[\<lambda>x. is_eclose_n(L, f(x), g(x), h(x)),
               \<lambda>i x. is_eclose_n(##Lset(i), f(x), g(x), h(x))]"
apply (simp only: is_eclose_n_def)
apply (intro FOL_reflections function_reflections is_iterates_reflection)
done

subsubsection\<open>Membership in @{term "eclose(A)"}\<close>

(* mem_eclose(M,A,l) ==
      \<exists>n[M]. \<exists>eclosen[M].
       finite_ordinal(M,n) & is_eclose_n(M,A,n,eclosen) & l \<in> eclosen *)
definition
  mem_eclose_fm :: "[i,i]=>i" where
    "mem_eclose_fm(x,y) ==
       Exists(Exists(
         And(finite_ordinal_fm(1),
           And(eclose_n_fm(x#+2,1,0), Member(y#+2,0)))))"

lemma mem_eclose_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> mem_eclose_fm(x,y) \<in> formula"
by (simp add: mem_eclose_fm_def)

lemma sats_mem_eclose_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, mem_eclose_fm(x,y), env) \<longleftrightarrow> mem_eclose(##A, nth(x,env), nth(y,env))"
by (simp add: mem_eclose_fm_def mem_eclose_def)

lemma mem_eclose_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> mem_eclose(##A, x, y) \<longleftrightarrow> sats(A, mem_eclose_fm(i,j), env)"
by simp

theorem mem_eclose_reflection:
     "REFLECTS[\<lambda>x. mem_eclose(L,f(x),g(x)),
               \<lambda>i x. mem_eclose(##Lset(i),f(x),g(x))]"
apply (simp only: mem_eclose_def)
apply (intro FOL_reflections finite_ordinal_reflection eclose_n_reflection)
done

subsubsection\<open>The Predicate ``Is @{term "eclose(A)"}''\<close>

(* is_eclose(M,A,Z) == \<forall>l[M]. l \<in> Z \<longleftrightarrow> mem_eclose(M,A,l) *)
definition
  is_eclose_fm :: "[i,i]=>i" where
    "is_eclose_fm(A,Z) ==
       Forall(Iff(Member(0,succ(Z)), mem_eclose_fm(succ(A),0)))"

lemma is_eclose_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> is_eclose_fm(x,y) \<in> formula"
by (simp add: is_eclose_fm_def)

lemma sats_is_eclose_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, is_eclose_fm(x,y), env) \<longleftrightarrow> is_eclose(##A, nth(x,env), nth(y,env))"
by (simp add: is_eclose_fm_def is_eclose_def)

lemma is_eclose_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> is_eclose(##A, x, y) \<longleftrightarrow> sats(A, is_eclose_fm(i,j), env)"
by simp

theorem is_eclose_reflection:
     "REFLECTS[\<lambda>x. is_eclose(L,f(x),g(x)),
               \<lambda>i x. is_eclose(##Lset(i),f(x),g(x))]"
apply (simp only: is_eclose_def)
apply (intro FOL_reflections mem_eclose_reflection)
done

subsubsection\<open>The List Functor, Internalized\<close>

definition
  list_functor_fm :: "[i,i,i]=>i" where
(* "is_list_functor(M,A,X,Z) ==
        \<exists>n1[M]. \<exists>AX[M].
         number1(M,n1) & cartprod(M,A,X,AX) & is_sum(M,n1,AX,Z)" *)
    "list_functor_fm(A,X,Z) ==
       Exists(Exists(
        And(number1_fm(1),
            And(cartprod_fm(A#+2,X#+2,0), sum_fm(1,0,Z#+2)))))"

lemma list_functor_type [TC]:
     "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> list_functor_fm(x,y,z) \<in> formula"
by (simp add: list_functor_fm_def)

lemma sats_list_functor_fm [simp]:
   "[| x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)|]
    ==> sats(A, list_functor_fm(x,y,z), env) \<longleftrightarrow>
        is_list_functor(##A, nth(x,env), nth(y,env), nth(z,env))"
by (simp add: list_functor_fm_def is_list_functor_def)

lemma list_functor_iff_sats:
  "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
      i \<in> nat; j \<in> nat; k \<in> nat; env \<in> list(A)|]
   ==> is_list_functor(##A, x, y, z) \<longleftrightarrow> sats(A, list_functor_fm(i,j,k), env)"
by simp

theorem list_functor_reflection:
     "REFLECTS[\<lambda>x. is_list_functor(L,f(x),g(x),h(x)),
               \<lambda>i x. is_list_functor(##Lset(i),f(x),g(x),h(x))]"
apply (simp only: is_list_functor_def)
apply (intro FOL_reflections number1_reflection
             cartprod_reflection sum_reflection)
done

subsubsection\<open>The Formula @{term is_list_N}, Internalized\<close>

(* "is_list_N(M,A,n,Z) ==
      \<exists>zero[M]. empty(M,zero) &
                is_iterates(M, is_list_functor(M,A), zero, n, Z)" *)

definition
  list_N_fm :: "[i,i,i]=>i" where
  "list_N_fm(A,n,Z) ==
     Exists(
       And(empty_fm(0),
           is_iterates_fm(list_functor_fm(A#+9#+3,1,0), 0, n#+1, Z#+1)))"

lemma list_N_fm_type [TC]:
 "[| x \<in> nat; y \<in> nat; z \<in> nat |] ==> list_N_fm(x,y,z) \<in> formula"
by (simp add: list_N_fm_def)

lemma sats_list_N_fm [simp]:
   "[| x \<in> nat; y < length(env); z < length(env); env \<in> list(A)|]
    ==> sats(A, list_N_fm(x,y,z), env) \<longleftrightarrow>
        is_list_N(##A, nth(x,env), nth(y,env), nth(z,env))"
apply (frule_tac x=z in lt_length_in_nat, assumption)
apply (frule_tac x=y in lt_length_in_nat, assumption)
apply (simp add: list_N_fm_def is_list_N_def sats_is_iterates_fm)
done

lemma list_N_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y; nth(k,env) = z;
          i \<in> nat; j < length(env); k < length(env); env \<in> list(A)|]
       ==> is_list_N(##A, x, y, z) \<longleftrightarrow> sats(A, list_N_fm(i,j,k), env)"
by (simp add: sats_list_N_fm)

theorem list_N_reflection:
     "REFLECTS[\<lambda>x. is_list_N(L, f(x), g(x), h(x)),
               \<lambda>i x. is_list_N(##Lset(i), f(x), g(x), h(x))]"
apply (simp only: is_list_N_def)
apply (intro FOL_reflections function_reflections
             is_iterates_reflection list_functor_reflection)
done

subsubsection\<open>The Predicate ``Is A List''\<close>

(* mem_list(M,A,l) ==
      \<exists>n[M]. \<exists>listn[M].
       finite_ordinal(M,n) & is_list_N(M,A,n,listn) & l \<in> listn *)
definition
  mem_list_fm :: "[i,i]=>i" where
    "mem_list_fm(x,y) ==
       Exists(Exists(
         And(finite_ordinal_fm(1),
           And(list_N_fm(x#+2,1,0), Member(y#+2,0)))))"

lemma mem_list_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> mem_list_fm(x,y) \<in> formula"
by (simp add: mem_list_fm_def)

lemma sats_mem_list_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, mem_list_fm(x,y), env) \<longleftrightarrow> mem_list(##A, nth(x,env), nth(y,env))"
by (simp add: mem_list_fm_def mem_list_def)

lemma mem_list_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> mem_list(##A, x, y) \<longleftrightarrow> sats(A, mem_list_fm(i,j), env)"
by simp

theorem mem_list_reflection:
     "REFLECTS[\<lambda>x. mem_list(L,f(x),g(x)),
               \<lambda>i x. mem_list(##Lset(i),f(x),g(x))]"
apply (simp only: mem_list_def)
apply (intro FOL_reflections finite_ordinal_reflection list_N_reflection)
done

subsubsection\<open>The Predicate ``Is @{term "list(A)"}''\<close>

(* is_list(M,A,Z) == \<forall>l[M]. l \<in> Z \<longleftrightarrow> mem_list(M,A,l) *)
definition
  is_list_fm :: "[i,i]=>i" where
    "is_list_fm(A,Z) ==
       Forall(Iff(Member(0,succ(Z)), mem_list_fm(succ(A),0)))"

lemma is_list_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> is_list_fm(x,y) \<in> formula"
by (simp add: is_list_fm_def)

lemma sats_is_list_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, is_list_fm(x,y), env) \<longleftrightarrow> is_list(##A, nth(x,env), nth(y,env))"
by (simp add: is_list_fm_def is_list_def)

lemma is_list_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i \<in> nat; j \<in> nat; env \<in> list(A)|]
       ==> is_list(##A, x, y) \<longleftrightarrow> sats(A, is_list_fm(i,j), env)"
by simp

theorem is_list_reflection:
     "REFLECTS[\<lambda>x. is_list(L,f(x),g(x)),
               \<lambda>i x. is_list(##Lset(i),f(x),g(x))]"
apply (simp only: is_list_def)
apply (intro FOL_reflections mem_list_reflection)
done

subsubsection\<open>The Formula Functor, Internalized\<close>

definition formula_functor_fm :: "[i,i]=>i" where
(*     "is_formula_functor(M,X,Z) ==
        \<exists>nat'[M]. \<exists>natnat[M]. \<exists>natnatsum[M]. \<exists>XX[M]. \<exists>X3[M].
           4           3               2       1       0
          omega(M,nat') & cartprod(M,nat',nat',natnat) &
          is_sum(M,natnat,natnat,natnatsum) &
          cartprod(M,X,X,XX) & is_sum(M,XX,X,X3) &
          is_sum(M,natnatsum,X3,Z)" *)
    "formula_functor_fm(X,Z) ==
       Exists(Exists(Exists(Exists(Exists(
        And(omega_fm(4),
         And(cartprod_fm(4,4,3),
          And(sum_fm(3,3,2),
           And(cartprod_fm(X#+5,X#+5,1),
            And(sum_fm(1,X#+5,0), sum_fm(2,0,Z#+5)))))))))))"

lemma formula_functor_type [TC]:
     "[| x \<in> nat; y \<in> nat |] ==> formula_functor_fm(x,y) \<in> formula"
by (simp add: formula_functor_fm_def)

lemma sats_formula_functor_fm [simp]:
   "[| x \<in> nat; y \<in> nat; env \<in> list(A)|]
    ==> sats(A, formula_functor_fm(x,y), env) \<longleftrightarrow>
        is_formula_functor(##A, nth(x,env), nth(y,env))"
by (simp add: formula_functor_fm_def is_formula_functor_def)

lemma formula_functor_iff_sats:
  "[| nth(i,env) = x; nth(j,env) = y;
      i \<in> nat; j \<in> nat; env \<in> list(A)|]
   ==> is_formula_functor(##A, x, y) \<longleftrightarrow> sats(A, formula_functor_fm(i,j), env)"
by simp

theorem formula_functor_reflection:
     "REFLECTS[\<lambda>x. is_formula_functor(L,f(x),g(x)),
               \<lambda>i x. is_formula_functor(##Lset(i),f(x),g(x))]"
apply (simp only: is_formula_functor_def)
apply (intro FOL_reflections omega_reflection
             cartprod_reflection sum_reflection)
done

subsubsection\<open>The Formula @{term is_formula_N}, Internalized\<close>

(*  "is_formula_N(M,n,Z) ==
      \<exists>zero[M]. empty(M,zero) &
                is_iterates(M, is_formula_functor(M), zero, n, Z)" *)
definition
  formula_N_fm :: "[i,i]=>i" where
  "formula_N_fm(n,Z) ==
     Exists(
       And(empty_fm(0),
           is_iterates_fm(formula_functor_fm(1,0), 0, n#+1, Z#+1)))"

lemma formula_N_fm_type [TC]:
 "[| x \<in> nat; y \<in> nat |] ==> formula_N_fm(x,y) \<in> formula"
by (simp add: formula_N_fm_def)

lemma sats_formula_N_fm [simp]:
   "[| x < length(env); y < length(env); env \<in> list(A)|]
    ==> sats(A, formula_N_fm(x,y), env) \<longleftrightarrow>
        is_formula_N(##A, nth(x,env), nth(y,env))"
apply (frule_tac x=y in lt_length_in_nat, assumption)
apply (frule lt_length_in_nat, assumption)
apply (simp add: formula_N_fm_def is_formula_N_def sats_is_iterates_fm)
done

lemma formula_N_iff_sats:
      "[| nth(i,env) = x; nth(j,env) = y;
          i < length(env); j < length(env); env \<in> list(A)|]
       ==> is_formula_N(##A, x, y) \<longleftrightarrow> sats(A, formula_N_fm(i,j), env)"
by (simp add: sats_formula_N_fm)

theorem formula_N_reflection:
     "REFLECTS[\<lambda>x. is_formula_N(L, f(x), g(x)),
               \<lambda>i x. is_formula_N(##Lset(i), f(x), g(x))]"
apply (simp only: is_formula_N_def)
apply (intro FOL_reflections function_reflections
             is_iterates_reflection formula_functor_reflection)
done

subsubsection\<open>The Predicate ``Is A Formula''\<close>

(*  mem_formula(M,p) ==
      \<exists>n[M]. \<exists>formn[M].
       finite_ordinal(M,n) & is_formula_N(M,n,formn) & p \<in> formn *)
definition
  mem_formula_fm :: "i=>i" where
    "mem_formula_fm(x) ==
       Exists(Exists(
         And(finite_ordinal_fm(1),
           And(formula_N_fm(1,0), Member(x#+2,0)))))"

lemma mem_formula_type [TC]:
     "x \<in> nat ==> mem_formula_fm(x) \<in> formula"
by (simp add: mem_formula_fm_def)

lemma sats_mem_formula_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, mem_formula_fm(x), env) \<longleftrightarrow> mem_formula(##A, nth(x,env))"
by (simp add: mem_formula_fm_def mem_formula_def)

lemma mem_formula_iff_sats:
      "[| nth(i,env) = x; i \<in> nat; env \<in> list(A)|]
       ==> mem_formula(##A, x) \<longleftrightarrow> sats(A, mem_formula_fm(i), env)"
by simp

theorem mem_formula_reflection:
     "REFLECTS[\<lambda>x. mem_formula(L,f(x)),
               \<lambda>i x. mem_formula(##Lset(i),f(x))]"
apply (simp only: mem_formula_def)
apply (intro FOL_reflections finite_ordinal_reflection formula_N_reflection)
done

subsubsection\<open>The Predicate ``Is @{term "formula"}''\<close>

(* is_formula(M,Z) == \<forall>p[M]. p \<in> Z \<longleftrightarrow> mem_formula(M,p) *)
definition
  is_formula_fm :: "i=>i" where
    "is_formula_fm(Z) == Forall(Iff(Member(0,succ(Z)), mem_formula_fm(0)))"

lemma is_formula_type [TC]:
     "x \<in> nat ==> is_formula_fm(x) \<in> formula"
by (simp add: is_formula_fm_def)

lemma sats_is_formula_fm [simp]:
   "[| x \<in> nat; env \<in> list(A)|]
    ==> sats(A, is_formula_fm(x), env) \<longleftrightarrow> is_formula(##A, nth(x,env))"
by (simp add: is_formula_fm_def is_formula_def)

lemma is_formula_iff_sats:
      "[| nth(i,env) = x; i \<in> nat; env \<in> list(A)|]
       ==> is_formula(##A, x) \<longleftrightarrow> sats(A, is_formula_fm(i), env)"
by simp

theorem is_formula_reflection:
     "REFLECTS[\<lambda>x. is_formula(L,f(x)),
               \<lambda>i x. is_formula(##Lset(i),f(x))]"
apply (simp only: is_formula_def)
apply (intro FOL_reflections mem_formula_reflection)
done

subsubsection\<open>The Operator @{term is_transrec}\<close>

text\<open>The three arguments of @{term p} are always 2, 1, 0.  It is buried
   within eight quantifiers!
   We call @{term p} with arguments a, f, z by equating them with
  the corresponding quantified variables with de Bruijn indices 2, 1, 0.\<close>

(* is_transrec :: "[i=>o, [i,i,i]=>o, i, i] => o"
   "is_transrec(M,MH,a,z) ==
      \<exists>sa[M]. \<exists>esa[M]. \<exists>mesa[M].
       2       1         0
       upair(M,a,a,sa) & is_eclose(M,sa,esa) & membership(M,esa,mesa) &
       is_wfrec(M,MH,mesa,a,z)" *)
definition
  is_transrec_fm :: "[i, i, i]=>i" where
 "is_transrec_fm(p,a,z) ==
    Exists(Exists(Exists(
      And(upair_fm(a#+3,a#+3,2),
       And(is_eclose_fm(2,1),
        And(Memrel_fm(1,0), is_wfrec_fm(p,0,a#+3,z#+3)))))))"

lemma is_transrec_type [TC]:
     "[| p \<in> formula; x \<in> nat; z \<in> nat |]
      ==> is_transrec_fm(p,x,z) \<in> formula"
by (simp add: is_transrec_fm_def)

lemma sats_is_transrec_fm:
  assumes MH_iff_sats:
      "!!a0 a1 a2 a3 a4 a5 a6 a7.
        [|a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A; a4\<in>A; a5\<in>A; a6\<in>A; a7\<in>A|]
        ==> MH(a2, a1, a0) \<longleftrightarrow>
            sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,
                          Cons(a4,Cons(a5,Cons(a6,Cons(a7,env)))))))))"
  shows
      "[|x < length(env); z < length(env); env \<in> list(A)|]
       ==> sats(A, is_transrec_fm(p,x,z), env) \<longleftrightarrow>
           is_transrec(##A, MH, nth(x,env), nth(z,env))"
apply (frule_tac x=z in lt_length_in_nat, assumption)
apply (frule_tac x=x in lt_length_in_nat, assumption)
apply (simp add: is_transrec_fm_def sats_is_wfrec_fm is_transrec_def MH_iff_sats [THEN iff_sym])
done

lemma is_transrec_iff_sats:
  assumes MH_iff_sats:
      "!!a0 a1 a2 a3 a4 a5 a6 a7.
        [|a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A; a4\<in>A; a5\<in>A; a6\<in>A; a7\<in>A|]
        ==> MH(a2, a1, a0) \<longleftrightarrow>
            sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,
                          Cons(a4,Cons(a5,Cons(a6,Cons(a7,env)))))))))"
  shows
  "[|nth(i,env) = x; nth(k,env) = z;
      i < length(env); k < length(env); env \<in> list(A)|]
   ==> is_transrec(##A, MH, x, z) \<longleftrightarrow> sats(A, is_transrec_fm(p,i,k), env)"
by (simp add: sats_is_transrec_fm [OF MH_iff_sats])

theorem is_transrec_reflection:
  assumes MH_reflection:
    "!!f' f g h. REFLECTS[\<lambda>x. MH(L, f'(x), f(x), g(x), h(x)),
                     \<lambda>i x. MH(##Lset(i), f'(x), f(x), g(x), h(x))]"
  shows "REFLECTS[\<lambda>x. is_transrec(L, MH(L,x), f(x), h(x)),
               \<lambda>i x. is_transrec(##Lset(i), MH(##Lset(i),x), f(x), h(x))]"
apply (simp (no_asm_use) only: is_transrec_def)
apply (intro FOL_reflections function_reflections MH_reflection
             is_wfrec_reflection is_eclose_reflection)
done

end


(*
  Title:  Maximal Consistent Sets
  Author: Asta Halkjær From
*)

chapter \<open>Maximal Consistent Sets\<close>

theory Maximal_Consistent_Sets imports "HOL-Cardinals.Cardinal_Order_Relation" begin

section \<open>Utility\<close>

lemma Set_Diff_Un: \<open>X - (Y \<union> Z) = X - Y - Z\<close>
  by blast

lemma infinite_Diff_fin_Un: \<open>infinite (X - Y) \<Longrightarrow> finite Z \<Longrightarrow> infinite (X - (Z \<union> Y))\<close>
  by (simp add: Set_Diff_Un Un_commute)

lemma infinite_Diff_subset: \<open>infinite (X - A) \<Longrightarrow> B \<subseteq> A \<Longrightarrow> infinite (X - B)\<close>
  by (meson Diff_cancel Diff_eq_empty_iff Diff_mono infinite_super)

lemma finite_bound:
  fixes X :: \<open>('a :: size) set\<close>
  assumes \<open>finite X\<close> \<open>X \<noteq> {}\<close>
  shows \<open>\<exists>x \<in> X. \<forall>y \<in> X. size y \<le> size x\<close>
  using assms by (induct X rule: finite_induct) force+

lemma infinite_UNIV_size:
  fixes f :: \<open>('a :: size) \<Rightarrow> 'a\<close>
  assumes \<open>\<And>x. size x < size (f x)\<close>
  shows \<open>infinite (UNIV :: 'a set)\<close>
proof
  assume \<open>finite (UNIV :: 'a set)\<close>
  then obtain x :: 'a where \<open>\<forall>y :: 'a. size y \<le> size x\<close>
    using finite_bound by fastforce
  moreover have \<open>size x < size (f x)\<close>
    using assms .
  ultimately show False
    using leD by blast
qed

lemma split_finite_sets:
  assumes \<open>finite A\<close> \<open>finite B\<close>
  assumes \<open>A \<subseteq> B \<union> S\<close>
  shows \<open>\<exists>B' C. finite C \<and> (B' \<union> C = A) \<and> B' \<subseteq> B \<and> C \<subseteq> S\<close>
  using assms subset_UnE by fastforce

lemma split_list:
  assumes \<open>set A \<subseteq> set B \<union> S\<close>
  shows \<open>\<exists>B' C. set (B' @ C) = set A \<and> set B' \<subseteq> set B \<and> set C \<subseteq> S\<close>
  using assms split_finite_sets[where A=\<open>set A\<close> and B=\<open>set B\<close> and S=S]
  by (metis List.finite_set finite_Un finite_list set_append)

lemma struct_split:
  assumes \<open>\<And>A B. P A \<Longrightarrow> set A \<subseteq> set B \<Longrightarrow> P B\<close> \<open>P A\<close> \<open>set A \<subseteq> set B \<union> X\<close>
  shows \<open>\<exists>C. set C \<subseteq> X \<and> P (B @ C)\<close>
proof -
  obtain B' C where C: \<open>set (B' @ C) = set A\<close> \<open>set B' \<subseteq> set B\<close> \<open>set C \<subseteq> X\<close>
    using assms(3) split_list by meson
  then have \<open>P (B @ C)\<close>
    using assms(1)[where B=\<open>B @ C\<close>] assms(2) by fastforce
  then show ?thesis
    using C by blast
qed

context wo_rel begin

lemma underS_bound: \<open>a \<in> underS n \<Longrightarrow> b \<in> underS n \<Longrightarrow> a \<in> under b \<or> b \<in> under a\<close>
  by (meson BNF_Least_Fixpoint.underS_Field REFL Refl_under_in in_mono under_ofilter ofilter_linord)

lemma finite_underS_bound:
  assumes \<open>finite X\<close> \<open>X \<subseteq> underS n\<close> \<open>X \<noteq> {}\<close>
  shows \<open>\<exists>a \<in> X. \<forall>b \<in> X. b \<in> under a\<close>
  using assms
proof (induct X rule: finite_induct)
  case (insert x F)
  then show ?case
  proof (cases \<open>F = {}\<close>)
    case True
    then show ?thesis
      using insert underS_bound by fast
  next
    case False
    then show ?thesis
      using insert underS_bound by (metis TRANS insert_absorb insert_iff insert_subset under_trans)
  qed
qed simp

lemma finite_bound_under:
  assumes \<open>finite p\<close> \<open>p \<subseteq> (\<Union>n \<in> Field r. f n)\<close>
  shows \<open>\<exists>m. p \<subseteq> (\<Union>n \<in> under m. f n)\<close>
  using assms
proof (induct rule: finite_induct)
  case (insert x p)
  then obtain m where \<open>p \<subseteq> (\<Union>n \<in> under m. f n)\<close>
    by fast
  moreover obtain m' where \<open>x \<in> f m'\<close> \<open>m' \<in> Field r\<close>
    using insert(4) by blast
  then have \<open>x \<in> (\<Union>n \<in> under m'. f n)\<close>
    using REFL Refl_under_in by fast
  ultimately have \<open>{x} \<union> p \<subseteq> (\<Union>n \<in> under m. f n) \<union> (\<Union>n \<in> under m'. f n)\<close>
    by fast
  then show ?case
    by (metis SUP_union Un_commute insert_is_Un sup.absorb_iff2 ofilter_linord under_ofilter)
qed simp

lemma underS_trans: \<open>a \<in> underS b \<Longrightarrow> b \<in> underS c \<Longrightarrow> a \<in> underS c\<close>
  by (meson ANTISYM TRANS underS_underS_trans)

end

lemma card_of_infinite_smaller_Union:
  assumes \<open>\<forall>x. |f x| <o |X|\<close> \<open>infinite X\<close>
  shows \<open>|\<Union>x \<in> X. f x| \<le>o |X|\<close>
  using assms by (metis (full_types) Field_card_of card_of_UNION_ordLeq_infinite
      card_of_well_order_on ordLeq_iff_ordLess_or_ordIso ordLess_or_ordLeq)

lemma card_of_params_marker_lists:
  assumes \<open>infinite (UNIV :: 'i set)\<close> \<open>|UNIV :: 'm set| \<le>o |UNIV :: nat set|\<close>
  shows \<open>|UNIV :: ('i + 'm \<times> nat) list set| \<le>o |UNIV :: 'i set|\<close>
proof -
  have \<open>(UNIV :: 'm set) \<noteq> {}\<close>
    by simp
  then have \<open>|UNIV :: 'm set| *c |UNIV :: nat set| \<le>o |UNIV :: nat set|\<close>
    using assms(2) by (simp add: cinfinite_def cprod_cinfinite_bound ordLess_imp_ordLeq)
  then have \<open>|UNIV :: ('m \<times> nat) set| \<le>o |UNIV :: nat set|\<close>
    unfolding cprod_def by simp
  moreover have \<open>|UNIV :: nat set| \<le>o |UNIV :: 'i set|\<close>
    using assms infinite_iff_card_of_nat by blast
  ultimately have \<open>|UNIV :: ('m \<times> nat) set| \<le>o |UNIV :: 'i set|\<close>
    using ordLeq_transitive by blast
  moreover have \<open>Cinfinite |UNIV :: 'i set|\<close>
    using assms by (simp add: cinfinite_def)
  ultimately have \<open>|UNIV :: 'i set| +c |UNIV :: ('m \<times> nat) set| =o |UNIV :: 'i set|\<close>
    using csum_absorb1 by blast
  then have \<open>|UNIV :: ('i + 'm \<times> nat) set| =o |UNIV :: 'i set|\<close>
    unfolding csum_def by simp
  then have \<open>|UNIV :: ('i + 'm \<times> nat) set| \<le>o |UNIV :: 'i set|\<close>
    using ordIso_iff_ordLeq by blast
  moreover have \<open>infinite (UNIV :: ('i + 'm \<times> nat) set)\<close>
    using assms by simp
  then have \<open>|UNIV :: ('i + 'm \<times> nat) list set| =o |UNIV :: ('i + 'm \<times> nat) set|\<close>
    by (metis card_of_lists_infinite lists_UNIV)
  ultimately have \<open>|UNIV :: ('i + 'm \<times> nat) list set| \<le>o |UNIV :: 'i set|\<close>
    using ordIso_ordLeq_trans by blast
  then show ?thesis
    using ordLeq_transitive by blast
qed

section \<open>Base Locale\<close>

locale MCS_Base =
  fixes consistent :: \<open>'a set \<Rightarrow> bool\<close>
  assumes consistent_hereditary: \<open>\<And>S S'. consistent S \<Longrightarrow> S' \<subseteq> S \<Longrightarrow> consistent S'\<close>
    and inconsistent_finite: \<open>\<And>S. \<not> consistent S \<Longrightarrow> \<exists>S' \<subseteq> S. finite S' \<and> \<not> consistent S'\<close>
begin

definition maximal :: \<open>'a set \<Rightarrow> bool\<close> where
  \<open>maximal S \<equiv> \<forall>p. consistent ({p} \<union> S) \<longrightarrow> p \<in> S\<close>

end

section \<open>Ordinal Locale\<close>

locale MCS_Lim_Ord = MCS_Base +
  fixes r :: \<open>'a rel\<close>
  assumes WELL: \<open>Well_order r\<close>
    and Cinfinite_r: \<open>Cinfinite r\<close>
  fixes params :: \<open>'a \<Rightarrow> 'i set\<close>
    and witness :: \<open>'a \<Rightarrow> 'a set \<Rightarrow> 'a set\<close>
  assumes finite_params: \<open>\<And>p. finite (params p)\<close>
    and finite_witness_params: \<open>\<And>p S. finite (\<Union>q \<in> witness p S. params q)\<close>
    and consistent_witness: \<open>\<And>p S. consistent ({p} \<union> S)
      \<Longrightarrow> infinite (UNIV - (\<Union>q \<in> S. params q))
      \<Longrightarrow> consistent (witness p S \<union> {p} \<union> S)\<close>
begin

lemma wo_rel_r: \<open>wo_rel r\<close>
  by (simp add: WELL wo_rel.intro)

lemma isLimOrd_r: \<open>isLimOrd r\<close>
  using Cinfinite_r card_order_infinite_isLimOrd cinfinite_def by blast

subsection \<open>Lindenbaum Extension\<close>

abbreviation paramss :: \<open>'a set \<Rightarrow> 'i set\<close> where
  \<open>paramss S \<equiv> \<Union>p \<in> S. params p\<close>

definition extendS :: \<open>'a \<Rightarrow> 'a set \<Rightarrow> 'a set\<close> where
  \<open>extendS n prev \<equiv> if consistent ({n} \<union> prev) then witness n prev \<union> {n} \<union> prev else prev\<close>

definition extendL :: \<open>('a \<Rightarrow> 'a set) \<Rightarrow> 'a \<Rightarrow> 'a set\<close> where
  \<open>extendL rec n \<equiv> \<Union>m \<in> underS r n. rec m\<close>

definition extend :: \<open>'a set \<Rightarrow> 'a \<Rightarrow> 'a set\<close> where
  \<open>extend S n \<equiv> worecZSL r S extendS extendL n\<close>

lemma adm_woL_extendL: \<open>adm_woL r extendL\<close>
  unfolding extendL_def wo_rel.adm_woL_def[OF wo_rel_r] by blast

definition Extend :: \<open>'a set \<Rightarrow> 'a set\<close> where
  \<open>Extend S \<equiv> \<Union>n \<in> Field r. extend S n\<close>

lemma extend_subset: \<open>n \<in> Field r \<Longrightarrow> S \<subseteq> extend S n\<close>
proof (induct n rule: wo_rel.well_order_inductZSL[OF wo_rel_r])
  case 1
  then show ?case
    unfolding extend_def wo_rel.worecZSL_zero[OF wo_rel_r adm_woL_extendL]
    by simp
next
  case (2 i)
  moreover from this have \<open>i \<in> Field r\<close>
    by (meson FieldI1 wo_rel.succ_in wo_rel_r)
  ultimately show ?case
    unfolding extend_def extendS_def wo_rel.worecZSL_succ[OF wo_rel_r adm_woL_extendL 2(1)]
    by auto
next
  case (3 i)
  then show ?case
    unfolding extend_def extendL_def wo_rel.worecZSL_isLim[OF wo_rel_r adm_woL_extendL 3(1-2)]
    using wo_rel.zero_in_Field[OF wo_rel_r] wo_rel.zero_smallest[OF wo_rel_r]
    by (metis SUP_upper2 emptyE underS_I)
qed

lemma Extend_subset': \<open>Field r \<noteq> {} \<Longrightarrow> S \<subseteq> Extend S\<close>
  unfolding Extend_def using extend_subset by fast

lemma extend_underS: \<open>m \<in> underS r n \<Longrightarrow> extend S m \<subseteq> extend S n\<close>
proof (induct n rule: wo_rel.well_order_inductZSL[OF wo_rel_r])
  case 1
  then show ?case
    unfolding extend_def using wo_rel.underS_zero[OF wo_rel_r] by fast
next
  case (2 i)
  moreover from this have \<open>m = i \<or> m \<in> underS r i\<close>
    by (metis wo_rel.less_succ[OF wo_rel_r] underS_E underS_I)
  ultimately show ?case
    unfolding extend_def extendS_def wo_rel.worecZSL_succ[OF wo_rel_r adm_woL_extendL 2(1)] by auto
next
  case (3 i)
  then show ?case
    unfolding extend_def extendL_def wo_rel.worecZSL_isLim[OF wo_rel_r adm_woL_extendL 3(1-2)]
    by blast
qed

lemma extend_under: \<open>m \<in> under r n \<Longrightarrow> extend S m \<subseteq> extend S n\<close>
  using extend_underS wo_rel.supr_greater[OF wo_rel_r] wo_rel.supr_under[OF wo_rel_r]
  by (metis emptyE in_Above_under set_eq_subset underS_I under_Field under_empty)

subsection \<open>Consistency\<close>

lemma params_origin:
  assumes \<open>a \<in> paramss (extend S n)\<close>
  shows \<open>a \<in> paramss S \<or> (\<exists>m \<in> underS r n. a \<in> paramss (witness m (extend S m) \<union> {m}))\<close>
  using assms
proof (induct n rule: wo_rel.well_order_inductZSL[OF wo_rel_r])
  case 1
  then show ?case
    unfolding extend_def wo_rel.worecZSL_zero[OF wo_rel_r adm_woL_extendL]
    by blast
next
  case (2 i)
  then consider (here) \<open>a \<in> paramss (witness i (extend S i) \<union> {i})\<close> | (there) \<open>a \<in> paramss (extend S i)\<close>
    using wo_rel.worecZSL_succ[OF wo_rel_r adm_woL_extendL 2(1)] extendS_def extend_def
    by (metis (no_types, lifting) UN_Un UnE)
  then show ?case
  proof cases
    case here
    moreover have \<open>i \<in> Field r\<close>
      by (meson WELL 2(1) well_order_on_domain wo_rel.succ_in_diff[OF wo_rel_r])
    ultimately show ?thesis
      using 2(1) by (metis Refl_under_in wo_rel.underS_succ[OF wo_rel_r] wo_rel.REFL[OF wo_rel_r])
  next
    case there
    then show ?thesis
      using 2 by (metis in_mono underS_subset_under wo_rel.underS_succ[OF wo_rel_r])
  next
  qed
next
  case (3 i)
  then obtain j where \<open>j \<in> underS r i\<close> \<open>a \<in> paramss (extend S j)\<close>
    unfolding extend_def extendL_def wo_rel.worecZSL_isLim[OF wo_rel_r adm_woL_extendL 3(1-2)]
    by blast
  then show ?case
    using 3 wo_rel.underS_trans[OF wo_rel_r, of _ j i] by meson
qed

lemma consistent_extend:
  assumes \<open>consistent S\<close> \<open>r \<le>o |UNIV - paramss S|\<close>
  shows \<open>consistent (extend S n)\<close>
  using assms(1)
proof (induct n rule: wo_rel.well_order_inductZSL[OF wo_rel_r])
  case 1
  then show ?case
    unfolding extend_def wo_rel.worecZSL_zero[OF wo_rel_r adm_woL_extendL]
    by blast
next
  case (2 i)
  then have \<open>i \<in> Field r\<close>
    by (meson WELL  well_order_on_domain wo_rel.succ_in_diff[OF wo_rel_r])
  then have *: \<open>|underS r i| <o r\<close>
    using card_of_underS by (simp add: Cinfinite_r)
  let ?paramss = \<open>\<lambda>k. paramss (witness k (extend S k) \<union> {k})\<close>
  let ?X = \<open>\<Union>k \<in> underS r i. ?paramss k\<close>
  have \<open>|?X| <o r\<close>
  proof (cases \<open>finite (underS r i)\<close>)
    case True
    then have \<open>finite ?X\<close>
      by (simp add: finite_params finite_witness_params)
    then show ?thesis
      using Cinfinite_r assms(2) unfolding cinfinite_def by (simp add: finite_ordLess_infinite)
  next
    case False
    moreover have \<open>\<forall>k. finite (?paramss k)\<close>
      by (simp add: finite_params finite_witness_params)
    then have \<open>\<forall>k. |?paramss k| <o |underS r i|\<close>
      using False by simp
    ultimately have \<open>|?X| \<le>o |underS r i|\<close>
      using card_of_infinite_smaller_Union by fast
    then show ?thesis
      using * ordLeq_ordLess_trans by blast
  qed
  then have \<open>|?X| <o |UNIV - paramss S|\<close>
    using assms(2) ordLess_ordLeq_trans by blast
  moreover have \<open>infinite (UNIV - paramss S)\<close>
    using assms(2) Cinfinite_r unfolding cinfinite_def by (metis Field_card_of ordLeq_finite_Field)
  ultimately have \<open>|UNIV - paramss S - ?X| =o |UNIV - paramss S|\<close>
    using card_of_Un_diff_infinite by blast
  moreover from this have \<open>infinite (UNIV - paramss S - ?X)\<close>
    using \<open>infinite (UNIV - paramss S)\<close> card_of_ordIso_finite by blast
  moreover have \<open>\<And>a. a \<in> paramss (extend S i) \<Longrightarrow> a \<in> paramss S \<or> a \<in> ?X\<close>
    using params_origin by simp
  then have \<open>paramss (extend S i) \<subseteq> paramss S \<union> ?X\<close>
    by fast
  ultimately have \<open>infinite (UNIV - paramss (extend S i))\<close>
    using infinite_Diff_subset by (metis (no_types, lifting) Set_Diff_Un)
  with 2 show ?case
    unfolding extend_def extendS_def wo_rel.worecZSL_succ[OF wo_rel_r adm_woL_extendL 2(1)]
    using consistent_witness by auto
next
  case (3 i)
  show ?case
  proof (rule ccontr)
    assume \<open>\<not> consistent (extend S i)\<close>
    then obtain S' where S': \<open>finite S'\<close> \<open>S' \<subseteq> (\<Union>n \<in> underS r i. extend S n)\<close> \<open>\<not> consistent S'\<close>
      unfolding extend_def extendL_def wo_rel.worecZSL_isLim[OF wo_rel_r adm_woL_extendL 3(1-2)]
      using inconsistent_finite by auto
    then obtain ns where ns: \<open>S' \<subseteq> (\<Union>n \<in> ns. extend S n)\<close> \<open>ns \<subseteq> underS r i\<close> \<open>finite ns\<close>
      by (metis finite_subset_Union finite_subset_image)
    moreover have \<open>ns \<noteq> {}\<close>
      using S'(3) assms calculation(1) consistent_hereditary by auto
    ultimately obtain j where \<open>\<forall>n \<in> ns. n \<in> under r j\<close> \<open>j \<in> underS r i\<close>
      using wo_rel.finite_underS_bound wo_rel_r ns by (meson subset_iff)
    then have \<open>\<forall>n \<in> ns. extend S n \<subseteq> extend S j\<close>
      using extend_under by fast
    then have \<open>S' \<subseteq> extend S j\<close>
      using S' ns(1) by blast
    then show False
      using 3(3-) \<open>\<not> consistent S'\<close> consistent_hereditary \<open>j \<in> underS r i\<close>
      by (meson BNF_Least_Fixpoint.underS_Field)
  qed
qed

lemma consistent_Extend:
  assumes \<open>consistent S\<close> \<open>r \<le>o |UNIV - paramss S|\<close>
  shows \<open>consistent (Extend S)\<close>
  unfolding Extend_def
proof (rule ccontr)
  assume \<open>\<not> consistent (\<Union>n \<in> Field r. extend S n)\<close>
  then obtain S' where \<open>finite S'\<close> \<open>S' \<subseteq> (\<Union>n \<in> Field r. extend S n)\<close> \<open>\<not> consistent S'\<close>
    using inconsistent_finite by metis
  then obtain m where \<open>S' \<subseteq> (\<Union>n \<in> under r m. extend S n)\<close> \<open>m \<in> Field r\<close>
    using wo_rel.finite_bound_under[OF wo_rel_r] assms consistent_hereditary
    by (metis Sup_empty emptyE image_empty subsetI under_empty)
  then have \<open>S' \<subseteq> extend S m\<close>
    using extend_under by fast
  moreover have \<open>consistent (extend S m)\<close>
    using assms consistent_extend \<open>m \<in> Field r\<close> by blast
  ultimately show False
    using \<open>\<not> consistent S'\<close> consistent_hereditary by blast
qed

lemma Extend_bound: \<open>n \<in> Field r \<Longrightarrow> extend S n \<subseteq> Extend S\<close>
  unfolding Extend_def by blast

subsection \<open>Maximality\<close>

definition maximal' :: \<open>'a set \<Rightarrow> bool\<close> where
  \<open>maximal' S \<equiv> \<forall>p \<in> Field r. consistent ({p} \<union> S) \<longrightarrow> p \<in> S\<close>

lemma maximal'_Extend: \<open>maximal' (Extend S)\<close>
  unfolding maximal'_def
proof safe
  fix p
  assume *: \<open>p \<in> Field r\<close> \<open>consistent ({p} \<union> Extend S)\<close>
  then have \<open>{p} \<union> extend S p \<subseteq> {p} \<union> Extend S\<close>
    unfolding Extend_def by blast
  then have **: \<open>consistent ({p} \<union> extend S p)\<close>
    using * consistent_hereditary by blast
  moreover have succ: \<open>aboveS r p \<noteq> {}\<close>
    using * isLimOrd_r wo_rel.isLimOrd_aboveS[OF wo_rel_r] by blast
  then have \<open>succ r p \<in> Field r\<close>
    using wo_rel.succ_in_Field[OF wo_rel_r] by blast
  moreover have \<open>p \<in> extend S (succ r p)\<close>
    using ** unfolding extend_def extendS_def wo_rel.worecZSL_succ[OF wo_rel_r adm_woL_extendL succ]
    by simp
  ultimately show \<open>p \<in> Extend S\<close>
    using Extend_bound by fast
qed

subsection \<open>Saturation\<close>

definition saturated' :: \<open>'a set \<Rightarrow> bool\<close> where
  \<open>saturated' S \<equiv> \<forall>p \<in> S. p \<in> Field r \<longrightarrow> (\<exists>S'. witness p S' \<subseteq> S)\<close>

lemma saturated'_Extend:
  assumes \<open>consistent (Extend S)\<close>
  shows \<open>saturated' (Extend S)\<close>
  unfolding saturated'_def
proof safe
  fix p
  assume *: \<open>p \<in> Extend S\<close> \<open>p \<in> Field r\<close>
  then have \<open>extend S p \<subseteq> Extend S\<close>
    unfolding Extend_def by blast
  then have \<open>consistent ({p} \<union> extend S p)\<close>
    using assms(1) * consistent_hereditary by auto
  moreover have succ: \<open>aboveS r p \<noteq> {}\<close>
    using * isLimOrd_r wo_rel.isLimOrd_aboveS wo_rel_r by fast
  then have \<open>succ r p \<in> Field r\<close>
    using wo_rel_r by (simp add: wo_rel.succ_in_Field)
  ultimately have \<open>extend S (succ r p) = witness p (extend S p) \<union> {p} \<union> extend S p\<close>
    unfolding extend_def extendS_def wo_rel.worecZSL_succ[OF wo_rel_r adm_woL_extendL succ]
    by simp
  moreover have \<open>extend S (succ r p) \<subseteq> Extend S\<close>
    unfolding Extend_def using \<open>succ r p \<in> Field r\<close> by blast
  ultimately show \<open>\<exists>a. witness p a \<subseteq> Extend S\<close>
    by fast
qed

end

section \<open>Locale with Saturation\<close>

locale MCS_Saturation = MCS_Base +
  assumes infinite_UNIV: \<open>infinite (UNIV :: 'a set)\<close>
  fixes params :: \<open>'a \<Rightarrow> 'i set\<close>
    and witness :: \<open>'a \<Rightarrow> 'a set \<Rightarrow> 'a set\<close>
  assumes \<open>\<And>p. finite (params p)\<close>
    and \<open>\<And>p S. finite (\<Union>q \<in> witness p S. params q)\<close>
    and \<open>\<And>p S. consistent ({p} \<union> S) \<Longrightarrow> infinite (UNIV - (\<Union>q \<in> S. params q))
      \<Longrightarrow> consistent (witness p S \<union> {p} \<union> S)\<close>

sublocale MCS_Saturation \<subseteq> MCS_Lim_Ord _ \<open>|UNIV|\<close>
proof
  show \<open>Well_order |UNIV|\<close>
    by simp
next
  show \<open>Cinfinite |UNIV :: 'a set|\<close>
    unfolding cinfinite_def using infinite_UNIV by simp
next
  fix p
  show \<open>finite (params p)\<close>
    by (metis MCS_Saturation_axioms MCS_Saturation_axioms_def MCS_Saturation_def)
next
  fix p S
  show \<open>finite (\<Union>q \<in> witness p S. params q)\<close>
    by (metis MCS_Saturation_axioms MCS_Saturation_axioms_def MCS_Saturation_def)
next
  fix p S
  show \<open>consistent ({p} \<union> S) \<Longrightarrow>
           infinite (UNIV - (\<Union>q \<in> S. params q)) \<Longrightarrow>
           consistent (witness p S \<union> {p} \<union> S)\<close>
    by (metis MCS_Saturation_axioms MCS_Saturation_axioms_def MCS_Saturation_def)
qed

context MCS_Saturation begin

theorem Extend_subset: \<open>S \<subseteq> Extend S\<close>
  by (simp add: Extend_subset')

lemma maximal_maximal': \<open>maximal S \<longleftrightarrow> maximal' S\<close>
  unfolding maximal_def maximal'_def by simp

lemma maximal_Extend: \<open>maximal (Extend S)\<close>
  using maximal'_Extend maximal_maximal' by fast

definition saturated :: \<open>'a set \<Rightarrow> bool\<close> where
  \<open>saturated S \<equiv> \<forall>p \<in> S. \<exists>S'. witness p S' \<subseteq> S\<close>

lemma saturated_saturated': \<open>saturated S \<longleftrightarrow> saturated' S\<close>
  unfolding saturated_def saturated'_def by simp

lemma saturated_Extend:
  assumes \<open>consistent (Extend S)\<close>
  shows \<open>saturated (Extend S)\<close>
  using assms saturated'_Extend saturated_saturated' by blast

theorem MCS_Extend:
  assumes \<open>consistent S\<close> \<open>|UNIV :: 'a set| \<le>o |UNIV - paramss S|\<close>
  shows \<open>consistent (Extend S)\<close> \<open>maximal (Extend S)\<close> \<open>saturated (Extend S)\<close>
  using assms consistent_Extend maximal_Extend saturated_Extend by blast+

end

section \<open>Locale without Saturation\<close>

locale MCS_No_Saturation = MCS_Base +
  assumes \<open>infinite (UNIV :: 'a set)\<close>

sublocale MCS_No_Saturation \<subseteq> MCS_Saturation consistent \<open>\<lambda>_. {} :: 'a set\<close> \<open>\<lambda>_ _. {}\<close>
proof
  show \<open>infinite (UNIV :: 'a set)\<close>
    using MCS_No_Saturation_axioms MCS_No_Saturation_axioms_def MCS_No_Saturation_def by blast
next
  show \<open>finite {}\<close> ..
next
  show \<open>finite (\<Union>_\<in>{}. {})\<close>
    by fast
next
  fix p S
  show \<open>consistent ({p} \<union> S) \<Longrightarrow> consistent ({} \<union> {p} \<union> S)\<close>
    by simp
qed

context MCS_No_Saturation begin

lemma always_saturated [simp]: \<open>saturated H\<close>
  unfolding saturated_def by simp

theorem MCS_Extend':
  assumes \<open>consistent S\<close>
  shows \<open>consistent (Extend S)\<close> \<open>maximal (Extend S)\<close>
  using assms consistent_Extend maximal_Extend by simp_all

end

section \<open>Truth Lemma\<close>

locale Truth_Base =
  fixes semics :: \<open>'model \<Rightarrow> ('model \<Rightarrow> 'fm \<Rightarrow> bool) \<Rightarrow> 'fm \<Rightarrow> bool\<close>
    and semantics :: \<open>'model \<Rightarrow> 'fm \<Rightarrow> bool\<close>
    and models_from :: \<open>'a set \<Rightarrow> 'model set\<close>
    and rel :: \<open>'a set \<Rightarrow> 'model \<Rightarrow> 'fm \<Rightarrow> bool\<close>
  assumes semics_semantics: \<open>semantics M p \<longleftrightarrow> semics M semantics p\<close>
    and Hintikka_model: \<open>\<And>H M p. \<forall>M \<in> models_from H. \<forall>p. semics M (rel H) p \<longleftrightarrow> rel H M p \<Longrightarrow>
      M \<in> models_from H \<Longrightarrow> semantics M p \<longleftrightarrow> rel H M p\<close>

locale Truth_Saturation = MCS_Saturation + Truth_Base +
  assumes MCS_Hintikka: \<open>\<And>H. consistent H \<Longrightarrow> maximal H \<Longrightarrow> saturated H \<Longrightarrow>
      \<forall>M \<in> models_from H. \<forall>p. semics M (rel H) p \<longleftrightarrow> rel H M p\<close>
begin

theorem truth_lemma_saturation:
  assumes \<open>consistent H\<close> \<open>maximal H\<close> \<open>saturated H\<close> \<open>M \<in> models_from H\<close>
  shows \<open>semantics M p \<longleftrightarrow> rel H M p\<close>
  using Hintikka_model MCS_Hintikka assms .

end

locale Truth_No_Saturation = MCS_No_Saturation + Truth_Base +
  assumes MCS_Hintikka: \<open>\<And>H. consistent H \<Longrightarrow> maximal H \<Longrightarrow>
      \<forall>M \<in> models_from H. \<forall>p. semics M (rel H) p \<longleftrightarrow> rel H M p\<close>
begin

theorem truth_lemma_no_saturation:
  assumes \<open>consistent H\<close> \<open>maximal H\<close> \<open>M \<in> models_from H\<close>
  shows \<open>semantics M p \<longleftrightarrow> rel H M p\<close>
  using Hintikka_model MCS_Hintikka assms .

end

end