Theory Datatype_absolute

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

section ‹Absoluteness Properties for Recursive Datatypes›

theory Datatype_absolute imports Formula WF_absolute begin


subsection‹The lfp of a continuous function can be expressed as a union›

definition
  directed :: "io" where
   "directed(A)  A0  (xA. yA. x  y  A)"

definition
  contin :: "(ii)  o" where
   "contin(h)  (A. directed(A)  h(A) = (XA. h(X)))"

lemma bnd_mono_iterates_subset: "bnd_mono(D, h); n  nat  h^n (0)  D"
apply (induct_tac n) 
 apply (simp_all add: bnd_mono_def, blast) 
done

lemma bnd_mono_increasing [rule_format]:
     "i  nat; j  nat; bnd_mono(D,h)  i  j  h^i(0)  h^j(0)"
apply (rule_tac m=i and n=j in diff_induct, simp_all)
apply (blast del: subsetI
             intro: bnd_mono_iterates_subset bnd_monoD2 [of concl: h]) 
done

lemma directed_iterates: "bnd_mono(D,h)  directed({h^n (0). nnat})"
apply (simp add: directed_def, clarify) 
apply (rename_tac i j)
apply (rule_tac x="i  j" in bexI) 
apply (rule_tac i = i and j = j in Ord_linear_le)
apply (simp_all add: subset_Un_iff [THEN iffD1] le_imp_subset
                     subset_Un_iff2 [THEN iffD1])
apply (simp_all add: subset_Un_iff [THEN iff_sym] bnd_mono_increasing
                     subset_Un_iff2 [THEN iff_sym])
done


lemma contin_iterates_eq: 
    "bnd_mono(D, h); contin(h) 
      h(nnat. h^n (0)) = (nnat. h^n (0))"
apply (simp add: contin_def directed_iterates) 
apply (rule trans) 
apply (rule equalityI) 
 apply (simp_all add: UN_subset_iff)
 apply safe
 apply (erule_tac [2] natE) 
  apply (rule_tac a="succ(x)" in UN_I) 
   apply simp_all 
apply blast 
done

lemma lfp_subset_Union:
     "bnd_mono(D, h); contin(h)  lfp(D,h)  (nnat. h^n(0))"
apply (rule lfp_lowerbound) 
 apply (simp add: contin_iterates_eq) 
apply (simp add: contin_def bnd_mono_iterates_subset UN_subset_iff) 
done

lemma Union_subset_lfp:
     "bnd_mono(D,h)  (nnat. h^n(0))  lfp(D,h)"
apply (simp add: UN_subset_iff)
apply (rule ballI)  
apply (induct_tac n, simp_all) 
apply (rule subset_trans [of _ "h(lfp(D,h))"])
 apply (blast dest: bnd_monoD2 [OF _ _ lfp_subset])  
apply (erule lfp_lemma2) 
done

lemma lfp_eq_Union:
     "bnd_mono(D, h); contin(h)  lfp(D,h) = (nnat. h^n(0))"
by (blast del: subsetI 
          intro: lfp_subset_Union Union_subset_lfp)


subsubsection‹Some Standard Datatype Constructions Preserve Continuity›

lemma contin_imp_mono: "XY; contin(F)  F(X)  F(Y)"
apply (simp add: contin_def) 
apply (drule_tac x="{X,Y}" in spec) 
apply (simp add: directed_def subset_Un_iff2 Un_commute) 
done

lemma sum_contin: "contin(F); contin(G)  contin(λX. F(X) + G(X))"
by (simp add: contin_def, blast)

lemma prod_contin: "contin(F); contin(G)  contin(λX. F(X) * G(X))" 
apply (subgoal_tac "B C. F(B)  F(B  C)")
 prefer 2 apply (simp add: Un_upper1 contin_imp_mono) 
apply (subgoal_tac "B C. G(C)  G(B  C)")
 prefer 2 apply (simp add: Un_upper2 contin_imp_mono) 
apply (simp add: contin_def, clarify) 
apply (rule equalityI) 
 prefer 2 apply blast 
apply clarify 
apply (rename_tac B C) 
apply (rule_tac a="B  C" in UN_I) 
 apply (simp add: directed_def, blast)  
done

lemma const_contin: "contin(λX. A)"
by (simp add: contin_def directed_def)

lemma id_contin: "contin(λX. X)"
by (simp add: contin_def)



subsection ‹Absoluteness for "Iterates"›

definition
  iterates_MH :: "[io, [i,i]o, i, i, i, i]  o" where
   "iterates_MH(M,isF,v,n,g,z) 
        is_nat_case(M, v, λm u. gm[M]. fun_apply(M,g,m,gm)  isF(gm,u),
                    n, z)"

definition
  is_iterates :: "[io, [i,i]o, i, i, i]  o" where
    "is_iterates(M,isF,v,n,Z)  
      sn[M]. msn[M]. successor(M,n,sn)  membership(M,sn,msn) 
                       is_wfrec(M, iterates_MH(M,isF,v), msn, n, Z)"

definition
  iterates_replacement :: "[io, [i,i]o, i]  o" where
   "iterates_replacement(M,isF,v) 
      n[M]. nnat  
         wfrec_replacement(M, iterates_MH(M,isF,v), Memrel(succ(n)))"

lemma (in M_basic) iterates_MH_abs:
  "relation1(M,isF,F); M(n); M(g); M(z) 
    iterates_MH(M,isF,v,n,g,z)  z = nat_case(v, λm. F(g`m), n)"
by (simp add: nat_case_abs [of _ "λm. F(g ` m)"]
              relation1_def iterates_MH_def)  

lemma (in M_trancl) iterates_imp_wfrec_replacement:
  "relation1(M,isF,F); n  nat; iterates_replacement(M,isF,v) 
    wfrec_replacement(M, λn f z. z = nat_case(v, λm. F(f`m), n), 
                       Memrel(succ(n)))" 
by (simp add: iterates_replacement_def iterates_MH_abs)

theorem (in M_trancl) iterates_abs:
  "iterates_replacement(M,isF,v); relation1(M,isF,F);
      n  nat; M(v); M(z); x[M]. M(F(x)) 
    is_iterates(M,isF,v,n,z)  z = iterates(F,n,v)" 
apply (frule iterates_imp_wfrec_replacement, assumption+)
apply (simp add: wf_Memrel trans_Memrel relation_Memrel 
                 is_iterates_def relation2_def iterates_MH_abs 
                 iterates_nat_def recursor_def transrec_def 
                 eclose_sing_Ord_eq nat_into_M
         trans_wfrec_abs [of _ _ _ _ "λn g. nat_case(v, λm. F(g`m), n)"])
done


lemma (in M_trancl) iterates_closed [intro,simp]:
  "iterates_replacement(M,isF,v); relation1(M,isF,F);
      n  nat; M(v); x[M]. M(F(x)) 
    M(iterates(F,n,v))"
apply (frule iterates_imp_wfrec_replacement, assumption+)
apply (simp add: wf_Memrel trans_Memrel relation_Memrel 
                 relation2_def iterates_MH_abs 
                 iterates_nat_def recursor_def transrec_def 
                 eclose_sing_Ord_eq nat_into_M
         trans_wfrec_closed [of _ _ _ "λn g. nat_case(v, λm. F(g`m), n)"])
done


subsection ‹lists without univ›

lemmas datatype_univs = Inl_in_univ Inr_in_univ 
                        Pair_in_univ nat_into_univ A_into_univ 

lemma list_fun_bnd_mono: "bnd_mono(univ(A), λX. {0} + A*X)"
apply (rule bnd_monoI)
 apply (intro subset_refl zero_subset_univ A_subset_univ 
              sum_subset_univ Sigma_subset_univ) 
apply (rule subset_refl sum_mono Sigma_mono | assumption)+
done

lemma list_fun_contin: "contin(λX. {0} + A*X)"
by (intro sum_contin prod_contin id_contin const_contin) 

text‹Re-expresses lists using sum and product›
lemma list_eq_lfp2: "list(A) = lfp(univ(A), λX. {0} + A*X)"
apply (simp add: list_def) 
apply (rule equalityI) 
 apply (rule lfp_lowerbound) 
  prefer 2 apply (rule lfp_subset)
 apply (clarify, subst lfp_unfold [OF list_fun_bnd_mono])
 apply (simp add: Nil_def Cons_def)
 apply blast 
txt‹Opposite inclusion›
apply (rule lfp_lowerbound) 
 prefer 2 apply (rule lfp_subset) 
apply (clarify, subst lfp_unfold [OF list.bnd_mono]) 
apply (simp add: Nil_def Cons_def)
apply (blast intro: datatype_univs
             dest: lfp_subset [THEN subsetD])
done

text‹Re-expresses lists using "iterates", no univ.›
lemma list_eq_Union:
     "list(A) = (nnat. (λX. {0} + A*X) ^ n (0))"
by (simp add: list_eq_lfp2 lfp_eq_Union list_fun_bnd_mono list_fun_contin)


definition
  is_list_functor :: "[io,i,i,i]  o" where
    "is_list_functor(M,A,X,Z)  
        n1[M]. AX[M]. 
         number1(M,n1)  cartprod(M,A,X,AX)  is_sum(M,n1,AX,Z)"

lemma (in M_basic) list_functor_abs [simp]: 
     "M(A); M(X); M(Z)  is_list_functor(M,A,X,Z)  (Z = {0} + A*X)"
by (simp add: is_list_functor_def singleton_0 nat_into_M)


subsection ‹formulas without univ›

lemma formula_fun_bnd_mono:
     "bnd_mono(univ(0), λX. ((nat*nat) + (nat*nat)) + (X*X + X))"
apply (rule bnd_monoI)
 apply (intro subset_refl zero_subset_univ A_subset_univ 
              sum_subset_univ Sigma_subset_univ nat_subset_univ) 
apply (rule subset_refl sum_mono Sigma_mono | assumption)+
done

lemma formula_fun_contin:
     "contin(λX. ((nat*nat) + (nat*nat)) + (X*X + X))"
by (intro sum_contin prod_contin id_contin const_contin) 


text‹Re-expresses formulas using sum and product›
lemma formula_eq_lfp2:
    "formula = lfp(univ(0), λX. ((nat*nat) + (nat*nat)) + (X*X + X))"
apply (simp add: formula_def) 
apply (rule equalityI) 
 apply (rule lfp_lowerbound) 
  prefer 2 apply (rule lfp_subset)
 apply (clarify, subst lfp_unfold [OF formula_fun_bnd_mono])
 apply (simp add: Member_def Equal_def Nand_def Forall_def)
 apply blast 
txt‹Opposite inclusion›
apply (rule lfp_lowerbound) 
 prefer 2 apply (rule lfp_subset, clarify) 
apply (subst lfp_unfold [OF formula.bnd_mono, simplified]) 
apply (simp add: Member_def Equal_def Nand_def Forall_def)  
apply (elim sumE SigmaE, simp_all) 
apply (blast intro: datatype_univs dest: lfp_subset [THEN subsetD])+  
done

text‹Re-expresses formulas using "iterates", no univ.›
lemma formula_eq_Union:
     "formula = 
      (nnat. (λX. ((nat*nat) + (nat*nat)) + (X*X + X)) ^ n (0))"
by (simp add: formula_eq_lfp2 lfp_eq_Union formula_fun_bnd_mono 
              formula_fun_contin)


definition
  is_formula_functor :: "[io,i,i]  o" where
    "is_formula_functor(M,X,Z)  
        nat'[M]. natnat[M]. natnatsum[M]. XX[M]. X3[M]. 
          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)"

lemma (in M_trancl) formula_functor_abs [simp]: 
     "M(X); M(Z) 
       is_formula_functor(M,X,Z)  
          Z = ((nat*nat) + (nat*nat)) + (X*X + X)"
by (simp add: is_formula_functor_def) 


subsectiontermM Contains the List and Formula Datatypes›

definition
  list_N :: "[i,i]  i" where
    "list_N(A,n)  (λX. {0} + A * X)^n (0)"

lemma Nil_in_list_N [simp]: "[]  list_N(A,succ(n))"
by (simp add: list_N_def Nil_def)

lemma Cons_in_list_N [simp]:
     "Cons(a,l)  list_N(A,succ(n))  aA  l  list_N(A,n)"
by (simp add: list_N_def Cons_def) 

text‹These two aren't simprules because they reveal the underlying
list representation.›
lemma list_N_0: "list_N(A,0) = 0"
by (simp add: list_N_def)

lemma list_N_succ: "list_N(A,succ(n)) = {0} + A * (list_N(A,n))"
by (simp add: list_N_def)

lemma list_N_imp_list:
  "l  list_N(A,n); n  nat  l  list(A)"
by (force simp add: list_eq_Union list_N_def)

lemma list_N_imp_length_lt [rule_format]:
     "n  nat  l  list_N(A,n). length(l) < n"
apply (induct_tac n)  
apply (auto simp add: list_N_0 list_N_succ 
                      Nil_def [symmetric] Cons_def [symmetric]) 
done

lemma list_imp_list_N [rule_format]:
     "l  list(A)  nnat. length(l) < n  l  list_N(A, n)"
apply (induct_tac l)
apply (force elim: natE)+
done

lemma list_N_imp_eq_length:
      "n  nat; l  list_N(A, n); l  list_N(A, succ(n)) 
        n = length(l)"
apply (rule le_anti_sym) 
 prefer 2 apply (simp add: list_N_imp_length_lt) 
apply (frule list_N_imp_list, simp)
apply (simp add: not_lt_iff_le [symmetric]) 
apply (blast intro: list_imp_list_N) 
done
  
text‹Express termlist_rec without using termrank or termVset,
neither of which is absolute.›
lemma (in M_trivial) list_rec_eq:
  "l  list(A) 
   list_rec(a,g,l) = 
   transrec (succ(length(l)),
      λx h. Lambda (list(A),
                    list_case' (a, 
                           λa l. g(a, l, h ` succ(length(l)) ` l)))) ` l"
apply (induct_tac l) 
apply (subst transrec, simp) 
apply (subst transrec) 
apply (simp add: list_imp_list_N) 
done

definition
  is_list_N :: "[io,i,i,i]  o" where
    "is_list_N(M,A,n,Z)  
      zero[M]. empty(M,zero)  
                is_iterates(M, is_list_functor(M,A), zero, n, Z)"

definition  
  mem_list :: "[io,i,i]  o" where
    "mem_list(M,A,l)  
      n[M]. listn[M]. 
       finite_ordinal(M,n)  is_list_N(M,A,n,listn)  l  listn"

definition
  is_list :: "[io,i,i]  o" where
    "is_list(M,A,Z)  l[M]. l  Z  mem_list(M,A,l)"

subsubsection‹Towards Absoluteness of termformula_rec

consts   depth :: "ii"
primrec
  "depth(Member(x,y)) = 0"
  "depth(Equal(x,y))  = 0"
  "depth(Nand(p,q)) = succ(depth(p)  depth(q))"
  "depth(Forall(p)) = succ(depth(p))"

lemma depth_type [TC]: "p  formula  depth(p)  nat"
by (induct_tac p, simp_all) 


definition
  formula_N :: "i  i" where
    "formula_N(n)  (λX. ((nat*nat) + (nat*nat)) + (X*X + X)) ^ n (0)"

lemma Member_in_formula_N [simp]:
     "Member(x,y)  formula_N(succ(n))  x  nat  y  nat"
by (simp add: formula_N_def Member_def) 

lemma Equal_in_formula_N [simp]:
     "Equal(x,y)  formula_N(succ(n))  x  nat  y  nat"
by (simp add: formula_N_def Equal_def) 

lemma Nand_in_formula_N [simp]:
     "Nand(x,y)  formula_N(succ(n))  x  formula_N(n)  y  formula_N(n)"
by (simp add: formula_N_def Nand_def) 

lemma Forall_in_formula_N [simp]:
     "Forall(x)  formula_N(succ(n))  x  formula_N(n)"
by (simp add: formula_N_def Forall_def) 

text‹These two aren't simprules because they reveal the underlying
formula representation.›
lemma formula_N_0: "formula_N(0) = 0"
by (simp add: formula_N_def)

lemma formula_N_succ:
     "formula_N(succ(n)) = 
      ((nat*nat) + (nat*nat)) + (formula_N(n) * formula_N(n) + formula_N(n))"
by (simp add: formula_N_def)

lemma formula_N_imp_formula:
  "p  formula_N(n); n  nat  p  formula"
by (force simp add: formula_eq_Union formula_N_def)

lemma formula_N_imp_depth_lt [rule_format]:
     "n  nat  p  formula_N(n). depth(p) < n"
apply (induct_tac n)  
apply (auto simp add: formula_N_0 formula_N_succ 
                      depth_type formula_N_imp_formula Un_least_lt_iff
                      Member_def [symmetric] Equal_def [symmetric]
                      Nand_def [symmetric] Forall_def [symmetric]) 
done

lemma formula_imp_formula_N [rule_format]:
     "p  formula  nnat. depth(p) < n  p  formula_N(n)"
apply (induct_tac p)
apply (simp_all add: succ_Un_distrib Un_least_lt_iff) 
apply (force elim: natE)+
done

lemma formula_N_imp_eq_depth:
      "n  nat; p  formula_N(n); p  formula_N(succ(n)) 
        n = depth(p)"
apply (rule le_anti_sym) 
 prefer 2 apply (simp add: formula_N_imp_depth_lt) 
apply (frule formula_N_imp_formula, simp)
apply (simp add: not_lt_iff_le [symmetric]) 
apply (blast intro: formula_imp_formula_N) 
done


text‹This result and the next are unused.›
lemma formula_N_mono [rule_format]:
  "m  nat; n  nat  mn  formula_N(m)  formula_N(n)"
apply (rule_tac m = m and n = n in diff_induct)
apply (simp_all add: formula_N_0 formula_N_succ, blast) 
done

lemma formula_N_distrib:
  "m  nat; n  nat  formula_N(m  n) = formula_N(m)  formula_N(n)"
apply (rule_tac i = m and j = n in Ord_linear_le, auto) 
apply (simp_all add: subset_Un_iff [THEN iffD1] subset_Un_iff2 [THEN iffD1] 
                     le_imp_subset formula_N_mono)
done

definition
  is_formula_N :: "[io,i,i]  o" where
    "is_formula_N(M,n,Z)  
      zero[M]. empty(M,zero)  
                is_iterates(M, is_formula_functor(M), zero, n, Z)"


definition  
  mem_formula :: "[io,i]  o" where
    "mem_formula(M,p)  
      n[M]. formn[M]. 
       finite_ordinal(M,n)  is_formula_N(M,n,formn)  p  formn"

definition
  is_formula :: "[io,i]  o" where
    "is_formula(M,Z)  p[M]. p  Z  mem_formula(M,p)"

locale M_datatypes = M_trancl +
 assumes list_replacement1:
   "M(A)  iterates_replacement(M, is_list_functor(M,A), 0)"
  and list_replacement2:
   "M(A)  strong_replacement(M,
         λn y. nnat  is_iterates(M, is_list_functor(M,A), 0, n, y))"
  and formula_replacement1:
   "iterates_replacement(M, is_formula_functor(M), 0)"
  and formula_replacement2:
   "strong_replacement(M,
         λn y. nnat  is_iterates(M, is_formula_functor(M), 0, n, y))"
  and nth_replacement:
   "M(l)  iterates_replacement(M, λl t. is_tl(M,l,t), l)"


subsubsection‹Absoluteness of the List Construction›

lemma (in M_datatypes) list_replacement2':
  "M(A)  strong_replacement(M, λn y. nnat  y = (λX. {0} + A * X)^n (0))"
apply (insert list_replacement2 [of A])
apply (rule strong_replacement_cong [THEN iffD1])
apply (rule conj_cong [OF iff_refl iterates_abs [of "is_list_functor(M,A)"]])
apply (simp_all add: list_replacement1 relation1_def)
done

lemma (in M_datatypes) list_closed [intro,simp]:
     "M(A)  M(list(A))"
apply (insert list_replacement1)
by  (simp add: RepFun_closed2 list_eq_Union
               list_replacement2' relation1_def
               iterates_closed [of "is_list_functor(M,A)"])

text‹WARNING: use only with dest:› or with variables fixed!›
lemmas (in M_datatypes) list_into_M = transM [OF _ list_closed]

lemma (in M_datatypes) list_N_abs [simp]:
     "M(A); nnat; M(Z)
       is_list_N(M,A,n,Z)  Z = list_N(A,n)"
apply (insert list_replacement1)
apply (simp add: is_list_N_def list_N_def relation1_def nat_into_M
                 iterates_abs [of "is_list_functor(M,A)" _ "λX. {0} + A*X"])
done

lemma (in M_datatypes) list_N_closed [intro,simp]:
     "M(A); nnat  M(list_N(A,n))"
apply (insert list_replacement1)
apply (simp add: is_list_N_def list_N_def relation1_def nat_into_M
                 iterates_closed [of "is_list_functor(M,A)"])
done

lemma (in M_datatypes) mem_list_abs [simp]:
     "M(A)  mem_list(M,A,l)  l  list(A)"
apply (insert list_replacement1)
apply (simp add: mem_list_def list_N_def relation1_def list_eq_Union
                 iterates_closed [of "is_list_functor(M,A)"])
done

lemma (in M_datatypes) list_abs [simp]:
     "M(A); M(Z)  is_list(M,A,Z)  Z = list(A)"
apply (simp add: is_list_def, safe)
apply (rule M_equalityI, simp_all)
done

subsubsection‹Absoluteness of Formulas›

lemma (in M_datatypes) formula_replacement2':
  "strong_replacement(M, λn y. nnat  y = (λX. ((nat*nat) + (nat*nat)) + (X*X + X))^n (0))"
apply (insert formula_replacement2)
apply (rule strong_replacement_cong [THEN iffD1])
apply (rule conj_cong [OF iff_refl iterates_abs [of "is_formula_functor(M)"]])
apply (simp_all add: formula_replacement1 relation1_def)
done

lemma (in M_datatypes) formula_closed [intro,simp]:
     "M(formula)"
apply (insert formula_replacement1)
apply  (simp add: RepFun_closed2 formula_eq_Union
                  formula_replacement2' relation1_def
                  iterates_closed [of "is_formula_functor(M)"])
done

lemmas (in M_datatypes) formula_into_M = transM [OF _ formula_closed]

lemma (in M_datatypes) formula_N_abs [simp]:
     "nnat; M(Z)
       is_formula_N(M,n,Z)  Z = formula_N(n)"
apply (insert formula_replacement1)
apply (simp add: is_formula_N_def formula_N_def relation1_def nat_into_M
                 iterates_abs [of "is_formula_functor(M)" _
                                  "λX. ((nat*nat) + (nat*nat)) + (X*X + X)"])
done

lemma (in M_datatypes) formula_N_closed [intro,simp]:
     "nnat  M(formula_N(n))"
apply (insert formula_replacement1)
apply (simp add: is_formula_N_def formula_N_def relation1_def nat_into_M
                 iterates_closed [of "is_formula_functor(M)"])
done

lemma (in M_datatypes) mem_formula_abs [simp]:
     "mem_formula(M,l)  l  formula"
apply (insert formula_replacement1)
apply (simp add: mem_formula_def relation1_def formula_eq_Union formula_N_def
                 iterates_closed [of "is_formula_functor(M)"])
done

lemma (in M_datatypes) formula_abs [simp]:
     "M(Z)  is_formula(M,Z)  Z = formula"
apply (simp add: is_formula_def, safe)
apply (rule M_equalityI, simp_all)
done


subsection‹Absoluteness for ε›-Closure: the termeclose Operator›

text‹Re-expresses eclose using "iterates"›
lemma eclose_eq_Union:
     "eclose(A) = (nnat. Union^n (A))"
apply (simp add: eclose_def)
apply (rule UN_cong)
apply (rule refl)
apply (induct_tac n)
apply (simp add: nat_rec_0)
apply (simp add: nat_rec_succ)
done

definition
  is_eclose_n :: "[io,i,i,i]  o" where
    "is_eclose_n(M,A,n,Z)  is_iterates(M, big_union(M), A, n, Z)"

definition
  mem_eclose :: "[io,i,i]  o" where
    "mem_eclose(M,A,l) 
      n[M]. eclosen[M].
       finite_ordinal(M,n)  is_eclose_n(M,A,n,eclosen)  l  eclosen"

definition
  is_eclose :: "[io,i,i]  o" where
    "is_eclose(M,A,Z)  u[M]. u  Z  mem_eclose(M,A,u)"


locale M_eclose = M_datatypes +
 assumes eclose_replacement1:
   "M(A)  iterates_replacement(M, big_union(M), A)"
  and eclose_replacement2:
   "M(A)  strong_replacement(M,
         λn y. nnat  is_iterates(M, big_union(M), A, n, y))"

lemma (in M_eclose) eclose_replacement2':
  "M(A)  strong_replacement(M, λn y. nnat  y = Union^n (A))"
apply (insert eclose_replacement2 [of A])
apply (rule strong_replacement_cong [THEN iffD1])
apply (rule conj_cong [OF iff_refl iterates_abs [of "big_union(M)"]])
apply (simp_all add: eclose_replacement1 relation1_def)
done

lemma (in M_eclose) eclose_closed [intro,simp]:
     "M(A)  M(eclose(A))"
apply (insert eclose_replacement1)
by  (simp add: RepFun_closed2 eclose_eq_Union
               eclose_replacement2' relation1_def
               iterates_closed [of "big_union(M)"])

lemma (in M_eclose) is_eclose_n_abs [simp]:
     "M(A); nnat; M(Z)  is_eclose_n(M,A,n,Z)  Z = Union^n (A)"
apply (insert eclose_replacement1)
apply (simp add: is_eclose_n_def relation1_def nat_into_M
                 iterates_abs [of "big_union(M)" _ "Union"])
done

lemma (in M_eclose) mem_eclose_abs [simp]:
     "M(A)  mem_eclose(M,A,l)  l  eclose(A)"
apply (insert eclose_replacement1)
apply (simp add: mem_eclose_def relation1_def eclose_eq_Union
                 iterates_closed [of "big_union(M)"])
done

lemma (in M_eclose) eclose_abs [simp]:
     "M(A); M(Z)  is_eclose(M,A,Z)  Z = eclose(A)"
apply (simp add: is_eclose_def, safe)
apply (rule M_equalityI, simp_all)
done


subsection ‹Absoluteness for termtransrec

textproptransrec(a,H)  wfrec(Memrel(eclose({a})), a, H)

definition
  is_transrec :: "[io, [i,i,i]o, i, i]  o" where
   "is_transrec(M,MH,a,z) 
      sa[M]. esa[M]. mesa[M].
       upair(M,a,a,sa)  is_eclose(M,sa,esa)  membership(M,esa,mesa) 
       is_wfrec(M,MH,mesa,a,z)"

definition
  transrec_replacement :: "[io, [i,i,i]o, i]  o" where
   "transrec_replacement(M,MH,a) 
      sa[M]. esa[M]. mesa[M].
       upair(M,a,a,sa)  is_eclose(M,sa,esa)  membership(M,esa,mesa) 
       wfrec_replacement(M,MH,mesa)"

text‹The condition termOrd(i) lets us use the simpler
  trans_wfrec_abs› rather than trans_wfrec_abs›,
  which I haven't even proved yet.›
theorem (in M_eclose) transrec_abs:
  "transrec_replacement(M,MH,i);  relation2(M,MH,H);
     Ord(i);  M(i);  M(z);
     x[M]. g[M]. function(g)  M(H(x,g))
    is_transrec(M,MH,i,z)  z = transrec(i,H)"
by (simp add: trans_wfrec_abs transrec_replacement_def is_transrec_def
       transrec_def eclose_sing_Ord_eq wf_Memrel trans_Memrel relation_Memrel)


theorem (in M_eclose) transrec_closed:
     "transrec_replacement(M,MH,i);  relation2(M,MH,H);
        Ord(i);  M(i);
        x[M]. g[M]. function(g)  M(H(x,g))
       M(transrec(i,H))"
by (simp add: trans_wfrec_closed transrec_replacement_def is_transrec_def
        transrec_def eclose_sing_Ord_eq wf_Memrel trans_Memrel relation_Memrel)


text‹Helps to prove instances of termtransrec_replacement
lemma (in M_eclose) transrec_replacementI:
   "M(a);
      strong_replacement (M,
                  λx z. y[M]. pair(M, x, y, z) 
                               is_wfrec(M,MH,Memrel(eclose({a})),x,y))
     transrec_replacement(M,MH,a)"
by (simp add: transrec_replacement_def wfrec_replacement_def)


subsection‹Absoluteness for the List Operator termlength
text‹But it is never used.›

definition
  is_length :: "[io,i,i,i]  o" where
    "is_length(M,A,l,n) 
       sn[M]. list_n[M]. list_sn[M].
        is_list_N(M,A,n,list_n)  l  list_n 
        successor(M,n,sn)  is_list_N(M,A,sn,list_sn)  l  list_sn"


lemma (in M_datatypes) length_abs [simp]:
     "M(A); l  list(A); n  nat  is_length(M,A,l,n)  n = length(l)"
apply (subgoal_tac "M(l)  M(n)")
 prefer 2 apply (blast dest: transM)
apply (simp add: is_length_def)
apply (blast intro: list_imp_list_N nat_into_Ord list_N_imp_eq_length
             dest: list_N_imp_length_lt)
done

text‹Proof is trivial since termlength returns natural numbers.›
lemma (in M_trivial) length_closed [intro,simp]:
     "l  list(A)  M(length(l))"
by (simp add: nat_into_M)


subsection ‹Absoluteness for the List Operator termnth

lemma nth_eq_hd_iterates_tl [rule_format]:
     "xs  list(A)  n  nat. nth(n,xs) = hd' (tl'^n (xs))"
apply (induct_tac xs)
apply (simp add: iterates_tl_Nil hd'_Nil, clarify)
apply (erule natE)
apply (simp add: hd'_Cons)
apply (simp add: tl'_Cons iterates_commute)
done

lemma (in M_basic) iterates_tl'_closed:
     "n  nat; M(x)  M(tl'^n (x))"
apply (induct_tac n, simp)
apply (simp add: tl'_Cons tl'_closed)
done

text‹Immediate by type-checking›
lemma (in M_datatypes) nth_closed [intro,simp]:
     "xs  list(A); n  nat; M(A)  M(nth(n,xs))"
apply (case_tac "n < length(xs)")
 apply (blast intro: nth_type transM)
apply (simp add: not_lt_iff_le nth_eq_0)
done

definition
  is_nth :: "[io,i,i,i]  o" where
    "is_nth(M,n,l,Z) 
      X[M]. is_iterates(M, is_tl(M), l, n, X)  is_hd(M,X,Z)"

lemma (in M_datatypes) nth_abs [simp]:
     "M(A); n  nat; l  list(A); M(Z)
       is_nth(M,n,l,Z)  Z = nth(n,l)"
apply (subgoal_tac "M(l)")
 prefer 2 apply (blast intro: transM)
apply (simp add: is_nth_def nth_eq_hd_iterates_tl nat_into_M
                 tl'_closed iterates_tl'_closed
                 iterates_abs [OF _ relation1_tl] nth_replacement)
done


subsection‹Relativization and Absoluteness for the termformula Constructors›

definition
  is_Member :: "[io,i,i,i]  o" where
     ― ‹because termMember(x,y)  Inl(Inl(x,y))
    "is_Member(M,x,y,Z) 
        p[M]. u[M]. pair(M,x,y,p)  is_Inl(M,p,u)  is_Inl(M,u,Z)"

lemma (in M_trivial) Member_abs [simp]:
     "M(x); M(y); M(Z)  is_Member(M,x,y,Z)  (Z = Member(x,y))"
by (simp add: is_Member_def Member_def)

lemma (in M_trivial) Member_in_M_iff [iff]:
     "M(Member(x,y))  M(x)  M(y)"
by (simp add: Member_def)

definition
  is_Equal :: "[io,i,i,i]  o" where
     ― ‹because termEqual(x,y)  Inl(Inr(x,y))
    "is_Equal(M,x,y,Z) 
        p[M]. u[M]. pair(M,x,y,p)  is_Inr(M,p,u)  is_Inl(M,u,Z)"

lemma (in M_trivial) Equal_abs [simp]:
     "M(x); M(y); M(Z)  is_Equal(M,x,y,Z)  (Z = Equal(x,y))"
by (simp add: is_Equal_def Equal_def)

lemma (in M_trivial) Equal_in_M_iff [iff]: "M(Equal(x,y))  M(x)  M(y)"
by (simp add: Equal_def)

definition
  is_Nand :: "[io,i,i,i]  o" where
     ― ‹because termNand(x,y)  Inr(Inl(x,y))
    "is_Nand(M,x,y,Z) 
        p[M]. u[M]. pair(M,x,y,p)  is_Inl(M,p,u)  is_Inr(M,u,Z)"

lemma (in M_trivial) Nand_abs [simp]:
     "M(x); M(y); M(Z)  is_Nand(M,x,y,Z)  (Z = Nand(x,y))"
by (simp add: is_Nand_def Nand_def)

lemma (in M_trivial) Nand_in_M_iff [iff]: "M(Nand(x,y))  M(x)  M(y)"
by (simp add: Nand_def)

definition
  is_Forall :: "[io,i,i]  o" where
     ― ‹because termForall(x)  Inr(Inr(p))
    "is_Forall(M,p,Z)  u[M]. is_Inr(M,p,u)  is_Inr(M,u,Z)"

lemma (in M_trivial) Forall_abs [simp]:
     "M(x); M(Z)  is_Forall(M,x,Z)  (Z = Forall(x))"
by (simp add: is_Forall_def Forall_def)

lemma (in M_trivial) Forall_in_M_iff [iff]: "M(Forall(x))  M(x)"
by (simp add: Forall_def)



subsection ‹Absoluteness for termformula_rec

definition
  formula_rec_case :: "[[i,i]i, [i,i]i, [i,i,i,i]i, [i,i]i, i, i]  i" where
    ― ‹the instance of termformula_case in termformula_rec
   "formula_rec_case(a,b,c,d,h) 
        formula_case (a, b,
                λu v. c(u, v, h ` succ(depth(u)) ` u,
                              h ` succ(depth(v)) ` v),
                λu. d(u, h ` succ(depth(u)) ` u))"

text‹Unfold termformula_rec to termformula_rec_case.
     Express termformula_rec without using termrank or termVset,
neither of which is absolute.›
lemma (in M_trivial) formula_rec_eq:
  "p  formula 
   formula_rec(a,b,c,d,p) =
   transrec (succ(depth(p)),
             λx h. Lambda (formula, formula_rec_case(a,b,c,d,h))) ` p"
apply (simp add: formula_rec_case_def)
apply (induct_tac p)
   txt‹Base case for termMember
   apply (subst transrec, simp add: formula.intros)
  txt‹Base case for termEqual
  apply (subst transrec, simp add: formula.intros)
 txt‹Inductive step for termNand
 apply (subst transrec)
 apply (simp add: succ_Un_distrib formula.intros)
txt‹Inductive step for termForall
apply (subst transrec)
apply (simp add: formula_imp_formula_N formula.intros)
done


subsubsection‹Absoluteness for the Formula Operator termdepth

definition
  is_depth :: "[io,i,i]  o" where
    "is_depth(M,p,n) 
       sn[M]. formula_n[M]. formula_sn[M].
        is_formula_N(M,n,formula_n)  p  formula_n 
        successor(M,n,sn)  is_formula_N(M,sn,formula_sn)  p  formula_sn"


lemma (in M_datatypes) depth_abs [simp]:
     "p  formula; n  nat  is_depth(M,p,n)  n = depth(p)"
apply (subgoal_tac "M(p)  M(n)")
 prefer 2 apply (blast dest: transM)
apply (simp add: is_depth_def)
apply (blast intro: formula_imp_formula_N nat_into_Ord formula_N_imp_eq_depth
             dest: formula_N_imp_depth_lt)
done

text‹Proof is trivial since termdepth returns natural numbers.›
lemma (in M_trivial) depth_closed [intro,simp]:
     "p  formula  M(depth(p))"
by (simp add: nat_into_M)


subsubsectiontermis_formula_case: relativization of termformula_case

definition
 is_formula_case ::
    "[io, [i,i,i]o, [i,i,i]o, [i,i,i]o, [i,i]o, i, i]  o" where
  ― ‹no constraint on non-formulas›
  "is_formula_case(M, is_a, is_b, is_c, is_d, p, z) 
      (x[M]. y[M]. finite_ordinal(M,x)  finite_ordinal(M,y) 
                      is_Member(M,x,y,p)  is_a(x,y,z)) 
      (x[M]. y[M]. finite_ordinal(M,x)  finite_ordinal(M,y) 
                      is_Equal(M,x,y,p)  is_b(x,y,z)) 
      (x[M]. y[M]. mem_formula(M,x)  mem_formula(M,y) 
                     is_Nand(M,x,y,p)  is_c(x,y,z)) 
      (x[M]. mem_formula(M,x)  is_Forall(M,x,p)  is_d(x,z))"

lemma (in M_datatypes) formula_case_abs [simp]:
     "Relation2(M,nat,nat,is_a,a); Relation2(M,nat,nat,is_b,b);
         Relation2(M,formula,formula,is_c,c); Relation1(M,formula,is_d,d);
         p  formula; M(z)
       is_formula_case(M,is_a,is_b,is_c,is_d,p,z) 
          z = formula_case(a,b,c,d,p)"
apply (simp add: formula_into_M is_formula_case_def)
apply (erule formula.cases)
   apply (simp_all add: Relation1_def Relation2_def)
done

lemma (in M_datatypes) formula_case_closed [intro,simp]:
  "p  formula;
     x[M]. y[M]. xnat  ynat  M(a(x,y));
     x[M]. y[M]. xnat  ynat  M(b(x,y));
     x[M]. y[M]. xformula  yformula  M(c(x,y));
     x[M]. xformula  M(d(x))  M(formula_case(a,b,c,d,p))"
by (erule formula.cases, simp_all)


subsubsection ‹Absoluteness for termformula_rec: Final Results›

definition
  is_formula_rec :: "[io, [i,i,i]o, i, i]  o" where
    ― ‹predicate to relativize the functional termformula_rec
   "is_formula_rec(M,MH,p,z)  
      dp[M]. i[M]. f[M]. finite_ordinal(M,dp)  is_depth(M,p,dp) 
             successor(M,dp,i)  fun_apply(M,f,p,z)  is_transrec(M,MH,i,f)"


text‹Sufficient conditions to relativize the instance of termformula_case
      in termformula_rec
lemma (in M_datatypes) Relation1_formula_rec_case:
     "Relation2(M, nat, nat, is_a, a);
        Relation2(M, nat, nat, is_b, b);
        Relation2 (M, formula, formula,
           is_c, λu v. c(u, v, h`succ(depth(u))`u, h`succ(depth(v))`v));
        Relation1(M, formula,
           is_d, λu. d(u, h ` succ(depth(u)) ` u));
        M(h)
       Relation1(M, formula,
                         is_formula_case (M, is_a, is_b, is_c, is_d),
                         formula_rec_case(a, b, c, d, h))"
apply (simp (no_asm) add: formula_rec_case_def Relation1_def)
apply (simp)
done


text‹This locale packages the premises of the following theorems,
      which is the normal purpose of locales.  It doesn't accumulate
      constraints on the class termM, as in most of this development.›
locale Formula_Rec = M_eclose +
  fixes a and is_a and b and is_b and c and is_c and d and is_d and MH
  defines
      "MH(u::i,f,z) 
        fml[M]. is_formula(M,fml) 
             is_lambda
         (M, fml, is_formula_case (M, is_a, is_b, is_c(f), is_d(f)), z)"

  assumes a_closed: "xnat; ynat  M(a(x,y))"
      and a_rel:    "Relation2(M, nat, nat, is_a, a)"
      and b_closed: "xnat; ynat  M(b(x,y))"
      and b_rel:    "Relation2(M, nat, nat, is_b, b)"
      and c_closed: "x  formula; y  formula; M(gx); M(gy)
                      M(c(x, y, gx, gy))"
      and c_rel:
         "M(f) 
          Relation2 (M, formula, formula, is_c(f),
             λu v. c(u, v, f ` succ(depth(u)) ` u, f ` succ(depth(v)) ` v))"
      and d_closed: "x  formula; M(gx)  M(d(x, gx))"
      and d_rel:
         "M(f) 
          Relation1(M, formula, is_d(f), λu. d(u, f ` succ(depth(u)) ` u))"
      and fr_replace: "n  nat  transrec_replacement(M,MH,n)"
      and fr_lam_replace:
           "M(g) 
            strong_replacement
              (M, λx y. x  formula 
                  y = x, formula_rec_case(a,b,c,d,g,x))"

lemma (in Formula_Rec) formula_rec_case_closed:
    "M(g); p  formula  M(formula_rec_case(a, b, c, d, g, p))"
by (simp add: formula_rec_case_def a_closed b_closed c_closed d_closed)

lemma (in Formula_Rec) formula_rec_lam_closed:
    "M(g)  M(Lambda (formula, formula_rec_case(a,b,c,d,g)))"
by (simp add: lam_closed2 fr_lam_replace formula_rec_case_closed)

lemma (in Formula_Rec) MH_rel2:
     "relation2 (M, MH,
             λx h. Lambda (formula, formula_rec_case(a,b,c,d,h)))"
apply (simp add: relation2_def MH_def, clarify)
apply (rule lambda_abs2)
apply (rule Relation1_formula_rec_case)
apply (simp_all add: a_rel b_rel c_rel d_rel formula_rec_case_closed)
done

lemma (in Formula_Rec) fr_transrec_closed:
    "n  nat
      M(transrec
          (n, λx h. Lambda(formula, formula_rec_case(a, b, c, d, h))))"
by (simp add: transrec_closed [OF fr_replace MH_rel2]
              nat_into_M formula_rec_lam_closed)

text‹The main two results: termformula_rec is absolute for termM.›
theorem (in Formula_Rec) formula_rec_closed:
    "p  formula  M(formula_rec(a,b,c,d,p))"
by (simp add: formula_rec_eq fr_transrec_closed
              transM [OF _ formula_closed])

theorem (in Formula_Rec) formula_rec_abs:
  "p  formula; M(z)
    is_formula_rec(M,MH,p,z)  z = formula_rec(a,b,c,d,p)"
by (simp add: is_formula_rec_def formula_rec_eq transM [OF _ formula_closed]
              transrec_abs [OF fr_replace MH_rel2] depth_type
              fr_transrec_closed formula_rec_lam_closed eq_commute)


end