diff --git a/src/ZF/AC/AC15_WO6.thy b/src/ZF/AC/AC15_WO6.thy
--- a/src/ZF/AC/AC15_WO6.thy
+++ b/src/ZF/AC/AC15_WO6.thy
@@ -1,289 +1,289 @@
 (*  Title:      ZF/AC/AC15_WO6.thy
     Author:     Krzysztof Grabczewski
 
 The proofs needed to state that AC10, ..., AC15 are equivalent to the rest.
 We need the following:
 
 WO1 \<Longrightarrow> AC10(n) \<Longrightarrow> AC11 \<Longrightarrow> AC12 \<Longrightarrow> AC15 \<Longrightarrow> WO6
 
 In order to add the formulations AC13 and AC14 we need:
 
 AC10(succ(n)) \<Longrightarrow> AC13(n) \<Longrightarrow> AC14 \<Longrightarrow> AC15
 
 or
 
 AC1 \<Longrightarrow> AC13(1);  AC13(m) \<Longrightarrow> AC13(n) \<Longrightarrow> AC14 \<Longrightarrow> AC15    (m\<le>n)
 
 So we don't have to prove all implications of both cases.
 Moreover we don't need to prove AC13(1) \<Longrightarrow> AC1 and AC11 \<Longrightarrow> AC14 as
 Rubin \<and> Rubin do.
 *)
 
 theory AC15_WO6
 imports HH Cardinal_aux
 begin
 
 
 (* ********************************************************************** *)
 (* Lemmas used in the proofs in which the conclusion is AC13, AC14        *)
 (* or AC15                                                                *)
 (*  - cons_times_nat_not_Finite                                           *)
 (*  - ex_fun_AC13_AC15                                                    *)
 (* ********************************************************************** *)
 
 lemma lepoll_Sigma: "A\<noteq>0 \<Longrightarrow> B \<lesssim> A*B"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (erule not_emptyE)
 apply (rule_tac x = "\<lambda>z \<in> B. \<langle>x,z\<rangle>" in exI)
 apply (fast intro!: snd_conv lam_injective)
 done
 
 lemma cons_times_nat_not_Finite:
      "0\<notin>A \<Longrightarrow> \<forall>B \<in> {cons(0,x*nat). x \<in> A}. \<not>Finite(B)"
 apply clarify 
 apply (rule nat_not_Finite [THEN notE] )
 apply (subgoal_tac "x \<noteq> 0")
  apply (blast intro: lepoll_Sigma [THEN lepoll_Finite])+
 done
 
 lemma lemma1: "\<lbrakk>\<Union>(C)=A; a \<in> A\<rbrakk> \<Longrightarrow> \<exists>B \<in> C. a \<in> B \<and> B \<subseteq> A"
 by fast
 
 lemma lemma2: 
         "\<lbrakk>pairwise_disjoint(A); B \<in> A; C \<in> A; a \<in> B; a \<in> C\<rbrakk> \<Longrightarrow> B=C"
 by (unfold pairwise_disjoint_def, blast) 
 
 lemma lemma3: 
      "\<forall>B \<in> {cons(0, x*nat). x \<in> A}. pairwise_disjoint(f`B) \<and>   
              sets_of_size_between(f`B, 2, n) \<and> \<Union>(f`B)=B   
      \<Longrightarrow> \<forall>B \<in> A. \<exists>! u. u \<in> f`cons(0, B*nat) \<and> u \<subseteq> cons(0, B*nat) \<and>   
              0 \<in> u \<and> 2 \<lesssim> u \<and> u \<lesssim> n"
-apply (unfold sets_of_size_between_def)
+  unfolding sets_of_size_between_def
 apply (rule ballI)
 apply (erule_tac x="cons(0, B*nat)" in ballE)
  apply (blast dest: lemma1 intro!: lemma2, blast)
 done
 
 lemma lemma4: "\<lbrakk>A \<lesssim> i; Ord(i)\<rbrakk> \<Longrightarrow> {P(a). a \<in> A} \<lesssim> i"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (erule exE)
 apply (rule_tac x = "\<lambda>x \<in> RepFun(A,P). \<mu> j. \<exists>a\<in>A. x=P(a) \<and> f`a=j" 
        in exI)
 apply (rule_tac d = "\<lambda>y. P (converse (f) `y) " in lam_injective)
 apply (erule RepFunE)
 apply (frule inj_is_fun [THEN apply_type], assumption)
 apply (fast intro: LeastI2 elim!: Ord_in_Ord inj_is_fun [THEN apply_type])
 apply (erule RepFunE)
 apply (rule LeastI2)
   apply fast
  apply (fast elim!: Ord_in_Ord inj_is_fun [THEN apply_type])
 apply (fast elim: sym left_inverse [THEN ssubst])
 done
 
 lemma lemma5_1:
      "\<lbrakk>B \<in> A; 2 \<lesssim> u(B)\<rbrakk> \<Longrightarrow> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<noteq> 0"
 apply simp
 apply (fast dest: lepoll_Diff_sing 
             elim: lepoll_trans [THEN succ_lepoll_natE] ssubst
             intro!: lepoll_refl)
 done
 
 lemma lemma5_2:
      "\<lbrakk>B \<in> A; u(B) \<subseteq> cons(0, B*nat)\<rbrakk>   
       \<Longrightarrow> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<subseteq> B"
 apply auto 
 done
 
 lemma lemma5_3:
      "\<lbrakk>n \<in> nat; B \<in> A; 0 \<in> u(B); u(B) \<lesssim> succ(n)\<rbrakk>   
       \<Longrightarrow> (\<lambda>x \<in> A. {fst(x). x \<in> u(x)-{0}})`B \<lesssim> n"
 apply simp
 apply (fast elim!: Diff_lepoll [THEN lemma4 [OF _ nat_into_Ord]])
 done
 
 lemma ex_fun_AC13_AC15:
      "\<lbrakk>\<forall>B \<in> {cons(0, x*nat). x \<in> A}.   
                 pairwise_disjoint(f`B) \<and>   
                 sets_of_size_between(f`B, 2, succ(n)) \<and> \<Union>(f`B)=B; 
          n \<in> nat\<rbrakk>   
       \<Longrightarrow> \<exists>f. \<forall>B \<in> A. f`B \<noteq> 0 \<and> f`B \<subseteq> B \<and> f`B \<lesssim> n"
 by (fast del: subsetI notI
          dest!: lemma3 theI intro!: lemma5_1 lemma5_2 lemma5_3)
 
 
 (* ********************************************************************** *)
 (* The target proofs                                                      *)
 (* ********************************************************************** *)
 
 (* ********************************************************************** *)
 (* AC10(n) \<Longrightarrow> AC11                                                       *)
 (* ********************************************************************** *)
 
 theorem AC10_AC11: "\<lbrakk>n \<in> nat; 1\<le>n; AC10(n)\<rbrakk> \<Longrightarrow> AC11"
 by (unfold AC10_def AC11_def, blast)
 
 (* ********************************************************************** *)
 (* AC11 \<Longrightarrow> AC12                                                          *)
 (* ********************************************************************** *)
 
 theorem AC11_AC12: "AC11 \<Longrightarrow> AC12"
 by (unfold AC10_def AC11_def AC11_def AC12_def, blast)
 
 (* ********************************************************************** *)
 (* AC12 \<Longrightarrow> AC15                                                          *)
 (* ********************************************************************** *)
 
 theorem AC12_AC15: "AC12 \<Longrightarrow> AC15"
 apply (unfold AC12_def AC15_def)
 apply (blast del: ballI 
              intro!: cons_times_nat_not_Finite ex_fun_AC13_AC15)
 done
 
 (* ********************************************************************** *)
 (* AC15 \<Longrightarrow> WO6                                                           *)
 (* ********************************************************************** *)
 
 lemma OUN_eq_UN: "Ord(x) \<Longrightarrow> (\<Union>a<x. F(a)) = (\<Union>a \<in> x. F(a))"
 by (fast intro!: ltI dest!: ltD)
 
 lemma AC15_WO6_aux1:
      "\<forall>x \<in> Pow(A)-{0}. f`x\<noteq>0 \<and> f`x \<subseteq> x \<and> f`x \<lesssim> m 
       \<Longrightarrow> (\<Union>i<\<mu> x. HH(f,A,x)={A}. HH(f,A,i)) = A"
 apply (simp add: Ord_Least [THEN OUN_eq_UN])
 apply (rule equalityI)
 apply (fast dest!: less_Least_subset_x)
 apply (blast del: subsetI 
            intro!: f_subsets_imp_UN_HH_eq_x [THEN Diff_eq_0_iff [THEN iffD1]])
 done
 
 lemma AC15_WO6_aux2:
      "\<forall>x \<in> Pow(A)-{0}. f`x\<noteq>0 \<and> f`x \<subseteq> x \<and> f`x \<lesssim> m 
       \<Longrightarrow> \<forall>x < (\<mu> x. HH(f,A,x)={A}). HH(f,A,x) \<lesssim> m"
 apply (rule oallI)
 apply (drule ltD [THEN less_Least_subset_x])
 apply (frule HH_subset_imp_eq)
 apply (erule ssubst)
 apply (blast dest!: HH_subset_x_imp_subset_Diff_UN [THEN not_emptyI2])
         (*but can't use del: DiffE despite the obvious conflict*)
 done
 
 theorem AC15_WO6: "AC15 \<Longrightarrow> WO6"
 apply (unfold AC15_def WO6_def)
 apply (rule allI)
 apply (erule_tac x = "Pow (A) -{0}" in allE)
 apply (erule impE, fast)
 apply (elim bexE conjE exE)
 apply (rule bexI)
  apply (rule conjI, assumption)
  apply (rule_tac x = "\<mu> i. HH (f,A,i) ={A}" in exI)
  apply (rule_tac x = "\<lambda>j \<in> (\<mu> i. HH (f,A,i) ={A}) . HH (f,A,j) " in exI)
  apply (simp_all add: ltD)
 apply (fast intro!: Ord_Least lam_type [THEN domain_of_fun]
             elim!: less_Least_subset_x AC15_WO6_aux1 AC15_WO6_aux2) 
 done
 
 
 (* ********************************************************************** *)
 (* The proof needed in the first case, not in the second                  *)
 (* ********************************************************************** *)
 
 (* ********************************************************************** *)
 (* AC10(n) \<Longrightarrow> AC13(n-1)  if 2\<le>n                                       *)
 (*                                                                        *)
 (* Because of the change to the formal definition of AC10(n) we prove     *)
 (* the following obviously equivalent theorem \<in>                           *)
 (* AC10(n) implies AC13(n) for (1\<le>n)                                   *)
 (* ********************************************************************** *)
 
 theorem AC10_AC13: "\<lbrakk>n \<in> nat; 1\<le>n; AC10(n)\<rbrakk> \<Longrightarrow> AC13(n)"
 apply (unfold AC10_def AC13_def, safe)
 apply (erule allE) 
 apply (erule impE [OF _ cons_times_nat_not_Finite], assumption) 
 apply (fast elim!: impE [OF _ cons_times_nat_not_Finite] 
             dest!: ex_fun_AC13_AC15)
 done
 
 (* ********************************************************************** *)
 (* The proofs needed in the second case, not in the first                 *)
 (* ********************************************************************** *)
 
 (* ********************************************************************** *)
 (* AC1 \<Longrightarrow> AC13(1)                                                        *)
 (* ********************************************************************** *)
 
 lemma AC1_AC13: "AC1 \<Longrightarrow> AC13(1)"
 apply (unfold AC1_def AC13_def)
 apply (rule allI)
 apply (erule allE)
 apply (rule impI)
 apply (drule mp, assumption) 
 apply (elim exE)
 apply (rule_tac x = "\<lambda>x \<in> A. {f`x}" in exI)
 apply (simp add: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll])
 done
 
 (* ********************************************************************** *)
 (* AC13(m) \<Longrightarrow> AC13(n) for m \<subseteq> n                                         *)
 (* ********************************************************************** *)
 
 lemma AC13_mono: "\<lbrakk>m\<le>n; AC13(m)\<rbrakk> \<Longrightarrow> AC13(n)"
-apply (unfold AC13_def)
+  unfolding AC13_def
 apply (drule le_imp_lepoll)
 apply (fast elim!: lepoll_trans)
 done
 
 (* ********************************************************************** *)
 (* The proofs necessary for both cases                                    *)
 (* ********************************************************************** *)
 
 (* ********************************************************************** *)
 (* AC13(n) \<Longrightarrow> AC14  if 1 \<subseteq> n                                            *)
 (* ********************************************************************** *)
 
 theorem AC13_AC14: "\<lbrakk>n \<in> nat; 1\<le>n; AC13(n)\<rbrakk> \<Longrightarrow> AC14"
 by (unfold AC13_def AC14_def, auto)
 
 (* ********************************************************************** *)
 (* AC14 \<Longrightarrow> AC15                                                          *)
 (* ********************************************************************** *)
 
 theorem AC14_AC15: "AC14 \<Longrightarrow> AC15"
 by (unfold AC13_def AC14_def AC15_def, fast)
 
 (* ********************************************************************** *)
 (* The redundant proofs; however cited by Rubin \<and> Rubin                   *)
 (* ********************************************************************** *)
 
 (* ********************************************************************** *)
 (* AC13(1) \<Longrightarrow> AC1                                                        *)
 (* ********************************************************************** *)
 
 lemma lemma_aux: "\<lbrakk>A\<noteq>0; A \<lesssim> 1\<rbrakk> \<Longrightarrow> \<exists>a. A={a}"
 by (fast elim!: not_emptyE lepoll_1_is_sing)
 
 lemma AC13_AC1_lemma:
      "\<forall>B \<in> A. f(B)\<noteq>0 \<and> f(B)<=B \<and> f(B) \<lesssim> 1   
       \<Longrightarrow> (\<lambda>x \<in> A. THE y. f(x)={y}) \<in> (\<Prod>X \<in> A. X)"
 apply (rule lam_type)
 apply (drule bspec, assumption)
 apply (elim conjE)
 apply (erule lemma_aux [THEN exE], assumption)
 apply (simp add: the_equality)
 done
 
 theorem AC13_AC1: "AC13(1) \<Longrightarrow> AC1"
 apply (unfold AC13_def AC1_def)
 apply (fast elim!: AC13_AC1_lemma)
 done
 
 (* ********************************************************************** *)
 (* AC11 \<Longrightarrow> AC14                                                          *)
 (* ********************************************************************** *)
 
 theorem AC11_AC14: "AC11 \<Longrightarrow> AC14"
 apply (unfold AC11_def AC14_def)
 apply (fast intro!: AC10_AC13)
 done
 
 end
 
diff --git a/src/ZF/AC/AC16_WO4.thy b/src/ZF/AC/AC16_WO4.thy
--- a/src/ZF/AC/AC16_WO4.thy
+++ b/src/ZF/AC/AC16_WO4.thy
@@ -1,578 +1,578 @@
 (*  Title:      ZF/AC/AC16_WO4.thy
     Author:     Krzysztof Grabczewski
 
 The proof of AC16(n, k) \<Longrightarrow> WO4(n-k)
 
 Tidied (using locales) by LCP
 *)
 
 theory AC16_WO4
 imports AC16_lemmas
 begin
 
 (* ********************************************************************** *)
 (* The case of finite set                                                 *)
 (* ********************************************************************** *)
 
 lemma lemma1:
      "\<lbrakk>Finite(A); 0<m; m \<in> nat\<rbrakk> 
       \<Longrightarrow> \<exists>a f. Ord(a) \<and> domain(f) = a \<and>   
                 (\<Union>b<a. f`b) = A \<and> (\<forall>b<a. f`b \<lesssim> m)"
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (erule bexE)
 apply (drule eqpoll_sym [THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]])
 apply (erule exE)
 apply (rule_tac x = n in exI)
 apply (rule_tac x = "\<lambda>i \<in> n. {f`i}" in exI)
 apply (simp add: ltD bij_def surj_def)
 apply (fast intro!: ltI nat_into_Ord lam_funtype [THEN domain_of_fun] 
                singleton_eqpoll_1 [THEN eqpoll_imp_lepoll, THEN lepoll_trans] 
                     nat_1_lepoll_iff [THEN iffD2]
           elim!: apply_type ltE)
 done
 
 (* ********************************************************************** *)
 (* The case of infinite set                                               *)
 (* ********************************************************************** *)
 
 (* well_ord(x,r) \<Longrightarrow> well_ord({{y,z}. y \<in> x}, Something(x,z))  **)
 lemmas well_ord_paired = paired_bij [THEN bij_is_inj, THEN well_ord_rvimage]
 
 lemma lepoll_trans1: "\<lbrakk>A \<lesssim> B; \<not> A \<lesssim> C\<rbrakk> \<Longrightarrow> \<not> B \<lesssim> C"
 by (blast intro: lepoll_trans)
 
 (* ********************************************************************** *)
 (* There exists a well ordered set y such that ...                        *)
 (* ********************************************************************** *)
 
 lemmas lepoll_paired = paired_eqpoll [THEN eqpoll_sym, THEN eqpoll_imp_lepoll]
 
 lemma lemma2: "\<exists>y R. well_ord(y,R) \<and> x \<inter> y = 0 \<and> \<not>y \<lesssim> z \<and> \<not>Finite(y)"
 apply (rule_tac x = "{{a,x}. a \<in> nat \<union> Hartog (z) }" in exI)
 apply (rule well_ord_Un [OF Ord_nat [THEN well_ord_Memrel] 
                          Ord_Hartog [THEN well_ord_Memrel], THEN exE])
 apply (blast intro!: Ord_Hartog well_ord_Memrel well_ord_paired
                       lepoll_trans1 [OF _ not_Hartog_lepoll_self]
                       lepoll_trans [OF subset_imp_lepoll lepoll_paired]
        elim!: nat_not_Finite [THEN notE]
        elim: mem_asym 
        dest!: Un_upper1 [THEN subset_imp_lepoll, THEN lepoll_Finite]
               lepoll_paired [THEN lepoll_Finite])
 done
 
 lemma infinite_Un: "\<not>Finite(B) \<Longrightarrow> \<not>Finite(A \<union> B)"
 by (blast intro: subset_Finite)
 
 (* ********************************************************************** *)
 (* There is a v \<in> s(u) such that k \<lesssim> x \<inter> y (in our case succ(k))    *)
 (* The idea of the proof is the following \<in>                               *)
 (* Suppose not, i.e. every element of s(u) has exactly k-1 elements of y   *)
 (* Thence y is less than or equipollent to {v \<in> Pow(x). v \<approx> n#-k}      *)
 (*   We have obtained this result in two steps \<in>                          *)
 (*   1. y is less than or equipollent to {v \<in> s(u). a \<subseteq> v}                  *)
 (*      where a is certain k-2 element subset of y                        *)
 (*   2. {v \<in> s(u). a \<subseteq> v} is less than or equipollent                       *)
 (*      to {v \<in> Pow(x). v \<approx> n-k}                                       *)
 (* ********************************************************************** *)
 
 (*Proof simplified by LCP*)
 lemma succ_not_lepoll_lemma:
      "\<lbrakk>\<not>(\<exists>x \<in> A. f`x=y); f \<in> inj(A, B); y \<in> B\<rbrakk>   
       \<Longrightarrow> (\<lambda>a \<in> succ(A). if(a=A, y, f`a)) \<in> inj(succ(A), B)"
 apply (rule_tac d = "\<lambda>z. if (z=y, A, converse (f) `z) " in lam_injective)
 apply (force simp add: inj_is_fun [THEN apply_type])
 (*this preliminary simplification prevents looping somehow*)
 apply (simp (no_asm_simp))
 apply force
 done
 
 lemma succ_not_lepoll_imp_eqpoll: "\<lbrakk>\<not>A \<approx> B; A \<lesssim> B\<rbrakk> \<Longrightarrow> succ(A) \<lesssim> B"
 apply (unfold lepoll_def eqpoll_def bij_def surj_def)
 apply (fast elim!: succ_not_lepoll_lemma inj_is_fun)
 done
 
 
 (* ********************************************************************** *)
 (* There is a k-2 element subset of y                                     *)
 (* ********************************************************************** *)
 
 lemmas ordertype_eqpoll =
        ordermap_bij [THEN exI [THEN eqpoll_def [THEN def_imp_iff, THEN iffD2]]]
 
 lemma cons_cons_subset:
      "\<lbrakk>a \<subseteq> y; b \<in> y-a; u \<in> x\<rbrakk> \<Longrightarrow> cons(b, cons(u, a)) \<in> Pow(x \<union> y)"
 by fast
 
 lemma cons_cons_eqpoll:
      "\<lbrakk>a \<approx> k; a \<subseteq> y; b \<in> y-a; u \<in> x; x \<inter> y = 0\<rbrakk>    
       \<Longrightarrow> cons(b, cons(u, a)) \<approx> succ(succ(k))"
 by (fast intro!: cons_eqpoll_succ)
 
 lemma set_eq_cons:
      "\<lbrakk>succ(k) \<approx> A; k \<approx> B; B \<subseteq> A; a \<in> A-B; k \<in> nat\<rbrakk> \<Longrightarrow> A = cons(a, B)"
 apply (rule equalityI)
 prefer 2 apply fast
 apply (rule Diff_eq_0_iff [THEN iffD1])
 apply (rule equals0I)
 apply (drule eqpoll_sym [THEN eqpoll_imp_lepoll])
 apply (drule eqpoll_sym [THEN cons_eqpoll_succ], fast)
 apply (drule cons_eqpoll_succ, fast)
 apply (fast elim!: lepoll_trans [THEN lepoll_trans, THEN succ_lepoll_natE,
          OF eqpoll_sym [THEN eqpoll_imp_lepoll] subset_imp_lepoll])
 done
 
 lemma cons_eqE: "\<lbrakk>cons(x,a) = cons(y,a); x \<notin> a\<rbrakk> \<Longrightarrow> x = y "
 by (fast elim!: equalityE)
 
 lemma eq_imp_Int_eq: "A = B \<Longrightarrow> A \<inter> C = B \<inter> C"
 by blast
 
 (* ********************************************************************** *)
 (* some arithmetic                                                        *)
 (* ********************************************************************** *)
 
 lemma eqpoll_sum_imp_Diff_lepoll_lemma [rule_format]:
      "\<lbrakk>k \<in> nat; m \<in> nat\<rbrakk> 
       \<Longrightarrow> \<forall>A B. A \<approx> k #+ m \<and> k \<lesssim> B \<and> B \<subseteq> A \<longrightarrow> A-B \<lesssim> m"
 apply (induct_tac "k")
 apply (simp add: add_0)
 apply (blast intro: eqpoll_imp_lepoll lepoll_trans
                     Diff_subset [THEN subset_imp_lepoll])
 apply (intro allI impI)
 apply (rule succ_lepoll_imp_not_empty [THEN not_emptyE], fast)
 apply (erule_tac x = "A - {xa}" in allE)
 apply (erule_tac x = "B - {xa}" in allE)
 apply (erule impE)
 apply (simp add: add_succ)
 apply (fast intro!: Diff_sing_eqpoll lepoll_Diff_sing) 
 apply (subgoal_tac "A - {xa} - (B - {xa}) = A - B", simp)
 apply blast 
 done
 
 lemma eqpoll_sum_imp_Diff_lepoll:
      "\<lbrakk>A \<approx> succ(k #+ m); B \<subseteq> A; succ(k) \<lesssim> B;  k \<in> nat; m \<in> nat\<rbrakk>   
       \<Longrightarrow> A-B \<lesssim> m"
 apply (simp only: add_succ [symmetric]) 
 apply (blast intro: eqpoll_sum_imp_Diff_lepoll_lemma) 
 done
 
 (* ********************************************************************** *)
 (* similar properties for \<approx>                                          *)
 (* ********************************************************************** *)
 
 lemma eqpoll_sum_imp_Diff_eqpoll_lemma [rule_format]:
      "\<lbrakk>k \<in> nat; m \<in> nat\<rbrakk> 
       \<Longrightarrow> \<forall>A B. A \<approx> k #+ m \<and> k \<approx> B \<and> B \<subseteq> A \<longrightarrow> A-B \<approx> m"
 apply (induct_tac "k")
 apply (force dest!: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_0_is_0])
 apply (intro allI impI)
 apply (rule succ_lepoll_imp_not_empty [THEN not_emptyE])
 apply (fast elim!: eqpoll_imp_lepoll)
 apply (erule_tac x = "A - {xa}" in allE)
 apply (erule_tac x = "B - {xa}" in allE)
 apply (erule impE)
 apply (force intro: eqpoll_sym intro!: Diff_sing_eqpoll)
 apply (subgoal_tac "A - {xa} - (B - {xa}) = A - B", simp)
 apply blast 
 done
 
 lemma eqpoll_sum_imp_Diff_eqpoll:
      "\<lbrakk>A \<approx> succ(k #+ m); B \<subseteq> A; succ(k) \<approx> B; k \<in> nat; m \<in> nat\<rbrakk>   
       \<Longrightarrow> A-B \<approx> m"
 apply (simp only: add_succ [symmetric]) 
 apply (blast intro: eqpoll_sum_imp_Diff_eqpoll_lemma) 
 done
 
 
 (* ********************************************************************** *)
 (* LL can be well ordered                                                 *)
 (* ********************************************************************** *)
 
 lemma subsets_lepoll_0_eq_unit: "{x \<in> Pow(X). x \<lesssim> 0} = {0}"
 by (fast dest!: lepoll_0_is_0 intro!: lepoll_refl)
 
 lemma subsets_lepoll_succ:
      "n \<in> nat \<Longrightarrow> {z \<in> Pow(y). z \<lesssim> succ(n)} =   
                   {z \<in> Pow(y). z \<lesssim> n} \<union> {z \<in> Pow(y). z \<approx> succ(n)}"
 by (blast intro: leI le_imp_lepoll nat_into_Ord 
                     lepoll_trans eqpoll_imp_lepoll
           dest!: lepoll_succ_disj)
 
 lemma Int_empty:
      "n \<in> nat \<Longrightarrow> {z \<in> Pow(y). z \<lesssim> n} \<inter> {z \<in> Pow(y). z \<approx> succ(n)} = 0"
 by (blast intro: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans] 
                  succ_lepoll_natE)
 
 locale AC16 =
   fixes x and y and k and l and m and t_n and R and MM and LL and GG and s 
   defines k_def:     "k   \<equiv> succ(l)"
       and MM_def:    "MM  \<equiv> {v \<in> t_n. succ(k) \<lesssim> v \<inter> y}"
       and LL_def:    "LL  \<equiv> {v \<inter> y. v \<in> MM}"
       and GG_def:    "GG  \<equiv> \<lambda>v \<in> LL. (THE w. w \<in> MM \<and> v \<subseteq> w) - v"
       and s_def:     "s(u) \<equiv> {v \<in> t_n. u \<in> v \<and> k \<lesssim> v \<inter> y}"
   assumes all_ex:    "\<forall>z \<in> {z \<in> Pow(x \<union> y) . z \<approx> succ(k)}.
                        \<exists>! w. w \<in> t_n \<and> z \<subseteq> w "
     and disjoint[iff]:  "x \<inter> y = 0"
     and "includes":  "t_n \<subseteq> {v \<in> Pow(x \<union> y). v \<approx> succ(k #+ m)}"
     and WO_R[iff]:      "well_ord(y,R)"
     and lnat[iff]:      "l \<in> nat"
     and mnat[iff]:      "m \<in> nat"
     and mpos[iff]:      "0<m"
     and Infinite[iff]:  "\<not> Finite(y)"
     and noLepoll:  "\<not> y \<lesssim> {v \<in> Pow(x). v \<approx> m}"
 begin
 
 lemma knat [iff]: "k \<in> nat"
 by (simp add: k_def)
 
 
 (* ********************************************************************** *)
 (*   1. y is less than or equipollent to {v \<in> s(u). a \<subseteq> v}                *)
 (*      where a is certain k-2 element subset of y                        *)
 (* ********************************************************************** *)
 
 lemma Diff_Finite_eqpoll: "\<lbrakk>l \<approx> a; a \<subseteq> y\<rbrakk> \<Longrightarrow> y - a \<approx> y"
 apply (insert WO_R Infinite lnat)
 apply (rule eqpoll_trans) 
 apply (rule Diff_lesspoll_eqpoll_Card) 
 apply (erule well_ord_cardinal_eqpoll [THEN eqpoll_sym])
 apply (blast intro: lesspoll_trans1
             intro!: Card_cardinal  
                     Card_cardinal [THEN Card_is_Ord, THEN nat_le_infinite_Ord,
                                    THEN le_imp_lepoll] 
             dest: well_ord_cardinal_eqpoll 
                    eqpoll_sym  eqpoll_imp_lepoll
                    n_lesspoll_nat [THEN lesspoll_trans2]
                    well_ord_cardinal_eqpoll [THEN eqpoll_sym, 
                           THEN eqpoll_imp_lepoll, THEN lepoll_infinite])+
 done
 
 
 lemma s_subset: "s(u) \<subseteq> t_n"
 by (unfold s_def, blast)
 
 lemma sI: 
       "\<lbrakk>w \<in> t_n; cons(b,cons(u,a)) \<subseteq> w; a \<subseteq> y; b \<in> y-a; l \<approx> a\<rbrakk> 
        \<Longrightarrow> w \<in> s(u)"
 apply (unfold s_def succ_def k_def)
 apply (blast intro!: eqpoll_imp_lepoll [THEN cons_lepoll_cong]
              intro: subset_imp_lepoll lepoll_trans)
 done
 
 lemma in_s_imp_u_in: "v \<in> s(u) \<Longrightarrow> u \<in> v"
 by (unfold s_def, blast)
 
 
 lemma ex1_superset_a:
      "\<lbrakk>l \<approx> a;  a \<subseteq> y;  b \<in> y - a;  u \<in> x\<rbrakk>   
       \<Longrightarrow> \<exists>! c. c \<in> s(u) \<and> a \<subseteq> c \<and> b \<in> c"
 apply (rule all_ex [simplified k_def, THEN ballE])
  apply (erule ex1E)
  apply (rule_tac a = w in ex1I, blast intro: sI)
  apply (blast dest: s_subset [THEN subsetD] in_s_imp_u_in)
 apply (blast del: PowI 
              intro!: cons_cons_subset eqpoll_sym [THEN cons_cons_eqpoll])
 done
 
 lemma the_eq_cons:
      "\<lbrakk>\<forall>v \<in> s(u). succ(l) \<approx> v \<inter> y;   
          l \<approx> a;  a \<subseteq> y;  b \<in> y - a;  u \<in> x\<rbrakk>    
       \<Longrightarrow> (THE c. c \<in> s(u) \<and> a \<subseteq> c \<and> b \<in> c) \<inter> y = cons(b, a)"
 apply (frule ex1_superset_a [THEN theI], assumption+)
 apply (rule set_eq_cons)
 apply (fast+)
 done
 
 lemma y_lepoll_subset_s:
      "\<lbrakk>\<forall>v \<in> s(u). succ(l) \<approx> v \<inter> y;   
          l \<approx> a;  a \<subseteq> y;  u \<in> x\<rbrakk>   
       \<Longrightarrow> y \<lesssim> {v \<in> s(u). a \<subseteq> v}"
 apply (rule Diff_Finite_eqpoll [THEN eqpoll_sym, THEN eqpoll_imp_lepoll, 
                                 THEN lepoll_trans],  fast+)
 apply (rule_tac  f3 = "\<lambda>b \<in> y-a. THE c. c \<in> s (u) \<and> a \<subseteq> c \<and> b \<in> c" 
         in exI [THEN lepoll_def [THEN def_imp_iff, THEN iffD2]])
 apply (simp add: inj_def)
 apply (rule conjI)
 apply (rule lam_type)
 apply (frule ex1_superset_a [THEN theI], fast+, clarify)
 apply (rule cons_eqE [of _ a])
 apply (drule_tac A = "THE c. P (c)" and C = y for P in eq_imp_Int_eq)
 apply (simp_all add: the_eq_cons)
 done
 
 
 (* ********************************************************************** *)
 (* back to the second part                                                *)
 (* ********************************************************************** *)
 
 
 (*relies on the disjointness of x, y*)
 lemma x_imp_not_y [dest]: "a \<in> x \<Longrightarrow> a \<notin> y"
 by (blast dest:  disjoint [THEN equalityD1, THEN subsetD, OF IntI])
 
 lemma w_Int_eq_w_Diff:
      "w \<subseteq> x \<union> y \<Longrightarrow> w \<inter> (x - {u}) = w - cons(u, w \<inter> y)" 
 by blast
 
 lemma w_Int_eqpoll_m:
      "\<lbrakk>w \<in> {v \<in> s(u). a \<subseteq> v};   
          l \<approx> a;  u \<in> x;   
          \<forall>v \<in> s(u). succ(l) \<approx> v \<inter> y\<rbrakk> 
       \<Longrightarrow> w \<inter> (x - {u}) \<approx> m"
 apply (erule CollectE)
 apply (subst w_Int_eq_w_Diff)
 apply (fast dest!: s_subset [THEN subsetD] 
                    "includes" [simplified k_def, THEN subsetD])
 apply (blast dest: s_subset [THEN subsetD] 
                    "includes" [simplified k_def, THEN subsetD] 
              dest: eqpoll_sym [THEN cons_eqpoll_succ, THEN eqpoll_sym] 
                    in_s_imp_u_in
             intro!: eqpoll_sum_imp_Diff_eqpoll)
 done
 
 
 (* ********************************************************************** *)
 (*   2. {v \<in> s(u). a \<subseteq> v} is less than or equipollent                       *)
 (*      to {v \<in> Pow(x). v \<approx> n-k}                                       *)
 (* ********************************************************************** *)
 
 lemma eqpoll_m_not_empty: "a \<approx> m \<Longrightarrow> a \<noteq> 0"
 apply (insert mpos)
 apply (fast elim!: zero_lt_natE dest!: eqpoll_succ_imp_not_empty)
 done
 
 lemma cons_cons_in:
      "\<lbrakk>z \<in> xa \<inter> (x - {u}); l \<approx> a; a \<subseteq> y; u \<in> x\<rbrakk>   
       \<Longrightarrow> \<exists>! w. w \<in> t_n \<and> cons(z, cons(u, a)) \<subseteq> w"
 apply (rule all_ex [THEN bspec])
-apply (unfold k_def)
+  unfolding k_def
 apply (fast intro!: cons_eqpoll_succ elim: eqpoll_sym)
 done
 
 lemma subset_s_lepoll_w:
      "\<lbrakk>\<forall>v \<in> s(u). succ(l) \<approx> v \<inter> y; a \<subseteq> y; l \<approx> a; u \<in> x\<rbrakk>   
       \<Longrightarrow> {v \<in> s(u). a \<subseteq> v} \<lesssim> {v \<in> Pow(x). v \<approx> m}"
 apply (rule_tac f3 = "\<lambda>w \<in> {v \<in> s (u) . a \<subseteq> v}. w \<inter> (x - {u})" 
        in exI [THEN lepoll_def [THEN def_imp_iff, THEN iffD2]])
 apply (simp add: inj_def)
 apply (intro conjI lam_type CollectI)
   apply fast
  apply (blast intro: w_Int_eqpoll_m) 
 apply (intro ballI impI)
 (** LEVEL 8 **)
 apply (rule w_Int_eqpoll_m [THEN eqpoll_m_not_empty, THEN not_emptyE])
 apply (blast, assumption+)
 apply (drule equalityD1 [THEN subsetD], assumption)
 apply (frule cons_cons_in, assumption+)
 apply (blast dest: ex1_two_eq intro: s_subset [THEN subsetD] in_s_imp_u_in)+
 done
 
 
 (* ********************************************************************** *)
 (* well_ord_subsets_lepoll_n                                              *)
 (* ********************************************************************** *)
 
 lemma well_ord_subsets_eqpoll_n:
      "n \<in> nat \<Longrightarrow> \<exists>S. well_ord({z \<in> Pow(y) . z \<approx> succ(n)}, S)"
 apply (rule WO_R [THEN well_ord_infinite_subsets_eqpoll_X,
                   THEN eqpoll_def [THEN def_imp_iff, THEN iffD1], THEN exE])
 apply (fast intro: bij_is_inj [THEN well_ord_rvimage])+
 done
 
 lemma well_ord_subsets_lepoll_n:
      "n \<in> nat \<Longrightarrow> \<exists>R. well_ord({z \<in> Pow(y). z \<lesssim> n}, R)"
 apply (induct_tac "n")
 apply (force intro!: well_ord_unit simp add: subsets_lepoll_0_eq_unit)
 apply (erule exE)
 apply (rule well_ord_subsets_eqpoll_n [THEN exE], assumption)
 apply (simp add: subsets_lepoll_succ)
 apply (drule well_ord_radd, assumption)
 apply (erule Int_empty [THEN disj_Un_eqpoll_sum,
                   THEN eqpoll_def [THEN def_imp_iff, THEN iffD1], THEN exE])
 apply (fast elim!: bij_is_inj [THEN well_ord_rvimage])
 done
 
 
 lemma LL_subset: "LL \<subseteq> {z \<in> Pow(y). z \<lesssim> succ(k #+ m)}"
 apply (unfold LL_def MM_def)
 apply (insert "includes")
 apply (blast intro: subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans)
 done
 
 lemma well_ord_LL: "\<exists>S. well_ord(LL,S)"
 apply (rule well_ord_subsets_lepoll_n [THEN exE, of "succ(k#+m)"])
 apply simp 
 apply (blast intro: well_ord_subset [OF _ LL_subset])
 done
 
 (* ********************************************************************** *)
 (* every element of LL is a contained in exactly one element of MM        *)
 (* ********************************************************************** *)
 
 lemma unique_superset_in_MM:
      "v \<in> LL \<Longrightarrow> \<exists>! w. w \<in> MM \<and> v \<subseteq> w"
 apply (unfold MM_def LL_def, safe, fast)
 apply (rule lepoll_imp_eqpoll_subset [THEN exE], assumption)
 apply (rule_tac x = x in all_ex [THEN ballE]) 
 apply (blast intro: eqpoll_sym)+
 done
 
 
 (* ********************************************************************** *)
 (* The function GG satisfies the conditions of WO4                        *)
 (* ********************************************************************** *)
 
 (* ********************************************************************** *)
 (* The union of appropriate values is the whole x                         *)
 (* ********************************************************************** *)
 
 lemma Int_in_LL: "w \<in> MM \<Longrightarrow> w \<inter> y \<in> LL"
 by (unfold LL_def, fast)
 
 lemma in_LL_eq_Int: 
      "v \<in> LL \<Longrightarrow> v = (THE x. x \<in> MM \<and> v \<subseteq> x) \<inter> y"
 apply (unfold LL_def, clarify)
 apply (subst unique_superset_in_MM [THEN the_equality2])
 apply (auto simp add: Int_in_LL)
 done
 
 lemma unique_superset1: "a \<in> LL \<Longrightarrow> (THE x. x \<in> MM \<and> a \<subseteq> x) \<in> MM"
 by (erule unique_superset_in_MM [THEN theI, THEN conjunct1]) 
 
 lemma the_in_MM_subset:
      "v \<in> LL \<Longrightarrow> (THE x. x \<in> MM \<and> v \<subseteq> x) \<subseteq> x \<union> y"
 apply (drule unique_superset1)
-apply (unfold MM_def)
+  unfolding MM_def
 apply (fast dest!: unique_superset1 "includes" [THEN subsetD])
 done
 
 lemma GG_subset: "v \<in> LL \<Longrightarrow> GG ` v \<subseteq> x"
-apply (unfold GG_def)
+  unfolding GG_def
 apply (frule the_in_MM_subset)
 apply (frule in_LL_eq_Int)
 apply (force elim: equalityE)
 done
 
 lemma nat_lepoll_ordertype: "nat \<lesssim> ordertype(y, R)"
 apply (rule nat_le_infinite_Ord [THEN le_imp_lepoll]) 
  apply (rule Ord_ordertype [OF WO_R]) 
 apply (rule ordertype_eqpoll [THEN eqpoll_imp_lepoll, THEN lepoll_infinite]) 
  apply (rule WO_R) 
 apply (rule Infinite) 
 done
 
 lemma ex_subset_eqpoll_n: "n \<in> nat \<Longrightarrow> \<exists>z. z \<subseteq> y \<and> n \<approx> z"
 apply (erule nat_lepoll_imp_ex_eqpoll_n)
 apply (rule lepoll_trans [OF nat_lepoll_ordertype]) 
 apply (rule ordertype_eqpoll [THEN eqpoll_sym, THEN eqpoll_imp_lepoll]) 
 apply (rule WO_R) 
 done
 
 
 lemma exists_proper_in_s: "u \<in> x \<Longrightarrow> \<exists>v \<in> s(u). succ(k) \<lesssim> v \<inter> y"
 apply (rule ccontr)
 apply (subgoal_tac "\<forall>v \<in> s (u) . k \<approx> v \<inter> y")
 prefer 2 apply (simp add: s_def, blast intro: succ_not_lepoll_imp_eqpoll)
-apply (unfold k_def)
+  unfolding k_def
 apply (insert all_ex "includes" lnat)
 apply (rule ex_subset_eqpoll_n [THEN exE], assumption)
 apply (rule noLepoll [THEN notE])
 apply (blast intro: lepoll_trans [OF y_lepoll_subset_s subset_s_lepoll_w])
 done
 
 lemma exists_in_MM: "u \<in> x \<Longrightarrow> \<exists>w \<in> MM. u \<in> w"
 apply (erule exists_proper_in_s [THEN bexE])
 apply (unfold MM_def s_def, fast)
 done
 
 lemma exists_in_LL: "u \<in> x \<Longrightarrow> \<exists>w \<in> LL. u \<in> GG`w"
 apply (rule exists_in_MM [THEN bexE], assumption)
 apply (rule bexI)
 apply (erule_tac [2] Int_in_LL)
-apply (unfold GG_def)
+  unfolding GG_def
 apply (simp add: Int_in_LL)
 apply (subst unique_superset_in_MM [THEN the_equality2])
 apply (fast elim!: Int_in_LL)+
 done
 
 lemma OUN_eq_x: "well_ord(LL,S) \<Longrightarrow>       
       (\<Union>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b)) = x"
 apply (rule equalityI)
 apply (rule subsetI)
 apply (erule OUN_E)
 apply (rule GG_subset [THEN subsetD])
 prefer 2 apply assumption
 apply (blast intro: ltD  ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun,
                                        THEN apply_type])
 apply (rule subsetI)
 apply (erule exists_in_LL [THEN bexE])
 apply (force intro: ltI [OF _ Ord_ordertype]
                     ordermap_type [THEN apply_type]
              simp add: ordermap_bij [THEN bij_is_inj, THEN left_inverse])
 done
 
 (* ********************************************************************** *)
 (* Every element of the family is less than or equipollent to n-k (m)     *)
 (* ********************************************************************** *)
 
 lemma in_MM_eqpoll_n: "w \<in> MM \<Longrightarrow> w \<approx> succ(k #+ m)"
-apply (unfold MM_def)
+  unfolding MM_def
 apply (fast dest: "includes" [THEN subsetD])
 done
 
 lemma in_LL_eqpoll_n: "w \<in> LL \<Longrightarrow> succ(k) \<lesssim> w"
 by (unfold LL_def MM_def, fast)
 
 lemma in_LL: "w \<in> LL \<Longrightarrow> w \<subseteq> (THE x. x \<in> MM \<and> w \<subseteq> x)"
 by (erule subset_trans [OF in_LL_eq_Int [THEN equalityD1] Int_lower1])
 
 lemma all_in_lepoll_m: 
       "well_ord(LL,S) \<Longrightarrow>       
        \<forall>b<ordertype(LL,S). GG ` (converse(ordermap(LL,S)) ` b) \<lesssim> m"
-apply (unfold GG_def)
+  unfolding GG_def
 apply (rule oallI)
 apply (simp add: ltD ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun, THEN apply_type])
 apply (insert "includes")
 apply (rule eqpoll_sum_imp_Diff_lepoll)
 apply (blast del: subsetI
              dest!: ltD 
              intro!: eqpoll_sum_imp_Diff_lepoll in_LL_eqpoll_n
              intro: in_LL   unique_superset1 [THEN in_MM_eqpoll_n] 
                     ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun, 
                                   THEN apply_type])+
 done
 
 lemma "conclusion":
      "\<exists>a f. Ord(a) \<and> domain(f) = a \<and> (\<Union>b<a. f ` b) = x \<and> (\<forall>b<a. f ` b \<lesssim> m)"
 apply (rule well_ord_LL [THEN exE])
 apply (rename_tac S)
 apply (rule_tac x = "ordertype (LL,S)" in exI)
 apply (rule_tac x = "\<lambda>b \<in> ordertype(LL,S). 
                       GG ` (converse (ordermap (LL,S)) ` b)"  in exI)
 apply (simp add: ltD)
 apply (blast intro: lam_funtype [THEN domain_of_fun] 
                     Ord_ordertype  OUN_eq_x  all_in_lepoll_m [THEN ospec])
 done
 
 end
 
 
 (* ********************************************************************** *)
 (* The main theorem AC16(n, k) \<Longrightarrow> WO4(n-k)                               *)
 (* ********************************************************************** *)
 
 theorem AC16_WO4: 
      "\<lbrakk>AC_Equiv.AC16(k #+ m, k); 0 < k; 0 < m; k \<in> nat; m \<in> nat\<rbrakk> \<Longrightarrow> WO4(m)"
 apply (unfold AC_Equiv.AC16_def WO4_def)
 apply (rule allI)
 apply (case_tac "Finite (A)")
 apply (rule lemma1, assumption+)
 apply (cut_tac lemma2)
 apply (elim exE conjE)
 apply (erule_tac x = "A \<union> y" in allE)
 apply (frule infinite_Un, drule mp, assumption)
 apply (erule zero_lt_natE, assumption, clarify)
 apply (blast intro: AC16.conclusion [OF AC16.intro])
 done
 
 end
diff --git a/src/ZF/AC/AC16_lemmas.thy b/src/ZF/AC/AC16_lemmas.thy
--- a/src/ZF/AC/AC16_lemmas.thy
+++ b/src/ZF/AC/AC16_lemmas.thy
@@ -1,236 +1,236 @@
 (*  Title:      ZF/AC/AC16_lemmas.thy
     Author:     Krzysztof Grabczewski
 
 Lemmas used in the proofs concerning AC16
 *)
 
 theory AC16_lemmas
 imports AC_Equiv Hartog Cardinal_aux
 begin
 
 lemma cons_Diff_eq: "a\<notin>A \<Longrightarrow> cons(a,A)-{a}=A"
 by fast
 
 lemma nat_1_lepoll_iff: "1\<lesssim>X \<longleftrightarrow> (\<exists>x. x \<in> X)"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (rule iffI)
 apply (fast intro: inj_is_fun [THEN apply_type])
 apply (erule exE)
 apply (rule_tac x = "\<lambda>a \<in> 1. x" in exI)
 apply (fast intro!: lam_injective)
 done
 
 lemma eqpoll_1_iff_singleton: "X\<approx>1 \<longleftrightarrow> (\<exists>x. X={x})"
 apply (rule iffI)
 apply (erule eqpollE)
 apply (drule nat_1_lepoll_iff [THEN iffD1])
 apply (fast intro!: lepoll_1_is_sing)
 apply (fast intro!: singleton_eqpoll_1)
 done
 
 lemma cons_eqpoll_succ: "\<lbrakk>x\<approx>n; y\<notin>x\<rbrakk> \<Longrightarrow> cons(y,x)\<approx>succ(n)"
-apply (unfold succ_def)
+  unfolding succ_def
 apply (fast elim!: cons_eqpoll_cong mem_irrefl)
 done
 
 lemma subsets_eqpoll_1_eq: "{Y \<in> Pow(X). Y\<approx>1} = {{x}. x \<in> X}"
 apply (rule equalityI)
 apply (rule subsetI)
 apply (erule CollectE)
 apply (drule eqpoll_1_iff_singleton [THEN iffD1])
 apply (fast intro!: RepFunI)
 apply (rule subsetI)
 apply (erule RepFunE)
 apply (rule CollectI, fast)
 apply (fast intro!: singleton_eqpoll_1)
 done
 
 lemma eqpoll_RepFun_sing: "X\<approx>{{x}. x \<in> X}"
 apply (unfold eqpoll_def bij_def)
 apply (rule_tac x = "\<lambda>x \<in> X. {x}" in exI)
 apply (rule IntI)
 apply (unfold inj_def surj_def, simp)
 apply (fast intro!: lam_type RepFunI intro: singleton_eq_iff [THEN iffD1], simp)
 apply (fast intro!: lam_type)
 done
 
 lemma subsets_eqpoll_1_eqpoll: "{Y \<in> Pow(X). Y\<approx>1}\<approx>X"
 apply (rule subsets_eqpoll_1_eq [THEN ssubst])
 apply (rule eqpoll_RepFun_sing [THEN eqpoll_sym])
 done
 
 lemma InfCard_Least_in:
      "\<lbrakk>InfCard(x); y \<subseteq> x; y \<approx> succ(z)\<rbrakk> \<Longrightarrow> (\<mu> i. i \<in> y) \<in> y"
 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll, 
                          THEN succ_lepoll_imp_not_empty, THEN not_emptyE])
 apply (fast intro: LeastI 
             dest!: InfCard_is_Card [THEN Card_is_Ord] 
             elim: Ord_in_Ord)
 done
 
 lemma subsets_lepoll_lemma1:
      "\<lbrakk>InfCard(x); n \<in> nat\<rbrakk> 
       \<Longrightarrow> {y \<in> Pow(x). y\<approx>succ(succ(n))} \<lesssim> x*{y \<in> Pow(x). y\<approx>succ(n)}"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (rule_tac x = "\<lambda>y \<in> {y \<in> Pow(x) . y\<approx>succ (succ (n))}. 
                       <\<mu> i. i \<in> y, y-{\<mu> i. i \<in> y}>" in exI)
 apply (rule_tac d = "\<lambda>z. cons (fst(z), snd(z))" in lam_injective)
  apply (blast intro!: Diff_sing_eqpoll intro: InfCard_Least_in)
 apply (simp, blast intro: InfCard_Least_in)
 done
 
 lemma set_of_Ord_succ_Union: "(\<forall>y \<in> z. Ord(y)) \<Longrightarrow> z \<subseteq> succ(\<Union>(z))"
 apply (rule subsetI)
 apply (case_tac "\<forall>y \<in> z. y \<subseteq> x", blast )
 apply (simp, erule bexE) 
 apply (rule_tac i=y and j=x in Ord_linear_le)
 apply (blast dest: le_imp_subset elim: leE ltE)+
 done
 
 lemma subset_not_mem: "j \<subseteq> i \<Longrightarrow> i \<notin> j"
 by (fast elim!: mem_irrefl)
 
 lemma succ_Union_not_mem:
      "(\<And>y. y \<in> z \<Longrightarrow> Ord(y)) \<Longrightarrow> succ(\<Union>(z)) \<notin> z"
 apply (rule set_of_Ord_succ_Union [THEN subset_not_mem], blast)
 done
 
 lemma Union_cons_eq_succ_Union:
      "\<Union>(cons(succ(\<Union>(z)),z)) = succ(\<Union>(z))"
 by fast
 
 lemma Un_Ord_disj: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> i \<union> j = i | i \<union> j = j"
 by (fast dest!: le_imp_subset elim: Ord_linear_le)
 
 lemma Union_eq_Un: "x \<in> X \<Longrightarrow> \<Union>(X) = x \<union> \<Union>(X-{x})"
 by fast
 
 lemma Union_in_lemma [rule_format]:
      "n \<in> nat \<Longrightarrow> \<forall>z. (\<forall>y \<in> z. Ord(y)) \<and> z\<approx>n \<and> z\<noteq>0 \<longrightarrow> \<Union>(z) \<in> z"
 apply (induct_tac "n")
 apply (fast dest!: eqpoll_imp_lepoll [THEN lepoll_0_is_0])
 apply (intro allI impI)
 apply (erule natE)
 apply (fast dest!: eqpoll_1_iff_singleton [THEN iffD1]
             intro!: Union_singleton, clarify) 
 apply (elim not_emptyE)
 apply (erule_tac x = "z-{xb}" in allE)
 apply (erule impE)
 apply (fast elim!: Diff_sing_eqpoll
                    Diff_sing_eqpoll [THEN eqpoll_succ_imp_not_empty])
 apply (subgoal_tac "xb \<union> \<Union>(z - {xb}) \<in> z")
 apply (simp add: Union_eq_Un [symmetric])
 apply (frule bspec, assumption)
 apply (drule bspec) 
 apply (erule Diff_subset [THEN subsetD])
 apply (drule Un_Ord_disj, assumption, auto) 
 done
 
 lemma Union_in: "\<lbrakk>\<forall>x \<in> z. Ord(x); z\<approx>n; z\<noteq>0; n \<in> nat\<rbrakk> \<Longrightarrow> \<Union>(z) \<in> z"
 by (blast intro: Union_in_lemma)
 
 lemma succ_Union_in_x:
      "\<lbrakk>InfCard(x); z \<in> Pow(x); z\<approx>n; n \<in> nat\<rbrakk> \<Longrightarrow> succ(\<Union>(z)) \<in> x"
 apply (rule Limit_has_succ [THEN ltE])
 prefer 3 apply assumption
 apply (erule InfCard_is_Limit)
 apply (case_tac "z=0")
 apply (simp, fast intro!: InfCard_is_Limit [THEN Limit_has_0])
 apply (rule ltI [OF PowD [THEN subsetD] InfCard_is_Card [THEN Card_is_Ord]], assumption)
 apply (blast intro: Union_in
                     InfCard_is_Card [THEN Card_is_Ord, THEN Ord_in_Ord])+
 done
 
 lemma succ_lepoll_succ_succ:
      "\<lbrakk>InfCard(x); n \<in> nat\<rbrakk> 
       \<Longrightarrow> {y \<in> Pow(x). y\<approx>succ(n)} \<lesssim> {y \<in> Pow(x). y\<approx>succ(succ(n))}"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (rule_tac x = "\<lambda>z \<in> {y\<in>Pow(x). y\<approx>succ(n)}. cons(succ(\<Union>(z)), z)" 
        in exI)
 apply (rule_tac d = "\<lambda>z. z-{\<Union>(z) }" in lam_injective)
 apply (blast intro!: succ_Union_in_x succ_Union_not_mem
              intro: cons_eqpoll_succ Ord_in_Ord
              dest!: InfCard_is_Card [THEN Card_is_Ord])
 apply (simp only: Union_cons_eq_succ_Union) 
 apply (rule cons_Diff_eq)
 apply (fast dest!: InfCard_is_Card [THEN Card_is_Ord]
             elim: Ord_in_Ord 
             intro!: succ_Union_not_mem)
 done
 
 lemma subsets_eqpoll_X:
      "\<lbrakk>InfCard(X); n \<in> nat\<rbrakk> \<Longrightarrow> {Y \<in> Pow(X). Y\<approx>succ(n)} \<approx> X"
 apply (induct_tac "n")
 apply (rule subsets_eqpoll_1_eqpoll)
 apply (rule eqpollI)
 apply (rule subsets_lepoll_lemma1 [THEN lepoll_trans], assumption+)
 apply (rule eqpoll_trans [THEN eqpoll_imp_lepoll]) 
  apply (erule eqpoll_refl [THEN prod_eqpoll_cong])
 apply (erule InfCard_square_eqpoll)
 apply (fast elim: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_trans] 
             intro!: succ_lepoll_succ_succ)
 done
 
 lemma image_vimage_eq:
      "\<lbrakk>f \<in> surj(A,B); y \<subseteq> B\<rbrakk> \<Longrightarrow> f``(converse(f)``y) = y"
-apply (unfold surj_def)
+  unfolding surj_def
 apply (fast dest: apply_equality2 elim: apply_iff [THEN iffD2])
 done
 
 lemma vimage_image_eq: "\<lbrakk>f \<in> inj(A,B); y \<subseteq> A\<rbrakk> \<Longrightarrow> converse(f)``(f``y) = y"
 by (fast elim!: inj_is_fun [THEN apply_Pair] dest: inj_equality)
 
 lemma subsets_eqpoll:
      "A\<approx>B \<Longrightarrow> {Y \<in> Pow(A). Y\<approx>n}\<approx>{Y \<in> Pow(B). Y\<approx>n}"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (erule exE)
 apply (rule_tac x = "\<lambda>X \<in> {Y \<in> Pow (A) . \<exists>f. f \<in> bij (Y, n) }. f``X" in exI)
 apply (rule_tac d = "\<lambda>Z. converse (f) ``Z" in lam_bijective)
 apply (fast intro!: bij_is_inj [THEN restrict_bij, THEN bij_converse_bij, 
                                 THEN comp_bij] 
             elim!: bij_is_fun [THEN fun_is_rel, THEN image_subset])
 apply (blast intro!:  bij_is_inj [THEN restrict_bij] 
                       comp_bij bij_converse_bij
                       bij_is_fun [THEN fun_is_rel, THEN image_subset])
 apply (fast elim!: bij_is_inj [THEN vimage_image_eq])
 apply (fast elim!: bij_is_surj [THEN image_vimage_eq])
 done
 
 lemma WO2_imp_ex_Card: "WO2 \<Longrightarrow> \<exists>a. Card(a) \<and> X\<approx>a"
-apply (unfold WO2_def)
+  unfolding WO2_def
 apply (drule spec [of _ X])
 apply (blast intro: Card_cardinal eqpoll_trans
           well_ord_Memrel [THEN well_ord_cardinal_eqpoll, THEN eqpoll_sym])
 done
 
 lemma lepoll_infinite: "\<lbrakk>X\<lesssim>Y; \<not>Finite(X)\<rbrakk> \<Longrightarrow> \<not>Finite(Y)"
 by (blast intro: lepoll_Finite)
 
 lemma infinite_Card_is_InfCard: "\<lbrakk>\<not>Finite(X); Card(X)\<rbrakk> \<Longrightarrow> InfCard(X)"
-apply (unfold InfCard_def)
+  unfolding InfCard_def
 apply (fast elim!: Card_is_Ord [THEN nat_le_infinite_Ord])
 done
 
 lemma WO2_infinite_subsets_eqpoll_X: "\<lbrakk>WO2; n \<in> nat; \<not>Finite(X)\<rbrakk>   
         \<Longrightarrow> {Y \<in> Pow(X). Y\<approx>succ(n)}\<approx>X"
 apply (drule WO2_imp_ex_Card)
 apply (elim allE exE conjE)
 apply (frule eqpoll_imp_lepoll [THEN lepoll_infinite], assumption)
 apply (drule infinite_Card_is_InfCard, assumption)
 apply (blast intro: subsets_eqpoll subsets_eqpoll_X eqpoll_sym eqpoll_trans) 
 done
 
 lemma well_ord_imp_ex_Card: "well_ord(X,R) \<Longrightarrow> \<exists>a. Card(a) \<and> X\<approx>a"
 by (fast elim!: well_ord_cardinal_eqpoll [THEN eqpoll_sym] 
          intro!: Card_cardinal)
 
 lemma well_ord_infinite_subsets_eqpoll_X:
      "\<lbrakk>well_ord(X,R); n \<in> nat; \<not>Finite(X)\<rbrakk> \<Longrightarrow> {Y \<in> Pow(X). Y\<approx>succ(n)}\<approx>X"
 apply (drule well_ord_imp_ex_Card)
 apply (elim allE exE conjE)
 apply (frule eqpoll_imp_lepoll [THEN lepoll_infinite], assumption)
 apply (drule infinite_Card_is_InfCard, assumption)
 apply (blast intro: subsets_eqpoll subsets_eqpoll_X eqpoll_sym eqpoll_trans) 
 done
 
 end
diff --git a/src/ZF/AC/AC17_AC1.thy b/src/ZF/AC/AC17_AC1.thy
--- a/src/ZF/AC/AC17_AC1.thy
+++ b/src/ZF/AC/AC17_AC1.thy
@@ -1,301 +1,301 @@
 (*  Title:      ZF/AC/AC17_AC1.thy
     Author:     Krzysztof Grabczewski
 
 The equivalence of AC0, AC1 and AC17
 
 Also, the proofs needed to show that each of AC2, AC3, ..., AC6 is equivalent
 to AC0 and AC1.
 *)
 
 theory AC17_AC1
 imports HH
 begin
 
 
 (** AC0 is equivalent to AC1.  
     AC0 comes from Suppes, AC1 from Rubin \<and> Rubin **)
 
 lemma AC0_AC1_lemma: "\<lbrakk>f:(\<Prod>X \<in> A. X); D \<subseteq> A\<rbrakk> \<Longrightarrow> \<exists>g. g:(\<Prod>X \<in> D. X)"
 by (fast intro!: lam_type apply_type)
 
 lemma AC0_AC1: "AC0 \<Longrightarrow> AC1"
 apply (unfold AC0_def AC1_def)
 apply (blast intro: AC0_AC1_lemma)
 done
 
 lemma AC1_AC0: "AC1 \<Longrightarrow> AC0"
 by (unfold AC0_def AC1_def, blast)
 
 
 (**** The proof of AC1 \<Longrightarrow> AC17 ****)
 
 lemma AC1_AC17_lemma: "f \<in> (\<Prod>X \<in> Pow(A) - {0}. X) \<Longrightarrow> f \<in> (Pow(A) - {0} -> A)"
 apply (rule Pi_type, assumption)
 apply (drule apply_type, assumption, fast)
 done
 
 lemma AC1_AC17: "AC1 \<Longrightarrow> AC17"
 apply (unfold AC1_def AC17_def)
 apply (rule allI)
 apply (rule ballI)
 apply (erule_tac x = "Pow (A) -{0}" in allE)
 apply (erule impE, fast)
 apply (erule exE)
 apply (rule bexI)
 apply (erule_tac [2] AC1_AC17_lemma)
 apply (rule apply_type, assumption)
 apply (fast dest!: AC1_AC17_lemma elim!: apply_type)
 done
 
 
 (**** The proof of AC17 \<Longrightarrow> AC1 ****)
 
 (* *********************************************************************** *)
 (* more properties of HH                                                   *)
 (* *********************************************************************** *)
 
 lemma UN_eq_imp_well_ord:
      "\<lbrakk>x - (\<Union>j \<in> \<mu> i. HH(\<lambda>X \<in> Pow(x)-{0}. {f`X}, x, i) = {x}.  
         HH(\<lambda>X \<in> Pow(x)-{0}. {f`X}, x, j)) = 0;   
         f \<in> Pow(x)-{0} -> x\<rbrakk>   
         \<Longrightarrow> \<exists>r. well_ord(x,r)"
 apply (rule exI)
 apply (erule well_ord_rvimage 
         [OF bij_Least_HH_x [THEN bij_converse_bij, THEN bij_is_inj] 
             Ord_Least [THEN well_ord_Memrel]], assumption)
 done
 
 (* *********************************************************************** *)
 (* theorems closer to the proof                                            *)
 (* *********************************************************************** *)
 
 lemma not_AC1_imp_ex:
      "\<not>AC1 \<Longrightarrow> \<exists>A. \<forall>f \<in> Pow(A)-{0} -> A. \<exists>u \<in> Pow(A)-{0}. f`u \<notin> u"
-apply (unfold AC1_def)
+  unfolding AC1_def
 apply (erule swap)
 apply (rule allI)
 apply (erule swap)
 apply (rule_tac x = "\<Union>(A)" in exI)
 apply (blast intro: lam_type)
 done
 
 lemma AC17_AC1_aux1:
      "\<lbrakk>\<forall>f \<in> Pow(x) - {0} -> x. \<exists>u \<in> Pow(x) - {0}. f`u\<notin>u;   
          \<exists>f \<in> Pow(x)-{0}->x.  
             x - (\<Union>a \<in> (\<mu> i. HH(\<lambda>X \<in> Pow(x)-{0}. {f`X},x,i)={x}).   
             HH(\<lambda>X \<in> Pow(x)-{0}. {f`X},x,a)) = 0\<rbrakk>  
         \<Longrightarrow> P"
 apply (erule bexE)
 apply (erule UN_eq_imp_well_ord [THEN exE], assumption)
 apply (erule ex_choice_fun_Pow [THEN exE])
 apply (erule ballE) 
 apply (fast intro: apply_type del: DiffE)
 apply (erule notE)
 apply (rule Pi_type, assumption)
 apply (blast dest: apply_type) 
 done
 
 lemma AC17_AC1_aux2:
       "\<not> (\<exists>f \<in> Pow(x)-{0}->x. x - F(f) = 0)   
        \<Longrightarrow> (\<lambda>f \<in> Pow(x)-{0}->x . x - F(f))   
            \<in> (Pow(x) -{0} -> x) -> Pow(x) - {0}"
 by (fast intro!: lam_type dest!: Diff_eq_0_iff [THEN iffD1])
 
 lemma AC17_AC1_aux3:
      "\<lbrakk>f`Z \<in> Z; Z \<in> Pow(x)-{0}\<rbrakk> 
       \<Longrightarrow> (\<lambda>X \<in> Pow(x)-{0}. {f`X})`Z \<in> Pow(Z)-{0}"
 by auto
 
 lemma AC17_AC1_aux4:
      "\<exists>f \<in> F. f`((\<lambda>f \<in> F. Q(f))`f) \<in> (\<lambda>f \<in> F. Q(f))`f   
       \<Longrightarrow> \<exists>f \<in> F. f`Q(f) \<in> Q(f)"
 by simp
 
 lemma AC17_AC1: "AC17 \<Longrightarrow> AC1"
-apply (unfold AC17_def)
+  unfolding AC17_def
 apply (rule classical)
 apply (erule not_AC1_imp_ex [THEN exE])
 apply (case_tac 
        "\<exists>f \<in> Pow(x)-{0} -> x. 
         x - (\<Union>a \<in> (\<mu> i. HH (\<lambda>X \<in> Pow (x) -{0}. {f`X},x,i) ={x}) . HH (\<lambda>X \<in> Pow (x) -{0}. {f`X},x,a)) = 0")
 apply (erule AC17_AC1_aux1, assumption)
 apply (drule AC17_AC1_aux2)
 apply (erule allE)
 apply (drule bspec, assumption)
 apply (drule AC17_AC1_aux4)
 apply (erule bexE)
 apply (drule apply_type, assumption)
 apply (simp add: HH_Least_eq_x del: Diff_iff ) 
 apply (drule AC17_AC1_aux3, assumption) 
 apply (fast dest!: subst_elem [OF _ HH_Least_eq_x [symmetric]]
                    f_subset_imp_HH_subset elim!: mem_irrefl)
 done
 
 
 (* **********************************************************************
     AC1 \<Longrightarrow> AC2 \<Longrightarrow> AC1
     AC1 \<Longrightarrow> AC4 \<Longrightarrow> AC3 \<Longrightarrow> AC1
     AC4 \<Longrightarrow> AC5 \<Longrightarrow> AC4
     AC1 \<longleftrightarrow> AC6
 ************************************************************************* *)
 
 (* ********************************************************************** *)
 (* AC1 \<Longrightarrow> AC2                                                            *)
 (* ********************************************************************** *)
 
 lemma AC1_AC2_aux1:
      "\<lbrakk>f:(\<Prod>X \<in> A. X);  B \<in> A;  0\<notin>A\<rbrakk> \<Longrightarrow> {f`B} \<subseteq> B \<inter> {f`C. C \<in> A}"
 by (fast elim!: apply_type)
 
 lemma AC1_AC2_aux2: 
         "\<lbrakk>pairwise_disjoint(A); B \<in> A; C \<in> A; D \<in> B; D \<in> C\<rbrakk> \<Longrightarrow> f`B = f`C"
 by (unfold pairwise_disjoint_def, fast)
 
 lemma AC1_AC2: "AC1 \<Longrightarrow> AC2"
 apply (unfold AC1_def AC2_def)
 apply (rule allI)
 apply (rule impI)  
 apply (elim asm_rl conjE allE exE impE, assumption)
 apply (intro exI ballI equalityI)
 prefer 2 apply (rule AC1_AC2_aux1, assumption+)
 apply (fast elim!: AC1_AC2_aux2 elim: apply_type)
 done
 
 
 (* ********************************************************************** *)
 (* AC2 \<Longrightarrow> AC1                                                            *)
 (* ********************************************************************** *)
 
 lemma AC2_AC1_aux1: "0\<notin>A \<Longrightarrow> 0 \<notin> {B*{B}. B \<in> A}"
 by (fast dest!: sym [THEN Sigma_empty_iff [THEN iffD1]])
 
 lemma AC2_AC1_aux2: "\<lbrakk>X*{X} \<inter> C = {y}; X \<in> A\<rbrakk>   
                \<Longrightarrow> (THE y. X*{X} \<inter> C = {y}): X*A"
 apply (rule subst_elem [of y])
 apply (blast elim!: equalityE)
 apply (auto simp add: singleton_eq_iff) 
 done
 
 lemma AC2_AC1_aux3:
      "\<forall>D \<in> {E*{E}. E \<in> A}. \<exists>y. D \<inter> C = {y}   
       \<Longrightarrow> (\<lambda>x \<in> A. fst(THE z. (x*{x} \<inter> C = {z}))) \<in> (\<Prod>X \<in> A. X)"
 apply (rule lam_type)
 apply (drule bspec, blast)
 apply (blast intro: AC2_AC1_aux2 fst_type)
 done
 
 lemma AC2_AC1: "AC2 \<Longrightarrow> AC1"
 apply (unfold AC1_def AC2_def pairwise_disjoint_def)
 apply (intro allI impI)
 apply (elim allE impE)
 prefer 2 apply (fast elim!: AC2_AC1_aux3) 
 apply (blast intro!: AC2_AC1_aux1)
 done
 
 
 (* ********************************************************************** *)
 (* AC1 \<Longrightarrow> AC4                                                            *)
 (* ********************************************************************** *)
 
 lemma empty_notin_images: "0 \<notin> {R``{x}. x \<in> domain(R)}"
 by blast
 
 lemma AC1_AC4: "AC1 \<Longrightarrow> AC4"
 apply (unfold AC1_def AC4_def)
 apply (intro allI impI)
 apply (drule spec, drule mp [OF _ empty_notin_images]) 
 apply (best intro!: lam_type elim!: apply_type)
 done
 
 
 (* ********************************************************************** *)
 (* AC4 \<Longrightarrow> AC3                                                            *)
 (* ********************************************************************** *)
 
 lemma AC4_AC3_aux1: "f \<in> A->B \<Longrightarrow> (\<Union>z \<in> A. {z}*f`z) \<subseteq> A*\<Union>(B)"
 by (fast dest!: apply_type)
 
 lemma AC4_AC3_aux2: "domain(\<Union>z \<in> A. {z}*f(z)) = {a \<in> A. f(a)\<noteq>0}"
 by blast
 
 lemma AC4_AC3_aux3: "x \<in> A \<Longrightarrow> (\<Union>z \<in> A. {z}*f(z))``{x} = f(x)"
 by fast
 
 lemma AC4_AC3: "AC4 \<Longrightarrow> AC3"
 apply (unfold AC3_def AC4_def)
 apply (intro allI ballI)
 apply (elim allE impE)
 apply (erule AC4_AC3_aux1)
 apply (simp add: AC4_AC3_aux2 AC4_AC3_aux3 cong add: Pi_cong)
 done
 
 (* ********************************************************************** *)
 (* AC3 \<Longrightarrow> AC1                                                            *)
 (* ********************************************************************** *)
 
 lemma AC3_AC1_lemma:
      "b\<notin>A \<Longrightarrow> (\<Prod>x \<in> {a \<in> A. id(A)`a\<noteq>b}. id(A)`x) = (\<Prod>x \<in> A. x)"
 apply (simp add: id_def cong add: Pi_cong)
 apply (rule_tac b = A in subst_context, fast)
 done
 
 lemma AC3_AC1: "AC3 \<Longrightarrow> AC1"
 apply (unfold AC1_def AC3_def)
 apply (fast intro!: id_type elim: AC3_AC1_lemma [THEN subst])
 done
 
 (* ********************************************************************** *)
 (* AC4 \<Longrightarrow> AC5                                                            *)
 (* ********************************************************************** *)
 
 lemma AC4_AC5: "AC4 \<Longrightarrow> AC5"
 apply (unfold range_def AC4_def AC5_def)
 apply (intro allI ballI)
 apply (elim allE impE)
 apply (erule fun_is_rel [THEN converse_type])
 apply (erule exE)
 apply (rename_tac g)
 apply (rule_tac x=g in bexI)
 apply (blast dest: apply_equality range_type) 
 apply (blast intro: Pi_type dest: apply_type fun_is_rel)
 done
 
 
 (* ********************************************************************** *)
 (* AC5 \<Longrightarrow> AC4, Rubin \<and> Rubin, p. 11                                      *)
 (* ********************************************************************** *)
 
 lemma AC5_AC4_aux1: "R \<subseteq> A*B \<Longrightarrow> (\<lambda>x \<in> R. fst(x)) \<in> R -> A"
 by (fast intro!: lam_type fst_type)
 
 lemma AC5_AC4_aux2: "R \<subseteq> A*B \<Longrightarrow> range(\<lambda>x \<in> R. fst(x)) = domain(R)"
 by (unfold lam_def, force)
 
 lemma AC5_AC4_aux3: "\<lbrakk>\<exists>f \<in> A->C. P(f,domain(f)); A=B\<rbrakk> \<Longrightarrow>  \<exists>f \<in> B->C. P(f,B)"
 apply (erule bexE)
 apply (frule domain_of_fun, fast)
 done
 
 lemma AC5_AC4_aux4: "\<lbrakk>R \<subseteq> A*B; g \<in> C->R; \<forall>x \<in> C. (\<lambda>z \<in> R. fst(z))` (g`x) = x\<rbrakk>  
                 \<Longrightarrow> (\<lambda>x \<in> C. snd(g`x)): (\<Prod>x \<in> C. R``{x})"
 apply (rule lam_type)
 apply (force dest: apply_type)
 done
 
 lemma AC5_AC4: "AC5 \<Longrightarrow> AC4"
 apply (unfold AC4_def AC5_def, clarify)
 apply (elim allE ballE)
 apply (drule AC5_AC4_aux3 [OF _ AC5_AC4_aux2], assumption)
 apply (fast elim!: AC5_AC4_aux4)
 apply (blast intro: AC5_AC4_aux1) 
 done
 
 
 (* ********************************************************************** *)
 (* AC1 \<longleftrightarrow> AC6                                                            *)
 (* ********************************************************************** *)
 
 lemma AC1_iff_AC6: "AC1 \<longleftrightarrow> AC6"
 by (unfold AC1_def AC6_def, blast)
 
 end
diff --git a/src/ZF/AC/AC18_AC19.thy b/src/ZF/AC/AC18_AC19.thy
--- a/src/ZF/AC/AC18_AC19.thy
+++ b/src/ZF/AC/AC18_AC19.thy
@@ -1,103 +1,103 @@
 (*  Title:      ZF/AC/AC18_AC19.thy
     Author:     Krzysztof Grabczewski
 
 The proof of AC1 \<Longrightarrow> AC18 \<Longrightarrow> AC19 \<Longrightarrow> AC1
 *)
 
 theory AC18_AC19
 imports AC_Equiv
 begin
 
 definition
   uu    :: "i \<Rightarrow> i" where
     "uu(a) \<equiv> {c \<union> {0}. c \<in> a}"
 
 
 (* ********************************************************************** *)
 (* AC1 \<Longrightarrow> AC18                                                           *)
 (* ********************************************************************** *)
 
 lemma PROD_subsets:
      "\<lbrakk>f \<in> (\<Prod>b \<in> {P(a). a \<in> A}. b);  \<forall>a \<in> A. P(a)<=Q(a)\<rbrakk>   
       \<Longrightarrow> (\<lambda>a \<in> A. f`P(a)) \<in> (\<Prod>a \<in> A. Q(a))"
 by (rule lam_type, drule apply_type, auto)
 
 lemma lemma_AC18:
      "\<lbrakk>\<forall>A. 0 \<notin> A \<longrightarrow> (\<exists>f. f \<in> (\<Prod>X \<in> A. X)); A \<noteq> 0\<rbrakk> 
       \<Longrightarrow> (\<Inter>a \<in> A. \<Union>b \<in> B(a). X(a, b)) \<subseteq> 
           (\<Union>f \<in> \<Prod>a \<in> A. B(a). \<Inter>a \<in> A. X(a, f`a))"
 apply (rule subsetI)
 apply (erule_tac x = "{{b \<in> B (a) . x \<in> X (a,b) }. a \<in> A}" in allE)
 apply (erule impE, fast)
 apply (erule exE)
 apply (rule UN_I)
  apply (fast elim!: PROD_subsets)
 apply (simp, fast elim!: not_emptyE dest: apply_type [OF _ RepFunI])
 done
 
 lemma AC1_AC18: "AC1 \<Longrightarrow> PROP AC18"
-apply (unfold AC1_def)
+  unfolding AC1_def
 apply (rule AC18.intro)
 apply (fast elim!: lemma_AC18 apply_type intro!: equalityI INT_I UN_I)
 done
 
 (* ********************************************************************** *)
 (* AC18 \<Longrightarrow> AC19                                                          *)
 (* ********************************************************************** *)
 
 theorem (in AC18) AC19
-apply (unfold AC19_def)
+  unfolding AC19_def
 apply (intro allI impI)
 apply (rule AC18 [of _ "\<lambda>x. x", THEN mp], blast)
 done
 
 (* ********************************************************************** *)
 (* AC19 \<Longrightarrow> AC1                                                           *)
 (* ********************************************************************** *)
 
 lemma RepRep_conj: 
         "\<lbrakk>A \<noteq> 0; 0 \<notin> A\<rbrakk> \<Longrightarrow> {uu(a). a \<in> A} \<noteq> 0 \<and> 0 \<notin> {uu(a). a \<in> A}"
 apply (unfold uu_def, auto) 
 apply (blast dest!: sym [THEN RepFun_eq_0_iff [THEN iffD1]])
 done
 
 lemma lemma1_1: "\<lbrakk>c \<in> a; x = c \<union> {0}; x \<notin> a\<rbrakk> \<Longrightarrow> x - {0} \<in> a"
 apply clarify 
 apply (rule subst_elem, assumption)
 apply (fast elim: notE subst_elem)
 done
 
 lemma lemma1_2: 
         "\<lbrakk>f`(uu(a)) \<notin> a; f \<in> (\<Prod>B \<in> {uu(a). a \<in> A}. B); a \<in> A\<rbrakk>   
                 \<Longrightarrow> f`(uu(a))-{0} \<in> a"
 apply (unfold uu_def, fast elim!: lemma1_1 dest!: apply_type)
 done
 
 lemma lemma1: "\<exists>f. f \<in> (\<Prod>B \<in> {uu(a). a \<in> A}. B) \<Longrightarrow> \<exists>f. f \<in> (\<Prod>B \<in> A. B)"
 apply (erule exE)
 apply (rule_tac x = "\<lambda>a\<in>A. if (f` (uu(a)) \<in> a, f` (uu(a)), f` (uu(a))-{0})" 
        in exI)
 apply (rule lam_type) 
 apply (simp add: lemma1_2)
 done
 
 lemma lemma2_1: "a\<noteq>0 \<Longrightarrow> 0 \<in> (\<Union>b \<in> uu(a). b)"
 by (unfold uu_def, auto)
 
 lemma lemma2: "\<lbrakk>A\<noteq>0; 0\<notin>A\<rbrakk> \<Longrightarrow> (\<Inter>x \<in> {uu(a). a \<in> A}. \<Union>b \<in> x. b) \<noteq> 0"
 apply (erule not_emptyE) 
 apply (rule_tac a = 0 in not_emptyI)
 apply (fast intro!: lemma2_1)
 done
 
 lemma AC19_AC1: "AC19 \<Longrightarrow> AC1"
 apply (unfold AC19_def AC1_def, clarify)
 apply (case_tac "A=0", force)
 apply (erule_tac x = "{uu (a) . a \<in> A}" in allE)
 apply (erule impE)
 apply (erule RepRep_conj, assumption)
 apply (rule lemma1)
 apply (drule lemma2, assumption, auto) 
 done
 
 end
diff --git a/src/ZF/AC/AC7_AC9.thy b/src/ZF/AC/AC7_AC9.thy
--- a/src/ZF/AC/AC7_AC9.thy
+++ b/src/ZF/AC/AC7_AC9.thy
@@ -1,169 +1,169 @@
 (*  Title:      ZF/AC/AC7_AC9.thy
     Author:     Krzysztof Grabczewski
 
 The proofs needed to state that AC7, AC8 and AC9 are equivalent to the previous
 instances of AC.
 *)
 
 theory AC7_AC9
 imports AC_Equiv
 begin
 
 (* ********************************************************************** *)
 (* Lemmas used in the proofs AC7 \<Longrightarrow> AC6 and AC9 \<Longrightarrow> AC1                  *)
 (*  - Sigma_fun_space_not0                                                *)
 (*  - Sigma_fun_space_eqpoll                                              *)
 (* ********************************************************************** *)
 
 lemma Sigma_fun_space_not0: "\<lbrakk>0\<notin>A; B \<in> A\<rbrakk> \<Longrightarrow> (nat->\<Union>(A)) * B \<noteq> 0"
 by (blast dest!: Sigma_empty_iff [THEN iffD1] Union_empty_iff [THEN iffD1])
 
 lemma inj_lemma: 
         "C \<in> A \<Longrightarrow> (\<lambda>g \<in> (nat->\<Union>(A))*C.   
                 (\<lambda>n \<in> nat. if(n=0, snd(g), fst(g)`(n #- 1))))   
                 \<in> inj((nat->\<Union>(A))*C, (nat->\<Union>(A)) ) "
-apply (unfold inj_def)
+  unfolding inj_def
 apply (rule CollectI)
 apply (fast intro!: lam_type if_type apply_type fst_type snd_type, auto) 
 apply (rule fun_extension, assumption+)
 apply (drule lam_eqE [OF _ nat_succI], assumption, simp) 
 apply (drule lam_eqE [OF _ nat_0I], simp) 
 done
 
 lemma Sigma_fun_space_eqpoll:
      "\<lbrakk>C \<in> A; 0\<notin>A\<rbrakk> \<Longrightarrow> (nat->\<Union>(A)) * C \<approx> (nat->\<Union>(A))"
 apply (rule eqpollI)
 apply (simp add: lepoll_def)
 apply (fast intro!: inj_lemma)
 apply (fast elim!: prod_lepoll_self not_sym [THEN not_emptyE] subst_elem 
             elim: swap)
 done
 
 
 (* ********************************************************************** *)
 (* AC6 \<Longrightarrow> AC7                                                            *)
 (* ********************************************************************** *)
 
 lemma AC6_AC7: "AC6 \<Longrightarrow> AC7"
 by (unfold AC6_def AC7_def, blast)
 
 (* ********************************************************************** *)
 (* AC7 \<Longrightarrow> AC6, Rubin \<and> Rubin p. 12, Theorem 2.8                          *)
 (* The case of the empty family of sets added in order to complete        *)
 (* the proof.                                                             *)
 (* ********************************************************************** *)
 
 lemma lemma1_1: "y \<in> (\<Prod>B \<in> A. Y*B) \<Longrightarrow> (\<lambda>B \<in> A. snd(y`B)) \<in> (\<Prod>B \<in> A. B)"
 by (fast intro!: lam_type snd_type apply_type)
 
 lemma lemma1_2:
      "y \<in> (\<Prod>B \<in> {Y*C. C \<in> A}. B) \<Longrightarrow> (\<lambda>B \<in> A. y`(Y*B)) \<in> (\<Prod>B \<in> A. Y*B)"
 apply (fast intro!: lam_type apply_type)
 done
 
 lemma AC7_AC6_lemma1:
      "(\<Prod>B \<in> {(nat->\<Union>(A))*C. C \<in> A}. B) \<noteq> 0 \<Longrightarrow> (\<Prod>B \<in> A. B) \<noteq> 0"
 by (fast intro!: equals0I lemma1_1 lemma1_2)
 
 lemma AC7_AC6_lemma2: "0 \<notin> A \<Longrightarrow> 0 \<notin> {(nat -> \<Union>(A)) * C. C \<in> A}"
 by (blast dest: Sigma_fun_space_not0)
 
 lemma AC7_AC6: "AC7 \<Longrightarrow> AC6"
 apply (unfold AC6_def AC7_def)
 apply (rule allI)
 apply (rule impI)
 apply (case_tac "A=0", simp)
 apply (rule AC7_AC6_lemma1)
 apply (erule allE) 
 apply (blast del: notI
              intro!: AC7_AC6_lemma2 intro: eqpoll_sym eqpoll_trans 
                     Sigma_fun_space_eqpoll)
 done
 
 
 (* ********************************************************************** *)
 (* AC1 \<Longrightarrow> AC8                                                            *)
 (* ********************************************************************** *)
 
 lemma AC1_AC8_lemma1: 
         "\<forall>B \<in> A. \<exists>B1 B2. B=\<langle>B1,B2\<rangle> \<and> B1 \<approx> B2   
         \<Longrightarrow> 0 \<notin> { bij(fst(B),snd(B)). B \<in> A }"
 apply (unfold eqpoll_def, auto)
 done
 
 lemma AC1_AC8_lemma2:
      "\<lbrakk>f \<in> (\<Prod>X \<in> RepFun(A,p). X); D \<in> A\<rbrakk> \<Longrightarrow> (\<lambda>x \<in> A. f`p(x))`D \<in> p(D)" 
 apply (simp, fast elim!: apply_type)
 done
 
 lemma AC1_AC8: "AC1 \<Longrightarrow> AC8"
 apply (unfold AC1_def AC8_def)
 apply (fast dest: AC1_AC8_lemma1 AC1_AC8_lemma2)
 done
 
 
 (* ********************************************************************** *)
 (* AC8 \<Longrightarrow> AC9                                                            *)
 (*  - this proof replaces the following two from Rubin \<and> Rubin:           *)
 (*    AC8 \<Longrightarrow> AC1 and AC1 \<Longrightarrow> AC9                                         *)
 (* ********************************************************************** *)
 
 lemma AC8_AC9_lemma:
      "\<forall>B1 \<in> A. \<forall>B2 \<in> A. B1 \<approx> B2 
       \<Longrightarrow> \<forall>B \<in> A*A. \<exists>B1 B2. B=\<langle>B1,B2\<rangle> \<and> B1 \<approx> B2"
 by fast
 
 lemma AC8_AC9: "AC8 \<Longrightarrow> AC9"
 apply (unfold AC8_def AC9_def)
 apply (intro allI impI)
 apply (erule allE)
 apply (erule impE, erule AC8_AC9_lemma, force) 
 done
 
 
 (* ********************************************************************** *)
 (* AC9 \<Longrightarrow> AC1                                                            *)
 (* The idea of this proof comes from "Equivalents of the Axiom of Choice" *)
 (* by Rubin \<and> Rubin. But (x * y) is not necessarily equipollent to        *)
 (* (x * y) \<union> {0} when y is a set of total functions acting from nat to   *)
 (* \<Union>(A) -- therefore we have used the set (y * nat) instead of y.     *)
 (* ********************************************************************** *)
 
 lemma snd_lepoll_SigmaI: "b \<in> B \<Longrightarrow> X \<lesssim> B \<times> X"
 by (blast intro: lepoll_trans prod_lepoll_self eqpoll_imp_lepoll 
                  prod_commute_eqpoll) 
 
 lemma nat_lepoll_lemma:
      "\<lbrakk>0 \<notin> A; B \<in> A\<rbrakk> \<Longrightarrow> nat \<lesssim> ((nat \<rightarrow> \<Union>(A)) \<times> B) \<times> nat"
 by (blast dest: Sigma_fun_space_not0 intro: snd_lepoll_SigmaI)
 
 lemma AC9_AC1_lemma1:
      "\<lbrakk>0\<notin>A;  A\<noteq>0;   
          C = {((nat->\<Union>(A))*B)*nat. B \<in> A}  \<union>  
              {cons(0,((nat->\<Union>(A))*B)*nat). B \<in> A};  
          B1 \<in> C;  B2 \<in> C\<rbrakk>   
       \<Longrightarrow> B1 \<approx> B2"
 by (blast intro!: nat_lepoll_lemma Sigma_fun_space_eqpoll
                      nat_cons_eqpoll [THEN eqpoll_trans] 
                      prod_eqpoll_cong [OF _ eqpoll_refl]
              intro: eqpoll_trans eqpoll_sym )
 
 lemma AC9_AC1_lemma2:
      "\<forall>B1 \<in> {(F*B)*N. B \<in> A} \<union> {cons(0,(F*B)*N). B \<in> A}.   
       \<forall>B2 \<in> {(F*B)*N. B \<in> A} \<union> {cons(0,(F*B)*N). B \<in> A}.   
         f`\<langle>B1,B2\<rangle> \<in> bij(B1, B2)   
       \<Longrightarrow> (\<lambda>B \<in> A. snd(fst((f`<cons(0,(F*B)*N),(F*B)*N>)`0))) \<in> (\<Prod>X \<in> A. X)"
 apply (intro lam_type snd_type fst_type)
 apply (rule apply_type [OF _ consI1]) 
 apply (fast intro!: fun_weaken_type bij_is_fun)
 done
 
 lemma AC9_AC1: "AC9 \<Longrightarrow> AC1"
 apply (unfold AC1_def AC9_def)
 apply (intro allI impI)
 apply (erule allE)
 apply (case_tac "A\<noteq>0")
 apply (blast dest: AC9_AC1_lemma1 AC9_AC1_lemma2, force) 
 done
 
 end
diff --git a/src/ZF/AC/AC_Equiv.thy b/src/ZF/AC/AC_Equiv.thy
--- a/src/ZF/AC/AC_Equiv.thy
+++ b/src/ZF/AC/AC_Equiv.thy
@@ -1,224 +1,224 @@
 (*  Title:      ZF/AC/AC_Equiv.thy
     Author:     Krzysztof Grabczewski
 
 Axioms AC1 -- AC19 come from "Equivalents of the Axiom of Choice, II"
 by H. Rubin and J.E. Rubin, 1985.
 
 Axiom AC0 comes from "Axiomatic Set Theory" by P. Suppes, 1972.
 
 Some Isabelle proofs of equivalences of these axioms are formalizations of
 proofs presented by the Rubins.  The others are based on the Rubins' proofs,
 but slightly changed.
 *)
 
 theory AC_Equiv
 imports ZF
 begin (*obviously not ZFC*)
 
 (* Well Ordering Theorems *)
 
 definition  
     "WO1 \<equiv> \<forall>A. \<exists>R. well_ord(A,R)"
 
 definition  
     "WO2 \<equiv> \<forall>A. \<exists>a. Ord(a) \<and> A\<approx>a"
 
 definition  
     "WO3 \<equiv> \<forall>A. \<exists>a. Ord(a) \<and> (\<exists>b. b \<subseteq> a \<and> A\<approx>b)"
 
 definition  
     "WO4(m) \<equiv> \<forall>A. \<exists>a f. Ord(a) \<and> domain(f)=a \<and>   
                          (\<Union>b<a. f`b) = A \<and> (\<forall>b<a. f`b \<lesssim> m)"
 
 definition  
     "WO5 \<equiv> \<exists>m \<in> nat. 1\<le>m \<and> WO4(m)"
 
 definition  
     "WO6 \<equiv> \<forall>A. \<exists>m \<in> nat. 1\<le>m \<and> (\<exists>a f. Ord(a) \<and> domain(f)=a
                                \<and> (\<Union>b<a. f`b) = A \<and> (\<forall>b<a. f`b \<lesssim> m))"
 
 definition  
     "WO7 \<equiv> \<forall>A. Finite(A) \<longleftrightarrow> (\<forall>R. well_ord(A,R) \<longrightarrow> well_ord(A,converse(R)))"
 
 definition  
     "WO8 \<equiv> \<forall>A. (\<exists>f. f \<in> (\<Prod>X \<in> A. X)) \<longrightarrow> (\<exists>R. well_ord(A,R))"
 
 
 definition
 (* Auxiliary concepts needed below *)
   pairwise_disjoint :: "i \<Rightarrow> o"  where
     "pairwise_disjoint(A) \<equiv> \<forall>A1 \<in> A. \<forall>A2 \<in> A. A1 \<inter> A2 \<noteq> 0 \<longrightarrow> A1=A2"
 
 definition
   sets_of_size_between :: "[i, i, i] \<Rightarrow> o"  where
     "sets_of_size_between(A,m,n) \<equiv> \<forall>B \<in> A. m \<lesssim> B \<and> B \<lesssim> n"
 
 
 (* Axioms of Choice *)  
 definition
     "AC0 \<equiv> \<forall>A. \<exists>f. f \<in> (\<Prod>X \<in> Pow(A)-{0}. X)"
 
 definition
     "AC1 \<equiv> \<forall>A. 0\<notin>A \<longrightarrow> (\<exists>f. f \<in> (\<Prod>X \<in> A. X))"
 
 definition
     "AC2 \<equiv> \<forall>A. 0\<notin>A \<and> pairwise_disjoint(A)   
                    \<longrightarrow> (\<exists>C. \<forall>B \<in> A. \<exists>y. B \<inter> C = {y})"
 definition
     "AC3 \<equiv> \<forall>A B. \<forall>f \<in> A->B. \<exists>g. g \<in> (\<Prod>x \<in> {a \<in> A. f`a\<noteq>0}. f`x)"
 
 definition
     "AC4 \<equiv> \<forall>R A B. (R \<subseteq> A*B \<longrightarrow> (\<exists>f. f \<in> (\<Prod>x \<in> domain(R). R``{x})))"
 
 definition
     "AC5 \<equiv> \<forall>A B. \<forall>f \<in> A->B. \<exists>g \<in> range(f)->A. \<forall>x \<in> domain(g). f`(g`x) = x"
 
 definition
     "AC6 \<equiv> \<forall>A. 0\<notin>A \<longrightarrow> (\<Prod>B \<in> A. B)\<noteq>0"
 
 definition
     "AC7 \<equiv> \<forall>A. 0\<notin>A \<and> (\<forall>B1 \<in> A. \<forall>B2 \<in> A. B1\<approx>B2) \<longrightarrow> (\<Prod>B \<in> A. B) \<noteq> 0"
 
 definition
     "AC8 \<equiv> \<forall>A. (\<forall>B \<in> A. \<exists>B1 B2. B=\<langle>B1,B2\<rangle> \<and> B1\<approx>B2)   
                    \<longrightarrow> (\<exists>f. \<forall>B \<in> A. f`B \<in> bij(fst(B),snd(B)))"
 
 definition
     "AC9 \<equiv> \<forall>A. (\<forall>B1 \<in> A. \<forall>B2 \<in> A. B1\<approx>B2) \<longrightarrow>   
                    (\<exists>f. \<forall>B1 \<in> A. \<forall>B2 \<in> A. f`\<langle>B1,B2\<rangle> \<in> bij(B1,B2))"
 
 definition
     "AC10(n) \<equiv>  \<forall>A. (\<forall>B \<in> A. \<not>Finite(B)) \<longrightarrow>   
                    (\<exists>f. \<forall>B \<in> A. (pairwise_disjoint(f`B) \<and>   
                    sets_of_size_between(f`B, 2, succ(n)) \<and> \<Union>(f`B)=B))"
 
 definition
     "AC11 \<equiv> \<exists>n \<in> nat. 1\<le>n \<and> AC10(n)"
 
 definition
     "AC12 \<equiv> \<forall>A. (\<forall>B \<in> A. \<not>Finite(B)) \<longrightarrow>
                  (\<exists>n \<in> nat. 1\<le>n \<and> (\<exists>f. \<forall>B \<in> A. (pairwise_disjoint(f`B) \<and>   
                       sets_of_size_between(f`B, 2, succ(n)) \<and> \<Union>(f`B)=B)))"
 
 definition
     "AC13(m) \<equiv> \<forall>A. 0\<notin>A \<longrightarrow> (\<exists>f. \<forall>B \<in> A. f`B\<noteq>0 \<and> f`B \<subseteq> B \<and> f`B \<lesssim> m)"
 
 definition
     "AC14 \<equiv> \<exists>m \<in> nat. 1\<le>m \<and> AC13(m)"
 
 definition
     "AC15 \<equiv> \<forall>A. 0\<notin>A \<longrightarrow> 
                  (\<exists>m \<in> nat. 1\<le>m \<and> (\<exists>f. \<forall>B \<in> A. f`B\<noteq>0 \<and> f`B \<subseteq> B \<and> f`B \<lesssim> m))"
 
 definition
     "AC16(n, k)  \<equiv> 
        \<forall>A. \<not>Finite(A) \<longrightarrow>   
            (\<exists>T. T \<subseteq> {X \<in> Pow(A). X\<approx>succ(n)} \<and>   
            (\<forall>X \<in> {X \<in> Pow(A). X\<approx>succ(k)}. \<exists>! Y. Y \<in> T \<and> X \<subseteq> Y))"
 
 definition
     "AC17 \<equiv> \<forall>A. \<forall>g \<in> (Pow(A)-{0} -> A) -> Pow(A)-{0}.   
                    \<exists>f \<in> Pow(A)-{0} -> A. f`(g`f) \<in> g`f"
 
 locale AC18 =
   assumes AC18: "A\<noteq>0 \<and> (\<forall>a \<in> A. B(a) \<noteq> 0) \<longrightarrow>
     ((\<Inter>a \<in> A. \<Union>b \<in> B(a). X(a,b)) =   
       (\<Union>f \<in> \<Prod>a \<in> A. B(a). \<Inter>a \<in> A. X(a, f`a)))"
   \<comment> \<open>AC18 cannot be expressed within the object-logic\<close>
 
 definition
     "AC19 \<equiv> \<forall>A. A\<noteq>0 \<and> 0\<notin>A \<longrightarrow> ((\<Inter>a \<in> A. \<Union>b \<in> a. b) =   
                    (\<Union>f \<in> (\<Prod>B \<in> A. B). \<Inter>a \<in> A. f`a))"
 
 
 
 (* ********************************************************************** *)
 (*                    Theorems concerning ordinals                        *)
 (* ********************************************************************** *)
 
 (* lemma for ordertype_Int *)
 lemma rvimage_id: "rvimage(A,id(A),r) = r \<inter> A*A"
-apply (unfold rvimage_def)
+  unfolding rvimage_def
 apply (rule equalityI, safe)
 apply (drule_tac P = "\<lambda>a. <id (A) `xb,a>:r" in id_conv [THEN subst],
        assumption)
 apply (drule_tac P = "\<lambda>a. \<langle>a,ya\<rangle>:r" in id_conv [THEN subst], (assumption+))
 apply (fast intro: id_conv [THEN ssubst])
 done
 
 (* used only in Hartog.ML *)
 lemma ordertype_Int:
      "well_ord(A,r) \<Longrightarrow> ordertype(A, r \<inter> A*A) = ordertype(A,r)"
 apply (rule_tac P = "\<lambda>a. ordertype (A,a) =ordertype (A,r) " in rvimage_id [THEN subst])
 apply (erule id_bij [THEN bij_ordertype_vimage])
 done
 
 lemma lam_sing_bij: "(\<lambda>x \<in> A. {x}) \<in> bij(A, {{x}. x \<in> A})"
 apply (rule_tac d = "\<lambda>z. THE x. z={x}" in lam_bijective)
 apply (auto simp add: the_equality)
 done
 
 lemma inj_strengthen_type: 
      "\<lbrakk>f \<in> inj(A, B);  \<And>a. a \<in> A \<Longrightarrow> f`a \<in> C\<rbrakk> \<Longrightarrow> f \<in> inj(A,C)"
 by (unfold inj_def, blast intro: Pi_type) 
 
 (* ********************************************************************** *)
 (* Another elimination rule for \<exists>!                                       *)
 (* ********************************************************************** *)
 
 lemma ex1_two_eq: "\<lbrakk>\<exists>! x. P(x); P(x); P(y)\<rbrakk> \<Longrightarrow> x=y"
 by blast
 
 (* ********************************************************************** *)
 (* Lemmas used in the proofs like WO? \<Longrightarrow> AC?                             *)
 (* ********************************************************************** *)
 
 lemma first_in_B:
      "\<lbrakk>well_ord(\<Union>(A),r); 0 \<notin> A; B \<in> A\<rbrakk> \<Longrightarrow> (THE b. first(b,B,r)) \<in> B"
 by (blast dest!: well_ord_imp_ex1_first
                     [THEN theI, THEN first_def [THEN def_imp_iff, THEN iffD1]])
 
 lemma ex_choice_fun: "\<lbrakk>well_ord(\<Union>(A), R); 0 \<notin> A\<rbrakk> \<Longrightarrow> \<exists>f. f \<in> (\<Prod>X \<in> A. X)"
 by (fast elim!: first_in_B intro!: lam_type)
 
 lemma ex_choice_fun_Pow: "well_ord(A, R) \<Longrightarrow> \<exists>f. f \<in> (\<Prod>X \<in> Pow(A)-{0}. X)"
 by (fast elim!: well_ord_subset [THEN ex_choice_fun])
 
 
 (* ********************************************************************** *)
 (* Lemmas needed to state when a finite relation is a function.           *)
 (*     The criteria are cardinalities of the relation and its domain.     *)
 (*     Used in WO6WO1.ML                                                  *)
 (* ********************************************************************** *)
 
 (*Using AC we could trivially prove, for all u, domain(u) \<lesssim> u*)
 lemma lepoll_m_imp_domain_lepoll_m: 
      "\<lbrakk>m \<in> nat; u \<lesssim> m\<rbrakk> \<Longrightarrow> domain(u) \<lesssim> m"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (erule exE)
 apply (rule_tac x = "\<lambda>x \<in> domain(u). \<mu> i. \<exists>y. \<langle>x,y\<rangle> \<in> u \<and> f`\<langle>x,y\<rangle> = i" 
        in exI)
 apply (rule_tac d = "\<lambda>y. fst (converse(f) ` y) " in lam_injective)
 apply (fast intro: LeastI2 nat_into_Ord [THEN Ord_in_Ord] 
                            inj_is_fun [THEN apply_type])
 apply (erule domainE)
 apply (frule inj_is_fun [THEN apply_type], assumption)
 apply (rule LeastI2)
 apply (auto elim!: nat_into_Ord [THEN Ord_in_Ord])
 done
 
 lemma rel_domain_ex1: 
     "\<lbrakk>succ(m) \<lesssim> domain(r); r \<lesssim> succ(m); m \<in> nat\<rbrakk> \<Longrightarrow> function(r)"
 apply (unfold function_def, safe)
 apply (rule ccontr) 
 apply (fast elim!: lepoll_trans [THEN succ_lepoll_natE] 
                    lepoll_m_imp_domain_lepoll_m [OF _ Diff_sing_lepoll]
             elim: domain_Diff_eq [OF _ not_sym, THEN subst])
 done
 
 lemma rel_is_fun:
      "\<lbrakk>succ(m) \<lesssim> domain(r);  r \<lesssim> succ(m);  m \<in> nat;   
          r \<subseteq> A*B; A=domain(r)\<rbrakk> \<Longrightarrow> r \<in> A->B"
 by (simp add: Pi_iff rel_domain_ex1)
 
 end
diff --git a/src/ZF/AC/Cardinal_aux.thy b/src/ZF/AC/Cardinal_aux.thy
--- a/src/ZF/AC/Cardinal_aux.thy
+++ b/src/ZF/AC/Cardinal_aux.thy
@@ -1,196 +1,196 @@
 (*  Title:      ZF/AC/Cardinal_aux.thy
     Author:     Krzysztof Grabczewski
 
 Auxiliary lemmas concerning cardinalities.
 *)
 
 theory Cardinal_aux imports AC_Equiv begin
 
 lemma Diff_lepoll: "\<lbrakk>A \<lesssim> succ(m); B \<subseteq> A; B\<noteq>0\<rbrakk> \<Longrightarrow> A-B \<lesssim> m"
 apply (rule not_emptyE, assumption)
 apply (blast intro: lepoll_trans [OF subset_imp_lepoll Diff_sing_lepoll])
 done
 
 
 (* ********************************************************************** *)
 (* Lemmas involving ordinals and cardinalities used in the proofs         *)
 (* concerning AC16 and DC                                                 *)
 (* ********************************************************************** *)
 
 
 (* j=|A| *)
 lemma lepoll_imp_ex_le_eqpoll:
      "\<lbrakk>A \<lesssim> i; Ord(i)\<rbrakk> \<Longrightarrow> \<exists>j. j \<le> i \<and> A \<approx> j"
 by (blast intro!: lepoll_cardinal_le well_ord_Memrel
                   well_ord_cardinal_eqpoll [THEN eqpoll_sym]
           dest: lepoll_well_ord)
 
 (* j=|A| *)
 lemma lesspoll_imp_ex_lt_eqpoll:
      "\<lbrakk>A \<prec> i; Ord(i)\<rbrakk> \<Longrightarrow> \<exists>j. j<i \<and> A \<approx> j"
 by (unfold lesspoll_def, blast dest!: lepoll_imp_ex_le_eqpoll elim!: leE)
 
 lemma Un_eqpoll_Inf_Ord:
   assumes A: "A \<approx> i" and B: "B \<approx> i" and NFI: "\<not> Finite(i)" and i: "Ord(i)"
   shows "A \<union> B \<approx> i"
 proof (rule eqpollI)
   have AB: "A \<approx> B" using A B by (blast intro: eqpoll_sym eqpoll_trans) 
   have "2 \<lesssim> nat" 
     by (rule subset_imp_lepoll) (rule OrdmemD [OF nat_2I Ord_nat]) 
   also have "... \<lesssim> i" 
     by (simp add: nat_le_infinite_Ord le_imp_lepoll NFI i)+
   also have "... \<approx> A" by (blast intro: eqpoll_sym A) 
   finally have "2 \<lesssim> A" .
   have ICI: "InfCard(|i|)" 
     by (simp add: Inf_Card_is_InfCard Finite_cardinal_iff NFI i) 
   have "A \<union> B \<lesssim> A + B" by (rule Un_lepoll_sum)
   also have "... \<lesssim> A \<times> B"
     by (rule lepoll_imp_sum_lepoll_prod [OF AB [THEN eqpoll_imp_lepoll] \<open>2 \<lesssim> A\<close>])
   also have "... \<approx> i \<times> i"
     by (blast intro: prod_eqpoll_cong eqpoll_imp_lepoll A B) 
   also have "... \<approx> i"
     by (blast intro: well_ord_InfCard_square_eq well_ord_Memrel ICI i) 
   finally show "A \<union> B \<lesssim> i" .
 next  
   have "i \<approx> A" by (blast intro: A eqpoll_sym)
   also have "... \<lesssim> A \<union> B" by (blast intro: subset_imp_lepoll) 
   finally show "i \<lesssim> A \<union> B" .
 qed
 
 schematic_goal paired_bij: "?f \<in> bij({{y,z}. y \<in> x}, x)"
 apply (rule RepFun_bijective)
 apply (simp add: doubleton_eq_iff, blast)
 done
 
 lemma paired_eqpoll: "{{y,z}. y \<in> x} \<approx> x"
 by (unfold eqpoll_def, fast intro!: paired_bij)
 
 lemma ex_eqpoll_disjoint: "\<exists>B. B \<approx> A \<and> B \<inter> C = 0"
 by (fast intro!: paired_eqpoll equals0I elim: mem_asym)
 
 (*Finally we reach this result.  Surely there's a simpler proof?*)
 lemma Un_lepoll_Inf_Ord:
      "\<lbrakk>A \<lesssim> i; B \<lesssim> i; \<not>Finite(i); Ord(i)\<rbrakk> \<Longrightarrow> A \<union> B \<lesssim> i"
 apply (rule_tac A1 = i and C1 = i in ex_eqpoll_disjoint [THEN exE])
 apply (erule conjE)
 apply (drule lepoll_trans)
 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll])
 apply (rule Un_lepoll_Un [THEN lepoll_trans], (assumption+))
 apply (blast intro: eqpoll_refl Un_eqpoll_Inf_Ord eqpoll_imp_lepoll)
 done
 
 lemma Least_in_Ord: "\<lbrakk>P(i); i \<in> j; Ord(j)\<rbrakk> \<Longrightarrow> (\<mu> i. P(i)) \<in> j"
 apply (erule Least_le [THEN leE])
 apply (erule Ord_in_Ord, assumption)
 apply (erule ltE)
 apply (fast dest: OrdmemD)
 apply (erule subst_elem, assumption)
 done
 
 lemma Diff_first_lepoll:
      "\<lbrakk>well_ord(x,r); y \<subseteq> x; y \<lesssim> succ(n); n \<in> nat\<rbrakk>
       \<Longrightarrow> y - {THE b. first(b,y,r)} \<lesssim> n"
 apply (case_tac "y=0", simp add: empty_lepollI)
 apply (fast intro!: Diff_sing_lepoll the_first_in)
 done
 
 lemma UN_subset_split:
      "(\<Union>x \<in> X. P(x)) \<subseteq> (\<Union>x \<in> X. P(x)-Q(x)) \<union> (\<Union>x \<in> X. Q(x))"
 by blast
 
 lemma UN_sing_lepoll: "Ord(a) \<Longrightarrow> (\<Union>x \<in> a. {P(x)}) \<lesssim> a"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (rule_tac x = "\<lambda>z \<in> (\<Union>x \<in> a. {P (x) }) . (\<mu> i. P (i) =z) " in exI)
 apply (rule_tac d = "\<lambda>z. P (z) " in lam_injective)
 apply (fast intro!: Least_in_Ord)
 apply (fast intro: LeastI elim!: Ord_in_Ord)
 done
 
 lemma UN_fun_lepoll_lemma [rule_format]:
      "\<lbrakk>well_ord(T, R); \<not>Finite(a); Ord(a); n \<in> nat\<rbrakk>
       \<Longrightarrow> \<forall>f. (\<forall>b \<in> a. f`b \<lesssim> n \<and> f`b \<subseteq> T) \<longrightarrow> (\<Union>b \<in> a. f`b) \<lesssim> a"
 apply (induct_tac "n")
 apply (rule allI)
 apply (rule impI)
 apply (rule_tac b = "\<Union>b \<in> a. f`b" in subst)
 apply (rule_tac [2] empty_lepollI)
 apply (rule equals0I [symmetric], clarify)
 apply (fast dest: lepoll_0_is_0 [THEN subst])
 apply (rule allI)
 apply (rule impI)
 apply (erule_tac x = "\<lambda>x \<in> a. f`x - {THE b. first (b,f`x,R) }" in allE)
 apply (erule impE, simp)
 apply (fast intro!: Diff_first_lepoll, simp)
 apply (rule UN_subset_split [THEN subset_imp_lepoll, THEN lepoll_trans])
 apply (fast intro: Un_lepoll_Inf_Ord UN_sing_lepoll)
 done
 
 lemma UN_fun_lepoll:
      "\<lbrakk>\<forall>b \<in> a. f`b \<lesssim> n \<and> f`b \<subseteq> T; well_ord(T, R);
          \<not>Finite(a); Ord(a); n \<in> nat\<rbrakk> \<Longrightarrow> (\<Union>b \<in> a. f`b) \<lesssim> a"
 by (blast intro: UN_fun_lepoll_lemma)
 
 lemma UN_lepoll:
      "\<lbrakk>\<forall>b \<in> a. F(b) \<lesssim> n \<and> F(b) \<subseteq> T; well_ord(T, R);
          \<not>Finite(a); Ord(a); n \<in> nat\<rbrakk>
       \<Longrightarrow> (\<Union>b \<in> a. F(b)) \<lesssim> a"
 apply (rule rev_mp)
 apply (rule_tac f="\<lambda>b \<in> a. F (b)" in UN_fun_lepoll)
 apply auto
 done
 
 lemma UN_eq_UN_Diffs:
      "Ord(a) \<Longrightarrow> (\<Union>b \<in> a. F(b)) = (\<Union>b \<in> a. F(b) - (\<Union>c \<in> b. F(c)))"
 apply (rule equalityI)
  prefer 2 apply fast
 apply (rule subsetI)
 apply (erule UN_E)
 apply (rule UN_I)
  apply (rule_tac P = "\<lambda>z. x \<in> F (z) " in Least_in_Ord, (assumption+))
 apply (rule DiffI, best intro: Ord_in_Ord LeastI, clarify)
 apply (erule_tac P = "\<lambda>z. x \<in> F (z) " and i = c in less_LeastE)
 apply (blast intro: Ord_Least ltI)
 done
 
 lemma lepoll_imp_eqpoll_subset:
      "a \<lesssim> X \<Longrightarrow> \<exists>Y. Y \<subseteq> X \<and> a \<approx> Y"
 apply (unfold lepoll_def eqpoll_def, clarify)
 apply (blast intro: restrict_bij
              dest: inj_is_fun [THEN fun_is_rel, THEN image_subset])
 done
 
 (* ********************************************************************** *)
 (* Diff_lesspoll_eqpoll_Card                                              *)
 (* ********************************************************************** *)
 
 lemma Diff_lesspoll_eqpoll_Card_lemma:
      "\<lbrakk>A\<approx>a; \<not>Finite(a); Card(a); B \<prec> a; A-B \<prec> a\<rbrakk> \<Longrightarrow> P"
 apply (elim lesspoll_imp_ex_lt_eqpoll [THEN exE] Card_is_Ord conjE)
 apply (frule_tac j=xa in Un_upper1_le [OF lt_Ord lt_Ord], assumption)
 apply (frule_tac j=xa in Un_upper2_le [OF lt_Ord lt_Ord], assumption)
 apply (drule Un_least_lt, assumption)
 apply (drule eqpoll_imp_lepoll [THEN lepoll_trans],
        rule le_imp_lepoll, assumption)+
 apply (case_tac "Finite(x \<union> xa)")
 txt\<open>finite case\<close>
  apply (drule Finite_Un [OF lepoll_Finite lepoll_Finite], assumption+)
  apply (drule subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_Finite])
  apply (fast dest: eqpoll_sym [THEN eqpoll_imp_lepoll, THEN lepoll_Finite])
 txt\<open>infinite case\<close>
 apply (drule Un_lepoll_Inf_Ord, (assumption+))
 apply (blast intro: le_Ord2)
 apply (drule lesspoll_trans1
              [OF subset_Un_Diff [THEN subset_imp_lepoll, THEN lepoll_trans]
                  lt_Card_imp_lesspoll], assumption+)
 apply (simp add: lesspoll_def)
 done
 
 lemma Diff_lesspoll_eqpoll_Card:
      "\<lbrakk>A \<approx> a; \<not>Finite(a); Card(a); B \<prec> a\<rbrakk> \<Longrightarrow> A - B \<approx> a"
 apply (rule ccontr)
 apply (rule Diff_lesspoll_eqpoll_Card_lemma, (assumption+))
 apply (blast intro: lesspoll_def [THEN def_imp_iff, THEN iffD2]
                     subset_imp_lepoll eqpoll_imp_lepoll lepoll_trans)
 done
 
 end
diff --git a/src/ZF/AC/DC.thy b/src/ZF/AC/DC.thy
--- a/src/ZF/AC/DC.thy
+++ b/src/ZF/AC/DC.thy
@@ -1,585 +1,585 @@
 (*  Title:      ZF/AC/DC.thy
     Author:     Krzysztof Grabczewski
 
 The proofs concerning the Axiom of Dependent Choice.
 *)
 
 theory DC
 imports AC_Equiv Hartog Cardinal_aux
 begin
 
 lemma RepFun_lepoll: "Ord(a) \<Longrightarrow> {P(b). b \<in> a} \<lesssim> a"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (rule_tac x = "\<lambda>z \<in> RepFun (a,P) . \<mu> i. z=P (i) " in exI)
 apply (rule_tac d="\<lambda>z. P (z)" in lam_injective)
  apply (fast intro!: Least_in_Ord)
 apply (rule sym) 
 apply (fast intro: LeastI Ord_in_Ord) 
 done
 
 text\<open>Trivial in the presence of AC, but here we need a wellordering of X\<close>
 lemma image_Ord_lepoll: "\<lbrakk>f \<in> X->Y; Ord(X)\<rbrakk> \<Longrightarrow> f``X \<lesssim> X"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (rule_tac x = "\<lambda>x \<in> f``X. \<mu> y. f`y = x" in exI)
 apply (rule_tac d = "\<lambda>z. f`z" in lam_injective)
 apply (fast intro!: Least_in_Ord apply_equality, clarify) 
 apply (rule LeastI) 
  apply (erule apply_equality, assumption+) 
 apply (blast intro: Ord_in_Ord)
 done
 
 lemma range_subset_domain: 
       "\<lbrakk>R \<subseteq> X*X;   \<And>g. g \<in> X \<Longrightarrow> \<exists>u. \<langle>g,u\<rangle> \<in> R\<rbrakk> 
        \<Longrightarrow> range(R) \<subseteq> domain(R)"
 by blast 
 
 lemma cons_fun_type: "g \<in> n->X \<Longrightarrow> cons(\<langle>n,x\<rangle>, g) \<in> succ(n) -> cons(x, X)"
-apply (unfold succ_def)
+  unfolding succ_def
 apply (fast intro!: fun_extend elim!: mem_irrefl)
 done
 
 lemma cons_fun_type2:
      "\<lbrakk>g \<in> n->X; x \<in> X\<rbrakk> \<Longrightarrow> cons(\<langle>n,x\<rangle>, g) \<in> succ(n) -> X"
 by (erule cons_absorb [THEN subst], erule cons_fun_type)
 
 lemma cons_image_n: "n \<in> nat \<Longrightarrow> cons(\<langle>n,x\<rangle>, g)``n = g``n"
 by (fast elim!: mem_irrefl)
 
 lemma cons_val_n: "g \<in> n->X \<Longrightarrow> cons(\<langle>n,x\<rangle>, g)`n = x"
 by (fast intro!: apply_equality elim!: cons_fun_type)
 
 lemma cons_image_k: "k \<in> n \<Longrightarrow> cons(\<langle>n,x\<rangle>, g)``k = g``k"
 by (fast elim: mem_asym)
 
 lemma cons_val_k: "\<lbrakk>k \<in> n; g \<in> n->X\<rbrakk> \<Longrightarrow> cons(\<langle>n,x\<rangle>, g)`k = g`k"
 by (fast intro!: apply_equality consI2 elim!: cons_fun_type apply_Pair)
 
 lemma domain_cons_eq_succ: "domain(f)=x \<Longrightarrow> domain(cons(\<langle>x,y\<rangle>, f)) = succ(x)"
 by (simp add: domain_cons succ_def)
 
 lemma restrict_cons_eq: "g \<in> n->X \<Longrightarrow> restrict(cons(\<langle>n,x\<rangle>, g), n) = g"
 apply (simp add: restrict_def Pi_iff)
 apply (blast intro: elim: mem_irrefl)  
 done
 
 lemma succ_in_succ: "\<lbrakk>Ord(k); i \<in> k\<rbrakk> \<Longrightarrow> succ(i) \<in> succ(k)"
 apply (rule Ord_linear [of "succ(i)" "succ(k)", THEN disjE])
 apply (fast elim: Ord_in_Ord mem_irrefl mem_asym)+
 done
 
 lemma restrict_eq_imp_val_eq: 
       "\<lbrakk>restrict(f, domain(g)) = g; x \<in> domain(g)\<rbrakk> 
        \<Longrightarrow> f`x = g`x" 
 by (erule subst, simp add: restrict)
 
 lemma domain_eq_imp_fun_type: "\<lbrakk>domain(f)=A; f \<in> B->C\<rbrakk> \<Longrightarrow> f \<in> A->C"
 by (frule domain_of_fun, fast)
 
 lemma ex_in_domain: "\<lbrakk>R \<subseteq> A * B; R \<noteq> 0\<rbrakk> \<Longrightarrow> \<exists>x. x \<in> domain(R)"
 by (fast elim!: not_emptyE)
 
 
 definition
   DC  :: "i \<Rightarrow> o"  where
     "DC(a) \<equiv> \<forall>X R. R \<subseteq> Pow(X)*X  \<and>
                     (\<forall>Y \<in> Pow(X). Y \<prec> a \<longrightarrow> (\<exists>x \<in> X. \<langle>Y,x\<rangle> \<in> R)) 
                     \<longrightarrow> (\<exists>f \<in> a->X. \<forall>b<a. <f``b,f`b> \<in> R)"
 
 definition
   DC0 :: o  where
     "DC0 \<equiv> \<forall>A B R. R \<subseteq> A*B \<and> R\<noteq>0 \<and> range(R) \<subseteq> domain(R) 
                     \<longrightarrow> (\<exists>f \<in> nat->domain(R). \<forall>n \<in> nat. <f`n,f`succ(n)>:R)"
 
 definition
   ff  :: "[i, i, i, i] \<Rightarrow> i"  where
     "ff(b, X, Q, R) \<equiv>
            transrec(b, \<lambda>c r. THE x. first(x, {x \<in> X. <r``c, x> \<in> R}, Q))"
 
 
 locale DC0_imp =
   fixes XX and RR and X and R
 
   assumes all_ex: "\<forall>Y \<in> Pow(X). Y \<prec> nat \<longrightarrow> (\<exists>x \<in> X. \<langle>Y, x\<rangle> \<in> R)"
 
   defines XX_def: "XX \<equiv> (\<Union>n \<in> nat. {f \<in> n->X. \<forall>k \<in> n. <f``k, f`k> \<in> R})"
      and RR_def:  "RR \<equiv> {\<langle>z1,z2\<rangle>:XX*XX. domain(z2)=succ(domain(z1))  
                                        \<and> restrict(z2, domain(z1)) = z1}"
 begin
 
 (* ********************************************************************** *)
 (* DC \<Longrightarrow> DC(omega)                                                       *)
 (*                                                                        *)
 (* The scheme of the proof:                                               *)
 (*                                                                        *)
 (* Assume DC. Let R and X satisfy the premise of DC(omega).               *)
 (*                                                                        *)
 (* Define XX and RR as follows:                                           *)
 (*                                                                        *)
 (*       XX = (\<Union>n \<in> nat. {f \<in> n->X. \<forall>k \<in> n. <f``k, f`k> \<in> R})           *)
 (*       f RR g iff domain(g)=succ(domain(f)) \<and>                           *)
 (*              restrict(g, domain(f)) = f                                *)
 (*                                                                        *)
 (* Then RR satisfies the hypotheses of DC.                                *)
 (* So applying DC:                                                        *)
 (*                                                                        *)
 (*       \<exists>f \<in> nat->XX. \<forall>n \<in> nat. f`n RR f`succ(n)                        *)
 (*                                                                        *)
 (* Thence                                                                 *)
 (*                                                                        *)
 (*       ff = {<n, f`succ(n)`n>. n \<in> nat}                                 *)
 (*                                                                        *)
 (* is the desired function.                                               *)
 (*                                                                        *)
 (* ********************************************************************** *)
 
 lemma lemma1_1: "RR \<subseteq> XX*XX"
 by (unfold RR_def, fast)
 
 lemma lemma1_2: "RR \<noteq> 0"
 apply (unfold RR_def XX_def)
 apply (rule all_ex [THEN ballE])
 apply (erule_tac [2] notE [OF _ empty_subsetI [THEN PowI]])
 apply (erule_tac impE [OF _ nat_0I [THEN n_lesspoll_nat]])
 apply (erule bexE)
 apply (rule_tac a = "<0, {\<langle>0, x\<rangle>}>" in not_emptyI)
 apply (rule CollectI)
 apply (rule SigmaI)
 apply (rule nat_0I [THEN UN_I])
 apply (simp (no_asm_simp) add: nat_0I [THEN UN_I])
 apply (rule nat_1I [THEN UN_I])
 apply (force intro!: singleton_fun [THEN Pi_type]
              simp add: singleton_0 [symmetric])
 apply (simp add: singleton_0)
 done
 
 lemma lemma1_3: "range(RR) \<subseteq> domain(RR)"
 apply (unfold RR_def XX_def)
 apply (rule range_subset_domain, blast, clarify)
 apply (frule fun_is_rel [THEN image_subset, THEN PowI, 
                          THEN all_ex [THEN bspec]])
 apply (erule impE[OF _ lesspoll_trans1[OF image_Ord_lepoll 
                                           [OF _ nat_into_Ord] n_lesspoll_nat]],
        assumption+)
 apply (erule bexE)
 apply (rule_tac x = "cons (\<langle>n,x\<rangle>, g) " in exI)
 apply (rule CollectI)
 apply (force elim!: cons_fun_type2 
              simp add: cons_image_n cons_val_n cons_image_k cons_val_k)
 apply (simp add: domain_of_fun succ_def restrict_cons_eq)
 done
 
 lemma lemma2:
      "\<lbrakk>\<forall>n \<in> nat. <f`n, f`succ(n)> \<in> RR;  f \<in> nat -> XX;  n \<in> nat\<rbrakk>   
       \<Longrightarrow> \<exists>k \<in> nat. f`succ(n) \<in> k -> X \<and> n \<in> k   
                   \<and> <f`succ(n)``n, f`succ(n)`n> \<in> R"
 apply (induct_tac "n")
 apply (drule apply_type [OF _ nat_1I])
 apply (drule bspec [OF _ nat_0I])
 apply (simp add: XX_def, safe)
 apply (rule rev_bexI, assumption)
 apply (subgoal_tac "0 \<in> y", force)
 apply (force simp add: RR_def
              intro: ltD elim!: nat_0_le [THEN leE])
 (** LEVEL 7, other subgoal **)
 apply (drule bspec [OF _ nat_succI], assumption)
 apply (subgoal_tac "f ` succ (succ (x)) \<in> succ (k) ->X")
 apply (drule apply_type [OF _ nat_succI [THEN nat_succI]], assumption)
 apply (simp (no_asm_use) add: XX_def RR_def)
 apply safe
 apply (frule_tac a="succ(k)" in domain_of_fun [symmetric, THEN trans], 
        assumption)
 apply (frule_tac a=y in domain_of_fun [symmetric, THEN trans], 
        assumption)
 apply (fast elim!: nat_into_Ord [THEN succ_in_succ] 
             dest!: bspec [OF _ nat_into_Ord [THEN succ_in_succ]])
 apply (drule domain_of_fun)
 apply (simp add: XX_def RR_def, clarify) 
 apply (blast dest: domain_of_fun [symmetric, THEN trans] )
 done
 
 lemma lemma3_1:
      "\<lbrakk>\<forall>n \<in> nat. <f`n, f`succ(n)> \<in> RR;  f \<in> nat -> XX;  m \<in> nat\<rbrakk>   
       \<Longrightarrow>  {f`succ(x)`x. x \<in> m} = {f`succ(m)`x. x \<in> m}"
 apply (subgoal_tac "\<forall>x \<in> m. f`succ (m) `x = f`succ (x) `x")
 apply simp
 apply (induct_tac "m", blast)
 apply (rule ballI)
 apply (erule succE)
  apply (rule restrict_eq_imp_val_eq)
   apply (drule bspec [OF _ nat_succI], assumption)
   apply (simp add: RR_def)
  apply (drule lemma2, assumption+)
  apply (fast dest!: domain_of_fun)
 apply (drule_tac x = xa in bspec, assumption)
 apply (erule sym [THEN trans, symmetric])
 apply (rule restrict_eq_imp_val_eq [symmetric])
  apply (drule bspec [OF _ nat_succI], assumption)
  apply (simp add: RR_def)
 apply (drule lemma2, assumption+)
 apply (blast dest!: domain_of_fun 
              intro: nat_into_Ord OrdmemD [THEN subsetD])
 done
 
 lemma lemma3:
      "\<lbrakk>\<forall>n \<in> nat. <f`n, f`succ(n)> \<in> RR;  f \<in> nat -> XX;  m \<in> nat\<rbrakk>  
       \<Longrightarrow> (\<lambda>x \<in> nat. f`succ(x)`x) `` m = f`succ(m)``m"
 apply (erule natE, simp)
 apply (subst image_lam)
  apply (fast elim!: OrdmemD [OF nat_succI Ord_nat])
 apply (subst lemma3_1, assumption+)
  apply fast
 apply (fast dest!: lemma2 
             elim!: image_fun [symmetric, OF _ OrdmemD [OF _ nat_into_Ord]])
 done
 
 end
 
 theorem DC0_imp_DC_nat: "DC0 \<Longrightarrow> DC(nat)"
 apply (unfold DC_def DC0_def, clarify)
 apply (elim allE)
 apply (erule impE)
    (*these three results comprise Lemma 1*)
 apply (blast intro!: DC0_imp.lemma1_1 [OF DC0_imp.intro] DC0_imp.lemma1_2 [OF DC0_imp.intro] DC0_imp.lemma1_3 [OF DC0_imp.intro])
 apply (erule bexE)
 apply (rule_tac x = "\<lambda>n \<in> nat. f`succ (n) `n" in rev_bexI)
  apply (rule lam_type, blast dest!: DC0_imp.lemma2 [OF DC0_imp.intro] intro: fun_weaken_type)
 apply (rule oallI)
 apply (frule DC0_imp.lemma2 [OF DC0_imp.intro], assumption)
   apply (blast intro: fun_weaken_type)
  apply (erule ltD) 
 (** LEVEL 11: last subgoal **)
 apply (subst DC0_imp.lemma3 [OF DC0_imp.intro], assumption+) 
   apply (fast elim!: fun_weaken_type)
  apply (erule ltD) 
 apply (force simp add: lt_def) 
 done
 
 
 (* ************************************************************************
    DC(omega) \<Longrightarrow> DC                                                       
                                                                           
    The scheme of the proof:                                               
                                                                           
    Assume DC(omega). Let R and x satisfy the premise of DC.               
                                                                           
    Define XX and RR as follows:                                           
                                                                           
     XX = (\<Union>n \<in> nat. {f \<in> succ(n)->domain(R). \<forall>k \<in> n. <f`k, f`succ(k)> \<in> R})
 
     RR = {\<langle>z1,z2\<rangle>:Fin(XX)*XX. 
            (domain(z2)=succ(\<Union>f \<in> z1. domain(f)) \<and>
             (\<forall>f \<in> z1. restrict(z2, domain(f)) = f)) |      
            (\<not> (\<exists>g \<in> XX. domain(g)=succ(\<Union>f \<in> z1. domain(f)) \<and>
                         (\<forall>f \<in> z1. restrict(g, domain(f)) = f)) \<and>           
             z2={\<langle>0,x\<rangle>})}                                          
                                                                           
    Then XX and RR satisfy the hypotheses of DC(omega).                    
    So applying DC:                                                        
                                                                           
          \<exists>f \<in> nat->XX. \<forall>n \<in> nat. f``n RR f`n                             
                                                                           
    Thence                                                                 
                                                                           
          ff = {<n, f`n`n>. n \<in> nat}                                         
                                                                           
    is the desired function.                                               
                                                                           
 ************************************************************************* *)
 
 lemma singleton_in_funs: 
  "x \<in> X \<Longrightarrow> {\<langle>0,x\<rangle>} \<in> 
             (\<Union>n \<in> nat. {f \<in> succ(n)->X. \<forall>k \<in> n. <f`k, f`succ(k)> \<in> R})"
 apply (rule nat_0I [THEN UN_I])
 apply (force simp add: singleton_0 [symmetric]
              intro!: singleton_fun [THEN Pi_type])
 done
 
 
 locale imp_DC0 =
   fixes XX and RR and x and R and f and allRR
   defines XX_def: "XX \<equiv> (\<Union>n \<in> nat.
                       {f \<in> succ(n)->domain(R). \<forall>k \<in> n. <f`k, f`succ(k)> \<in> R})"
       and RR_def:
          "RR \<equiv> {\<langle>z1,z2\<rangle>:Fin(XX)*XX. 
                   (domain(z2)=succ(\<Union>f \<in> z1. domain(f))  
                     \<and> (\<forall>f \<in> z1. restrict(z2, domain(f)) = f))
                   | (\<not> (\<exists>g \<in> XX. domain(g)=succ(\<Union>f \<in> z1. domain(f))  
                      \<and> (\<forall>f \<in> z1. restrict(g, domain(f)) = f)) \<and> z2={\<langle>0,x\<rangle>})}"
       and allRR_def:
         "allRR \<equiv> \<forall>b<nat.
                    <f``b, f`b> \<in>  
                     {\<langle>z1,z2\<rangle>\<in>Fin(XX)*XX. (domain(z2)=succ(\<Union>f \<in> z1. domain(f))
                                     \<and> (\<Union>f \<in> z1. domain(f)) = b  
                                     \<and> (\<forall>f \<in> z1. restrict(z2,domain(f)) = f))}"
 begin
 
 lemma lemma4:
      "\<lbrakk>range(R) \<subseteq> domain(R);  x \<in> domain(R)\<rbrakk>   
       \<Longrightarrow> RR \<subseteq> Pow(XX)*XX \<and>   
              (\<forall>Y \<in> Pow(XX). Y \<prec> nat \<longrightarrow> (\<exists>x \<in> XX. \<langle>Y,x\<rangle>:RR))"
 apply (rule conjI)
 apply (force dest!: FinD [THEN PowI] simp add: RR_def)
 apply (rule impI [THEN ballI])
 apply (drule Finite_Fin [OF lesspoll_nat_is_Finite PowD], assumption)
 apply (case_tac
        "\<exists>g \<in> XX. domain (g) =
              succ(\<Union>f \<in> Y. domain(f)) \<and> (\<forall>f\<in>Y. restrict(g, domain(f)) = f)")
 apply (simp add: RR_def, blast)
 apply (safe del: domainE)
 apply (unfold XX_def RR_def)
 apply (rule rev_bexI, erule singleton_in_funs)
 apply (simp add: nat_0I [THEN rev_bexI] cons_fun_type2)
 done
 
 lemma UN_image_succ_eq:
      "\<lbrakk>f \<in> nat->X; n \<in> nat\<rbrakk> 
       \<Longrightarrow> (\<Union>x \<in> f``succ(n). P(x)) =  P(f`n) \<union> (\<Union>x \<in> f``n. P(x))"
 by (simp add: image_fun OrdmemD) 
 
 lemma UN_image_succ_eq_succ:
      "\<lbrakk>(\<Union>x \<in> f``n. P(x)) = y; P(f`n) = succ(y);   
          f \<in> nat -> X; n \<in> nat\<rbrakk> \<Longrightarrow> (\<Union>x \<in> f``succ(n). P(x)) = succ(y)"
 by (simp add: UN_image_succ_eq, blast)
 
 lemma apply_domain_type:
      "\<lbrakk>h \<in> succ(n) -> D;  n \<in> nat; domain(h)=succ(y)\<rbrakk> \<Longrightarrow> h`y \<in> D"
 by (fast elim: apply_type dest!: trans [OF sym domain_of_fun])
 
 lemma image_fun_succ:
      "\<lbrakk>h \<in> nat -> X; n \<in> nat\<rbrakk> \<Longrightarrow> h``succ(n) = cons(h`n, h``n)"
 by (simp add: image_fun OrdmemD) 
 
 lemma f_n_type:
      "\<lbrakk>domain(f`n) = succ(k); f \<in> nat -> XX;  n \<in> nat\<rbrakk>    
       \<Longrightarrow> f`n \<in> succ(k) -> domain(R)"
-apply (unfold XX_def)
+  unfolding XX_def
 apply (drule apply_type, assumption)
 apply (fast elim: domain_eq_imp_fun_type)
 done
 
 lemma f_n_pairs_in_R [rule_format]: 
      "\<lbrakk>h \<in> nat -> XX;  domain(h`n) = succ(k);  n \<in> nat\<rbrakk>   
       \<Longrightarrow> \<forall>i \<in> k. <h`n`i, h`n`succ(i)> \<in> R"
-apply (unfold XX_def)
+  unfolding XX_def
 apply (drule apply_type, assumption)
 apply (elim UN_E CollectE)
 apply (drule domain_of_fun [symmetric, THEN trans], assumption, simp)
 done
 
 lemma restrict_cons_eq_restrict: 
      "\<lbrakk>restrict(h, domain(u))=u;  h \<in> n->X;  domain(u) \<subseteq> n\<rbrakk>   
       \<Longrightarrow> restrict(cons(\<langle>n, y\<rangle>, h), domain(u)) = u"
-apply (unfold restrict_def)
+  unfolding restrict_def
 apply (simp add: restrict_def Pi_iff)
 apply (erule sym [THEN trans, symmetric])
 apply (blast elim: mem_irrefl)  
 done
 
 lemma all_in_image_restrict_eq:
      "\<lbrakk>\<forall>x \<in> f``n. restrict(f`n, domain(x))=x;   
          f \<in> nat -> XX;   
          n \<in> nat;  domain(f`n) = succ(n);   
          (\<Union>x \<in> f``n. domain(x)) \<subseteq> n\<rbrakk>  
       \<Longrightarrow> \<forall>x \<in> f``succ(n). restrict(cons(<succ(n),y>, f`n), domain(x)) = x"
 apply (rule ballI)
 apply (simp add: image_fun_succ)
 apply (drule f_n_type, assumption+)
 apply (erule disjE)
  apply (simp add: domain_of_fun restrict_cons_eq) 
 apply (blast intro!: restrict_cons_eq_restrict)
 done
 
 lemma simplify_recursion: 
      "\<lbrakk>\<forall>b<nat. <f``b, f`b> \<in> RR;   
          f \<in> nat -> XX; range(R) \<subseteq> domain(R); x \<in> domain(R)\<rbrakk>    
       \<Longrightarrow> allRR"
 apply (unfold RR_def allRR_def)
 apply (rule oallI, drule ltD)
 apply (erule nat_induct)
 apply (drule_tac x=0 in ospec, blast intro: Limit_has_0) 
 apply (force simp add: singleton_fun [THEN domain_of_fun] singleton_in_funs) 
 (*induction step*) (** LEVEL 5 **)
 (*prevent simplification of \<not>\<exists> to \<forall>\<not> *)
 apply (simp only: separation split)
 apply (drule_tac x="succ(xa)" in ospec, blast intro: ltI)
 apply (elim conjE disjE)
 apply (force elim!: trans subst_context
              intro!: UN_image_succ_eq_succ)
 apply (erule notE)
 apply (simp add: XX_def UN_image_succ_eq_succ)
 apply (elim conjE bexE)
 apply (drule apply_domain_type, assumption+)
 apply (erule domainE)+
 apply (frule f_n_type)
 apply (simp add: XX_def, assumption+)
 apply (rule rev_bexI, erule nat_succI)
 apply (rename_tac m i j y z) 
 apply (rule_tac x = "cons(<succ(m), z>, f`m)" in bexI)
 prefer 2 apply (blast intro: cons_fun_type2) 
 apply (rule conjI)
 prefer 2 apply (fast del: ballI subsetI
                  elim: trans [OF _ subst_context, THEN domain_cons_eq_succ]
                        subst_context
                        all_in_image_restrict_eq [simplified XX_def]
                        trans equalityD1)
 (*one remaining subgoal*)
 apply (rule ballI)
 apply (erule succE)
 (** LEVEL 25 **)
  apply (simp add: cons_val_n cons_val_k)
 (*assumption+ will not perform the required backtracking!*)
 apply (drule f_n_pairs_in_R [simplified XX_def, OF _ domain_of_fun], 
        assumption, assumption, assumption)
 apply (simp add: nat_into_Ord [THEN succ_in_succ] succI2 cons_val_k)
 done
 
 
 lemma lemma2: 
      "\<lbrakk>allRR; f \<in> nat->XX; range(R) \<subseteq> domain(R); x \<in> domain(R); n \<in> nat\<rbrakk>
       \<Longrightarrow> f`n \<in> succ(n) -> domain(R) \<and> (\<forall>i \<in> n. <f`n`i, f`n`succ(i)>:R)"
-apply (unfold allRR_def)
+  unfolding allRR_def
 apply (drule ospec)
 apply (erule ltI [OF _ Ord_nat])
 apply (erule CollectE, simp)
 apply (rule conjI)
 prefer 2 apply (fast elim!: f_n_pairs_in_R trans subst_context)
-apply (unfold XX_def)
+  unfolding XX_def
 apply (fast elim!: trans [THEN domain_eq_imp_fun_type] subst_context)
 done
 
 lemma lemma3:
      "\<lbrakk>allRR; f \<in> nat->XX; n\<in>nat; range(R) \<subseteq> domain(R);  x \<in> domain(R)\<rbrakk>
       \<Longrightarrow> f`n`n = f`succ(n)`n"
 apply (frule lemma2 [THEN conjunct1, THEN domain_of_fun], assumption+)
-apply (unfold allRR_def)
+  unfolding allRR_def
 apply (drule ospec) 
 apply (drule ltI [OF nat_succI Ord_nat], assumption, simp)
 apply (elim conjE ballE)
 apply (erule restrict_eq_imp_val_eq [symmetric], force) 
 apply (simp add: image_fun OrdmemD) 
 done
 
 end
 
 
 theorem DC_nat_imp_DC0: "DC(nat) \<Longrightarrow> DC0"
 apply (unfold DC_def DC0_def)
 apply (intro allI impI)
 apply (erule asm_rl conjE ex_in_domain [THEN exE] allE)+
 apply (erule impE [OF _ imp_DC0.lemma4], assumption+)
 apply (erule bexE)
 apply (drule imp_DC0.simplify_recursion, assumption+)
 apply (rule_tac x = "\<lambda>n \<in> nat. f`n`n" in bexI)
 apply (rule_tac [2] lam_type)
 apply (erule_tac [2] apply_type [OF imp_DC0.lemma2 [THEN conjunct1] succI1])
 apply (rule ballI)
 apply (frule_tac n="succ(n)" in imp_DC0.lemma2, 
        (assumption|erule nat_succI)+)
 apply (drule imp_DC0.lemma3, auto)
 done
 
 (* ********************************************************************** *)
 (* \<forall>K. Card(K) \<longrightarrow> DC(K) \<Longrightarrow> WO3                                       *)
 (* ********************************************************************** *)
 
 lemma fun_Ord_inj:
       "\<lbrakk>f \<in> a->X;  Ord(a); 
           \<And>b c. \<lbrakk>b<c; c \<in> a\<rbrakk> \<Longrightarrow> f`b\<noteq>f`c\<rbrakk>    
        \<Longrightarrow> f \<in> inj(a, X)"
 apply (unfold inj_def, simp) 
 apply (intro ballI impI)
 apply (rule_tac j=x in Ord_in_Ord [THEN Ord_linear_lt], assumption+)
 apply (blast intro: Ord_in_Ord, auto) 
 apply (atomize, blast dest: not_sym) 
 done
 
 lemma value_in_image: "\<lbrakk>f \<in> X->Y; A \<subseteq> X; a \<in> A\<rbrakk> \<Longrightarrow> f`a \<in> f``A"
 by (fast elim!: image_fun [THEN ssubst])
 
 lemma lesspoll_lemma: "\<lbrakk>\<not> A \<prec> B; C \<prec> B\<rbrakk> \<Longrightarrow> A - C \<noteq> 0"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (fast dest!: Diff_eq_0_iff [THEN iffD1, THEN subset_imp_lepoll]
             intro!: eqpollI elim: notE
             elim!: eqpollE lepoll_trans)
 done
 
 theorem DC_WO3: "(\<forall>K. Card(K) \<longrightarrow> DC(K)) \<Longrightarrow> WO3"
 apply (unfold DC_def WO3_def)
 apply (rule allI)
 apply (case_tac "A \<prec> Hartog (A)")
 apply (fast dest!: lesspoll_imp_ex_lt_eqpoll 
             intro!: Ord_Hartog leI [THEN le_imp_subset])
 apply (erule allE impE)+
 apply (rule Card_Hartog)
 apply (erule_tac x = A in allE)
 apply (erule_tac x = "{\<langle>z1,z2\<rangle> \<in> Pow (A) *A . z1 \<prec> Hartog (A) \<and> z2 \<notin> z1}" 
                  in allE)
 apply simp
 apply (erule impE, fast elim: lesspoll_lemma [THEN not_emptyE])
 apply (erule bexE)
 apply (rule Hartog_lepoll_selfE) 
 apply (rule lepoll_def [THEN def_imp_iff, THEN iffD2])
 apply (rule exI, rule fun_Ord_inj, assumption, rule Ord_Hartog)
 apply (drule value_in_image) 
 apply (drule OrdmemD, rule Ord_Hartog, assumption+, erule ltD) 
 apply (drule ospec)
 apply (blast intro: ltI Ord_Hartog, force) 
 done
 
 (* ********************************************************************** *)
 (* WO1 \<Longrightarrow> \<forall>K. Card(K) \<longrightarrow> DC(K)                                       *)
 (* ********************************************************************** *)
 
 lemma images_eq:
      "\<lbrakk>\<forall>x \<in> A. f`x=g`x; f \<in> Df->Cf; g \<in> Dg->Cg; A \<subseteq> Df; A \<subseteq> Dg\<rbrakk> 
       \<Longrightarrow> f``A = g``A"
 apply (simp (no_asm_simp) add: image_fun)
 done
 
 lemma lam_images_eq:
      "\<lbrakk>Ord(a); b \<in> a\<rbrakk> \<Longrightarrow> (\<lambda>x \<in> a. h(x))``b = (\<lambda>x \<in> b. h(x))``b"
 apply (rule images_eq)
     apply (rule ballI)
     apply (drule OrdmemD [THEN subsetD], assumption+)
     apply simp
    apply (fast elim!: RepFunI OrdmemD intro!: lam_type)+
 done
 
 lemma lam_type_RepFun: "(\<lambda>b \<in> a. h(b)) \<in> a -> {h(b). b \<in> a}"
 by (fast intro!: lam_type RepFunI)
 
 lemma lemmaX:
      "\<lbrakk>\<forall>Y \<in> Pow(X). Y \<prec> K \<longrightarrow> (\<exists>x \<in> X. \<langle>Y, x\<rangle> \<in> R);   
          b \<in> K; Z \<in> Pow(X); Z \<prec> K\<rbrakk>   
       \<Longrightarrow> {x \<in> X. \<langle>Z,x\<rangle> \<in> R} \<noteq> 0"
 by blast
 
 
 lemma WO1_DC_lemma:
      "\<lbrakk>Card(K); well_ord(X,Q);   
          \<forall>Y \<in> Pow(X). Y \<prec> K \<longrightarrow> (\<exists>x \<in> X. \<langle>Y, x\<rangle> \<in> R); b \<in> K\<rbrakk>   
       \<Longrightarrow> ff(b, X, Q, R) \<in> {x \<in> X. <(\<lambda>c \<in> b. ff(c, X, Q, R))``b, x> \<in> R}"
 apply (rule_tac P = "b \<in> K" in impE, (erule_tac [2] asm_rl)+)
 apply (rule_tac i=b in Card_is_Ord [THEN Ord_in_Ord, THEN trans_induct], 
        assumption+)
 apply (rule impI)
 apply (rule ff_def [THEN def_transrec, THEN ssubst])
 apply (erule the_first_in, fast)
 apply (simp add: image_fun [OF lam_type_RepFun subset_refl])
 apply (erule lemmaX, assumption)
  apply (blast intro: Card_is_Ord OrdmemD [THEN subsetD])
 apply (blast intro: lesspoll_trans1 in_Card_imp_lesspoll RepFun_lepoll)
 done
 
 theorem WO1_DC_Card: "WO1 \<Longrightarrow> \<forall>K. Card(K) \<longrightarrow> DC(K)"
 apply (unfold DC_def WO1_def)
 apply (rule allI impI)+
 apply (erule allE exE conjE)+
 apply (rule_tac x = "\<lambda>b \<in> K. ff (b, X, Ra, R) " in bexI)
  apply (simp add: lam_images_eq [OF Card_is_Ord ltD])
  apply (fast elim!: ltE WO1_DC_lemma [THEN CollectD2])
 apply (rule_tac lam_type)
 apply (rule WO1_DC_lemma [THEN CollectD1], assumption+)
 done
 
 end
diff --git a/src/ZF/AC/HH.thy b/src/ZF/AC/HH.thy
--- a/src/ZF/AC/HH.thy
+++ b/src/ZF/AC/HH.thy
@@ -1,245 +1,245 @@
 (*  Title:      ZF/AC/HH.thy
     Author:     Krzysztof Grabczewski
 
 Some properties of the recursive definition of HH used in the proofs of
   AC17 \<Longrightarrow> AC1
   AC1 \<Longrightarrow> WO2
   AC15 \<Longrightarrow> WO6
 *)
 
 theory HH
 imports AC_Equiv Hartog
 begin
 
 definition
   HH :: "[i, i, i] \<Rightarrow> i"  where
     "HH(f,x,a) \<equiv> transrec(a, \<lambda>b r. let z = x - (\<Union>c \<in> b. r`c)
                                     in  if f`z \<in> Pow(z)-{0} then f`z else {x})"
 
 subsection\<open>Lemmas useful in each of the three proofs\<close>
 
 lemma HH_def_satisfies_eq:
      "HH(f,x,a) = (let z = x - (\<Union>b \<in> a. HH(f,x,b))   
                    in  if f`z \<in> Pow(z)-{0} then f`z else {x})"
 by (rule HH_def [THEN def_transrec, THEN trans], simp)
 
 lemma HH_values: "HH(f,x,a) \<in> Pow(x)-{0} | HH(f,x,a)={x}"
 apply (rule HH_def_satisfies_eq [THEN ssubst])
 apply (simp add: Let_def Diff_subset [THEN PowI], fast)
 done
 
 lemma subset_imp_Diff_eq:
      "B \<subseteq> A \<Longrightarrow> X-(\<Union>a \<in> A. P(a)) = X-(\<Union>a \<in> A-B. P(a))-(\<Union>b \<in> B. P(b))"
 by fast
 
 lemma Ord_DiffE: "\<lbrakk>c \<in> a-b; b<a\<rbrakk> \<Longrightarrow> c=b | b<c \<and> c<a"
 apply (erule ltE)
 apply (drule Ord_linear [of _ c])
 apply (fast elim: Ord_in_Ord)
 apply (fast intro!: ltI intro: Ord_in_Ord)
 done
 
 lemma Diff_UN_eq_self: "(\<And>y. y\<in>A \<Longrightarrow> P(y) = {x}) \<Longrightarrow> x - (\<Union>y \<in> A. P(y)) = x" 
 by (simp, fast elim!: mem_irrefl)
 
 lemma HH_eq: "x - (\<Union>b \<in> a. HH(f,x,b)) = x - (\<Union>b \<in> a1. HH(f,x,b))   
               \<Longrightarrow> HH(f,x,a) = HH(f,x,a1)"
 apply (subst HH_def_satisfies_eq [of _ _ a1]) 
 apply (rule HH_def_satisfies_eq [THEN trans], simp) 
 done
 
 lemma HH_is_x_gt_too: "\<lbrakk>HH(f,x,b)={x}; b<a\<rbrakk> \<Longrightarrow> HH(f,x,a)={x}"
 apply (rule_tac P = "b<a" in impE)
 prefer 2 apply assumption+
 apply (erule lt_Ord2 [THEN trans_induct])
 apply (rule impI)
 apply (rule HH_eq [THEN trans])
 prefer 2 apply assumption+
 apply (rule leI [THEN le_imp_subset, THEN subset_imp_Diff_eq, THEN ssubst], 
        assumption)
 apply (rule_tac t = "\<lambda>z. z-X" for X in subst_context)
 apply (rule Diff_UN_eq_self)
 apply (drule Ord_DiffE, assumption) 
 apply (fast elim: ltE, auto) 
 done
 
 lemma HH_subset_x_lt_too:
      "\<lbrakk>HH(f,x,a) \<in> Pow(x)-{0}; b<a\<rbrakk> \<Longrightarrow> HH(f,x,b) \<in> Pow(x)-{0}"
 apply (rule HH_values [THEN disjE], assumption)
 apply (drule HH_is_x_gt_too, assumption)
 apply (drule subst, assumption)
 apply (fast elim!: mem_irrefl)
 done
 
 lemma HH_subset_x_imp_subset_Diff_UN:
     "HH(f,x,a) \<in> Pow(x)-{0} \<Longrightarrow> HH(f,x,a) \<in> Pow(x - (\<Union>b \<in> a. HH(f,x,b)))-{0}"
 apply (drule HH_def_satisfies_eq [THEN subst])
 apply (rule HH_def_satisfies_eq [THEN ssubst])
 apply (simp add: Let_def Diff_subset [THEN PowI])
 apply (drule split_if [THEN iffD1])
 apply (fast elim!: mem_irrefl)
 done
 
 lemma HH_eq_arg_lt:
      "\<lbrakk>HH(f,x,v)=HH(f,x,w); HH(f,x,v) \<in> Pow(x)-{0}; v \<in> w\<rbrakk> \<Longrightarrow> P"
 apply (frule_tac P = "\<lambda>y. y \<in> Pow (x) -{0}" in subst, assumption)
 apply (drule_tac a = w in HH_subset_x_imp_subset_Diff_UN)
 apply (drule subst_elem, assumption)
 apply (fast intro!: singleton_iff [THEN iffD2] equals0I)
 done
 
 lemma HH_eq_imp_arg_eq:
   "\<lbrakk>HH(f,x,v)=HH(f,x,w); HH(f,x,w) \<in> Pow(x)-{0}; Ord(v); Ord(w)\<rbrakk> \<Longrightarrow> v=w"
 apply (rule_tac j = w in Ord_linear_lt)
 apply (simp_all (no_asm_simp))
  apply (drule subst_elem, assumption) 
  apply (blast dest: ltD HH_eq_arg_lt)
 apply (blast dest: HH_eq_arg_lt [OF sym] ltD) 
 done
 
 lemma HH_subset_x_imp_lepoll: 
      "\<lbrakk>HH(f, x, i) \<in> Pow(x)-{0}; Ord(i)\<rbrakk> \<Longrightarrow> i \<lesssim> Pow(x)-{0}"
 apply (unfold lepoll_def inj_def)
 apply (rule_tac x = "\<lambda>j \<in> i. HH (f, x, j) " in exI)
 apply (simp (no_asm_simp))
 apply (fast del: DiffE
             elim!: HH_eq_imp_arg_eq Ord_in_Ord HH_subset_x_lt_too 
             intro!: lam_type ballI ltI intro: bexI)
 done
 
 lemma HH_Hartog_is_x: "HH(f, x, Hartog(Pow(x)-{0})) = {x}"
 apply (rule HH_values [THEN disjE])
 prefer 2 apply assumption 
 apply (fast del: DiffE
             intro!: Ord_Hartog 
             dest!: HH_subset_x_imp_lepoll 
             elim!: Hartog_lepoll_selfE)
 done
 
 lemma HH_Least_eq_x: "HH(f, x, \<mu> i. HH(f, x, i) = {x}) = {x}"
 by (fast intro!: Ord_Hartog HH_Hartog_is_x LeastI)
 
 lemma less_Least_subset_x:
      "a \<in> (\<mu> i. HH(f,x,i)={x}) \<Longrightarrow> HH(f,x,a) \<in> Pow(x)-{0}"
 apply (rule HH_values [THEN disjE], assumption)
 apply (rule less_LeastE)
 apply (erule_tac [2] ltI [OF _ Ord_Least], assumption)
 done
 
 subsection\<open>Lemmas used in the proofs of AC1 \<Longrightarrow> WO2 and AC17 \<Longrightarrow> AC1\<close>
 
 lemma lam_Least_HH_inj_Pow: 
         "(\<lambda>a \<in> (\<mu> i. HH(f,x,i)={x}). HH(f,x,a))   
          \<in> inj(\<mu> i. HH(f,x,i)={x}, Pow(x)-{0})"
 apply (unfold inj_def, simp)
 apply (fast intro!: lam_type dest: less_Least_subset_x 
             elim!: HH_eq_imp_arg_eq Ord_Least [THEN Ord_in_Ord])
 done
 
 lemma lam_Least_HH_inj:
      "\<forall>a \<in> (\<mu> i. HH(f,x,i)={x}). \<exists>z \<in> x. HH(f,x,a) = {z}   
       \<Longrightarrow> (\<lambda>a \<in> (\<mu> i. HH(f,x,i)={x}). HH(f,x,a))   
           \<in> inj(\<mu> i. HH(f,x,i)={x}, {{y}. y \<in> x})"
 by (rule lam_Least_HH_inj_Pow [THEN inj_strengthen_type], simp)
 
 lemma lam_surj_sing: 
         "\<lbrakk>x - (\<Union>a \<in> A. F(a)) = 0;  \<forall>a \<in> A. \<exists>z \<in> x. F(a) = {z}\<rbrakk>   
          \<Longrightarrow> (\<lambda>a \<in> A. F(a)) \<in> surj(A, {{y}. y \<in> x})"
 apply (simp add: surj_def lam_type Diff_eq_0_iff)
 apply (blast elim: equalityE) 
 done
 
 lemma not_emptyI2: "y \<in> Pow(x)-{0} \<Longrightarrow> x \<noteq> 0"
 by auto
 
 lemma f_subset_imp_HH_subset:
      "f`(x - (\<Union>j \<in> i. HH(f,x,j))) \<in> Pow(x - (\<Union>j \<in> i. HH(f,x,j)))-{0}   
       \<Longrightarrow> HH(f, x, i) \<in> Pow(x) - {0}"
 apply (rule HH_def_satisfies_eq [THEN ssubst])
 apply (simp add: Let_def Diff_subset [THEN PowI] not_emptyI2 [THEN if_P], fast)
 done
 
 lemma f_subsets_imp_UN_HH_eq_x:
      "\<forall>z \<in> Pow(x)-{0}. f`z \<in> Pow(z)-{0}
       \<Longrightarrow> x - (\<Union>j \<in> (\<mu> i. HH(f,x,i)={x}). HH(f,x,j)) = 0"
 apply (case_tac "P \<in> {0}" for P, fast)
 apply (drule Diff_subset [THEN PowI, THEN DiffI])
 apply (drule bspec, assumption) 
 apply (drule f_subset_imp_HH_subset) 
 apply (blast dest!: subst_elem [OF _ HH_Least_eq_x [symmetric]] 
              elim!: mem_irrefl)
 done
 
 lemma HH_values2: "HH(f,x,i) = f`(x - (\<Union>j \<in> i. HH(f,x,j))) | HH(f,x,i)={x}"
 apply (rule HH_def_satisfies_eq [THEN ssubst])
 apply (simp add: Let_def Diff_subset [THEN PowI])
 done
 
 lemma HH_subset_imp_eq:
      "HH(f,x,i): Pow(x)-{0} \<Longrightarrow> HH(f,x,i)=f`(x - (\<Union>j \<in> i. HH(f,x,j)))"
 apply (rule HH_values2 [THEN disjE], assumption)
 apply (fast elim!: equalityE mem_irrefl dest!: singleton_subsetD)
 done
 
 lemma f_sing_imp_HH_sing:
      "\<lbrakk>f \<in> (Pow(x)-{0}) -> {{z}. z \<in> x};   
          a \<in> (\<mu> i. HH(f,x,i)={x})\<rbrakk> \<Longrightarrow> \<exists>z \<in> x. HH(f,x,a) = {z}"
 apply (drule less_Least_subset_x)
 apply (frule HH_subset_imp_eq)
 apply (drule apply_type)
 apply (rule Diff_subset [THEN PowI, THEN DiffI])
 apply (fast dest!: HH_subset_x_imp_subset_Diff_UN [THEN not_emptyI2], force) 
 done
 
 lemma f_sing_lam_bij: 
      "\<lbrakk>x - (\<Union>j \<in> (\<mu> i. HH(f,x,i)={x}). HH(f,x,j)) = 0;   
          f \<in> (Pow(x)-{0}) -> {{z}. z \<in> x}\<rbrakk>   
       \<Longrightarrow> (\<lambda>a \<in> (\<mu> i. HH(f,x,i)={x}). HH(f,x,a))   
           \<in> bij(\<mu> i. HH(f,x,i)={x}, {{y}. y \<in> x})"
-apply (unfold bij_def)
+  unfolding bij_def
 apply (fast intro!: lam_Least_HH_inj lam_surj_sing f_sing_imp_HH_sing)
 done
 
 lemma lam_singI:
      "f \<in> (\<Prod>X \<in> Pow(x)-{0}. F(X))   
       \<Longrightarrow> (\<lambda>X \<in> Pow(x)-{0}. {f`X}) \<in> (\<Prod>X \<in> Pow(x)-{0}. {{z}. z \<in> F(X)})"
 by (fast del: DiffI DiffE
             intro!: lam_type singleton_eq_iff [THEN iffD2] dest: apply_type)
 
 (*FIXME: both uses have the form ...[THEN bij_converse_bij], so 
   simplification is needed!*)
 lemmas bij_Least_HH_x =  
     comp_bij [OF f_sing_lam_bij [OF _ lam_singI] 
               lam_sing_bij [THEN bij_converse_bij]]
 
 
 subsection\<open>The proof of AC1 \<Longrightarrow> WO2\<close>
 
 (*Establishing the existence of a bijection, namely
 converse
  (converse(\<lambda>x\<in>x. {x}) O
   Lambda
    (\<mu> i. HH(\<lambda>X\<in>Pow(x) - {0}. {f ` X}, x, i) = {x},
     HH(\<lambda>X\<in>Pow(x) - {0}. {f ` X}, x)))
 Perhaps it could be simplified. *)
 
 lemma bijection:
      "f \<in> (\<Prod>X \<in> Pow(x) - {0}. X) 
       \<Longrightarrow> \<exists>g. g \<in> bij(x, \<mu> i. HH(\<lambda>X \<in> Pow(x)-{0}. {f`X}, x, i) = {x})"
 apply (rule exI) 
 apply (rule bij_Least_HH_x [THEN bij_converse_bij])
 apply (rule f_subsets_imp_UN_HH_eq_x)
 apply (intro ballI apply_type) 
 apply (fast intro: lam_type apply_type del: DiffE, assumption) 
 apply (fast intro: Pi_weaken_type)
 done
 
 lemma AC1_WO2: "AC1 \<Longrightarrow> WO2"
 apply (unfold AC1_def WO2_def eqpoll_def)
 apply (intro allI) 
 apply (drule_tac x = "Pow(A) - {0}" in spec) 
 apply (blast dest: bijection)
 done
 
 end
 
diff --git a/src/ZF/AC/Hartog.thy b/src/ZF/AC/Hartog.thy
--- a/src/ZF/AC/Hartog.thy
+++ b/src/ZF/AC/Hartog.thy
@@ -1,83 +1,83 @@
 (*  Title:      ZF/AC/Hartog.thy
     Author:     Krzysztof Grabczewski
 
 Hartog's function.
 *)
 
 theory Hartog
 imports AC_Equiv
 begin
 
 definition
   Hartog :: "i \<Rightarrow> i"  where
    "Hartog(X) \<equiv> \<mu> i. \<not> i \<lesssim> X"
 
 lemma Ords_in_set: "\<forall>a. Ord(a) \<longrightarrow> a \<in> X \<Longrightarrow> P"
 apply (rule_tac X = "{y \<in> X. Ord (y) }" in ON_class [elim_format])
 apply fast
 done
 
 lemma Ord_lepoll_imp_ex_well_ord:
      "\<lbrakk>Ord(a); a \<lesssim> X\<rbrakk> 
       \<Longrightarrow> \<exists>Y. Y \<subseteq> X \<and> (\<exists>R. well_ord(Y,R) \<and> ordertype(Y,R)=a)"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (erule exE)
 apply (intro exI conjI)
   apply (erule inj_is_fun [THEN fun_is_rel, THEN image_subset])
  apply (rule well_ord_rvimage [OF bij_is_inj well_ord_Memrel]) 
   apply (erule restrict_bij [THEN bij_converse_bij]) 
 apply (rule subset_refl, assumption) 
 apply (rule trans) 
 apply (rule bij_ordertype_vimage) 
 apply (erule restrict_bij [THEN bij_converse_bij]) 
 apply (rule subset_refl) 
 apply (erule well_ord_Memrel) 
 apply (erule ordertype_Memrel) 
 done
 
 lemma Ord_lepoll_imp_eq_ordertype:
      "\<lbrakk>Ord(a); a \<lesssim> X\<rbrakk> \<Longrightarrow> \<exists>Y. Y \<subseteq> X \<and> (\<exists>R. R \<subseteq> X*X \<and> ordertype(Y,R)=a)"
 apply (drule Ord_lepoll_imp_ex_well_ord, assumption, clarify)
 apply (intro exI conjI)
 apply (erule_tac [3] ordertype_Int, auto) 
 done
 
 lemma Ords_lepoll_set_lemma:
      "(\<forall>a. Ord(a) \<longrightarrow> a \<lesssim> X) \<Longrightarrow>   
        \<forall>a. Ord(a) \<longrightarrow>   
         a \<in> {b. Z \<in> Pow(X)*Pow(X*X), \<exists>Y R. Z=\<langle>Y,R\<rangle> \<and> ordertype(Y,R)=b}"
 apply (intro allI impI)
 apply (elim allE impE, assumption)
 apply (blast dest!: Ord_lepoll_imp_eq_ordertype intro: sym) 
 done
 
 lemma Ords_lepoll_set: "\<forall>a. Ord(a) \<longrightarrow> a \<lesssim> X \<Longrightarrow> P"
 by (erule Ords_lepoll_set_lemma [THEN Ords_in_set])
 
 lemma ex_Ord_not_lepoll: "\<exists>a. Ord(a) \<and> \<not>a \<lesssim> X"
 apply (rule ccontr)
 apply (best intro: Ords_lepoll_set) 
 done
 
 lemma not_Hartog_lepoll_self: "\<not> Hartog(A) \<lesssim> A"
-apply (unfold Hartog_def)
+  unfolding Hartog_def
 apply (rule ex_Ord_not_lepoll [THEN exE])
 apply (rule LeastI, auto) 
 done
 
 lemmas Hartog_lepoll_selfE = not_Hartog_lepoll_self [THEN notE]
 
 lemma Ord_Hartog: "Ord(Hartog(A))"
 by (unfold Hartog_def, rule Ord_Least)
 
 lemma less_HartogE1: "\<lbrakk>i < Hartog(A); \<not> i \<lesssim> A\<rbrakk> \<Longrightarrow> P"
 by (unfold Hartog_def, fast elim: less_LeastE)
 
 lemma less_HartogE: "\<lbrakk>i < Hartog(A); i \<approx> Hartog(A)\<rbrakk> \<Longrightarrow> P"
 by (blast intro: less_HartogE1 eqpoll_sym eqpoll_imp_lepoll 
                  lepoll_trans [THEN Hartog_lepoll_selfE])
 
 lemma Card_Hartog: "Card(Hartog(A))"
 by (fast intro!: CardI Ord_Hartog elim: less_HartogE)
 
 end
diff --git a/src/ZF/AC/WO1_AC.thy b/src/ZF/AC/WO1_AC.thy
--- a/src/ZF/AC/WO1_AC.thy
+++ b/src/ZF/AC/WO1_AC.thy
@@ -1,106 +1,106 @@
 (*  Title:      ZF/AC/WO1_AC.thy
     Author:     Krzysztof Grabczewski
 
 The proofs of WO1 \<Longrightarrow> AC1 and WO1 \<Longrightarrow> AC10(n) for n >= 1
 
 The latter proof is referred to as clear by the Rubins.
 However it seems to be quite complicated.
 The formal proof presented below is a mechanisation of the proof 
 by Lawrence C. Paulson which is the following:
 
 Assume WO1.  Let s be a set of infinite sets.
  
 Suppose x \<in> s.  Then x is equipollent to |x| (by WO1), an infinite cardinal
 call it K.  Since K = K \<oplus> K = |K+K| (by InfCard_cdouble_eq) there is an 
 isomorphism h \<in> bij(K+K, x).  (Here + means disjoint sum.)
  
 So there is a partition of x into 2-element sets, namely
  
         {{h(Inl(i)), h(Inr(i))} . i \<in> K}
  
 So for all x \<in> s the desired partition exists.  By AC1 (which follows from WO1) 
 there exists a function f that chooses a partition for each x \<in> s.  Therefore we 
 have AC10(2).
 
 *)
 
 theory WO1_AC
 imports AC_Equiv
 begin
 
 (* ********************************************************************** *)
 (* WO1 \<Longrightarrow> AC1                                                            *)
 (* ********************************************************************** *)
 
 theorem WO1_AC1: "WO1 \<Longrightarrow> AC1"
 by (unfold AC1_def WO1_def, fast elim!: ex_choice_fun)
 
 (* ********************************************************************** *)
 (* WO1 \<Longrightarrow> AC10(n) (n >= 1)                                               *)
 (* ********************************************************************** *)
 
 lemma lemma1: "\<lbrakk>WO1; \<forall>B \<in> A. \<exists>C \<in> D(B). P(C,B)\<rbrakk> \<Longrightarrow> \<exists>f. \<forall>B \<in> A. P(f`B,B)"
-apply (unfold WO1_def)
+  unfolding WO1_def
 apply (erule_tac x = "\<Union>({{C \<in> D (B) . P (C,B) }. B \<in> A}) " in allE)
 apply (erule exE, drule ex_choice_fun, fast)
 apply (erule exE)
 apply (rule_tac x = "\<lambda>x \<in> A. f`{C \<in> D (x) . P (C,x) }" in exI)
 apply (simp, blast dest!: apply_type [OF _ RepFunI])
 done
 
 lemma lemma2_1: "\<lbrakk>\<not>Finite(B); WO1\<rbrakk> \<Longrightarrow> |B| + |B| \<approx>  B"
-apply (unfold WO1_def)
+  unfolding WO1_def
 apply (rule eqpoll_trans)
 prefer 2 apply (fast elim!: well_ord_cardinal_eqpoll)
 apply (rule eqpoll_sym [THEN eqpoll_trans])
 apply (fast elim!: well_ord_cardinal_eqpoll)
 apply (drule spec [of _ B]) 
 apply (clarify dest!: eqpoll_imp_Finite_iff [OF well_ord_cardinal_eqpoll]) 
 apply (simp add: cadd_def [symmetric] 
             eqpoll_refl InfCard_cdouble_eq Card_cardinal Inf_Card_is_InfCard) 
 done
 
 lemma lemma2_2:
      "f \<in> bij(D+D, B) \<Longrightarrow> {{f`Inl(i), f`Inr(i)}. i \<in> D} \<in> Pow(Pow(B))"
 by (fast elim!: bij_is_fun [THEN apply_type])
 
 
 lemma lemma2_3: 
         "f \<in> bij(D+D, B) \<Longrightarrow> pairwise_disjoint({{f`Inl(i), f`Inr(i)}. i \<in> D})"
-apply (unfold pairwise_disjoint_def)
+  unfolding pairwise_disjoint_def
 apply (blast dest: bij_is_inj [THEN inj_apply_equality])
 done
 
 lemma lemma2_4:
      "\<lbrakk>f \<in> bij(D+D, B); 1\<le>n\<rbrakk> 
       \<Longrightarrow> sets_of_size_between({{f`Inl(i), f`Inr(i)}. i \<in> D}, 2, succ(n))"
 apply (simp (no_asm_simp) add: sets_of_size_between_def succ_def)
 apply (blast intro!: cons_lepoll_cong 
             intro: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll]  
                    le_imp_subset [THEN subset_imp_lepoll]  lepoll_trans 
             dest: bij_is_inj [THEN inj_apply_equality] elim!: mem_irrefl)
 done
 
 lemma lemma2_5: 
      "f \<in> bij(D+D, B) \<Longrightarrow> \<Union>({{f`Inl(i), f`Inr(i)}. i \<in> D})=B"
 apply (unfold bij_def surj_def)
 apply (fast elim!: inj_is_fun [THEN apply_type])
 done
 
 lemma lemma2:
      "\<lbrakk>WO1; \<not>Finite(B); 1\<le>n\<rbrakk>   
       \<Longrightarrow> \<exists>C \<in> Pow(Pow(B)). pairwise_disjoint(C) \<and>   
                 sets_of_size_between(C, 2, succ(n)) \<and>   
                 \<Union>(C)=B"
 apply (drule lemma2_1 [THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]], 
        assumption)
 apply (blast intro!: lemma2_2 lemma2_3 lemma2_4 lemma2_5)
 done
 
 theorem WO1_AC10: "\<lbrakk>WO1; 1\<le>n\<rbrakk> \<Longrightarrow> AC10(n)"
-apply (unfold AC10_def)
+  unfolding AC10_def
 apply (fast intro!: lemma1 elim!: lemma2)
 done
 
 end
 
diff --git a/src/ZF/AC/WO1_WO7.thy b/src/ZF/AC/WO1_WO7.thy
--- a/src/ZF/AC/WO1_WO7.thy
+++ b/src/ZF/AC/WO1_WO7.thy
@@ -1,114 +1,114 @@
 (*  Title:      ZF/AC/WO1_WO7.thy
     Author:     Lawrence C Paulson, CU Computer Laboratory
     Copyright   1998  University of Cambridge
 
 WO7 \<longleftrightarrow> LEMMA \<longleftrightarrow> WO1 (Rubin \<and> Rubin p. 5)
 LEMMA is the sentence denoted by (**)
 
 Also, WO1 \<longleftrightarrow> WO8
 *)
 
 theory WO1_WO7
 imports AC_Equiv
 begin
 
 definition
     "LEMMA \<equiv>
      \<forall>X. \<not>Finite(X) \<longrightarrow> (\<exists>R. well_ord(X,R) \<and> \<not>well_ord(X,converse(R)))"
 
 (* ********************************************************************** *)
 (* It is easy to see that WO7 is equivalent to (**)                       *)
 (* ********************************************************************** *)
 
 lemma WO7_iff_LEMMA: "WO7 \<longleftrightarrow> LEMMA"
 apply (unfold WO7_def LEMMA_def)
 apply (blast intro: Finite_well_ord_converse)
 done
 
 (* ********************************************************************** *)
 (* It is also easy to show that LEMMA implies WO1.                        *)
 (* ********************************************************************** *)
 
 lemma LEMMA_imp_WO1: "LEMMA \<Longrightarrow> WO1"
 apply (unfold WO1_def LEMMA_def Finite_def eqpoll_def)
 apply (blast intro!: well_ord_rvimage [OF bij_is_inj nat_implies_well_ord])
 done
 
 (* ********************************************************************** *)
 (* The Rubins' proof of the other implication is contained within the     *)
 (* following sentence \<in>                                                   *)
 (* "... each infinite ordinal is well ordered by < but not by >."         *)
 (* This statement can be proved by the following two theorems.            *)
 (* But moreover we need to show similar property for any well ordered     *)
 (* infinite set. It is not very difficult thanks to Isabelle order types  *)
 (* We show that if a set is well ordered by some relation and by its     *)
 (* converse, then apropriate order type is well ordered by the converse   *)
 (* of it's membership relation, which in connection with the previous     *)
 (* gives the conclusion.                                                  *)
 (* ********************************************************************** *)
 
 lemma converse_Memrel_not_wf_on: 
     "\<lbrakk>Ord(a); \<not>Finite(a)\<rbrakk> \<Longrightarrow> \<not>wf[a](converse(Memrel(a)))"
 apply (unfold wf_on_def wf_def)
 apply (drule nat_le_infinite_Ord [THEN le_imp_subset], assumption)
 apply (rule notI)
 apply (erule_tac x = nat in allE, blast)
 done
 
 lemma converse_Memrel_not_well_ord: 
     "\<lbrakk>Ord(a); \<not>Finite(a)\<rbrakk> \<Longrightarrow> \<not>well_ord(a,converse(Memrel(a)))"
-apply (unfold well_ord_def)
+  unfolding well_ord_def
 apply (blast dest: converse_Memrel_not_wf_on)
 done
 
 lemma well_ord_rvimage_ordertype:
      "well_ord(A,r) \<Longrightarrow>
        rvimage (ordertype(A,r), converse(ordermap(A,r)),r) =
        Memrel(ordertype(A,r))" 
 by (blast intro: ordertype_ord_iso [THEN ord_iso_sym] ord_iso_rvimage_eq
              Memrel_type [THEN subset_Int_iff [THEN iffD1]] trans)
 
 lemma well_ord_converse_Memrel:
      "\<lbrakk>well_ord(A,r); well_ord(A,converse(r))\<rbrakk>   
       \<Longrightarrow> well_ord(ordertype(A,r), converse(Memrel(ordertype(A,r))))" 
 apply (subst well_ord_rvimage_ordertype [symmetric], assumption) 
 apply (rule rvimage_converse [THEN subst])
 apply (blast intro: ordertype_ord_iso ord_iso_sym ord_iso_is_bij
                     bij_is_inj well_ord_rvimage)
 done
 
 lemma WO1_imp_LEMMA: "WO1 \<Longrightarrow> LEMMA"
 apply (unfold WO1_def LEMMA_def, clarify) 
 apply (blast dest: well_ord_converse_Memrel
                    Ord_ordertype [THEN converse_Memrel_not_well_ord]
              intro: ordertype_ord_iso ord_iso_is_bij bij_is_inj lepoll_Finite
                     lepoll_def [THEN def_imp_iff, THEN iffD2] )
 done
 
 lemma WO1_iff_WO7: "WO1 \<longleftrightarrow> WO7"
 apply (simp add: WO7_iff_LEMMA)
 apply (blast intro: LEMMA_imp_WO1 WO1_imp_LEMMA)
 done
 
 
 
 (* ********************************************************************** *)
 (*            The proof of WO8 \<longleftrightarrow> WO1 (Rubin \<and> Rubin p. 6)               *)
 (* ********************************************************************** *)
 
 lemma WO1_WO8: "WO1 \<Longrightarrow> WO8"
 by (unfold WO1_def WO8_def, fast)
 
 
 (* The implication "WO8 \<Longrightarrow> WO1": a faithful image of Rubin \<and> Rubin's proof*)
 lemma WO8_WO1: "WO8 \<Longrightarrow> WO1"
 apply (unfold WO1_def WO8_def)
 apply (rule allI)
 apply (erule_tac x = "{{x}. x \<in> A}" in allE)
 apply (erule impE)
  apply (rule_tac x = "\<lambda>a \<in> {{x}. x \<in> A}. THE x. a={x}" in exI)
  apply (force intro!: lam_type simp add: singleton_eq_iff the_equality)
 apply (blast intro: lam_sing_bij bij_is_inj well_ord_rvimage)
 done
 
 end
diff --git a/src/ZF/AC/WO2_AC16.thy b/src/ZF/AC/WO2_AC16.thy
--- a/src/ZF/AC/WO2_AC16.thy
+++ b/src/ZF/AC/WO2_AC16.thy
@@ -1,579 +1,579 @@
 (*  Title:      ZF/AC/WO2_AC16.thy
     Author:     Krzysztof Grabczewski
 
 The proof of WO2 \<Longrightarrow> AC16(k #+ m, k)
   
 The main part of the proof is the inductive reasoning concerning
 properties of constructed family T_gamma.
 The proof deals with three cases for ordinals: 0, succ and limit ordinal.
 The first instance is trivial, the third not difficult, but the second
 is very complicated requiring many lemmas.
 We also need to prove that at any stage gamma the set 
 (s - \<Union>(...) - k_gamma)   (Rubin \<and> Rubin page 15)
 contains m distinct elements (in fact is equipollent to s)
 *)
 
 theory WO2_AC16 imports AC_Equiv AC16_lemmas Cardinal_aux begin
 
 (**** A recursive definition used in the proof of WO2 \<Longrightarrow> AC16 ****)
 
 definition
   recfunAC16 :: "[i,i,i,i] \<Rightarrow> i"  where
     "recfunAC16(f,h,i,a) \<equiv> 
          transrec2(i, 0, 
               \<lambda>g r. if (\<exists>y \<in> r. h`g \<subseteq> y) then r
                     else r \<union> {f`(\<mu> i. h`g \<subseteq> f`i \<and> 
                          (\<forall>b<a. (h`b \<subseteq> f`i \<longrightarrow> (\<forall>t \<in> r. \<not> h`b \<subseteq> t))))})"
 
 (* ********************************************************************** *)
 (* Basic properties of recfunAC16                                         *)
 (* ********************************************************************** *)
 
 lemma recfunAC16_0: "recfunAC16(f,h,0,a) = 0"
 by (simp add: recfunAC16_def)
 
 lemma recfunAC16_succ: 
      "recfunAC16(f,h,succ(i),a) =   
       (if (\<exists>y \<in> recfunAC16(f,h,i,a). h ` i \<subseteq> y) then recfunAC16(f,h,i,a)  
        else recfunAC16(f,h,i,a) \<union>  
             {f ` (\<mu> j. h ` i \<subseteq> f ` j \<and>   
              (\<forall>b<a. (h`b \<subseteq> f`j   
               \<longrightarrow> (\<forall>t \<in> recfunAC16(f,h,i,a). \<not> h`b \<subseteq> t))))})"
 apply (simp add: recfunAC16_def)
 done
 
 lemma recfunAC16_Limit: "Limit(i)   
         \<Longrightarrow> recfunAC16(f,h,i,a) = (\<Union>j<i. recfunAC16(f,h,j,a))"
 by (simp add: recfunAC16_def transrec2_Limit)
 
 (* ********************************************************************** *)
 (* Monotonicity of transrec2                                              *)
 (* ********************************************************************** *)
 
 lemma transrec2_mono_lemma [rule_format]:
      "\<lbrakk>\<And>g r. r \<subseteq> B(g,r);  Ord(i)\<rbrakk>   
       \<Longrightarrow> j<i \<longrightarrow> transrec2(j, 0, B) \<subseteq> transrec2(i, 0, B)"
 apply (erule trans_induct)
 apply (rule Ord_cases, assumption+, fast)
 apply (simp (no_asm_simp))
 apply (blast elim!: leE) 
 apply (simp add: transrec2_Limit) 
 apply (blast intro: OUN_I ltI Ord_in_Ord [THEN le_refl]
              elim!: Limit_has_succ [THEN ltE])
 done
 
 lemma transrec2_mono:
      "\<lbrakk>\<And>g r. r \<subseteq> B(g,r); j\<le>i\<rbrakk> 
       \<Longrightarrow> transrec2(j, 0, B) \<subseteq> transrec2(i, 0, B)"
 apply (erule leE)
 apply (rule transrec2_mono_lemma)
 apply (auto intro: lt_Ord2 ) 
 done
 
 (* ********************************************************************** *)
 (* Monotonicity of recfunAC16                                             *)
 (* ********************************************************************** *)
 
 lemma recfunAC16_mono: 
        "i\<le>j \<Longrightarrow> recfunAC16(f, g, i, a) \<subseteq> recfunAC16(f, g, j, a)"
-apply (unfold recfunAC16_def)
+  unfolding recfunAC16_def
 apply (rule transrec2_mono, auto) 
 done
 
 (* ********************************************************************** *)
 (* case of limit ordinal                                                  *)
 (* ********************************************************************** *)
 
 
 lemma lemma3_1:
     "\<lbrakk>\<forall>y<x. \<forall>z<a. z<y | (\<exists>Y \<in> F(y). f(z)<=Y) \<longrightarrow> (\<exists>! Y. Y \<in> F(y) \<and> f(z)<=Y);
         \<forall>i j. i\<le>j \<longrightarrow> F(i) \<subseteq> F(j); j\<le>i; i<x; z<a;
         V \<in> F(i); f(z)<=V; W \<in> F(j); f(z)<=W\<rbrakk>   
      \<Longrightarrow> V = W"
 apply (erule asm_rl allE impE)+
 apply (drule subsetD, assumption, blast) 
 done
 
 
 lemma lemma3:
     "\<lbrakk>\<forall>y<x. \<forall>z<a. z<y | (\<exists>Y \<in> F(y). f(z)<=Y) \<longrightarrow> (\<exists>! Y. Y \<in> F(y) \<and> f(z)<=Y);
         \<forall>i j. i\<le>j \<longrightarrow> F(i) \<subseteq> F(j); i<x; j<x; z<a;   
         V \<in> F(i); f(z)<=V; W \<in> F(j); f(z)<=W\<rbrakk>   
      \<Longrightarrow> V = W"
 apply (rule_tac j=j in Ord_linear_le [OF lt_Ord lt_Ord], assumption+)
 apply (erule lemma3_1 [symmetric], assumption+)
 apply (erule lemma3_1, assumption+)
 done
 
 lemma lemma4:
      "\<lbrakk>\<forall>y<x. F(y) \<subseteq> X \<and>   
                 (\<forall>x<a. x < y | (\<exists>Y \<in> F(y). h(x) \<subseteq> Y) \<longrightarrow>   
                  (\<exists>! Y. Y \<in> F(y) \<and> h(x) \<subseteq> Y)); 
          x < a\<rbrakk>   
       \<Longrightarrow> \<forall>y<x. \<forall>z<a. z < y | (\<exists>Y \<in> F(y). h(z) \<subseteq> Y) \<longrightarrow>   
                        (\<exists>! Y. Y \<in> F(y) \<and> h(z) \<subseteq> Y)"
 apply (intro oallI impI)
 apply (drule ospec, assumption, clarify)
 apply (blast elim!: oallE ) 
 done
 
 lemma lemma5:
      "\<lbrakk>\<forall>y<x. F(y) \<subseteq> X \<and>   
                (\<forall>x<a. x < y | (\<exists>Y \<in> F(y). h(x) \<subseteq> Y) \<longrightarrow>   
                 (\<exists>! Y. Y \<in> F(y) \<and> h(x) \<subseteq> Y));  
          x < a; Limit(x); \<forall>i j. i\<le>j \<longrightarrow> F(i) \<subseteq> F(j)\<rbrakk>   
       \<Longrightarrow> (\<Union>x<x. F(x)) \<subseteq> X \<and>   
           (\<forall>xa<a. xa < x | (\<exists>x \<in> \<Union>x<x. F(x). h(xa) \<subseteq> x)   
                 \<longrightarrow> (\<exists>! Y. Y \<in> (\<Union>x<x. F(x)) \<and> h(xa) \<subseteq> Y))"
 apply (rule conjI)
 apply (rule subsetI)
 apply (erule OUN_E)
 apply (drule ospec, assumption, fast)
 apply (drule lemma4, assumption)
 apply (rule oallI)
 apply (rule impI)
 apply (erule disjE)
 apply (frule ospec, erule Limit_has_succ, assumption) 
 apply (drule_tac A = a and x = xa in ospec, assumption)
 apply (erule impE, rule le_refl [THEN disjI1], erule lt_Ord) 
 apply (blast intro: lemma3 Limit_has_succ) 
 apply (blast intro: lemma3) 
 done
 
 (* ********************************************************************** *)
 (* case of successor ordinal                                              *)
 (* ********************************************************************** *)
 
 (*
   First quite complicated proof of the fact used in the recursive construction
   of the family T_gamma (WO2 \<Longrightarrow> AC16(k #+ m, k)) - the fact that at any stage
   gamma the set (s - \<Union>(...) - k_gamma) is equipollent to s
   (Rubin \<and> Rubin page 15).
 *)
 
 (* ********************************************************************** *)
 (* dbl_Diff_eqpoll_Card                                                   *)
 (* ********************************************************************** *)
 
 
 lemma dbl_Diff_eqpoll_Card:
       "\<lbrakk>A\<approx>a; Card(a); \<not>Finite(a); B\<prec>a; C\<prec>a\<rbrakk> \<Longrightarrow> A - B - C\<approx>a"
 by (blast intro: Diff_lesspoll_eqpoll_Card) 
 
 (* ********************************************************************** *)
 (* Case of finite ordinals                                                *)
 (* ********************************************************************** *)
 
 
 lemma Finite_lesspoll_infinite_Ord: 
       "\<lbrakk>Finite(X); \<not>Finite(a); Ord(a)\<rbrakk> \<Longrightarrow> X\<prec>a"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (rule conjI)
 apply (drule nat_le_infinite_Ord [THEN le_imp_lepoll], assumption)
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (blast intro: leI [THEN le_imp_subset, THEN subset_imp_lepoll]
                     ltI eqpoll_imp_lepoll lepoll_trans) 
 apply (blast intro: eqpoll_sym [THEN eqpoll_trans])
 done
 
 lemma Union_lesspoll:
      "\<lbrakk>\<forall>x \<in> X. x \<lesssim> n \<and> x \<subseteq> T; well_ord(T, R); X \<lesssim> b;   
          b<a; \<not>Finite(a); Card(a); n \<in> nat\<rbrakk>   
       \<Longrightarrow> \<Union>(X)\<prec>a"
 apply (case_tac "Finite (X)")
 apply (blast intro: Card_is_Ord Finite_lesspoll_infinite_Ord 
                     lepoll_nat_imp_Finite Finite_Union)
 apply (drule lepoll_imp_ex_le_eqpoll) 
 apply (erule lt_Ord) 
 apply (elim exE conjE)
 apply (frule eqpoll_imp_lepoll [THEN lepoll_infinite], assumption)
 apply (erule eqpoll_sym [THEN eqpoll_def [THEN def_imp_iff, THEN iffD1],
                          THEN exE])
 apply (frule bij_is_surj [THEN surj_image_eq])
 apply (drule image_fun [OF bij_is_fun subset_refl])
 apply (drule sym [THEN trans], assumption)
 apply (blast intro: lt_Ord UN_lepoll lt_Card_imp_lesspoll
                     lt_trans1 lesspoll_trans1)
 done
 
 (* ********************************************************************** *)
 (* recfunAC16_lepoll_index                                                *)
 (* ********************************************************************** *)
 
 lemma Un_sing_eq_cons: "A \<union> {a} = cons(a, A)"
 by fast
 
 lemma Un_lepoll_succ: "A \<lesssim> B \<Longrightarrow> A \<union> {a} \<lesssim> succ(B)"
 apply (simp add: Un_sing_eq_cons succ_def)
 apply (blast elim!: mem_irrefl intro: cons_lepoll_cong)
 done
 
 lemma Diff_UN_succ_empty: "Ord(a) \<Longrightarrow> F(a) - (\<Union>b<succ(a). F(b)) = 0"
 by (fast intro!: le_refl)
 
 lemma Diff_UN_succ_subset: "Ord(a) \<Longrightarrow> F(a) \<union> X - (\<Union>b<succ(a). F(b)) \<subseteq> X"
 by blast
 
 lemma recfunAC16_Diff_lepoll_1:
      "Ord(x) 
       \<Longrightarrow> recfunAC16(f, g, x, a) - (\<Union>i<x. recfunAC16(f, g, i, a)) \<lesssim> 1"
 apply (erule Ord_cases)
   apply (simp add: recfunAC16_0 empty_subsetI [THEN subset_imp_lepoll])
 (*Limit case*)
 prefer 2 apply (simp add: recfunAC16_Limit Diff_cancel 
                           empty_subsetI [THEN subset_imp_lepoll])
 (*succ case*)
 apply (simp add: recfunAC16_succ
                  Diff_UN_succ_empty [of _ "\<lambda>j. recfunAC16(f,g,j,a)"]
                  empty_subsetI [THEN subset_imp_lepoll])
 apply (best intro: Diff_UN_succ_subset [THEN subset_imp_lepoll]
                    singleton_eqpoll_1 [THEN eqpoll_imp_lepoll] lepoll_trans)
 done
 
 lemma in_Least_Diff:
      "\<lbrakk>z \<in> F(x); Ord(x)\<rbrakk>   
       \<Longrightarrow> z \<in> F(\<mu> i. z \<in> F(i)) - (\<Union>j<(\<mu> i. z \<in> F(i)). F(j))"
 by (fast elim: less_LeastE elim!: LeastI)
 
 lemma Least_eq_imp_ex:
      "\<lbrakk>(\<mu> i. w \<in> F(i)) = (\<mu> i. z \<in> F(i));   
          w \<in> (\<Union>i<a. F(i)); z \<in> (\<Union>i<a. F(i))\<rbrakk>   
       \<Longrightarrow> \<exists>b<a. w \<in> (F(b) - (\<Union>c<b. F(c))) \<and> z \<in> (F(b) - (\<Union>c<b. F(c)))"
 apply (elim OUN_E)
 apply (drule in_Least_Diff, erule lt_Ord) 
 apply (frule in_Least_Diff, erule lt_Ord) 
 apply (rule oexI, force) 
 apply (blast intro: lt_Ord Least_le [THEN lt_trans1]) 
 done
 
 
 lemma two_in_lepoll_1: "\<lbrakk>A \<lesssim> 1; a \<in> A; b \<in> A\<rbrakk> \<Longrightarrow> a=b"
 by (fast dest!: lepoll_1_is_sing)
 
 
 lemma UN_lepoll_index:
      "\<lbrakk>\<forall>i<a. F(i)-(\<Union>j<i. F(j)) \<lesssim> 1; Limit(a)\<rbrakk>   
       \<Longrightarrow> (\<Union>x<a. F(x)) \<lesssim> a"
 apply (rule lepoll_def [THEN def_imp_iff [THEN iffD2]])
 apply (rule_tac x = "\<lambda>z \<in> (\<Union>x<a. F (x)). \<mu> i. z \<in> F (i) " in exI)
-apply (unfold inj_def)
+  unfolding inj_def
 apply (rule CollectI)
 apply (rule lam_type)
 apply (erule OUN_E)
 apply (erule Least_in_Ord)
 apply (erule ltD)
 apply (erule lt_Ord2)
 apply (intro ballI)
 apply (simp (no_asm_simp))
 apply (rule impI)
 apply (drule Least_eq_imp_ex, assumption+)
 apply (fast elim!: two_in_lepoll_1)
 done
 
 
 lemma recfunAC16_lepoll_index: "Ord(y) \<Longrightarrow> recfunAC16(f, h, y, a) \<lesssim> y"
 apply (erule trans_induct3)
 (*0 case*)
 apply (simp (no_asm_simp) add: recfunAC16_0 lepoll_refl)
 (*succ case*)
 apply (simp (no_asm_simp) add: recfunAC16_succ)
 apply (blast dest!: succI1 [THEN rev_bspec] 
              intro: subset_succI [THEN subset_imp_lepoll] Un_lepoll_succ  
                     lepoll_trans)
 apply (simp (no_asm_simp) add: recfunAC16_Limit)
 apply (blast intro: lt_Ord [THEN recfunAC16_Diff_lepoll_1] UN_lepoll_index)
 done
 
 
 lemma Union_recfunAC16_lesspoll:
      "\<lbrakk>recfunAC16(f,g,y,a) \<subseteq> {X \<in> Pow(A). X\<approx>n};   
          A\<approx>a;  y<a;  \<not>Finite(a);  Card(a);  n \<in> nat\<rbrakk>   
       \<Longrightarrow> \<Union>(recfunAC16(f,g,y,a))\<prec>a"
 apply (erule eqpoll_def [THEN def_imp_iff, THEN iffD1, THEN exE])
 apply (rule_tac T=A in Union_lesspoll, simp_all)
 apply (blast intro!: eqpoll_imp_lepoll)
 apply (blast intro: bij_is_inj Card_is_Ord [THEN well_ord_Memrel]
                     well_ord_rvimage)
 apply (erule lt_Ord [THEN recfunAC16_lepoll_index])
 done
 
 lemma dbl_Diff_eqpoll:
      "\<lbrakk>recfunAC16(f, h, y, a) \<subseteq> {X \<in> Pow(A) . X\<approx>succ(k #+ m)};   
          Card(a); \<not> Finite(a); A\<approx>a;   
          k \<in> nat;  y<a;   
          h \<in> bij(a, {Y \<in> Pow(A). Y\<approx>succ(k)})\<rbrakk>   
       \<Longrightarrow> A - \<Union>(recfunAC16(f, h, y, a)) - h`y\<approx>a"
 apply (rule dbl_Diff_eqpoll_Card, simp_all)
 apply (simp add: Union_recfunAC16_lesspoll)
 apply (rule Finite_lesspoll_infinite_Ord) 
 apply (rule Finite_def [THEN def_imp_iff, THEN iffD2]) 
 apply (blast dest: ltD bij_is_fun [THEN apply_type], assumption)  
 apply (blast intro: Card_is_Ord) 
 done
 
 (* back to the proof *)
 
 lemmas disj_Un_eqpoll_nat_sum = 
     eqpoll_trans [THEN eqpoll_trans, 
                   OF disj_Un_eqpoll_sum sum_eqpoll_cong nat_sum_eqpoll_sum]
 
 
 lemma Un_in_Collect: "\<lbrakk>x \<in> Pow(A - B - h`i); x\<approx>m;   
         h \<in> bij(a, {x \<in> Pow(A) . x\<approx>k}); i<a; k \<in> nat; m \<in> nat\<rbrakk>   
         \<Longrightarrow> h ` i \<union> x \<in> {x \<in> Pow(A) . x\<approx>k #+ m}"
 by (blast intro: disj_Un_eqpoll_nat_sum
           dest:  ltD bij_is_fun [THEN apply_type])
 
 
 (* ********************************************************************** *)
 (* Lemmas simplifying assumptions                                         *)
 (* ********************************************************************** *)
 
 lemma lemma6:
      "\<lbrakk>\<forall>y<succ(j). F(y)<=X \<and> (\<forall>x<a. x<y | P(x,y) \<longrightarrow> Q(x,y)); succ(j)<a\<rbrakk>
       \<Longrightarrow> F(j)<=X \<and> (\<forall>x<a. x<j | P(x,j) \<longrightarrow> Q(x,j))"
 by (blast intro!: lt_Ord succI1 [THEN ltI, THEN lt_Ord, THEN le_refl]) 
 
 
 lemma lemma7:
      "\<lbrakk>\<forall>x<a. x<j | P(x,j) \<longrightarrow> Q(x,j);  succ(j)<a\<rbrakk>   
       \<Longrightarrow> P(j,j) \<longrightarrow> (\<forall>x<a. x\<le>j | P(x,j) \<longrightarrow> Q(x,j))"
 by (fast elim!: leE)
 
 (* ********************************************************************** *)
 (* Lemmas needed to prove ex_next_set, which means that for any successor *)
 (* ordinal there is a set satisfying certain properties                   *)
 (* ********************************************************************** *)
 
 lemma ex_subset_eqpoll:
      "\<lbrakk>A\<approx>a; \<not> Finite(a); Ord(a); m \<in> nat\<rbrakk> \<Longrightarrow> \<exists>X \<in> Pow(A). X\<approx>m"
 apply (rule lepoll_imp_eqpoll_subset [of m A, THEN exE]) 
  apply (rule lepoll_trans, rule leI [THEN le_imp_lepoll])
   apply (blast intro: lt_trans2 [OF ltI nat_le_infinite_Ord] Ord_nat)
 apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll]) 
 apply (fast elim!: eqpoll_sym)
 done
 
 lemma subset_Un_disjoint: "\<lbrakk>A \<subseteq> B \<union> C; A \<inter> C = 0\<rbrakk> \<Longrightarrow> A \<subseteq> B"
 by blast
 
 
 lemma Int_empty:
      "\<lbrakk>X \<in> Pow(A - \<Union>(B) -C); T \<in> B; F \<subseteq> T\<rbrakk> \<Longrightarrow> F \<inter> X = 0"
 by blast
 
 
 (* ********************************************************************** *)
 (* equipollent subset (and finite) is the whole set                       *)
 (* ********************************************************************** *)
 
 
 lemma subset_imp_eq_lemma:
      "m \<in> nat \<Longrightarrow> \<forall>A B. A \<subseteq> B \<and> m \<lesssim> A \<and> B \<lesssim> m \<longrightarrow> A=B"
 apply (induct_tac "m")
 apply (fast dest!: lepoll_0_is_0)
 apply (intro allI impI)
 apply (elim conjE)
 apply (rule succ_lepoll_imp_not_empty [THEN not_emptyE], assumption)
 apply (frule subsetD [THEN Diff_sing_lepoll], assumption+)
 apply (frule lepoll_Diff_sing)
 apply (erule allE impE)+
 apply (rule conjI)
 prefer 2 apply fast
 apply fast
 apply (blast elim: equalityE) 
 done
 
 
 lemma subset_imp_eq: "\<lbrakk>A \<subseteq> B; m \<lesssim> A; B \<lesssim> m; m \<in> nat\<rbrakk> \<Longrightarrow> A=B"
 by (blast dest!: subset_imp_eq_lemma)
 
 
 lemma bij_imp_arg_eq:
      "\<lbrakk>f \<in> bij(a, {Y \<in> X. Y\<approx>succ(k)}); k \<in> nat; f`b \<subseteq> f`y; b<a; y<a\<rbrakk> 
       \<Longrightarrow> b=y"
 apply (drule subset_imp_eq)
 apply (erule_tac [3] nat_succI)
 apply (unfold bij_def inj_def)
 apply (blast intro: eqpoll_sym eqpoll_imp_lepoll
              dest:  ltD apply_type)+
 done
 
 
 lemma ex_next_set:
      "\<lbrakk>recfunAC16(f, h, y, a) \<subseteq> {X \<in> Pow(A) . X\<approx>succ(k #+ m)};   
          Card(a); \<not> Finite(a); A\<approx>a;   
          k \<in> nat; m \<in> nat; y<a;   
          h \<in> bij(a, {Y \<in> Pow(A). Y\<approx>succ(k)});   
          \<not> (\<exists>Y \<in> recfunAC16(f, h, y, a). h`y \<subseteq> Y)\<rbrakk>   
       \<Longrightarrow> \<exists>X \<in> {Y \<in> Pow(A). Y\<approx>succ(k #+ m)}. h`y \<subseteq> X \<and>   
                 (\<forall>b<a. h`b \<subseteq> X \<longrightarrow>   
                 (\<forall>T \<in> recfunAC16(f, h, y, a). \<not> h`b \<subseteq> T))"
 apply (erule_tac m1=m in dbl_Diff_eqpoll [THEN ex_subset_eqpoll, THEN bexE], 
        assumption+)
 apply (erule Card_is_Ord, assumption)
 apply (frule Un_in_Collect, (erule asm_rl nat_succI)+) 
 apply (erule CollectE)
 apply (rule rev_bexI, simp)
 apply (rule conjI, blast) 
 apply (intro ballI impI oallI notI)
 apply (drule subset_Un_disjoint, rule Int_empty, assumption+)
 apply (blast dest: bij_imp_arg_eq) 
 done
 
 (* ********************************************************************** *)
 (* Lemma ex_next_Ord states that for any successor                        *)
 (* ordinal there is a number of the set satisfying certain properties     *)
 (* ********************************************************************** *)
 
 lemma ex_next_Ord:
      "\<lbrakk>recfunAC16(f, h, y, a) \<subseteq> {X \<in> Pow(A) . X\<approx>succ(k #+ m)};   
          Card(a); \<not> Finite(a); A\<approx>a;   
          k \<in> nat; m \<in> nat; y<a;   
          h \<in> bij(a, {Y \<in> Pow(A). Y\<approx>succ(k)});   
          f \<in> bij(a, {Y \<in> Pow(A). Y\<approx>succ(k #+ m)});   
          \<not> (\<exists>Y \<in> recfunAC16(f, h, y, a). h`y \<subseteq> Y)\<rbrakk>   
       \<Longrightarrow> \<exists>c<a. h`y \<subseteq> f`c \<and>   
                 (\<forall>b<a. h`b \<subseteq> f`c \<longrightarrow>   
                 (\<forall>T \<in> recfunAC16(f, h, y, a). \<not> h`b \<subseteq> T))"
 apply (drule ex_next_set, assumption+)
 apply (erule bexE)
 apply (rule_tac x="converse(f)`X" in oexI)
 apply (simp add: right_inverse_bij)
 apply (blast intro: bij_converse_bij bij_is_fun [THEN apply_type] ltI
                     Card_is_Ord)
 done
 
 
 (* ********************************************************************** *)
 (* Lemma simplifying assumptions                                          *)
 (* ********************************************************************** *)
 
 lemma lemma8:
      "\<lbrakk>\<forall>x<a. x<j | (\<exists>xa \<in> F(j). P(x, xa))   
          \<longrightarrow> (\<exists>! Y. Y \<in> F(j) \<and> P(x, Y)); F(j) \<subseteq> X;   
          L \<in> X; P(j, L) \<and> (\<forall>x<a. P(x, L) \<longrightarrow> (\<forall>xa \<in> F(j). \<not>P(x, xa)))\<rbrakk>   
       \<Longrightarrow> F(j) \<union> {L} \<subseteq> X \<and>   
           (\<forall>x<a. x\<le>j | (\<exists>xa \<in> (F(j) \<union> {L}). P(x, xa)) \<longrightarrow>   
                  (\<exists>! Y. Y \<in> (F(j) \<union> {L}) \<and> P(x, Y)))"
 apply (rule conjI)
 apply (fast intro!: singleton_subsetI)
 apply (rule oallI)
 apply (blast elim!: leE oallE)
 done
 
 (* ********************************************************************** *)
 (* The main part of the proof: inductive proof of the property of T_gamma *)
 (* lemma main_induct                                                      *)
 (* ********************************************************************** *)
 
 lemma main_induct:
      "\<lbrakk>b < a; f \<in> bij(a, {Y \<in> Pow(A) . Y\<approx>succ(k #+ m)});   
          h \<in> bij(a, {Y \<in> Pow(A) . Y\<approx>succ(k)});   
          \<not>Finite(a); Card(a); A\<approx>a; k \<in> nat; m \<in> nat\<rbrakk>   
       \<Longrightarrow> recfunAC16(f, h, b, a) \<subseteq> {X \<in> Pow(A) . X\<approx>succ(k #+ m)} \<and>   
           (\<forall>x<a. x < b | (\<exists>Y \<in> recfunAC16(f, h, b, a). h ` x \<subseteq> Y) \<longrightarrow>   
           (\<exists>! Y. Y \<in> recfunAC16(f, h, b, a) \<and> h ` x \<subseteq> Y))"
 apply (erule lt_induct)
 apply (frule lt_Ord)
 apply (erule Ord_cases)
 (* case 0 *)
 apply (simp add: recfunAC16_0)
 (* case Limit *)
 prefer 2  apply (simp add: recfunAC16_Limit)
           apply (rule lemma5, assumption+)
           apply (blast dest!: recfunAC16_mono)
 (* case succ *)
 apply clarify 
 apply (erule lemma6 [THEN conjE], assumption)
 apply (simp (no_asm_simp) split del: split_if add: recfunAC16_succ)
 apply (rule conjI [THEN split_if [THEN iffD2]])
  apply (simp, erule lemma7, assumption)
 apply (rule impI)
 apply (rule ex_next_Ord [THEN oexE], 
        assumption+, rule le_refl [THEN lt_trans], assumption+) 
 apply (erule lemma8, assumption)
  apply (rule bij_is_fun [THEN apply_type], assumption)
  apply (erule Least_le [THEN lt_trans2, THEN ltD])
   apply (erule lt_Ord) 
  apply (erule succ_leI)
 apply (erule LeastI) 
 apply (erule lt_Ord) 
 done
 
 (* ********************************************************************** *)
 (* Lemma to simplify the inductive proof                                  *)
 (*   - the desired property is a consequence of the inductive assumption  *)
 (* ********************************************************************** *)
 
 lemma lemma_simp_induct:
      "\<lbrakk>\<forall>b. b<a \<longrightarrow> F(b) \<subseteq> S \<and> (\<forall>x<a. (x<b | (\<exists>Y \<in> F(b). f`x \<subseteq> Y))  
                                    \<longrightarrow> (\<exists>! Y. Y \<in> F(b) \<and> f`x \<subseteq> Y));
          f \<in> a->f``(a); Limit(a); 
          \<forall>i j. i\<le>j \<longrightarrow> F(i) \<subseteq> F(j)\<rbrakk>   
         \<Longrightarrow> (\<Union>j<a. F(j)) \<subseteq> S \<and>   
             (\<forall>x \<in> f``a. \<exists>! Y. Y \<in> (\<Union>j<a. F(j)) \<and> x \<subseteq> Y)"
 apply (rule conjI)
 apply (rule subsetI)
 apply (erule OUN_E, blast) 
 apply (rule ballI)
 apply (erule imageE)
 apply (drule ltI, erule Limit_is_Ord) 
 apply (drule Limit_has_succ, assumption) 
 apply (frule_tac x1="succ(xa)" in spec [THEN mp], assumption)
 apply (erule conjE)
 apply (drule ospec) 
 (** LEVEL 10 **)
 apply (erule leI [THEN succ_leE])
 apply (erule impE)
 apply (fast elim!: leI [THEN succ_leE, THEN lt_Ord, THEN le_refl])
 apply (drule apply_equality, assumption) 
 apply (elim conjE ex1E)
 (** LEVEL 15 **)
 apply (rule ex1I, blast) 
 apply (elim conjE OUN_E)
 apply (erule_tac i="succ(xa)" and j=aa 
        in Ord_linear_le [OF lt_Ord lt_Ord], assumption)
 prefer 2 
 apply (drule spec [THEN spec, THEN mp, THEN subsetD], assumption+, blast) 
 (** LEVEL 20 **)
 apply (drule_tac x1=aa in spec [THEN mp], assumption)
 apply (frule succ_leE)
 apply (drule spec [THEN spec, THEN mp, THEN subsetD], assumption+, blast) 
 done
 
 (* ********************************************************************** *)
 (* The target theorem                                                     *)
 (* ********************************************************************** *)
 
 theorem WO2_AC16: "\<lbrakk>WO2; 0<m; k \<in> nat; m \<in> nat\<rbrakk> \<Longrightarrow> AC16(k #+ m,k)"
-apply (unfold AC16_def)
+  unfolding AC16_def
 apply (rule allI)
 apply (rule impI)
 apply (frule WO2_infinite_subsets_eqpoll_X, assumption+)
 apply (frule_tac n="k #+ m" in WO2_infinite_subsets_eqpoll_X, simp, simp) 
 apply (frule WO2_imp_ex_Card)
 apply (elim exE conjE)
 apply (drule eqpoll_trans [THEN eqpoll_sym, 
                            THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]],
        assumption)
 apply (drule eqpoll_trans [THEN eqpoll_sym, 
                            THEN eqpoll_def [THEN def_imp_iff, THEN iffD1]], 
        assumption+)
 apply (elim exE)
 apply (rename_tac h)
 apply (rule_tac x = "\<Union>j<a. recfunAC16 (h,f,j,a) " in exI)
 apply (rule_tac P="\<lambda>z. Y \<and> (\<forall>x \<in> z. Z(x))"  for Y Z
        in bij_is_surj [THEN surj_image_eq, THEN subst], assumption)
 apply (rule lemma_simp_induct)
 apply (blast del: conjI notI
              intro!: main_induct eqpoll_imp_lepoll [THEN lepoll_infinite] ) 
 apply (blast intro: bij_is_fun [THEN surj_image, THEN surj_is_fun])
 apply (erule eqpoll_imp_lepoll [THEN lepoll_infinite, 
                                 THEN infinite_Card_is_InfCard, 
                                 THEN InfCard_is_Limit], 
        assumption+)
 apply (blast dest!: recfunAC16_mono)
 done
 
 end
diff --git a/src/ZF/AC/WO6_WO1.thy b/src/ZF/AC/WO6_WO1.thy
--- a/src/ZF/AC/WO6_WO1.thy
+++ b/src/ZF/AC/WO6_WO1.thy
@@ -1,539 +1,539 @@
 (*  Title:      ZF/AC/WO6_WO1.thy
     Author:     Krzysztof Grabczewski
 
 Proofs needed to state that formulations WO1,...,WO6 are all equivalent.
 The only hard one is WO6 \<Longrightarrow> WO1.
 
 Every proof (except WO6 \<Longrightarrow> WO1 and WO1 \<Longrightarrow> WO2) are described as "clear"
 by Rubin \<and> Rubin (page 2). 
 They refer reader to a book by Gödel to see the proof WO1 \<Longrightarrow> WO2.
 Fortunately order types made this proof also very easy.
 *)
 
 theory WO6_WO1
 imports Cardinal_aux
 begin
 
 (* Auxiliary definitions used in proof *)
 definition
   NN  :: "i \<Rightarrow> i"  where
     "NN(y) \<equiv> {m \<in> nat. \<exists>a. \<exists>f. Ord(a) \<and> domain(f)=a  \<and>  
                         (\<Union>b<a. f`b) = y \<and> (\<forall>b<a. f`b \<lesssim> m)}"
   
 definition
   uu  :: "[i, i, i, i] \<Rightarrow> i"  where
     "uu(f, beta, gamma, delta) \<equiv> (f`beta * f`gamma) \<inter> f`delta"
 
 
 (** Definitions for case 1 **)
 definition
   vv1 :: "[i, i, i] \<Rightarrow> i"  where
      "vv1(f,m,b) \<equiv>                                                
            let g = \<mu> g. (\<exists>d. Ord(d) \<and> (domain(uu(f,b,g,d)) \<noteq> 0 \<and> 
                                  domain(uu(f,b,g,d)) \<lesssim> m));      
                d = \<mu> d. domain(uu(f,b,g,d)) \<noteq> 0 \<and>                  
                             domain(uu(f,b,g,d)) \<lesssim> m         
            in  if f`b \<noteq> 0 then domain(uu(f,b,g,d)) else 0"
 
 definition
   ww1 :: "[i, i, i] \<Rightarrow> i"  where
      "ww1(f,m,b) \<equiv> f`b - vv1(f,m,b)"
 
 definition
   gg1 :: "[i, i, i] \<Rightarrow> i"  where
      "gg1(f,a,m) \<equiv> \<lambda>b \<in> a++a. if b<a then vv1(f,m,b) else ww1(f,m,b--a)"
 
 
 (** Definitions for case 2 **)
 definition
   vv2 :: "[i, i, i, i] \<Rightarrow> i"  where
      "vv2(f,b,g,s) \<equiv>   
            if f`g \<noteq> 0 then {uu(f, b, g, \<mu> d. uu(f,b,g,d) \<noteq> 0)`s} else 0"
 
 definition
   ww2 :: "[i, i, i, i] \<Rightarrow> i"  where
      "ww2(f,b,g,s) \<equiv> f`g - vv2(f,b,g,s)"
 
 definition
   gg2 :: "[i, i, i, i] \<Rightarrow> i"  where
      "gg2(f,a,b,s) \<equiv>
               \<lambda>g \<in> a++a. if g<a then vv2(f,b,g,s) else ww2(f,b,g--a,s)"
 
 
 lemma WO2_WO3: "WO2 \<Longrightarrow> WO3"
 by (unfold WO2_def WO3_def, fast)
 
 (* ********************************************************************** *)
 
 lemma WO3_WO1: "WO3 \<Longrightarrow> WO1"
 apply (unfold eqpoll_def WO1_def WO3_def)
 apply (intro allI)
 apply (drule_tac x=A in spec) 
 apply (blast intro: bij_is_inj well_ord_rvimage 
                     well_ord_Memrel [THEN well_ord_subset])
 done
 
 (* ********************************************************************** *)
 
 lemma WO1_WO2: "WO1 \<Longrightarrow> WO2"
 apply (unfold eqpoll_def WO1_def WO2_def)
 apply (blast intro!: Ord_ordertype ordermap_bij)
 done
 
 (* ********************************************************************** *)
 
 lemma lam_sets: "f \<in> A->B \<Longrightarrow> (\<lambda>x \<in> A. {f`x}): A -> {{b}. b \<in> B}"
 by (fast intro!: lam_type apply_type)
 
 lemma surj_imp_eq': "f \<in> surj(A,B) \<Longrightarrow> (\<Union>a \<in> A. {f`a}) = B"
-apply (unfold surj_def)
+  unfolding surj_def
 apply (fast elim!: apply_type)
 done
 
 lemma surj_imp_eq: "\<lbrakk>f \<in> surj(A,B); Ord(A)\<rbrakk> \<Longrightarrow> (\<Union>a<A. {f`a}) = B"
 by (fast dest!: surj_imp_eq' intro!: ltI elim!: ltE)
 
 lemma WO1_WO4: "WO1 \<Longrightarrow> WO4(1)"
 apply (unfold WO1_def WO4_def)
 apply (rule allI)
 apply (erule_tac x = A in allE)
 apply (erule exE)
 apply (intro exI conjI)
 apply (erule Ord_ordertype)
 apply (erule ordermap_bij [THEN bij_converse_bij, THEN bij_is_fun, THEN lam_sets, THEN domain_of_fun])
 apply (simp_all add: singleton_eqpoll_1 eqpoll_imp_lepoll Ord_ordertype
        ordermap_bij [THEN bij_converse_bij, THEN bij_is_surj, THEN surj_imp_eq]
        ltD)
 done
 
 (* ********************************************************************** *)
 
 lemma WO4_mono: "\<lbrakk>m\<le>n; WO4(m)\<rbrakk> \<Longrightarrow> WO4(n)"
-apply (unfold WO4_def)
+  unfolding WO4_def
 apply (blast dest!: spec intro: lepoll_trans [OF _ le_imp_lepoll])
 done
 
 (* ********************************************************************** *)
 
 lemma WO4_WO5: "\<lbrakk>m \<in> nat; 1\<le>m; WO4(m)\<rbrakk> \<Longrightarrow> WO5"
 by (unfold WO4_def WO5_def, blast)
 
 (* ********************************************************************** *)
 
 lemma WO5_WO6: "WO5 \<Longrightarrow> WO6"
 by (unfold WO4_def WO5_def WO6_def, blast)
 
 
 (* ********************************************************************** 
     The proof of "WO6 \<Longrightarrow> WO1".  Simplified by L C Paulson.
 
     From the book "Equivalents of the Axiom of Choice" by Rubin \<and> Rubin,
     pages 2-5
 ************************************************************************* *)
 
 lemma lt_oadd_odiff_disj:
       "\<lbrakk>k < i++j;  Ord(i);  Ord(j)\<rbrakk> 
        \<Longrightarrow> k < i  |  (\<not> k<i \<and> k = i ++ (k--i) \<and> (k--i)<j)"
 apply (rule_tac i = k and j = i in Ord_linear2)
 prefer 4 
    apply (drule odiff_lt_mono2, assumption)
    apply (simp add: oadd_odiff_inverse odiff_oadd_inverse)
 apply (auto elim!: lt_Ord)
 done
 
 
 (* ********************************************************************** *)
 (* The most complicated part of the proof - lemma ii - p. 2-4             *)
 (* ********************************************************************** *)
 
 (* ********************************************************************** *)
 (* some properties of relation uu(beta, gamma, delta) - p. 2              *)
 (* ********************************************************************** *)
 
 lemma domain_uu_subset: "domain(uu(f,b,g,d)) \<subseteq> f`b"
 by (unfold uu_def, blast)
 
 lemma quant_domain_uu_lepoll_m:
      "\<forall>b<a. f`b \<lesssim> m \<Longrightarrow> \<forall>b<a. \<forall>g<a. \<forall>d<a. domain(uu(f,b,g,d)) \<lesssim> m"
 by (blast intro: domain_uu_subset [THEN subset_imp_lepoll] lepoll_trans)
 
 lemma uu_subset1: "uu(f,b,g,d) \<subseteq> f`b * f`g"
 by (unfold uu_def, blast)
 
 lemma uu_subset2: "uu(f,b,g,d) \<subseteq> f`d"
 by (unfold uu_def, blast)
 
 lemma uu_lepoll_m: "\<lbrakk>\<forall>b<a. f`b \<lesssim> m;  d<a\<rbrakk> \<Longrightarrow> uu(f,b,g,d) \<lesssim> m"
 by (blast intro: uu_subset2 [THEN subset_imp_lepoll] lepoll_trans)
 
 (* ********************************************************************** *)
 (* Two cases for lemma ii                                                 *)
 (* ********************************************************************** *)
 lemma cases: 
      "\<forall>b<a. \<forall>g<a. \<forall>d<a. u(f,b,g,d) \<lesssim> m   
       \<Longrightarrow> (\<forall>b<a. f`b \<noteq> 0 \<longrightarrow>  
                   (\<exists>g<a. \<exists>d<a. u(f,b,g,d) \<noteq> 0 \<and> u(f,b,g,d) \<prec> m))  
         | (\<exists>b<a. f`b \<noteq> 0 \<and> (\<forall>g<a. \<forall>d<a. u(f,b,g,d) \<noteq> 0 \<longrightarrow>   
                                         u(f,b,g,d) \<approx> m))"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (blast del: equalityI)
 done
 
 (* ********************************************************************** *)
 (* Lemmas used in both cases                                              *)
 (* ********************************************************************** *)
 lemma UN_oadd: "Ord(a) \<Longrightarrow> (\<Union>b<a++a. C(b)) = (\<Union>b<a. C(b) \<union> C(a++b))"
 by (blast intro: ltI lt_oadd1 oadd_lt_mono2 dest!: lt_oadd_disj)
 
 
 (* ********************************************************************** *)
 (* Case 1: lemmas                                                        *)
 (* ********************************************************************** *)
 
 lemma vv1_subset: "vv1(f,m,b) \<subseteq> f`b"
 by (simp add: vv1_def Let_def domain_uu_subset)
 
 (* ********************************************************************** *)
 (* Case 1: Union of images is the whole "y"                              *)
 (* ********************************************************************** *)
 lemma UN_gg1_eq: 
   "\<lbrakk>Ord(a);  m \<in> nat\<rbrakk> \<Longrightarrow> (\<Union>b<a++a. gg1(f,a,m)`b) = (\<Union>b<a. f`b)"
 by (simp add: gg1_def UN_oadd lt_oadd1 oadd_le_self [THEN le_imp_not_lt] 
               lt_Ord odiff_oadd_inverse ltD vv1_subset [THEN Diff_partition]
               ww1_def)
 
 lemma domain_gg1: "domain(gg1(f,a,m)) = a++a"
 by (simp add: lam_funtype [THEN domain_of_fun] gg1_def)
 
 (* ********************************************************************** *)
 (* every value of defined function is less than or equipollent to m       *)
 (* ********************************************************************** *)
 lemma nested_LeastI:
      "\<lbrakk>P(a, b);  Ord(a);  Ord(b);   
          Least_a = (\<mu> a. \<exists>x. Ord(x) \<and> P(a, x))\<rbrakk>   
       \<Longrightarrow> P(Least_a, \<mu> b. P(Least_a, b))"
 apply (erule ssubst)
 apply (rule_tac Q = "\<lambda>z. P (z, \<mu> b. P (z, b))" in LeastI2)
 apply (fast elim!: LeastI)+
 done
 
 lemmas nested_Least_instance =
        nested_LeastI [of "\<lambda>g d. domain(uu(f,b,g,d)) \<noteq> 0 \<and> 
                                 domain(uu(f,b,g,d)) \<lesssim> m"] for f b m
 
 lemma gg1_lepoll_m: 
      "\<lbrakk>Ord(a);  m \<in> nat;   
          \<forall>b<a. f`b \<noteq>0 \<longrightarrow>                                        
              (\<exists>g<a. \<exists>d<a. domain(uu(f,b,g,d)) \<noteq> 0  \<and>                
                           domain(uu(f,b,g,d)) \<lesssim> m);             
          \<forall>b<a. f`b \<lesssim> succ(m);  b<a++a\<rbrakk> 
       \<Longrightarrow> gg1(f,a,m)`b \<lesssim> m"
 apply (simp add: gg1_def empty_lepollI)
 apply (safe dest!: lt_oadd_odiff_disj)
 (*Case b<a   \<in> show vv1(f,m,b) \<lesssim> m *)
  apply (simp add: vv1_def Let_def empty_lepollI)
  apply (fast intro: nested_Least_instance [THEN conjunct2]
              elim!: lt_Ord)
 (*Case a\<le>b \<in> show ww1(f,m,b--a) \<lesssim> m *)
 apply (simp add: ww1_def empty_lepollI)
 apply (case_tac "f` (b--a) = 0", simp add: empty_lepollI)
 apply (rule Diff_lepoll, blast)
 apply (rule vv1_subset)
 apply (drule ospec [THEN mp], assumption+)
 apply (elim oexE conjE)
 apply (simp add: vv1_def Let_def lt_Ord nested_Least_instance [THEN conjunct1])
 done
 
 (* ********************************************************************** *)
 (* Case 2: lemmas                                                        *)
 (* ********************************************************************** *)
 
 (* ********************************************************************** *)
 (* Case 2: vv2_subset                                                    *)
 (* ********************************************************************** *)
 
 lemma ex_d_uu_not_empty:
      "\<lbrakk>b<a;  g<a;  f`b\<noteq>0;  f`g\<noteq>0;         
          y*y \<subseteq> y;  (\<Union>b<a. f`b)=y\<rbrakk> 
       \<Longrightarrow> \<exists>d<a. uu(f,b,g,d) \<noteq> 0"
 by (unfold uu_def, blast) 
 
 lemma uu_not_empty:
      "\<lbrakk>b<a; g<a; f`b\<noteq>0; f`g\<noteq>0;  y*y \<subseteq> y; (\<Union>b<a. f`b)=y\<rbrakk>   
       \<Longrightarrow> uu(f,b,g,\<mu> d. (uu(f,b,g,d) \<noteq> 0)) \<noteq> 0"
 apply (drule ex_d_uu_not_empty, assumption+)
 apply (fast elim!: LeastI lt_Ord)
 done
 
 lemma not_empty_rel_imp_domain: "\<lbrakk>r \<subseteq> A*B; r\<noteq>0\<rbrakk> \<Longrightarrow> domain(r)\<noteq>0"
 by blast
 
 lemma Least_uu_not_empty_lt_a:
      "\<lbrakk>b<a; g<a; f`b\<noteq>0; f`g\<noteq>0; y*y \<subseteq> y; (\<Union>b<a. f`b)=y\<rbrakk>   
       \<Longrightarrow> (\<mu> d. uu(f,b,g,d) \<noteq> 0) < a"
 apply (erule ex_d_uu_not_empty [THEN oexE], assumption+)
 apply (blast intro: Least_le [THEN lt_trans1] lt_Ord)
 done
 
 lemma subset_Diff_sing: "\<lbrakk>B \<subseteq> A; a\<notin>B\<rbrakk> \<Longrightarrow> B \<subseteq> A-{a}"
 by blast
 
 (*Could this be proved more directly?*)
 lemma supset_lepoll_imp_eq:
      "\<lbrakk>A \<lesssim> m; m \<lesssim> B; B \<subseteq> A; m \<in> nat\<rbrakk> \<Longrightarrow> A=B"
 apply (erule natE)
 apply (fast dest!: lepoll_0_is_0 intro!: equalityI)
 apply (safe intro!: equalityI)
 apply (rule ccontr)
 apply (rule succ_lepoll_natE)
  apply (erule lepoll_trans)  
  apply (rule lepoll_trans)  
   apply (erule subset_Diff_sing [THEN subset_imp_lepoll], assumption)
  apply (rule Diff_sing_lepoll, assumption+) 
 done
 
 lemma uu_Least_is_fun:
      "\<lbrakk>\<forall>g<a. \<forall>d<a. domain(uu(f, b, g, d))\<noteq>0 \<longrightarrow>                
           domain(uu(f, b, g, d)) \<approx> succ(m);                         
           \<forall>b<a. f`b \<lesssim> succ(m);  y*y \<subseteq> y;                        
           (\<Union>b<a. f`b)=y;  b<a;  g<a;  d<a;                             
           f`b\<noteq>0;  f`g\<noteq>0;  m \<in> nat;  s \<in> f`b\<rbrakk> 
       \<Longrightarrow> uu(f, b, g, \<mu> d. uu(f,b,g,d)\<noteq>0) \<in> f`b -> f`g"
 apply (drule_tac x2=g in ospec [THEN ospec, THEN mp])
    apply (rule_tac [3] not_empty_rel_imp_domain [OF uu_subset1 uu_not_empty])
         apply (rule_tac [2] Least_uu_not_empty_lt_a, assumption+)
 apply (rule rel_is_fun)
     apply (erule eqpoll_sym [THEN eqpoll_imp_lepoll]) 
    apply (erule uu_lepoll_m) 
    apply (rule Least_uu_not_empty_lt_a, assumption+) 
 apply (rule uu_subset1)
 apply (rule supset_lepoll_imp_eq [OF _ eqpoll_sym [THEN eqpoll_imp_lepoll]])
 apply (fast intro!: domain_uu_subset)+
 done
 
 lemma vv2_subset: 
      "\<lbrakk>\<forall>g<a. \<forall>d<a. domain(uu(f, b, g, d))\<noteq>0 \<longrightarrow>             
                        domain(uu(f, b, g, d)) \<approx> succ(m);
          \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y;
          (\<Union>b<a. f`b)=y;  b<a;  g<a;  m \<in> nat;  s \<in> f`b\<rbrakk> 
       \<Longrightarrow> vv2(f,b,g,s) \<subseteq> f`g"
 apply (simp add: vv2_def)
 apply (blast intro: uu_Least_is_fun [THEN apply_type])
 done
 
 (* ********************************************************************** *)
 (* Case 2: Union of images is the whole "y"                              *)
 (* ********************************************************************** *)
 lemma UN_gg2_eq: 
      "\<lbrakk>\<forall>g<a. \<forall>d<a. domain(uu(f,b,g,d)) \<noteq> 0 \<longrightarrow>              
                domain(uu(f,b,g,d)) \<approx> succ(m);                         
          \<forall>b<a. f`b \<lesssim> succ(m); y*y \<subseteq> y;                        
          (\<Union>b<a. f`b)=y;  Ord(a);  m \<in> nat;  s \<in> f`b;  b<a\<rbrakk> 
       \<Longrightarrow> (\<Union>g<a++a. gg2(f,a,b,s) ` g) = y"
-apply (unfold gg2_def)
+  unfolding gg2_def
 apply (drule sym) 
 apply (simp add: ltD UN_oadd  oadd_le_self [THEN le_imp_not_lt] 
                  lt_Ord odiff_oadd_inverse ww2_def 
                  vv2_subset [THEN Diff_partition])
 done
 
 lemma domain_gg2: "domain(gg2(f,a,b,s)) = a++a"
 by (simp add: lam_funtype [THEN domain_of_fun] gg2_def)
 
 
 (* ********************************************************************** *)
 (* every value of defined function is less than or equipollent to m       *)
 (* ********************************************************************** *)
 
 lemma vv2_lepoll: "\<lbrakk>m \<in> nat; m\<noteq>0\<rbrakk> \<Longrightarrow> vv2(f,b,g,s) \<lesssim> m"
-apply (unfold vv2_def)
+  unfolding vv2_def
 apply (simp add: empty_lepollI)
 apply (fast dest!: le_imp_subset [THEN subset_imp_lepoll, THEN lepoll_0_is_0] 
        intro!: singleton_eqpoll_1 [THEN eqpoll_imp_lepoll, THEN lepoll_trans]
                not_lt_imp_le [THEN le_imp_subset, THEN subset_imp_lepoll]
                nat_into_Ord nat_1I)
 done
 
 lemma ww2_lepoll: 
     "\<lbrakk>\<forall>b<a. f`b \<lesssim> succ(m);  g<a;  m \<in> nat;  vv2(f,b,g,d) \<subseteq> f`g\<rbrakk>  
      \<Longrightarrow> ww2(f,b,g,d) \<lesssim> m"
-apply (unfold ww2_def)
+  unfolding ww2_def
 apply (case_tac "f`g = 0")
 apply (simp add: empty_lepollI)
 apply (drule ospec, assumption)
 apply (rule Diff_lepoll, assumption+)
 apply (simp add: vv2_def not_emptyI)
 done
 
 lemma gg2_lepoll_m: 
      "\<lbrakk>\<forall>g<a. \<forall>d<a. domain(uu(f,b,g,d)) \<noteq> 0 \<longrightarrow>              
                       domain(uu(f,b,g,d)) \<approx> succ(m);                         
          \<forall>b<a. f`b \<lesssim> succ(m);  y*y \<subseteq> y;                     
          (\<Union>b<a. f`b)=y;  b<a;  s \<in> f`b;  m \<in> nat;  m\<noteq> 0;  g<a++a\<rbrakk> 
       \<Longrightarrow> gg2(f,a,b,s) ` g \<lesssim> m"
 apply (simp add: gg2_def empty_lepollI)
 apply (safe elim!: lt_Ord2 dest!: lt_oadd_odiff_disj)
  apply (simp add: vv2_lepoll)
 apply (simp add: ww2_lepoll vv2_subset)
 done
 
 (* ********************************************************************** *)
 (* lemma ii                                                               *)
 (* ********************************************************************** *)
 lemma lemma_ii: "\<lbrakk>succ(m) \<in> NN(y); y*y \<subseteq> y; m \<in> nat; m\<noteq>0\<rbrakk> \<Longrightarrow> m \<in> NN(y)"
-apply (unfold NN_def)
+  unfolding NN_def
 apply (elim CollectE exE conjE) 
 apply (rule quant_domain_uu_lepoll_m [THEN cases, THEN disjE], assumption)
 (* case 1 *)
 apply (simp add: lesspoll_succ_iff)
 apply (rule_tac x = "a++a" in exI)
 apply (fast intro!: Ord_oadd domain_gg1 UN_gg1_eq gg1_lepoll_m)
 (* case 2 *)
 apply (elim oexE conjE)
 apply (rule_tac A = "f`B" for B in not_emptyE, assumption)
 apply (rule CollectI)
 apply (erule succ_natD)
 apply (rule_tac x = "a++a" in exI)
 apply (rule_tac x = "gg2 (f,a,b,x) " in exI)
 apply (simp add: Ord_oadd domain_gg2 UN_gg2_eq gg2_lepoll_m)
 done
 
 
 (* ********************************************************************** *)
 (* lemma iv - p. 4:                                                       *)
 (* For every set x there is a set y such that   x \<union> (y * y) \<subseteq> y         *)
 (* ********************************************************************** *)
 
 
 (* The leading \<forall>-quantifier looks odd but makes the proofs shorter 
    (used only in the following two lemmas)                          *)
 
 lemma z_n_subset_z_succ_n:
      "\<forall>n \<in> nat. rec(n, x, \<lambda>k r. r \<union> r*r) \<subseteq> rec(succ(n), x, \<lambda>k r. r \<union> r*r)"
 by (fast intro: rec_succ [THEN ssubst])
 
 lemma le_subsets:
      "\<lbrakk>\<forall>n \<in> nat. f(n)<=f(succ(n)); n\<le>m; n \<in> nat; m \<in> nat\<rbrakk>   
       \<Longrightarrow> f(n)<=f(m)"
 apply (erule_tac P = "n\<le>m" in rev_mp)
 apply (rule_tac P = "\<lambda>z. n\<le>z \<longrightarrow> f (n) \<subseteq> f (z) " in nat_induct) 
 apply (auto simp add: le_iff) 
 done
 
 lemma le_imp_rec_subset:
      "\<lbrakk>n\<le>m; m \<in> nat\<rbrakk> 
       \<Longrightarrow> rec(n, x, \<lambda>k r. r \<union> r*r) \<subseteq> rec(m, x, \<lambda>k r. r \<union> r*r)"
 apply (rule z_n_subset_z_succ_n [THEN le_subsets])
 apply (blast intro: lt_nat_in_nat)+
 done
 
 lemma lemma_iv: "\<exists>y. x \<union> y*y \<subseteq> y"
 apply (rule_tac x = "\<Union>n \<in> nat. rec (n, x, \<lambda>k r. r \<union> r*r) " in exI)
 apply safe
 apply (rule nat_0I [THEN UN_I], simp)
 apply (rule_tac a = "succ (n \<union> na) " in UN_I)
 apply (erule Un_nat_type [THEN nat_succI], assumption)
 apply (auto intro: le_imp_rec_subset [THEN subsetD] 
             intro!: Un_upper1_le Un_upper2_le Un_nat_type 
             elim!: nat_into_Ord)
 done
 
 (* ********************************************************************** *)
 (* Rubin \<and> Rubin wrote,                                                   *)
 (* "It follows from (ii) and mathematical induction that if y*y \<subseteq> y then *)
 (* y can be well-ordered"                                                 *)
 
 (* In fact we have to prove                                               *)
 (*      * WO6 \<Longrightarrow> NN(y) \<noteq> 0                                              *)
 (*      * reverse induction which lets us infer that 1 \<in> NN(y)            *)
 (*      * 1 \<in> NN(y) \<Longrightarrow> y can be well-ordered                             *)
 (* ********************************************************************** *)
 
 (* ********************************************************************** *)
 (*      WO6 \<Longrightarrow> NN(y) \<noteq> 0                                                *)
 (* ********************************************************************** *)
 
 lemma WO6_imp_NN_not_empty: "WO6 \<Longrightarrow> NN(y) \<noteq> 0"
 by (unfold WO6_def NN_def, clarify, blast)
 
 (* ********************************************************************** *)
 (*      1 \<in> NN(y) \<Longrightarrow> y can be well-ordered                               *)
 (* ********************************************************************** *)
 
 lemma lemma1:
      "\<lbrakk>(\<Union>b<a. f`b)=y; x \<in> y; \<forall>b<a. f`b \<lesssim> 1; Ord(a)\<rbrakk> \<Longrightarrow> \<exists>c<a. f`c = {x}"
 by (fast elim!: lepoll_1_is_sing)
 
 lemma lemma2:
      "\<lbrakk>(\<Union>b<a. f`b)=y; x \<in> y; \<forall>b<a. f`b \<lesssim> 1; Ord(a)\<rbrakk>   
       \<Longrightarrow> f` (\<mu> i. f`i = {x}) = {x}"
 apply (drule lemma1, assumption+)
 apply (fast elim!: lt_Ord intro: LeastI)
 done
 
 lemma NN_imp_ex_inj: "1 \<in> NN(y) \<Longrightarrow> \<exists>a f. Ord(a) \<and> f \<in> inj(y, a)"
-apply (unfold NN_def)
+  unfolding NN_def
 apply (elim CollectE exE conjE)
 apply (rule_tac x = a in exI)
 apply (rule_tac x = "\<lambda>x \<in> y. \<mu> i. f`i = {x}" in exI)
 apply (rule conjI, assumption)
 apply (rule_tac d = "\<lambda>i. THE x. x \<in> f`i" in lam_injective)
 apply (drule lemma1, assumption+)
 apply (fast elim!: Least_le [THEN lt_trans1, THEN ltD] lt_Ord)
 apply (rule lemma2 [THEN ssubst], assumption+, blast)
 done
 
 lemma y_well_ord: "\<lbrakk>y*y \<subseteq> y; 1 \<in> NN(y)\<rbrakk> \<Longrightarrow> \<exists>r. well_ord(y, r)"
 apply (drule NN_imp_ex_inj)
 apply (fast elim!: well_ord_rvimage [OF _ well_ord_Memrel])
 done
 
 (* ********************************************************************** *)
 (*      reverse induction which lets us infer that 1 \<in> NN(y)              *)
 (* ********************************************************************** *)
 
 lemma rev_induct_lemma [rule_format]: 
      "\<lbrakk>n \<in> nat; \<And>m. \<lbrakk>m \<in> nat; m\<noteq>0; P(succ(m))\<rbrakk> \<Longrightarrow> P(m)\<rbrakk>   
       \<Longrightarrow> n\<noteq>0 \<longrightarrow> P(n) \<longrightarrow> P(1)"
 by (erule nat_induct, blast+)
 
 lemma rev_induct:
      "\<lbrakk>n \<in> nat;  P(n);  n\<noteq>0;   
          \<And>m. \<lbrakk>m \<in> nat; m\<noteq>0; P(succ(m))\<rbrakk> \<Longrightarrow> P(m)\<rbrakk>   
       \<Longrightarrow> P(1)"
 by (rule rev_induct_lemma, blast+)
 
 lemma NN_into_nat: "n \<in> NN(y) \<Longrightarrow> n \<in> nat"
 by (simp add: NN_def)
 
 lemma lemma3: "\<lbrakk>n \<in> NN(y); y*y \<subseteq> y; n\<noteq>0\<rbrakk> \<Longrightarrow> 1 \<in> NN(y)"
 apply (rule rev_induct [OF NN_into_nat], assumption+)
 apply (rule lemma_ii, assumption+)
 done
 
 (* ********************************************************************** *)
 (* Main theorem "WO6 \<Longrightarrow> WO1"                                             *)
 (* ********************************************************************** *)
 
 (* another helpful lemma *)
 lemma NN_y_0: "0 \<in> NN(y) \<Longrightarrow> y=0"
-apply (unfold NN_def) 
+  unfolding NN_def 
 apply (fast intro!: equalityI dest!: lepoll_0_is_0 elim: subst)
 done
 
 lemma WO6_imp_WO1: "WO6 \<Longrightarrow> WO1"
-apply (unfold WO1_def)
+  unfolding WO1_def
 apply (rule allI)
 apply (case_tac "A=0")
 apply (fast intro!: well_ord_Memrel nat_0I [THEN nat_into_Ord])
 apply (rule_tac x = A in lemma_iv [elim_format])
 apply (erule exE)
 apply (drule WO6_imp_NN_not_empty)
 apply (erule Un_subset_iff [THEN iffD1, THEN conjE])
 apply (erule_tac A = "NN (y) " in not_emptyE)
 apply (frule y_well_ord)
  apply (fast intro!: lemma3 dest!: NN_y_0 elim!: not_emptyE)
 apply (fast elim: well_ord_subset)
 done
 
 end
diff --git a/src/ZF/Arith.thy b/src/ZF/Arith.thy
--- a/src/ZF/Arith.thy
+++ b/src/ZF/Arith.thy
@@ -1,549 +1,549 @@
 (*  Title:      ZF/Arith.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1992  University of Cambridge
 *)
 
 (*"Difference" is subtraction of natural numbers.
   There are no negative numbers; we have
      m #- n = 0  iff  m<=n   and     m #- n = succ(k) iff m>n.
   Also, rec(m, 0, \<lambda>z w.z) is pred(m).
 *)
 
 section\<open>Arithmetic Operators and Their Definitions\<close>
 
 theory Arith imports Univ begin
 
 text\<open>Proofs about elementary arithmetic: addition, multiplication, etc.\<close>
 
 definition
   pred   :: "i\<Rightarrow>i"    (*inverse of succ*)  where
     "pred(y) \<equiv> nat_case(0, \<lambda>x. x, y)"
 
 definition
   natify :: "i\<Rightarrow>i"    (*coerces non-nats to nats*)  where
     "natify \<equiv> Vrecursor(\<lambda>f a. if a = succ(pred(a)) then succ(f`pred(a))
                                                     else 0)"
 
 consts
   raw_add  :: "[i,i]\<Rightarrow>i"
   raw_diff  :: "[i,i]\<Rightarrow>i"
   raw_mult  :: "[i,i]\<Rightarrow>i"
 
 primrec
   "raw_add (0, n) = n"
   "raw_add (succ(m), n) = succ(raw_add(m, n))"
 
 primrec
   raw_diff_0:     "raw_diff(m, 0) = m"
   raw_diff_succ:  "raw_diff(m, succ(n)) =
                      nat_case(0, \<lambda>x. x, raw_diff(m, n))"
 
 primrec
   "raw_mult(0, n) = 0"
   "raw_mult(succ(m), n) = raw_add (n, raw_mult(m, n))"
 
 definition
   add :: "[i,i]\<Rightarrow>i"                    (infixl \<open>#+\<close> 65)  where
     "m #+ n \<equiv> raw_add (natify(m), natify(n))"
 
 definition
   diff :: "[i,i]\<Rightarrow>i"                    (infixl \<open>#-\<close> 65)  where
     "m #- n \<equiv> raw_diff (natify(m), natify(n))"
 
 definition
   mult :: "[i,i]\<Rightarrow>i"                    (infixl \<open>#*\<close> 70)  where
     "m #* n \<equiv> raw_mult (natify(m), natify(n))"
 
 definition
   raw_div  :: "[i,i]\<Rightarrow>i"  where
     "raw_div (m, n) \<equiv>
        transrec(m, \<lambda>j f. if j<n | n=0 then 0 else succ(f`(j#-n)))"
 
 definition
   raw_mod  :: "[i,i]\<Rightarrow>i"  where
     "raw_mod (m, n) \<equiv>
        transrec(m, \<lambda>j f. if j<n | n=0 then j else f`(j#-n))"
 
 definition
   div  :: "[i,i]\<Rightarrow>i"                    (infixl \<open>div\<close> 70)  where
     "m div n \<equiv> raw_div (natify(m), natify(n))"
 
 definition
   mod  :: "[i,i]\<Rightarrow>i"                    (infixl \<open>mod\<close> 70)  where
     "m mod n \<equiv> raw_mod (natify(m), natify(n))"
 
 declare rec_type [simp]
         nat_0_le [simp]
 
 
 lemma zero_lt_lemma: "\<lbrakk>0<k; k \<in> nat\<rbrakk> \<Longrightarrow> \<exists>j\<in>nat. k = succ(j)"
 apply (erule rev_mp)
 apply (induct_tac "k", auto)
 done
 
 (* @{term"\<lbrakk>0 < k; k \<in> nat; \<And>j. \<lbrakk>j \<in> nat; k = succ(j)\<rbrakk> \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"} *)
 lemmas zero_lt_natE = zero_lt_lemma [THEN bexE]
 
 
 subsection\<open>\<open>natify\<close>, the Coercion to \<^term>\<open>nat\<close>\<close>
 
 lemma pred_succ_eq [simp]: "pred(succ(y)) = y"
 by (unfold pred_def, auto)
 
 lemma natify_succ: "natify(succ(x)) = succ(natify(x))"
 by (rule natify_def [THEN def_Vrecursor, THEN trans], auto)
 
 lemma natify_0 [simp]: "natify(0) = 0"
 by (rule natify_def [THEN def_Vrecursor, THEN trans], auto)
 
 lemma natify_non_succ: "\<forall>z. x \<noteq> succ(z) \<Longrightarrow> natify(x) = 0"
 by (rule natify_def [THEN def_Vrecursor, THEN trans], auto)
 
 lemma natify_in_nat [iff,TC]: "natify(x) \<in> nat"
 apply (rule_tac a=x in eps_induct)
 apply (case_tac "\<exists>z. x = succ(z)")
 apply (auto simp add: natify_succ natify_non_succ)
 done
 
 lemma natify_ident [simp]: "n \<in> nat \<Longrightarrow> natify(n) = n"
 apply (induct_tac "n")
 apply (auto simp add: natify_succ)
 done
 
 lemma natify_eqE: "\<lbrakk>natify(x) = y;  x \<in> nat\<rbrakk> \<Longrightarrow> x=y"
 by auto
 
 
 (*** Collapsing rules: to remove natify from arithmetic expressions ***)
 
 lemma natify_idem [simp]: "natify(natify(x)) = natify(x)"
 by simp
 
 (** Addition **)
 
 lemma add_natify1 [simp]: "natify(m) #+ n = m #+ n"
 by (simp add: add_def)
 
 lemma add_natify2 [simp]: "m #+ natify(n) = m #+ n"
 by (simp add: add_def)
 
 (** Multiplication **)
 
 lemma mult_natify1 [simp]: "natify(m) #* n = m #* n"
 by (simp add: mult_def)
 
 lemma mult_natify2 [simp]: "m #* natify(n) = m #* n"
 by (simp add: mult_def)
 
 (** Difference **)
 
 lemma diff_natify1 [simp]: "natify(m) #- n = m #- n"
 by (simp add: diff_def)
 
 lemma diff_natify2 [simp]: "m #- natify(n) = m #- n"
 by (simp add: diff_def)
 
 (** Remainder **)
 
 lemma mod_natify1 [simp]: "natify(m) mod n = m mod n"
 by (simp add: mod_def)
 
 lemma mod_natify2 [simp]: "m mod natify(n) = m mod n"
 by (simp add: mod_def)
 
 
 (** Quotient **)
 
 lemma div_natify1 [simp]: "natify(m) div n = m div n"
 by (simp add: div_def)
 
 lemma div_natify2 [simp]: "m div natify(n) = m div n"
 by (simp add: div_def)
 
 
 subsection\<open>Typing rules\<close>
 
 (** Addition **)
 
 lemma raw_add_type: "\<lbrakk>m\<in>nat;  n\<in>nat\<rbrakk> \<Longrightarrow> raw_add (m, n) \<in> nat"
 by (induct_tac "m", auto)
 
 lemma add_type [iff,TC]: "m #+ n \<in> nat"
 by (simp add: add_def raw_add_type)
 
 (** Multiplication **)
 
 lemma raw_mult_type: "\<lbrakk>m\<in>nat;  n\<in>nat\<rbrakk> \<Longrightarrow> raw_mult (m, n) \<in> nat"
 apply (induct_tac "m")
 apply (simp_all add: raw_add_type)
 done
 
 lemma mult_type [iff,TC]: "m #* n \<in> nat"
 by (simp add: mult_def raw_mult_type)
 
 
 (** Difference **)
 
 lemma raw_diff_type: "\<lbrakk>m\<in>nat;  n\<in>nat\<rbrakk> \<Longrightarrow> raw_diff (m, n) \<in> nat"
 by (induct_tac "n", auto)
 
 lemma diff_type [iff,TC]: "m #- n \<in> nat"
 by (simp add: diff_def raw_diff_type)
 
 lemma diff_0_eq_0 [simp]: "0 #- n = 0"
-apply (unfold diff_def)
+  unfolding diff_def
 apply (rule natify_in_nat [THEN nat_induct], auto)
 done
 
 (*Must simplify BEFORE the induction: else we get a critical pair*)
 lemma diff_succ_succ [simp]: "succ(m) #- succ(n) = m #- n"
 apply (simp add: natify_succ diff_def)
 apply (rule_tac x1 = n in natify_in_nat [THEN nat_induct], auto)
 done
 
 (*This defining property is no longer wanted*)
 declare raw_diff_succ [simp del]
 
 (*Natify has weakened this law, compared with the older approach*)
 lemma diff_0 [simp]: "m #- 0 = natify(m)"
 by (simp add: diff_def)
 
 lemma diff_le_self: "m\<in>nat \<Longrightarrow> (m #- n) \<le> m"
 apply (subgoal_tac " (m #- natify (n)) \<le> m")
 apply (rule_tac [2] m = m and n = "natify (n) " in diff_induct)
 apply (erule_tac [6] leE)
 apply (simp_all add: le_iff)
 done
 
 
 subsection\<open>Addition\<close>
 
 (*Natify has weakened this law, compared with the older approach*)
 lemma add_0_natify [simp]: "0 #+ m = natify(m)"
 by (simp add: add_def)
 
 lemma add_succ [simp]: "succ(m) #+ n = succ(m #+ n)"
 by (simp add: natify_succ add_def)
 
 lemma add_0: "m \<in> nat \<Longrightarrow> 0 #+ m = m"
 by simp
 
 (*Associative law for addition*)
 lemma add_assoc: "(m #+ n) #+ k = m #+ (n #+ k)"
 apply (subgoal_tac "(natify(m) #+ natify(n)) #+ natify(k) =
                     natify(m) #+ (natify(n) #+ natify(k))")
 apply (rule_tac [2] n = "natify(m)" in nat_induct)
 apply auto
 done
 
 (*The following two lemmas are used for add_commute and sometimes
   elsewhere, since they are safe for rewriting.*)
 lemma add_0_right_natify [simp]: "m #+ 0 = natify(m)"
 apply (subgoal_tac "natify(m) #+ 0 = natify(m)")
 apply (rule_tac [2] n = "natify(m)" in nat_induct)
 apply auto
 done
 
 lemma add_succ_right [simp]: "m #+ succ(n) = succ(m #+ n)"
-apply (unfold add_def)
+  unfolding add_def
 apply (rule_tac n = "natify(m) " in nat_induct)
 apply (auto simp add: natify_succ)
 done
 
 lemma add_0_right: "m \<in> nat \<Longrightarrow> m #+ 0 = m"
 by auto
 
 (*Commutative law for addition*)
 lemma add_commute: "m #+ n = n #+ m"
 apply (subgoal_tac "natify(m) #+ natify(n) = natify(n) #+ natify(m) ")
 apply (rule_tac [2] n = "natify(m) " in nat_induct)
 apply auto
 done
 
 (*for a/c rewriting*)
 lemma add_left_commute: "m#+(n#+k)=n#+(m#+k)"
 apply (rule add_commute [THEN trans])
 apply (rule add_assoc [THEN trans])
 apply (rule add_commute [THEN subst_context])
 done
 
 (*Addition is an AC-operator*)
 lemmas add_ac = add_assoc add_commute add_left_commute
 
 (*Cancellation law on the left*)
 lemma raw_add_left_cancel:
      "\<lbrakk>raw_add(k, m) = raw_add(k, n);  k\<in>nat\<rbrakk> \<Longrightarrow> m=n"
 apply (erule rev_mp)
 apply (induct_tac "k", auto)
 done
 
 lemma add_left_cancel_natify: "k #+ m = k #+ n \<Longrightarrow> natify(m) = natify(n)"
-apply (unfold add_def)
+  unfolding add_def
 apply (drule raw_add_left_cancel, auto)
 done
 
 lemma add_left_cancel:
      "\<lbrakk>i = j;  i #+ m = j #+ n;  m\<in>nat;  n\<in>nat\<rbrakk> \<Longrightarrow> m = n"
 by (force dest!: add_left_cancel_natify)
 
 (*Thanks to Sten Agerholm*)
 lemma add_le_elim1_natify: "k#+m \<le> k#+n \<Longrightarrow> natify(m) \<le> natify(n)"
 apply (rule_tac P = "natify(k) #+m \<le> natify(k) #+n" in rev_mp)
 apply (rule_tac [2] n = "natify(k) " in nat_induct)
 apply auto
 done
 
 lemma add_le_elim1: "\<lbrakk>k#+m \<le> k#+n; m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> m \<le> n"
 by (drule add_le_elim1_natify, auto)
 
 lemma add_lt_elim1_natify: "k#+m < k#+n \<Longrightarrow> natify(m) < natify(n)"
 apply (rule_tac P = "natify(k) #+m < natify(k) #+n" in rev_mp)
 apply (rule_tac [2] n = "natify(k) " in nat_induct)
 apply auto
 done
 
 lemma add_lt_elim1: "\<lbrakk>k#+m < k#+n; m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> m < n"
 by (drule add_lt_elim1_natify, auto)
 
 lemma zero_less_add: "\<lbrakk>n \<in> nat; m \<in> nat\<rbrakk> \<Longrightarrow> 0 < m #+ n \<longleftrightarrow> (0<m | 0<n)"
 by (induct_tac "n", auto)
 
 
 subsection\<open>Monotonicity of Addition\<close>
 
 (*strict, in 1st argument; proof is by rule induction on 'less than'.
   Still need j\<in>nat, for consider j = omega.  Then we can have i<omega,
   which is the same as i\<in>nat, but natify(j)=0, so the conclusion fails.*)
 lemma add_lt_mono1: "\<lbrakk>i<j; j\<in>nat\<rbrakk> \<Longrightarrow> i#+k < j#+k"
 apply (frule lt_nat_in_nat, assumption)
 apply (erule succ_lt_induct)
 apply (simp_all add: leI)
 done
 
 text\<open>strict, in second argument\<close>
 lemma add_lt_mono2: "\<lbrakk>i<j; j\<in>nat\<rbrakk> \<Longrightarrow> k#+i < k#+j"
 by (simp add: add_commute [of k] add_lt_mono1)
 
 text\<open>A [clumsy] way of lifting < monotonicity to \<open>\<le>\<close> monotonicity\<close>
 lemma Ord_lt_mono_imp_le_mono:
   assumes lt_mono: "\<And>i j. \<lbrakk>i<j; j:k\<rbrakk> \<Longrightarrow> f(i) < f(j)"
       and ford:    "\<And>i. i:k \<Longrightarrow> Ord(f(i))"
       and leij:    "i \<le> j"
       and jink:    "j:k"
   shows "f(i) \<le> f(j)"
 apply (insert leij jink)
 apply (blast intro!: leCI lt_mono ford elim!: leE)
 done
 
 text\<open>\<open>\<le>\<close> monotonicity, 1st argument\<close>
 lemma add_le_mono1: "\<lbrakk>i \<le> j; j\<in>nat\<rbrakk> \<Longrightarrow> i#+k \<le> j#+k"
 apply (rule_tac f = "\<lambda>j. j#+k" in Ord_lt_mono_imp_le_mono, typecheck)
 apply (blast intro: add_lt_mono1 add_type [THEN nat_into_Ord])+
 done
 
 text\<open>\<open>\<le>\<close> monotonicity, both arguments\<close>
 lemma add_le_mono: "\<lbrakk>i \<le> j; k \<le> l; j\<in>nat; l\<in>nat\<rbrakk> \<Longrightarrow> i#+k \<le> j#+l"
 apply (rule add_le_mono1 [THEN le_trans], assumption+)
 apply (subst add_commute, subst add_commute, rule add_le_mono1, assumption+)
 done
 
 text\<open>Combinations of less-than and less-than-or-equals\<close>
 
 lemma add_lt_le_mono: "\<lbrakk>i<j; k\<le>l; j\<in>nat; l\<in>nat\<rbrakk> \<Longrightarrow> i#+k < j#+l"
 apply (rule add_lt_mono1 [THEN lt_trans2], assumption+)
 apply (subst add_commute, subst add_commute, rule add_le_mono1, assumption+)
 done
 
 lemma add_le_lt_mono: "\<lbrakk>i\<le>j; k<l; j\<in>nat; l\<in>nat\<rbrakk> \<Longrightarrow> i#+k < j#+l"
 by (subst add_commute, subst add_commute, erule add_lt_le_mono, assumption+)
 
 text\<open>Less-than: in other words, strict in both arguments\<close>
 lemma add_lt_mono: "\<lbrakk>i<j; k<l; j\<in>nat; l\<in>nat\<rbrakk> \<Longrightarrow> i#+k < j#+l"
 apply (rule add_lt_le_mono)
 apply (auto intro: leI)
 done
 
 (** Subtraction is the inverse of addition. **)
 
 lemma diff_add_inverse: "(n#+m) #- n = natify(m)"
 apply (subgoal_tac " (natify(n) #+ m) #- natify(n) = natify(m) ")
 apply (rule_tac [2] n = "natify(n) " in nat_induct)
 apply auto
 done
 
 lemma diff_add_inverse2: "(m#+n) #- n = natify(m)"
 by (simp add: add_commute [of m] diff_add_inverse)
 
 lemma diff_cancel: "(k#+m) #- (k#+n) = m #- n"
 apply (subgoal_tac "(natify(k) #+ natify(m)) #- (natify(k) #+ natify(n)) =
                     natify(m) #- natify(n) ")
 apply (rule_tac [2] n = "natify(k) " in nat_induct)
 apply auto
 done
 
 lemma diff_cancel2: "(m#+k) #- (n#+k) = m #- n"
 by (simp add: add_commute [of _ k] diff_cancel)
 
 lemma diff_add_0: "n #- (n#+m) = 0"
 apply (subgoal_tac "natify(n) #- (natify(n) #+ natify(m)) = 0")
 apply (rule_tac [2] n = "natify(n) " in nat_induct)
 apply auto
 done
 
 lemma pred_0 [simp]: "pred(0) = 0"
 by (simp add: pred_def)
 
 lemma eq_succ_imp_eq_m1: "\<lbrakk>i = succ(j); i\<in>nat\<rbrakk> \<Longrightarrow> j = i #- 1 \<and> j \<in>nat"
 by simp
 
 lemma pred_Un_distrib:
     "\<lbrakk>i\<in>nat; j\<in>nat\<rbrakk> \<Longrightarrow> pred(i \<union> j) = pred(i) \<union> pred(j)"
 apply (erule_tac n=i in natE, simp)
 apply (erule_tac n=j in natE, simp)
 apply (simp add:  succ_Un_distrib [symmetric])
 done
 
 lemma pred_type [TC,simp]:
     "i \<in> nat \<Longrightarrow> pred(i) \<in> nat"
 by (simp add: pred_def split: split_nat_case)
 
 lemma nat_diff_pred: "\<lbrakk>i\<in>nat; j\<in>nat\<rbrakk> \<Longrightarrow> i #- succ(j) = pred(i #- j)"
 apply (rule_tac m=i and n=j in diff_induct)
 apply (auto simp add: pred_def nat_imp_quasinat split: split_nat_case)
 done
 
 lemma diff_succ_eq_pred: "i #- succ(j) = pred(i #- j)"
 apply (insert nat_diff_pred [of "natify(i)" "natify(j)"])
 apply (simp add: natify_succ [symmetric])
 done
 
 lemma nat_diff_Un_distrib:
     "\<lbrakk>i\<in>nat; j\<in>nat; k\<in>nat\<rbrakk> \<Longrightarrow> (i \<union> j) #- k = (i#-k) \<union> (j#-k)"
 apply (rule_tac n=k in nat_induct)
 apply (simp_all add: diff_succ_eq_pred pred_Un_distrib)
 done
 
 lemma diff_Un_distrib:
     "\<lbrakk>i\<in>nat; j\<in>nat\<rbrakk> \<Longrightarrow> (i \<union> j) #- k = (i#-k) \<union> (j#-k)"
 by (insert nat_diff_Un_distrib [of i j "natify(k)"], simp)
 
 text\<open>We actually prove \<^term>\<open>i #- j #- k = i #- (j #+ k)\<close>\<close>
 lemma diff_diff_left [simplified]:
      "natify(i)#-natify(j)#-k = natify(i) #- (natify(j)#+k)"
 by (rule_tac m="natify(i)" and n="natify(j)" in diff_induct, auto)
 
 
 (** Lemmas for the CancelNumerals simproc **)
 
 lemma eq_add_iff: "(u #+ m = u #+ n) \<longleftrightarrow> (0 #+ m = natify(n))"
 apply auto
 apply (blast dest: add_left_cancel_natify)
 apply (simp add: add_def)
 done
 
 lemma less_add_iff: "(u #+ m < u #+ n) \<longleftrightarrow> (0 #+ m < natify(n))"
 apply (auto simp add: add_lt_elim1_natify)
 apply (drule add_lt_mono1)
 apply (auto simp add: add_commute [of u])
 done
 
 lemma diff_add_eq: "((u #+ m) #- (u #+ n)) = ((0 #+ m) #- n)"
 by (simp add: diff_cancel)
 
 (*To tidy up the result of a simproc.  Only the RHS will be simplified.*)
 lemma eq_cong2: "u = u' \<Longrightarrow> (t\<equiv>u) \<equiv> (t\<equiv>u')"
 by auto
 
 lemma iff_cong2: "u \<longleftrightarrow> u' \<Longrightarrow> (t\<equiv>u) \<equiv> (t\<equiv>u')"
 by auto
 
 
 subsection\<open>Multiplication\<close>
 
 lemma mult_0 [simp]: "0 #* m = 0"
 by (simp add: mult_def)
 
 lemma mult_succ [simp]: "succ(m) #* n = n #+ (m #* n)"
 by (simp add: add_def mult_def natify_succ raw_mult_type)
 
 (*right annihilation in product*)
 lemma mult_0_right [simp]: "m #* 0 = 0"
-apply (unfold mult_def)
+  unfolding mult_def
 apply (rule_tac n = "natify(m) " in nat_induct)
 apply auto
 done
 
 (*right successor law for multiplication*)
 lemma mult_succ_right [simp]: "m #* succ(n) = m #+ (m #* n)"
 apply (subgoal_tac "natify(m) #* succ (natify(n)) =
                     natify(m) #+ (natify(m) #* natify(n))")
 apply (simp (no_asm_use) add: natify_succ add_def mult_def)
 apply (rule_tac n = "natify(m) " in nat_induct)
 apply (simp_all add: add_ac)
 done
 
 lemma mult_1_natify [simp]: "1 #* n = natify(n)"
 by auto
 
 lemma mult_1_right_natify [simp]: "n #* 1 = natify(n)"
 by auto
 
 lemma mult_1: "n \<in> nat \<Longrightarrow> 1 #* n = n"
 by simp
 
 lemma mult_1_right: "n \<in> nat \<Longrightarrow> n #* 1 = n"
 by simp
 
 (*Commutative law for multiplication*)
 lemma mult_commute: "m #* n = n #* m"
 apply (subgoal_tac "natify(m) #* natify(n) = natify(n) #* natify(m) ")
 apply (rule_tac [2] n = "natify(m) " in nat_induct)
 apply auto
 done
 
 (*addition distributes over multiplication*)
 lemma add_mult_distrib: "(m #+ n) #* k = (m #* k) #+ (n #* k)"
 apply (subgoal_tac "(natify(m) #+ natify(n)) #* natify(k) =
                     (natify(m) #* natify(k)) #+ (natify(n) #* natify(k))")
 apply (rule_tac [2] n = "natify(m) " in nat_induct)
 apply (simp_all add: add_assoc [symmetric])
 done
 
 (*Distributive law on the left*)
 lemma add_mult_distrib_left: "k #* (m #+ n) = (k #* m) #+ (k #* n)"
 apply (subgoal_tac "natify(k) #* (natify(m) #+ natify(n)) =
                     (natify(k) #* natify(m)) #+ (natify(k) #* natify(n))")
 apply (rule_tac [2] n = "natify(m) " in nat_induct)
 apply (simp_all add: add_ac)
 done
 
 (*Associative law for multiplication*)
 lemma mult_assoc: "(m #* n) #* k = m #* (n #* k)"
 apply (subgoal_tac "(natify(m) #* natify(n)) #* natify(k) =
                     natify(m) #* (natify(n) #* natify(k))")
 apply (rule_tac [2] n = "natify(m) " in nat_induct)
 apply (simp_all add: add_mult_distrib)
 done
 
 (*for a/c rewriting*)
 lemma mult_left_commute: "m #* (n #* k) = n #* (m #* k)"
 apply (rule mult_commute [THEN trans])
 apply (rule mult_assoc [THEN trans])
 apply (rule mult_commute [THEN subst_context])
 done
 
 lemmas mult_ac = mult_assoc mult_commute mult_left_commute
 
 
 lemma lt_succ_eq_0_disj:
      "\<lbrakk>m\<in>nat; n\<in>nat\<rbrakk>
       \<Longrightarrow> (m < succ(n)) \<longleftrightarrow> (m = 0 | (\<exists>j\<in>nat. m = succ(j) \<and> j < n))"
 by (induct_tac "m", auto)
 
 lemma less_diff_conv [rule_format]:
      "\<lbrakk>j\<in>nat; k\<in>nat\<rbrakk> \<Longrightarrow> \<forall>i\<in>nat. (i < j #- k) \<longleftrightarrow> (i #+ k < j)"
 by (erule_tac m = k in diff_induct, auto)
 
 lemmas nat_typechecks = rec_type nat_0I nat_1I nat_succI Ord_nat
 
 end
diff --git a/src/ZF/ArithSimp.thy b/src/ZF/ArithSimp.thy
--- a/src/ZF/ArithSimp.thy
+++ b/src/ZF/ArithSimp.thy
@@ -1,569 +1,569 @@
 (*  Title:      ZF/ArithSimp.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   2000  University of Cambridge
 *)
 
 section\<open>Arithmetic with simplification\<close>
 
 theory ArithSimp
 imports Arith
 begin
 
 ML_file \<open>~~/src/Provers/Arith/cancel_numerals.ML\<close>
 ML_file \<open>~~/src/Provers/Arith/combine_numerals.ML\<close>
 ML_file \<open>arith_data.ML\<close>
 
 
 subsection\<open>Difference\<close>
 
 lemma diff_self_eq_0 [simp]: "m #- m = 0"
 apply (subgoal_tac "natify (m) #- natify (m) = 0")
 apply (rule_tac [2] natify_in_nat [THEN nat_induct], auto)
 done
 
 (**Addition is the inverse of subtraction**)
 
 (*We need m:nat even if we replace the RHS by natify(m), for consider e.g.
   n=2, m=omega; then n + (m-n) = 2 + (0-2) = 2 \<noteq> 0 = natify(m).*)
 lemma add_diff_inverse: "\<lbrakk>n \<le> m;  m:nat\<rbrakk> \<Longrightarrow> n #+ (m#-n) = m"
 apply (frule lt_nat_in_nat, erule nat_succI)
 apply (erule rev_mp)
 apply (rule_tac m = m and n = n in diff_induct, auto)
 done
 
 lemma add_diff_inverse2: "\<lbrakk>n \<le> m;  m:nat\<rbrakk> \<Longrightarrow> (m#-n) #+ n = m"
 apply (frule lt_nat_in_nat, erule nat_succI)
 apply (simp (no_asm_simp) add: add_commute add_diff_inverse)
 done
 
 (*Proof is IDENTICAL to that of add_diff_inverse*)
 lemma diff_succ: "\<lbrakk>n \<le> m;  m:nat\<rbrakk> \<Longrightarrow> succ(m) #- n = succ(m#-n)"
 apply (frule lt_nat_in_nat, erule nat_succI)
 apply (erule rev_mp)
 apply (rule_tac m = m and n = n in diff_induct)
 apply (simp_all (no_asm_simp))
 done
 
 lemma zero_less_diff [simp]:
      "\<lbrakk>m: nat; n: nat\<rbrakk> \<Longrightarrow> 0 < (n #- m)   \<longleftrightarrow>   m<n"
 apply (rule_tac m = m and n = n in diff_induct)
 apply (simp_all (no_asm_simp))
 done
 
 
 (** Difference distributes over multiplication **)
 
 lemma diff_mult_distrib: "(m #- n) #* k = (m #* k) #- (n #* k)"
 apply (subgoal_tac " (natify (m) #- natify (n)) #* natify (k) = (natify (m) #* natify (k)) #- (natify (n) #* natify (k))")
 apply (rule_tac [2] m = "natify (m) " and n = "natify (n) " in diff_induct)
 apply (simp_all add: diff_cancel)
 done
 
 lemma diff_mult_distrib2: "k #* (m #- n) = (k #* m) #- (k #* n)"
 apply (simp (no_asm) add: mult_commute [of k] diff_mult_distrib)
 done
 
 
 subsection\<open>Remainder\<close>
 
 (*We need m:nat even with natify*)
 lemma div_termination: "\<lbrakk>0<n;  n \<le> m;  m:nat\<rbrakk> \<Longrightarrow> m #- n < m"
 apply (frule lt_nat_in_nat, erule nat_succI)
 apply (erule rev_mp)
 apply (erule rev_mp)
 apply (rule_tac m = m and n = n in diff_induct)
 apply (simp_all (no_asm_simp) add: diff_le_self)
 done
 
 (*for mod and div*)
 lemmas div_rls =
     nat_typechecks Ord_transrec_type apply_funtype
     div_termination [THEN ltD]
     nat_into_Ord not_lt_iff_le [THEN iffD1]
 
 lemma raw_mod_type: "\<lbrakk>m:nat;  n:nat\<rbrakk> \<Longrightarrow> raw_mod (m, n) \<in> nat"
-apply (unfold raw_mod_def)
+  unfolding raw_mod_def
 apply (rule Ord_transrec_type)
 apply (auto simp add: nat_into_Ord [THEN Ord_0_lt_iff])
 apply (blast intro: div_rls)
 done
 
 lemma mod_type [TC,iff]: "m mod n \<in> nat"
-apply (unfold mod_def)
+  unfolding mod_def
 apply (simp (no_asm) add: mod_def raw_mod_type)
 done
 
 
 (** Aribtrary definitions for division by zero.  Useful to simplify
     certain equations **)
 
 lemma DIVISION_BY_ZERO_DIV: "a div 0 = 0"
-apply (unfold div_def)
+  unfolding div_def
 apply (rule raw_div_def [THEN def_transrec, THEN trans])
 apply (simp (no_asm_simp))
 done  (*NOT for adding to default simpset*)
 
 lemma DIVISION_BY_ZERO_MOD: "a mod 0 = natify(a)"
-apply (unfold mod_def)
+  unfolding mod_def
 apply (rule raw_mod_def [THEN def_transrec, THEN trans])
 apply (simp (no_asm_simp))
 done  (*NOT for adding to default simpset*)
 
 lemma raw_mod_less: "m<n \<Longrightarrow> raw_mod (m,n) = m"
 apply (rule raw_mod_def [THEN def_transrec, THEN trans])
 apply (simp (no_asm_simp) add: div_termination [THEN ltD])
 done
 
 lemma mod_less [simp]: "\<lbrakk>m<n; n \<in> nat\<rbrakk> \<Longrightarrow> m mod n = m"
 apply (frule lt_nat_in_nat, assumption)
 apply (simp (no_asm_simp) add: mod_def raw_mod_less)
 done
 
 lemma raw_mod_geq:
      "\<lbrakk>0<n; n \<le> m;  m:nat\<rbrakk> \<Longrightarrow> raw_mod (m, n) = raw_mod (m#-n, n)"
 apply (frule lt_nat_in_nat, erule nat_succI)
 apply (rule raw_mod_def [THEN def_transrec, THEN trans])
 apply (simp (no_asm_simp) add: div_termination [THEN ltD] not_lt_iff_le [THEN iffD2], blast)
 done
 
 
 lemma mod_geq: "\<lbrakk>n \<le> m;  m:nat\<rbrakk> \<Longrightarrow> m mod n = (m#-n) mod n"
 apply (frule lt_nat_in_nat, erule nat_succI)
 apply (case_tac "n=0")
  apply (simp add: DIVISION_BY_ZERO_MOD)
 apply (simp add: mod_def raw_mod_geq nat_into_Ord [THEN Ord_0_lt_iff])
 done
 
 
 subsection\<open>Division\<close>
 
 lemma raw_div_type: "\<lbrakk>m:nat;  n:nat\<rbrakk> \<Longrightarrow> raw_div (m, n) \<in> nat"
-apply (unfold raw_div_def)
+  unfolding raw_div_def
 apply (rule Ord_transrec_type)
 apply (auto simp add: nat_into_Ord [THEN Ord_0_lt_iff])
 apply (blast intro: div_rls)
 done
 
 lemma div_type [TC,iff]: "m div n \<in> nat"
-apply (unfold div_def)
+  unfolding div_def
 apply (simp (no_asm) add: div_def raw_div_type)
 done
 
 lemma raw_div_less: "m<n \<Longrightarrow> raw_div (m,n) = 0"
 apply (rule raw_div_def [THEN def_transrec, THEN trans])
 apply (simp (no_asm_simp) add: div_termination [THEN ltD])
 done
 
 lemma div_less [simp]: "\<lbrakk>m<n; n \<in> nat\<rbrakk> \<Longrightarrow> m div n = 0"
 apply (frule lt_nat_in_nat, assumption)
 apply (simp (no_asm_simp) add: div_def raw_div_less)
 done
 
 lemma raw_div_geq: "\<lbrakk>0<n;  n \<le> m;  m:nat\<rbrakk> \<Longrightarrow> raw_div(m,n) = succ(raw_div(m#-n, n))"
 apply (subgoal_tac "n \<noteq> 0")
 prefer 2 apply blast
 apply (frule lt_nat_in_nat, erule nat_succI)
 apply (rule raw_div_def [THEN def_transrec, THEN trans])
 apply (simp (no_asm_simp) add: div_termination [THEN ltD] not_lt_iff_le [THEN iffD2] )
 done
 
 lemma div_geq [simp]:
      "\<lbrakk>0<n;  n \<le> m;  m:nat\<rbrakk> \<Longrightarrow> m div n = succ ((m#-n) div n)"
 apply (frule lt_nat_in_nat, erule nat_succI)
 apply (simp (no_asm_simp) add: div_def raw_div_geq)
 done
 
 declare div_less [simp] div_geq [simp]
 
 
 (*A key result*)
 lemma mod_div_lemma: "\<lbrakk>m: nat;  n: nat\<rbrakk> \<Longrightarrow> (m div n)#*n #+ m mod n = m"
 apply (case_tac "n=0")
  apply (simp add: DIVISION_BY_ZERO_MOD)
 apply (simp add: nat_into_Ord [THEN Ord_0_lt_iff])
 apply (erule complete_induct)
 apply (case_tac "x<n")
 txt\<open>case x<n\<close>
 apply (simp (no_asm_simp))
 txt\<open>case \<^term>\<open>n \<le> x\<close>\<close>
 apply (simp add: not_lt_iff_le add_assoc mod_geq div_termination [THEN ltD] add_diff_inverse)
 done
 
 lemma mod_div_equality_natify: "(m div n)#*n #+ m mod n = natify(m)"
 apply (subgoal_tac " (natify (m) div natify (n))#*natify (n) #+ natify (m) mod natify (n) = natify (m) ")
 apply force
 apply (subst mod_div_lemma, auto)
 done
 
 lemma mod_div_equality: "m: nat \<Longrightarrow> (m div n)#*n #+ m mod n = m"
 apply (simp (no_asm_simp) add: mod_div_equality_natify)
 done
 
 
 subsection\<open>Further Facts about Remainder\<close>
 
 text\<open>(mainly for mutilated chess board)\<close>
 
 lemma mod_succ_lemma:
      "\<lbrakk>0<n;  m:nat;  n:nat\<rbrakk>
       \<Longrightarrow> succ(m) mod n = (if succ(m mod n) = n then 0 else succ(m mod n))"
 apply (erule complete_induct)
 apply (case_tac "succ (x) <n")
 txt\<open>case succ(x) < n\<close>
  apply (simp (no_asm_simp) add: nat_le_refl [THEN lt_trans] succ_neq_self)
  apply (simp add: ltD [THEN mem_imp_not_eq])
 txt\<open>case \<^term>\<open>n \<le> succ(x)\<close>\<close>
 apply (simp add: mod_geq not_lt_iff_le)
 apply (erule leE)
  apply (simp (no_asm_simp) add: mod_geq div_termination [THEN ltD] diff_succ)
 txt\<open>equality case\<close>
 apply (simp add: diff_self_eq_0)
 done
 
 lemma mod_succ:
   "n:nat \<Longrightarrow> succ(m) mod n = (if succ(m mod n) = n then 0 else succ(m mod n))"
 apply (case_tac "n=0")
  apply (simp (no_asm_simp) add: natify_succ DIVISION_BY_ZERO_MOD)
 apply (subgoal_tac "natify (succ (m)) mod n = (if succ (natify (m) mod n) = n then 0 else succ (natify (m) mod n))")
  prefer 2
  apply (subst natify_succ)
  apply (rule mod_succ_lemma)
   apply (auto simp del: natify_succ simp add: nat_into_Ord [THEN Ord_0_lt_iff])
 done
 
 lemma mod_less_divisor: "\<lbrakk>0<n;  n:nat\<rbrakk> \<Longrightarrow> m mod n < n"
 apply (subgoal_tac "natify (m) mod n < n")
 apply (rule_tac [2] i = "natify (m) " in complete_induct)
 apply (case_tac [3] "x<n", auto)
 txt\<open>case \<^term>\<open>n \<le> x\<close>\<close>
 apply (simp add: mod_geq not_lt_iff_le div_termination [THEN ltD])
 done
 
 lemma mod_1_eq [simp]: "m mod 1 = 0"
 by (cut_tac n = 1 in mod_less_divisor, auto)
 
 lemma mod2_cases: "b<2 \<Longrightarrow> k mod 2 = b | k mod 2 = (if b=1 then 0 else 1)"
 apply (subgoal_tac "k mod 2: 2")
  prefer 2 apply (simp add: mod_less_divisor [THEN ltD])
 apply (drule ltD, auto)
 done
 
 lemma mod2_succ_succ [simp]: "succ(succ(m)) mod 2 = m mod 2"
 apply (subgoal_tac "m mod 2: 2")
  prefer 2 apply (simp add: mod_less_divisor [THEN ltD])
 apply (auto simp add: mod_succ)
 done
 
 lemma mod2_add_more [simp]: "(m#+m#+n) mod 2 = n mod 2"
 apply (subgoal_tac " (natify (m) #+natify (m) #+n) mod 2 = n mod 2")
 apply (rule_tac [2] n = "natify (m) " in nat_induct)
 apply auto
 done
 
 lemma mod2_add_self [simp]: "(m#+m) mod 2 = 0"
 by (cut_tac n = 0 in mod2_add_more, auto)
 
 
 subsection\<open>Additional theorems about \<open>\<le>\<close>\<close>
 
 lemma add_le_self: "m:nat \<Longrightarrow> m \<le> (m #+ n)"
 apply (simp (no_asm_simp))
 done
 
 lemma add_le_self2: "m:nat \<Longrightarrow> m \<le> (n #+ m)"
 apply (simp (no_asm_simp))
 done
 
 (*** Monotonicity of Multiplication ***)
 
 lemma mult_le_mono1: "\<lbrakk>i \<le> j; j:nat\<rbrakk> \<Longrightarrow> (i#*k) \<le> (j#*k)"
 apply (subgoal_tac "natify (i) #*natify (k) \<le> j#*natify (k) ")
 apply (frule_tac [2] lt_nat_in_nat)
 apply (rule_tac [3] n = "natify (k) " in nat_induct)
 apply (simp_all add: add_le_mono)
 done
 
 (* @{text"\<le>"} monotonicity, BOTH arguments*)
 lemma mult_le_mono: "\<lbrakk>i \<le> j; k \<le> l; j:nat; l:nat\<rbrakk> \<Longrightarrow> i#*k \<le> j#*l"
 apply (rule mult_le_mono1 [THEN le_trans], assumption+)
 apply (subst mult_commute, subst mult_commute, rule mult_le_mono1, assumption+)
 done
 
 (*strict, in 1st argument; proof is by induction on k>0.
   I can't see how to relax the typing conditions.*)
 lemma mult_lt_mono2: "\<lbrakk>i<j; 0<k; j:nat; k:nat\<rbrakk> \<Longrightarrow> k#*i < k#*j"
 apply (erule zero_lt_natE)
 apply (frule_tac [2] lt_nat_in_nat)
 apply (simp_all (no_asm_simp))
 apply (induct_tac "x")
 apply (simp_all (no_asm_simp) add: add_lt_mono)
 done
 
 lemma mult_lt_mono1: "\<lbrakk>i<j; 0<k; j:nat; k:nat\<rbrakk> \<Longrightarrow> i#*k < j#*k"
 apply (simp (no_asm_simp) add: mult_lt_mono2 mult_commute [of _ k])
 done
 
 lemma add_eq_0_iff [iff]: "m#+n = 0 \<longleftrightarrow> natify(m)=0 \<and> natify(n)=0"
 apply (subgoal_tac "natify (m) #+ natify (n) = 0 \<longleftrightarrow> natify (m) =0 \<and> natify (n) =0")
 apply (rule_tac [2] n = "natify (m) " in natE)
  apply (rule_tac [4] n = "natify (n) " in natE)
 apply auto
 done
 
 lemma zero_lt_mult_iff [iff]: "0 < m#*n \<longleftrightarrow> 0 < natify(m) \<and> 0 < natify(n)"
 apply (subgoal_tac "0 < natify (m) #*natify (n) \<longleftrightarrow> 0 < natify (m) \<and> 0 < natify (n) ")
 apply (rule_tac [2] n = "natify (m) " in natE)
  apply (rule_tac [4] n = "natify (n) " in natE)
   apply (rule_tac [3] n = "natify (n) " in natE)
 apply auto
 done
 
 lemma mult_eq_1_iff [iff]: "m#*n = 1 \<longleftrightarrow> natify(m)=1 \<and> natify(n)=1"
 apply (subgoal_tac "natify (m) #* natify (n) = 1 \<longleftrightarrow> natify (m) =1 \<and> natify (n) =1")
 apply (rule_tac [2] n = "natify (m) " in natE)
  apply (rule_tac [4] n = "natify (n) " in natE)
 apply auto
 done
 
 
 lemma mult_is_zero: "\<lbrakk>m: nat; n: nat\<rbrakk> \<Longrightarrow> (m #* n = 0) \<longleftrightarrow> (m = 0 | n = 0)"
 apply auto
 apply (erule natE)
 apply (erule_tac [2] natE, auto)
 done
 
 lemma mult_is_zero_natify [iff]:
      "(m #* n = 0) \<longleftrightarrow> (natify(m) = 0 | natify(n) = 0)"
 apply (cut_tac m = "natify (m) " and n = "natify (n) " in mult_is_zero)
 apply auto
 done
 
 
 subsection\<open>Cancellation Laws for Common Factors in Comparisons\<close>
 
 lemma mult_less_cancel_lemma:
      "\<lbrakk>k: nat; m: nat; n: nat\<rbrakk> \<Longrightarrow> (m#*k < n#*k) \<longleftrightarrow> (0<k \<and> m<n)"
 apply (safe intro!: mult_lt_mono1)
 apply (erule natE, auto)
 apply (rule not_le_iff_lt [THEN iffD1])
 apply (drule_tac [3] not_le_iff_lt [THEN [2] rev_iffD2])
 prefer 5 apply (blast intro: mult_le_mono1, auto)
 done
 
 lemma mult_less_cancel2 [simp]:
      "(m#*k < n#*k) \<longleftrightarrow> (0 < natify(k) \<and> natify(m) < natify(n))"
 apply (rule iff_trans)
 apply (rule_tac [2] mult_less_cancel_lemma, auto)
 done
 
 lemma mult_less_cancel1 [simp]:
      "(k#*m < k#*n) \<longleftrightarrow> (0 < natify(k) \<and> natify(m) < natify(n))"
 apply (simp (no_asm) add: mult_less_cancel2 mult_commute [of k])
 done
 
 lemma mult_le_cancel2 [simp]: "(m#*k \<le> n#*k) \<longleftrightarrow> (0 < natify(k) \<longrightarrow> natify(m) \<le> natify(n))"
 apply (simp (no_asm_simp) add: not_lt_iff_le [THEN iff_sym])
 apply auto
 done
 
 lemma mult_le_cancel1 [simp]: "(k#*m \<le> k#*n) \<longleftrightarrow> (0 < natify(k) \<longrightarrow> natify(m) \<le> natify(n))"
 apply (simp (no_asm_simp) add: not_lt_iff_le [THEN iff_sym])
 apply auto
 done
 
 lemma mult_le_cancel_le1: "k \<in> nat \<Longrightarrow> k #* m \<le> k \<longleftrightarrow> (0 < k \<longrightarrow> natify(m) \<le> 1)"
 by (cut_tac k = k and m = m and n = 1 in mult_le_cancel1, auto)
 
 lemma Ord_eq_iff_le: "\<lbrakk>Ord(m); Ord(n)\<rbrakk> \<Longrightarrow> m=n \<longleftrightarrow> (m \<le> n \<and> n \<le> m)"
 by (blast intro: le_anti_sym)
 
 lemma mult_cancel2_lemma:
      "\<lbrakk>k: nat; m: nat; n: nat\<rbrakk> \<Longrightarrow> (m#*k = n#*k) \<longleftrightarrow> (m=n | k=0)"
 apply (simp (no_asm_simp) add: Ord_eq_iff_le [of "m#*k"] Ord_eq_iff_le [of m])
 apply (auto simp add: Ord_0_lt_iff)
 done
 
 lemma mult_cancel2 [simp]:
      "(m#*k = n#*k) \<longleftrightarrow> (natify(m) = natify(n) | natify(k) = 0)"
 apply (rule iff_trans)
 apply (rule_tac [2] mult_cancel2_lemma, auto)
 done
 
 lemma mult_cancel1 [simp]:
      "(k#*m = k#*n) \<longleftrightarrow> (natify(m) = natify(n) | natify(k) = 0)"
 apply (simp (no_asm) add: mult_cancel2 mult_commute [of k])
 done
 
 
 (** Cancellation law for division **)
 
 lemma div_cancel_raw:
      "\<lbrakk>0<n; 0<k; k:nat; m:nat; n:nat\<rbrakk> \<Longrightarrow> (k#*m) div (k#*n) = m div n"
 apply (erule_tac i = m in complete_induct)
 apply (case_tac "x<n")
  apply (simp add: div_less zero_lt_mult_iff mult_lt_mono2)
 apply (simp add: not_lt_iff_le zero_lt_mult_iff le_refl [THEN mult_le_mono]
           div_geq diff_mult_distrib2 [symmetric] div_termination [THEN ltD])
 done
 
 lemma div_cancel:
      "\<lbrakk>0 < natify(n);  0 < natify(k)\<rbrakk> \<Longrightarrow> (k#*m) div (k#*n) = m div n"
 apply (cut_tac k = "natify (k) " and m = "natify (m)" and n = "natify (n)"
        in div_cancel_raw)
 apply auto
 done
 
 
 subsection\<open>More Lemmas about Remainder\<close>
 
 lemma mult_mod_distrib_raw:
      "\<lbrakk>k:nat; m:nat; n:nat\<rbrakk> \<Longrightarrow> (k#*m) mod (k#*n) = k #* (m mod n)"
 apply (case_tac "k=0")
  apply (simp add: DIVISION_BY_ZERO_MOD)
 apply (case_tac "n=0")
  apply (simp add: DIVISION_BY_ZERO_MOD)
 apply (simp add: nat_into_Ord [THEN Ord_0_lt_iff])
 apply (erule_tac i = m in complete_induct)
 apply (case_tac "x<n")
  apply (simp (no_asm_simp) add: mod_less zero_lt_mult_iff mult_lt_mono2)
 apply (simp add: not_lt_iff_le zero_lt_mult_iff le_refl [THEN mult_le_mono]
          mod_geq diff_mult_distrib2 [symmetric] div_termination [THEN ltD])
 done
 
 lemma mod_mult_distrib2: "k #* (m mod n) = (k#*m) mod (k#*n)"
 apply (cut_tac k = "natify (k) " and m = "natify (m)" and n = "natify (n)"
        in mult_mod_distrib_raw)
 apply auto
 done
 
 lemma mult_mod_distrib: "(m mod n) #* k = (m#*k) mod (n#*k)"
 apply (simp (no_asm) add: mult_commute mod_mult_distrib2)
 done
 
 lemma mod_add_self2_raw: "n \<in> nat \<Longrightarrow> (m #+ n) mod n = m mod n"
 apply (subgoal_tac " (n #+ m) mod n = (n #+ m #- n) mod n")
 apply (simp add: add_commute)
 apply (subst mod_geq [symmetric], auto)
 done
 
 lemma mod_add_self2 [simp]: "(m #+ n) mod n = m mod n"
 apply (cut_tac n = "natify (n) " in mod_add_self2_raw)
 apply auto
 done
 
 lemma mod_add_self1 [simp]: "(n#+m) mod n = m mod n"
 apply (simp (no_asm_simp) add: add_commute mod_add_self2)
 done
 
 lemma mod_mult_self1_raw: "k \<in> nat \<Longrightarrow> (m #+ k#*n) mod n = m mod n"
 apply (erule nat_induct)
 apply (simp_all (no_asm_simp) add: add_left_commute [of _ n])
 done
 
 lemma mod_mult_self1 [simp]: "(m #+ k#*n) mod n = m mod n"
 apply (cut_tac k = "natify (k) " in mod_mult_self1_raw)
 apply auto
 done
 
 lemma mod_mult_self2 [simp]: "(m #+ n#*k) mod n = m mod n"
 apply (simp (no_asm) add: mult_commute mod_mult_self1)
 done
 
 (*Lemma for gcd*)
 lemma mult_eq_self_implies_10: "m = m#*n \<Longrightarrow> natify(n)=1 | m=0"
 apply (subgoal_tac "m: nat")
  prefer 2
  apply (erule ssubst)
  apply simp
 apply (rule disjCI)
 apply (drule sym)
 apply (rule Ord_linear_lt [of "natify(n)" 1])
 apply simp_all
  apply (subgoal_tac "m #* n = 0", simp)
  apply (subst mult_natify2 [symmetric])
  apply (simp del: mult_natify2)
 apply (drule nat_into_Ord [THEN Ord_0_lt, THEN [2] mult_lt_mono2], auto)
 done
 
 lemma less_imp_succ_add [rule_format]:
      "\<lbrakk>m<n; n: nat\<rbrakk> \<Longrightarrow> \<exists>k\<in>nat. n = succ(m#+k)"
 apply (frule lt_nat_in_nat, assumption)
 apply (erule rev_mp)
 apply (induct_tac "n")
 apply (simp_all (no_asm) add: le_iff)
 apply (blast elim!: leE intro!: add_0_right [symmetric] add_succ_right [symmetric])
 done
 
 lemma less_iff_succ_add:
      "\<lbrakk>m: nat; n: nat\<rbrakk> \<Longrightarrow> (m<n) \<longleftrightarrow> (\<exists>k\<in>nat. n = succ(m#+k))"
 by (auto intro: less_imp_succ_add)
 
 lemma add_lt_elim2:
      "\<lbrakk>a #+ d = b #+ c; a < b; b \<in> nat; c \<in> nat; d \<in> nat\<rbrakk> \<Longrightarrow> c < d"
 by (drule less_imp_succ_add, auto)
 
 lemma add_le_elim2:
      "\<lbrakk>a #+ d = b #+ c; a \<le> b; b \<in> nat; c \<in> nat; d \<in> nat\<rbrakk> \<Longrightarrow> c \<le> d"
 by (drule less_imp_succ_add, auto)
 
 
 subsubsection\<open>More Lemmas About Difference\<close>
 
 lemma diff_is_0_lemma:
      "\<lbrakk>m: nat; n: nat\<rbrakk> \<Longrightarrow> m #- n = 0 \<longleftrightarrow> m \<le> n"
 apply (rule_tac m = m and n = n in diff_induct, simp_all)
 done
 
 lemma diff_is_0_iff: "m #- n = 0 \<longleftrightarrow> natify(m) \<le> natify(n)"
 by (simp add: diff_is_0_lemma [symmetric])
 
 lemma nat_lt_imp_diff_eq_0:
      "\<lbrakk>a:nat; b:nat; a<b\<rbrakk> \<Longrightarrow> a #- b = 0"
 by (simp add: diff_is_0_iff le_iff)
 
 lemma raw_nat_diff_split:
      "\<lbrakk>a:nat; b:nat\<rbrakk> \<Longrightarrow>
       (P(a #- b)) \<longleftrightarrow> ((a < b \<longrightarrow>P(0)) \<and> (\<forall>d\<in>nat. a = b #+ d \<longrightarrow> P(d)))"
 apply (case_tac "a < b")
  apply (force simp add: nat_lt_imp_diff_eq_0)
 apply (rule iffI, force, simp)
 apply (drule_tac x="a#-b" in bspec)
 apply (simp_all add: Ordinal.not_lt_iff_le add_diff_inverse)
 done
 
 lemma nat_diff_split:
    "(P(a #- b)) \<longleftrightarrow>
     (natify(a) < natify(b) \<longrightarrow>P(0)) \<and> (\<forall>d\<in>nat. natify(a) = b #+ d \<longrightarrow> P(d))"
 apply (cut_tac P=P and a="natify(a)" and b="natify(b)" in raw_nat_diff_split)
 apply simp_all
 done
 
 text\<open>Difference and less-than\<close>
 
 lemma diff_lt_imp_lt: "\<lbrakk>(k#-i) < (k#-j); i\<in>nat; j\<in>nat; k\<in>nat\<rbrakk> \<Longrightarrow> j<i"
 apply (erule rev_mp)
 apply (simp split: nat_diff_split, auto)
  apply (blast intro: add_le_self lt_trans1)
 apply (rule not_le_iff_lt [THEN iffD1], auto)
 apply (subgoal_tac "i #+ da < j #+ d", force)
 apply (blast intro: add_le_lt_mono)
 done
 
 lemma lt_imp_diff_lt: "\<lbrakk>j<i; i\<le>k; k\<in>nat\<rbrakk> \<Longrightarrow> (k#-i) < (k#-j)"
 apply (frule le_in_nat, assumption)
 apply (frule lt_nat_in_nat, assumption)
 apply (simp split: nat_diff_split, auto)
   apply (blast intro: lt_asym lt_trans2)
  apply (blast intro: lt_irrefl lt_trans2)
 apply (rule not_le_iff_lt [THEN iffD1], auto)
 apply (subgoal_tac "j #+ d < i #+ da", force)
 apply (blast intro: add_lt_le_mono)
 done
 
 
 lemma diff_lt_iff_lt: "\<lbrakk>i\<le>k; j\<in>nat; k\<in>nat\<rbrakk> \<Longrightarrow> (k#-i) < (k#-j) \<longleftrightarrow> j<i"
 apply (frule le_in_nat, assumption)
 apply (blast intro: lt_imp_diff_lt diff_lt_imp_lt)
 done
 
 end
diff --git a/src/ZF/Bin.thy b/src/ZF/Bin.thy
--- a/src/ZF/Bin.thy
+++ b/src/ZF/Bin.thy
@@ -1,763 +1,763 @@
 (*  Title:      ZF/Bin.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 
    The sign Pls stands for an infinite string of leading 0's.
    The sign Min stands for an infinite string of leading 1's.
 
 A number can have multiple representations, namely leading 0's with sign
 Pls and leading 1's with sign Min.  See twos-compl.ML/int_of_binary for
 the numerical interpretation.
 
 The representation expects that (m mod 2) is 0 or 1, even if m is negative;
 For instance, \<not>5 div 2 = \<not>3 and \<not>5 mod 2 = 1; thus \<not>5 = (\<not>3)*2 + 1
 *)
 
 section\<open>Arithmetic on Binary Integers\<close>
 
 theory Bin
 imports Int Datatype
 begin
 
 consts  bin :: i
 datatype
   "bin" = Pls
         | Min
         | Bit ("w \<in> bin", "b \<in> bool")     (infixl \<open>BIT\<close> 90)
 
 consts
   integ_of  :: "i\<Rightarrow>i"
   NCons     :: "[i,i]\<Rightarrow>i"
   bin_succ  :: "i\<Rightarrow>i"
   bin_pred  :: "i\<Rightarrow>i"
   bin_minus :: "i\<Rightarrow>i"
   bin_adder :: "i\<Rightarrow>i"
   bin_mult  :: "[i,i]\<Rightarrow>i"
 
 primrec
   integ_of_Pls:  "integ_of (Pls)     = $# 0"
   integ_of_Min:  "integ_of (Min)     = $-($#1)"
   integ_of_BIT:  "integ_of (w BIT b) = $#b $+ integ_of(w) $+ integ_of(w)"
 
     (** recall that cond(1,b,c)=b and cond(0,b,c)=0 **)
 
 primrec (*NCons adds a bit, suppressing leading 0s and 1s*)
   NCons_Pls: "NCons (Pls,b)     = cond(b,Pls BIT b,Pls)"
   NCons_Min: "NCons (Min,b)     = cond(b,Min,Min BIT b)"
   NCons_BIT: "NCons (w BIT c,b) = w BIT c BIT b"
 
 primrec (*successor.  If a BIT, can change a 0 to a 1 without recursion.*)
   bin_succ_Pls:  "bin_succ (Pls)     = Pls BIT 1"
   bin_succ_Min:  "bin_succ (Min)     = Pls"
   bin_succ_BIT:  "bin_succ (w BIT b) = cond(b, bin_succ(w) BIT 0, NCons(w,1))"
 
 primrec (*predecessor*)
   bin_pred_Pls:  "bin_pred (Pls)     = Min"
   bin_pred_Min:  "bin_pred (Min)     = Min BIT 0"
   bin_pred_BIT:  "bin_pred (w BIT b) = cond(b, NCons(w,0), bin_pred(w) BIT 1)"
 
 primrec (*unary negation*)
   bin_minus_Pls:
     "bin_minus (Pls)       = Pls"
   bin_minus_Min:
     "bin_minus (Min)       = Pls BIT 1"
   bin_minus_BIT:
     "bin_minus (w BIT b) = cond(b, bin_pred(NCons(bin_minus(w),0)),
                                 bin_minus(w) BIT 0)"
 
 primrec (*sum*)
   bin_adder_Pls:
     "bin_adder (Pls)     = (\<lambda>w\<in>bin. w)"
   bin_adder_Min:
     "bin_adder (Min)     = (\<lambda>w\<in>bin. bin_pred(w))"
   bin_adder_BIT:
     "bin_adder (v BIT x) =
        (\<lambda>w\<in>bin.
          bin_case (v BIT x, bin_pred(v BIT x),
                    \<lambda>w y. NCons(bin_adder (v) ` cond(x and y, bin_succ(w), w),
                                x xor y),
                    w))"
 
 (*The bin_case above replaces the following mutually recursive function:
 primrec
   "adding (v,x,Pls)     = v BIT x"
   "adding (v,x,Min)     = bin_pred(v BIT x)"
   "adding (v,x,w BIT y) = NCons(bin_adder (v, cond(x and y, bin_succ(w), w)),
                                 x xor y)"
 *)
 
 definition
   bin_add   :: "[i,i]\<Rightarrow>i"  where
     "bin_add(v,w) \<equiv> bin_adder(v)`w"
 
 
 primrec
   bin_mult_Pls:
     "bin_mult (Pls,w)     = Pls"
   bin_mult_Min:
     "bin_mult (Min,w)     = bin_minus(w)"
   bin_mult_BIT:
     "bin_mult (v BIT b,w) = cond(b, bin_add(NCons(bin_mult(v,w),0),w),
                                  NCons(bin_mult(v,w),0))"
 
 syntax
   "_Int0" :: i  (\<open>#' 0\<close>)
   "_Int1" :: i  (\<open>#' 1\<close>)
   "_Int2" :: i  (\<open>#' 2\<close>)
   "_Neg_Int1" :: i  (\<open>#-' 1\<close>)
   "_Neg_Int2" :: i  (\<open>#-' 2\<close>)
 translations
   "#0" \<rightleftharpoons> "CONST integ_of(CONST Pls)"
   "#1" \<rightleftharpoons> "CONST integ_of(CONST Pls BIT 1)"
   "#2" \<rightleftharpoons> "CONST integ_of(CONST Pls BIT 1 BIT 0)"
   "#-1" \<rightleftharpoons> "CONST integ_of(CONST Min)"
   "#-2" \<rightleftharpoons> "CONST integ_of(CONST Min BIT 0)"
 
 syntax
   "_Int" :: "num_token \<Rightarrow> i"  (\<open>#_\<close> 1000)
   "_Neg_Int" :: "num_token \<Rightarrow> i"  (\<open>#-_\<close> 1000)
 
 ML_file \<open>Tools/numeral_syntax.ML\<close>
 
 
 declare bin.intros [simp,TC]
 
 lemma NCons_Pls_0: "NCons(Pls,0) = Pls"
 by simp
 
 lemma NCons_Pls_1: "NCons(Pls,1) = Pls BIT 1"
 by simp
 
 lemma NCons_Min_0: "NCons(Min,0) = Min BIT 0"
 by simp
 
 lemma NCons_Min_1: "NCons(Min,1) = Min"
 by simp
 
 lemma NCons_BIT: "NCons(w BIT x,b) = w BIT x BIT b"
 by (simp add: bin.case_eqns)
 
 lemmas NCons_simps [simp] =
     NCons_Pls_0 NCons_Pls_1 NCons_Min_0 NCons_Min_1 NCons_BIT
 
 
 
 (** Type checking **)
 
 lemma integ_of_type [TC]: "w \<in> bin \<Longrightarrow> integ_of(w) \<in> int"
 apply (induct_tac "w")
 apply (simp_all add: bool_into_nat)
 done
 
 lemma NCons_type [TC]: "\<lbrakk>w \<in> bin; b \<in> bool\<rbrakk> \<Longrightarrow> NCons(w,b) \<in> bin"
 by (induct_tac "w", auto)
 
 lemma bin_succ_type [TC]: "w \<in> bin \<Longrightarrow> bin_succ(w) \<in> bin"
 by (induct_tac "w", auto)
 
 lemma bin_pred_type [TC]: "w \<in> bin \<Longrightarrow> bin_pred(w) \<in> bin"
 by (induct_tac "w", auto)
 
 lemma bin_minus_type [TC]: "w \<in> bin \<Longrightarrow> bin_minus(w) \<in> bin"
 by (induct_tac "w", auto)
 
 (*This proof is complicated by the mutual recursion*)
 lemma bin_add_type [rule_format]:
      "v \<in> bin \<Longrightarrow> \<forall>w\<in>bin. bin_add(v,w) \<in> bin"
-apply (unfold bin_add_def)
+  unfolding bin_add_def
 apply (induct_tac "v")
 apply (rule_tac [3] ballI)
 apply (rename_tac [3] "w'")
 apply (induct_tac [3] "w'")
 apply (simp_all add: NCons_type)
 done
 
 declare bin_add_type [TC]
 
 lemma bin_mult_type [TC]: "\<lbrakk>v \<in> bin; w \<in> bin\<rbrakk> \<Longrightarrow> bin_mult(v,w) \<in> bin"
 by (induct_tac "v", auto)
 
 
 subsubsection\<open>The Carry and Borrow Functions,
             \<^term>\<open>bin_succ\<close> and \<^term>\<open>bin_pred\<close>\<close>
 
 (*NCons preserves the integer value of its argument*)
 lemma integ_of_NCons [simp]:
      "\<lbrakk>w \<in> bin; b \<in> bool\<rbrakk> \<Longrightarrow> integ_of(NCons(w,b)) = integ_of(w BIT b)"
 apply (erule bin.cases)
 apply (auto elim!: boolE)
 done
 
 lemma integ_of_succ [simp]:
      "w \<in> bin \<Longrightarrow> integ_of(bin_succ(w)) = $#1 $+ integ_of(w)"
 apply (erule bin.induct)
 apply (auto simp add: zadd_ac elim!: boolE)
 done
 
 lemma integ_of_pred [simp]:
      "w \<in> bin \<Longrightarrow> integ_of(bin_pred(w)) = $- ($#1) $+ integ_of(w)"
 apply (erule bin.induct)
 apply (auto simp add: zadd_ac elim!: boolE)
 done
 
 
 subsubsection\<open>\<^term>\<open>bin_minus\<close>: Unary Negation of Binary Integers\<close>
 
 lemma integ_of_minus: "w \<in> bin \<Longrightarrow> integ_of(bin_minus(w)) = $- integ_of(w)"
 apply (erule bin.induct)
 apply (auto simp add: zadd_ac zminus_zadd_distrib  elim!: boolE)
 done
 
 
 subsubsection\<open>\<^term>\<open>bin_add\<close>: Binary Addition\<close>
 
 lemma bin_add_Pls [simp]: "w \<in> bin \<Longrightarrow> bin_add(Pls,w) = w"
 by (unfold bin_add_def, simp)
 
 lemma bin_add_Pls_right: "w \<in> bin \<Longrightarrow> bin_add(w,Pls) = w"
-apply (unfold bin_add_def)
+  unfolding bin_add_def
 apply (erule bin.induct, auto)
 done
 
 lemma bin_add_Min [simp]: "w \<in> bin \<Longrightarrow> bin_add(Min,w) = bin_pred(w)"
 by (unfold bin_add_def, simp)
 
 lemma bin_add_Min_right: "w \<in> bin \<Longrightarrow> bin_add(w,Min) = bin_pred(w)"
-apply (unfold bin_add_def)
+  unfolding bin_add_def
 apply (erule bin.induct, auto)
 done
 
 lemma bin_add_BIT_Pls [simp]: "bin_add(v BIT x,Pls) = v BIT x"
 by (unfold bin_add_def, simp)
 
 lemma bin_add_BIT_Min [simp]: "bin_add(v BIT x,Min) = bin_pred(v BIT x)"
 by (unfold bin_add_def, simp)
 
 lemma bin_add_BIT_BIT [simp]:
      "\<lbrakk>w \<in> bin;  y \<in> bool\<rbrakk>
       \<Longrightarrow> bin_add(v BIT x, w BIT y) =
           NCons(bin_add(v, cond(x and y, bin_succ(w), w)), x xor y)"
 by (unfold bin_add_def, simp)
 
 lemma integ_of_add [rule_format]:
      "v \<in> bin \<Longrightarrow>
           \<forall>w\<in>bin. integ_of(bin_add(v,w)) = integ_of(v) $+ integ_of(w)"
 apply (erule bin.induct, simp, simp)
 apply (rule ballI)
 apply (induct_tac "wa")
 apply (auto simp add: zadd_ac elim!: boolE)
 done
 
 (*Subtraction*)
 lemma diff_integ_of_eq:
      "\<lbrakk>v \<in> bin;  w \<in> bin\<rbrakk>
       \<Longrightarrow> integ_of(v) $- integ_of(w) = integ_of(bin_add (v, bin_minus(w)))"
-apply (unfold zdiff_def)
+  unfolding zdiff_def
 apply (simp add: integ_of_add integ_of_minus)
 done
 
 
 subsubsection\<open>\<^term>\<open>bin_mult\<close>: Binary Multiplication\<close>
 
 lemma integ_of_mult:
      "\<lbrakk>v \<in> bin;  w \<in> bin\<rbrakk>
       \<Longrightarrow> integ_of(bin_mult(v,w)) = integ_of(v) $* integ_of(w)"
 apply (induct_tac "v", simp)
 apply (simp add: integ_of_minus)
 apply (auto simp add: zadd_ac integ_of_add zadd_zmult_distrib  elim!: boolE)
 done
 
 
 subsection\<open>Computations\<close>
 
 (** extra rules for bin_succ, bin_pred **)
 
 lemma bin_succ_1: "bin_succ(w BIT 1) = bin_succ(w) BIT 0"
 by simp
 
 lemma bin_succ_0: "bin_succ(w BIT 0) = NCons(w,1)"
 by simp
 
 lemma bin_pred_1: "bin_pred(w BIT 1) = NCons(w,0)"
 by simp
 
 lemma bin_pred_0: "bin_pred(w BIT 0) = bin_pred(w) BIT 1"
 by simp
 
 (** extra rules for bin_minus **)
 
 lemma bin_minus_1: "bin_minus(w BIT 1) = bin_pred(NCons(bin_minus(w), 0))"
 by simp
 
 lemma bin_minus_0: "bin_minus(w BIT 0) = bin_minus(w) BIT 0"
 by simp
 
 (** extra rules for bin_add **)
 
 lemma bin_add_BIT_11: "w \<in> bin \<Longrightarrow> bin_add(v BIT 1, w BIT 1) =
                      NCons(bin_add(v, bin_succ(w)), 0)"
 by simp
 
 lemma bin_add_BIT_10: "w \<in> bin \<Longrightarrow> bin_add(v BIT 1, w BIT 0) =
                      NCons(bin_add(v,w), 1)"
 by simp
 
 lemma bin_add_BIT_0: "\<lbrakk>w \<in> bin;  y \<in> bool\<rbrakk>
       \<Longrightarrow> bin_add(v BIT 0, w BIT y) = NCons(bin_add(v,w), y)"
 by simp
 
 (** extra rules for bin_mult **)
 
 lemma bin_mult_1: "bin_mult(v BIT 1, w) = bin_add(NCons(bin_mult(v,w),0), w)"
 by simp
 
 lemma bin_mult_0: "bin_mult(v BIT 0, w) = NCons(bin_mult(v,w),0)"
 by simp
 
 
 (** Simplification rules with integer constants **)
 
 lemma int_of_0: "$#0 = #0"
 by simp
 
 lemma int_of_succ: "$# succ(n) = #1 $+ $#n"
 by (simp add: int_of_add [symmetric] natify_succ)
 
 lemma zminus_0 [simp]: "$- #0 = #0"
 by simp
 
 lemma zadd_0_intify [simp]: "#0 $+ z = intify(z)"
 by simp
 
 lemma zadd_0_right_intify [simp]: "z $+ #0 = intify(z)"
 by simp
 
 lemma zmult_1_intify [simp]: "#1 $* z = intify(z)"
 by simp
 
 lemma zmult_1_right_intify [simp]: "z $* #1 = intify(z)"
 by (subst zmult_commute, simp)
 
 lemma zmult_0 [simp]: "#0 $* z = #0"
 by simp
 
 lemma zmult_0_right [simp]: "z $* #0 = #0"
 by (subst zmult_commute, simp)
 
 lemma zmult_minus1 [simp]: "#-1 $* z = $-z"
 by (simp add: zcompare_rls)
 
 lemma zmult_minus1_right [simp]: "z $* #-1 = $-z"
 apply (subst zmult_commute)
 apply (rule zmult_minus1)
 done
 
 
 subsection\<open>Simplification Rules for Comparison of Binary Numbers\<close>
 text\<open>Thanks to Norbert Voelker\<close>
 
 (** Equals (=) **)
 
 lemma eq_integ_of_eq:
      "\<lbrakk>v \<in> bin;  w \<in> bin\<rbrakk>
       \<Longrightarrow> ((integ_of(v)) = integ_of(w)) \<longleftrightarrow>
           iszero (integ_of (bin_add (v, bin_minus(w))))"
-apply (unfold iszero_def)
+  unfolding iszero_def
 apply (simp add: zcompare_rls integ_of_add integ_of_minus)
 done
 
 lemma iszero_integ_of_Pls: "iszero (integ_of(Pls))"
 by (unfold iszero_def, simp)
 
 
 lemma nonzero_integ_of_Min: "\<not> iszero (integ_of(Min))"
-apply (unfold iszero_def)
+  unfolding iszero_def
 apply (simp add: zminus_equation)
 done
 
 lemma iszero_integ_of_BIT:
      "\<lbrakk>w \<in> bin; x \<in> bool\<rbrakk>
       \<Longrightarrow> iszero (integ_of (w BIT x)) \<longleftrightarrow> (x=0 \<and> iszero (integ_of(w)))"
 apply (unfold iszero_def, simp)
 apply (subgoal_tac "integ_of (w) \<in> int")
 apply typecheck
 apply (drule int_cases)
 apply (safe elim!: boolE)
 apply (simp_all (asm_lr) add: zcompare_rls zminus_zadd_distrib [symmetric]
                      int_of_add [symmetric])
 done
 
 lemma iszero_integ_of_0:
      "w \<in> bin \<Longrightarrow> iszero (integ_of (w BIT 0)) \<longleftrightarrow> iszero (integ_of(w))"
 by (simp only: iszero_integ_of_BIT, blast)
 
 lemma iszero_integ_of_1: "w \<in> bin \<Longrightarrow> \<not> iszero (integ_of (w BIT 1))"
 by (simp only: iszero_integ_of_BIT, blast)
 
 
 
 (** Less-than (<) **)
 
 lemma less_integ_of_eq_neg:
      "\<lbrakk>v \<in> bin;  w \<in> bin\<rbrakk>
       \<Longrightarrow> integ_of(v) $< integ_of(w)
           \<longleftrightarrow> znegative (integ_of (bin_add (v, bin_minus(w))))"
 apply (unfold zless_def zdiff_def)
 apply (simp add: integ_of_minus integ_of_add)
 done
 
 lemma not_neg_integ_of_Pls: "\<not> znegative (integ_of(Pls))"
 by simp
 
 lemma neg_integ_of_Min: "znegative (integ_of(Min))"
 by simp
 
 lemma neg_integ_of_BIT:
      "\<lbrakk>w \<in> bin; x \<in> bool\<rbrakk>
       \<Longrightarrow> znegative (integ_of (w BIT x)) \<longleftrightarrow> znegative (integ_of(w))"
 apply simp
 apply (subgoal_tac "integ_of (w) \<in> int")
 apply typecheck
 apply (drule int_cases)
 apply (auto elim!: boolE simp add: int_of_add [symmetric]  zcompare_rls)
 apply (simp_all add: zminus_zadd_distrib [symmetric] zdiff_def
                      int_of_add [symmetric])
 apply (subgoal_tac "$#1 $- $# succ (succ (n #+ n)) = $- $# succ (n #+ n) ")
  apply (simp add: zdiff_def)
 apply (simp add: equation_zminus int_of_diff [symmetric])
 done
 
 (** Less-than-or-equals (<=) **)
 
 lemma le_integ_of_eq_not_less:
      "(integ_of(x) $\<le> (integ_of(w))) \<longleftrightarrow> \<not> (integ_of(w) $< (integ_of(x)))"
 by (simp add: not_zless_iff_zle [THEN iff_sym])
 
 
 (*Delete the original rewrites, with their clumsy conditional expressions*)
 declare bin_succ_BIT [simp del]
         bin_pred_BIT [simp del]
         bin_minus_BIT [simp del]
         NCons_Pls [simp del]
         NCons_Min [simp del]
         bin_adder_BIT [simp del]
         bin_mult_BIT [simp del]
 
 (*Hide the binary representation of integer constants*)
 declare integ_of_Pls [simp del] integ_of_Min [simp del] integ_of_BIT [simp del]
 
 
 lemmas bin_arith_extra_simps =
      integ_of_add [symmetric]
      integ_of_minus [symmetric]
      integ_of_mult [symmetric]
      bin_succ_1 bin_succ_0
      bin_pred_1 bin_pred_0
      bin_minus_1 bin_minus_0
      bin_add_Pls_right bin_add_Min_right
      bin_add_BIT_0 bin_add_BIT_10 bin_add_BIT_11
      diff_integ_of_eq
      bin_mult_1 bin_mult_0 NCons_simps
 
 
 (*For making a minimal simpset, one must include these default simprules
   of thy.  Also include simp_thms, or at least (\<not>False)=True*)
 lemmas bin_arith_simps =
      bin_pred_Pls bin_pred_Min
      bin_succ_Pls bin_succ_Min
      bin_add_Pls bin_add_Min
      bin_minus_Pls bin_minus_Min
      bin_mult_Pls bin_mult_Min
      bin_arith_extra_simps
 
 (*Simplification of relational operations*)
 lemmas bin_rel_simps =
      eq_integ_of_eq iszero_integ_of_Pls nonzero_integ_of_Min
      iszero_integ_of_0 iszero_integ_of_1
      less_integ_of_eq_neg
      not_neg_integ_of_Pls neg_integ_of_Min neg_integ_of_BIT
      le_integ_of_eq_not_less
 
 declare bin_arith_simps [simp]
 declare bin_rel_simps [simp]
 
 
 (** Simplification of arithmetic when nested to the right **)
 
 lemma add_integ_of_left [simp]:
      "\<lbrakk>v \<in> bin;  w \<in> bin\<rbrakk>
       \<Longrightarrow> integ_of(v) $+ (integ_of(w) $+ z) = (integ_of(bin_add(v,w)) $+ z)"
 by (simp add: zadd_assoc [symmetric])
 
 lemma mult_integ_of_left [simp]:
      "\<lbrakk>v \<in> bin;  w \<in> bin\<rbrakk>
       \<Longrightarrow> integ_of(v) $* (integ_of(w) $* z) = (integ_of(bin_mult(v,w)) $* z)"
 by (simp add: zmult_assoc [symmetric])
 
 lemma add_integ_of_diff1 [simp]:
     "\<lbrakk>v \<in> bin;  w \<in> bin\<rbrakk>
       \<Longrightarrow> integ_of(v) $+ (integ_of(w) $- c) = integ_of(bin_add(v,w)) $- (c)"
-apply (unfold zdiff_def)
+  unfolding zdiff_def
 apply (rule add_integ_of_left, auto)
 done
 
 lemma add_integ_of_diff2 [simp]:
      "\<lbrakk>v \<in> bin;  w \<in> bin\<rbrakk>
       \<Longrightarrow> integ_of(v) $+ (c $- integ_of(w)) =
           integ_of (bin_add (v, bin_minus(w))) $+ (c)"
 apply (subst diff_integ_of_eq [symmetric])
 apply (simp_all add: zdiff_def zadd_ac)
 done
 
 
 (** More for integer constants **)
 
 declare int_of_0 [simp] int_of_succ [simp]
 
 lemma zdiff0 [simp]: "#0 $- x = $-x"
 by (simp add: zdiff_def)
 
 lemma zdiff0_right [simp]: "x $- #0 = intify(x)"
 by (simp add: zdiff_def)
 
 lemma zdiff_self [simp]: "x $- x = #0"
 by (simp add: zdiff_def)
 
 lemma znegative_iff_zless_0: "k \<in> int \<Longrightarrow> znegative(k) \<longleftrightarrow> k $< #0"
 by (simp add: zless_def)
 
 lemma zero_zless_imp_znegative_zminus: "\<lbrakk>#0 $< k; k \<in> int\<rbrakk> \<Longrightarrow> znegative($-k)"
 by (simp add: zless_def)
 
 lemma zero_zle_int_of [simp]: "#0 $\<le> $# n"
 by (simp add: not_zless_iff_zle [THEN iff_sym] znegative_iff_zless_0 [THEN iff_sym])
 
 lemma nat_of_0 [simp]: "nat_of(#0) = 0"
 by (simp only: natify_0 int_of_0 [symmetric] nat_of_int_of)
 
 lemma nat_le_int0_lemma: "\<lbrakk>z $\<le> $#0; z \<in> int\<rbrakk> \<Longrightarrow> nat_of(z) = 0"
 by (auto simp add: znegative_iff_zless_0 [THEN iff_sym] zle_def zneg_nat_of)
 
 lemma nat_le_int0: "z $\<le> $#0 \<Longrightarrow> nat_of(z) = 0"
 apply (subgoal_tac "nat_of (intify (z)) = 0")
 apply (rule_tac [2] nat_le_int0_lemma, auto)
 done
 
 lemma int_of_eq_0_imp_natify_eq_0: "$# n = #0 \<Longrightarrow> natify(n) = 0"
 by (rule not_znegative_imp_zero, auto)
 
 lemma nat_of_zminus_int_of: "nat_of($- $# n) = 0"
 by (simp add: nat_of_def int_of_def raw_nat_of zminus image_intrel_int)
 
 lemma int_of_nat_of: "#0 $\<le> z \<Longrightarrow> $# nat_of(z) = intify(z)"
 apply (rule not_zneg_nat_of_intify)
 apply (simp add: znegative_iff_zless_0 not_zless_iff_zle)
 done
 
 declare int_of_nat_of [simp] nat_of_zminus_int_of [simp]
 
 lemma int_of_nat_of_if: "$# nat_of(z) = (if #0 $\<le> z then intify(z) else #0)"
 by (simp add: int_of_nat_of znegative_iff_zless_0 not_zle_iff_zless)
 
 lemma zless_nat_iff_int_zless: "\<lbrakk>m \<in> nat; z \<in> int\<rbrakk> \<Longrightarrow> (m < nat_of(z)) \<longleftrightarrow> ($#m $< z)"
 apply (case_tac "znegative (z) ")
 apply (erule_tac [2] not_zneg_nat_of [THEN subst])
 apply (auto dest: zless_trans dest!: zero_zle_int_of [THEN zle_zless_trans]
             simp add: znegative_iff_zless_0)
 done
 
 
 (** nat_of and zless **)
 
 (*An alternative condition is  @{term"$#0 \<subseteq> w"}  *)
 lemma zless_nat_conj_lemma: "$#0 $< z \<Longrightarrow> (nat_of(w) < nat_of(z)) \<longleftrightarrow> (w $< z)"
 apply (rule iff_trans)
 apply (rule zless_int_of [THEN iff_sym])
 apply (auto simp add: int_of_nat_of_if simp del: zless_int_of)
 apply (auto elim: zless_asym simp add: not_zle_iff_zless)
 apply (blast intro: zless_zle_trans)
 done
 
 lemma zless_nat_conj: "(nat_of(w) < nat_of(z)) \<longleftrightarrow> ($#0 $< z \<and> w $< z)"
 apply (case_tac "$#0 $< z")
 apply (auto simp add: zless_nat_conj_lemma nat_le_int0 not_zless_iff_zle)
 done
 
 (*This simprule cannot be added unless we can find a way to make eq_integ_of_eq
   unconditional!
   [The condition "True" is a hack to prevent looping.
     Conditional rewrite rules are tried after unconditional ones, so a rule
     like eq_nat_number_of will be tried first to eliminate #mm=#nn.]
   lemma integ_of_reorient [simp]:
        "True \<Longrightarrow> (integ_of(w) = x) \<longleftrightarrow> (x = integ_of(w))"
   by auto
 *)
 
 lemma integ_of_minus_reorient [simp]:
      "(integ_of(w) = $- x) \<longleftrightarrow> ($- x = integ_of(w))"
 by auto
 
 lemma integ_of_add_reorient [simp]:
      "(integ_of(w) = x $+ y) \<longleftrightarrow> (x $+ y = integ_of(w))"
 by auto
 
 lemma integ_of_diff_reorient [simp]:
      "(integ_of(w) = x $- y) \<longleftrightarrow> (x $- y = integ_of(w))"
 by auto
 
 lemma integ_of_mult_reorient [simp]:
      "(integ_of(w) = x $* y) \<longleftrightarrow> (x $* y = integ_of(w))"
 by auto
 
 (** To simplify inequalities involving integer negation and literals,
     such as -x = #3
 **)
 
 lemmas [simp] =
   zminus_equation [where y = "integ_of(w)"]
   equation_zminus [where x = "integ_of(w)"]
   for w
 
 lemmas [iff] =
   zminus_zless [where y = "integ_of(w)"]
   zless_zminus [where x = "integ_of(w)"]
   for w
 
 lemmas [iff] =
   zminus_zle [where y = "integ_of(w)"]
   zle_zminus [where x = "integ_of(w)"]
   for w
 
 lemmas [simp] =
   Let_def [where s = "integ_of(w)"] for w
 
 
 (*** Simprocs for numeric literals ***)
 
 (** Combining of literal coefficients in sums of products **)
 
 lemma zless_iff_zdiff_zless_0: "(x $< y) \<longleftrightarrow> (x$-y $< #0)"
   by (simp add: zcompare_rls)
 
 lemma eq_iff_zdiff_eq_0: "\<lbrakk>x \<in> int; y \<in> int\<rbrakk> \<Longrightarrow> (x = y) \<longleftrightarrow> (x$-y = #0)"
   by (simp add: zcompare_rls)
 
 lemma zle_iff_zdiff_zle_0: "(x $\<le> y) \<longleftrightarrow> (x$-y $\<le> #0)"
   by (simp add: zcompare_rls)
 
 
 (** For combine_numerals **)
 
 lemma left_zadd_zmult_distrib: "i$*u $+ (j$*u $+ k) = (i$+j)$*u $+ k"
   by (simp add: zadd_zmult_distrib zadd_ac)
 
 
 (** For cancel_numerals **)
 
 lemma eq_add_iff1: "(i$*u $+ m = j$*u $+ n) \<longleftrightarrow> ((i$-j)$*u $+ m = intify(n))"
   apply (simp add: zdiff_def zadd_zmult_distrib)
   apply (simp add: zcompare_rls)
   apply (simp add: zadd_ac)
   done
 
 lemma eq_add_iff2: "(i$*u $+ m = j$*u $+ n) \<longleftrightarrow> (intify(m) = (j$-i)$*u $+ n)"
   apply (simp add: zdiff_def zadd_zmult_distrib)
   apply (simp add: zcompare_rls)
   apply (simp add: zadd_ac)
   done
 
 context fixes n :: i
 begin
 
 lemmas rel_iff_rel_0_rls =
   zless_iff_zdiff_zless_0 [where y = "u $+ v"]
   eq_iff_zdiff_eq_0 [where y = "u $+ v"]
   zle_iff_zdiff_zle_0 [where y = "u $+ v"]
   zless_iff_zdiff_zless_0 [where y = n]
   eq_iff_zdiff_eq_0 [where y = n]
   zle_iff_zdiff_zle_0 [where y = n]
   for u v
 
 lemma less_add_iff1: "(i$*u $+ m $< j$*u $+ n) \<longleftrightarrow> ((i$-j)$*u $+ m $< n)"
   apply (simp add: zdiff_def zadd_zmult_distrib zadd_ac rel_iff_rel_0_rls)
   done
 
 lemma less_add_iff2: "(i$*u $+ m $< j$*u $+ n) \<longleftrightarrow> (m $< (j$-i)$*u $+ n)"
   apply (simp add: zdiff_def zadd_zmult_distrib zadd_ac rel_iff_rel_0_rls)
   done
 
 end
 
 lemma le_add_iff1: "(i$*u $+ m $\<le> j$*u $+ n) \<longleftrightarrow> ((i$-j)$*u $+ m $\<le> n)"
   apply (simp add: zdiff_def zadd_zmult_distrib)
   apply (simp add: zcompare_rls)
   apply (simp add: zadd_ac)
   done
 
 lemma le_add_iff2: "(i$*u $+ m $\<le> j$*u $+ n) \<longleftrightarrow> (m $\<le> (j$-i)$*u $+ n)"
   apply (simp add: zdiff_def zadd_zmult_distrib)
   apply (simp add: zcompare_rls)
   apply (simp add: zadd_ac)
   done
 
 ML_file \<open>int_arith.ML\<close>
 
 subsection \<open>examples:\<close>
 
 text \<open>\<open>combine_numerals_prod\<close> (products of separate literals)\<close>
 lemma "#5 $* x $* #3 = y" apply simp oops
 
 schematic_goal "y2 $+ ?x42 = y $+ y2" apply simp oops
 
 lemma "oo : int \<Longrightarrow> l $+ (l $+ #2) $+ oo = oo" apply simp oops
 
 lemma "#9$*x $+ y = x$*#23 $+ z" apply simp oops
 lemma "y $+ x = x $+ z" apply simp oops
 
 lemma "x : int \<Longrightarrow> x $+ y $+ z = x $+ z" apply simp oops
 lemma "x : int \<Longrightarrow> y $+ (z $+ x) = z $+ x" apply simp oops
 lemma "z : int \<Longrightarrow> x $+ y $+ z = (z $+ y) $+ (x $+ w)" apply simp oops
 lemma "z : int \<Longrightarrow> x$*y $+ z = (z $+ y) $+ (y$*x $+ w)" apply simp oops
 
 lemma "#-3 $* x $+ y $\<le> x $* #2 $+ z" apply simp oops
 lemma "y $+ x $\<le> x $+ z" apply simp oops
 lemma "x $+ y $+ z $\<le> x $+ z" apply simp oops
 
 lemma "y $+ (z $+ x) $< z $+ x" apply simp oops
 lemma "x $+ y $+ z $< (z $+ y) $+ (x $+ w)" apply simp oops
 lemma "x$*y $+ z $< (z $+ y) $+ (y$*x $+ w)" apply simp oops
 
 lemma "l $+ #2 $+ #2 $+ #2 $+ (l $+ #2) $+ (oo $+ #2) = uu" apply simp oops
 lemma "u : int \<Longrightarrow> #2 $* u = u" apply simp oops
 lemma "(i $+ j $+ #12 $+ k) $- #15 = y" apply simp oops
 lemma "(i $+ j $+ #12 $+ k) $- #5 = y" apply simp oops
 
 lemma "y $- b $< b" apply simp oops
 lemma "y $- (#3 $* b $+ c) $< b $- #2 $* c" apply simp oops
 
 lemma "(#2 $* x $- (u $* v) $+ y) $- v $* #3 $* u = w" apply simp oops
 lemma "(#2 $* x $* u $* v $+ (u $* v) $* #4 $+ y) $- v $* u $* #4 = w" apply simp oops
 lemma "(#2 $* x $* u $* v $+ (u $* v) $* #4 $+ y) $- v $* u = w" apply simp oops
 lemma "u $* v $- (x $* u $* v $+ (u $* v) $* #4 $+ y) = w" apply simp oops
 
 lemma "(i $+ j $+ #12 $+ k) = u $+ #15 $+ y" apply simp oops
 lemma "(i $+ j $* #2 $+ #12 $+ k) = j $+ #5 $+ y" apply simp oops
 
 lemma "#2 $* y $+ #3 $* z $+ #6 $* w $+ #2 $* y $+ #3 $* z $+ #2 $* u = #2 $* y' $+ #3 $* z' $+ #6 $* w' $+ #2 $* y' $+ #3 $* z' $+ u $+ vv" apply simp oops
 
 lemma "a $+ $-(b$+c) $+ b = d" apply simp oops
 lemma "a $+ $-(b$+c) $- b = d" apply simp oops
 
 text \<open>negative numerals\<close>
 lemma "(i $+ j $+ #-2 $+ k) $- (u $+ #5 $+ y) = zz" apply simp oops
 lemma "(i $+ j $+ #-3 $+ k) $< u $+ #5 $+ y" apply simp oops
 lemma "(i $+ j $+ #3 $+ k) $< u $+ #-6 $+ y" apply simp oops
 lemma "(i $+ j $+ #-12 $+ k) $- #15 = y" apply simp oops
 lemma "(i $+ j $+ #12 $+ k) $- #-15 = y" apply simp oops
 lemma "(i $+ j $+ #-12 $+ k) $- #-15 = y" apply simp oops
 
 text \<open>Multiplying separated numerals\<close>
 lemma "#6 $* ($# x $* #2) =  uu" apply simp oops
 lemma "#4 $* ($# x $* $# x) $* (#2 $* $# x) =  uu" apply simp oops
 
 end
diff --git a/src/ZF/Cardinal.thy b/src/ZF/Cardinal.thy
--- a/src/ZF/Cardinal.thy
+++ b/src/ZF/Cardinal.thy
@@ -1,1180 +1,1180 @@
 (*  Title:      ZF/Cardinal.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section\<open>Cardinal Numbers Without the Axiom of Choice\<close>
 
 theory Cardinal imports OrderType Finite Nat Sum begin
 
 definition
   (*least ordinal operator*)
    Least    :: "(i\<Rightarrow>o) \<Rightarrow> i"    (binder \<open>\<mu> \<close> 10)  where
      "Least(P) \<equiv> THE i. Ord(i) \<and> P(i) \<and> (\<forall>j. j<i \<longrightarrow> \<not>P(j))"
 
 definition
   eqpoll   :: "[i,i] \<Rightarrow> o"     (infixl \<open>\<approx>\<close> 50)  where
     "A \<approx> B \<equiv> \<exists>f. f \<in> bij(A,B)"
 
 definition
   lepoll   :: "[i,i] \<Rightarrow> o"     (infixl \<open>\<lesssim>\<close> 50)  where
     "A \<lesssim> B \<equiv> \<exists>f. f \<in> inj(A,B)"
 
 definition
   lesspoll :: "[i,i] \<Rightarrow> o"     (infixl \<open>\<prec>\<close> 50)  where
     "A \<prec> B \<equiv> A \<lesssim> B \<and> \<not>(A \<approx> B)"
 
 definition
   cardinal :: "i\<Rightarrow>i"           (\<open>|_|\<close>)  where
     "|A| \<equiv> (\<mu> i. i \<approx> A)"
 
 definition
   Finite   :: "i\<Rightarrow>o"  where
     "Finite(A) \<equiv> \<exists>n\<in>nat. A \<approx> n"
 
 definition
   Card     :: "i\<Rightarrow>o"  where
     "Card(i) \<equiv> (i = |i|)"
 
 
 subsection\<open>The Schroeder-Bernstein Theorem\<close>
 text\<open>See Davey and Priestly, page 106\<close>
 
 (** Lemma: Banach's Decomposition Theorem **)
 
 lemma decomp_bnd_mono: "bnd_mono(X, \<lambda>W. X - g``(Y - f``W))"
 by (rule bnd_monoI, blast+)
 
 lemma Banach_last_equation:
     "g \<in> Y->X
      \<Longrightarrow> g``(Y - f`` lfp(X, \<lambda>W. X - g``(Y - f``W))) =
          X - lfp(X, \<lambda>W. X - g``(Y - f``W))"
 apply (rule_tac P = "\<lambda>u. v = X-u" for v
        in decomp_bnd_mono [THEN lfp_unfold, THEN ssubst])
 apply (simp add: double_complement  fun_is_rel [THEN image_subset])
 done
 
 lemma decomposition:
      "\<lbrakk>f \<in> X->Y;  g \<in> Y->X\<rbrakk> \<Longrightarrow>
       \<exists>XA XB YA YB. (XA \<inter> XB = 0) \<and> (XA \<union> XB = X) \<and>
                       (YA \<inter> YB = 0) \<and> (YA \<union> YB = Y) \<and>
                       f``XA=YA \<and> g``YB=XB"
 apply (intro exI conjI)
 apply (rule_tac [6] Banach_last_equation)
 apply (rule_tac [5] refl)
 apply (assumption |
        rule  Diff_disjoint Diff_partition fun_is_rel image_subset lfp_subset)+
 done
 
 lemma schroeder_bernstein:
     "\<lbrakk>f \<in> inj(X,Y);  g \<in> inj(Y,X)\<rbrakk> \<Longrightarrow> \<exists>h. h \<in> bij(X,Y)"
 apply (insert decomposition [of f X Y g])
 apply (simp add: inj_is_fun)
 apply (blast intro!: restrict_bij bij_disjoint_Un intro: bij_converse_bij)
 (* The instantiation of exI to @{term"restrict(f,XA) \<union> converse(restrict(g,YB))"}
    is forced by the context\<And>*)
 done
 
 
 (** Equipollence is an equivalence relation **)
 
 lemma bij_imp_eqpoll: "f \<in> bij(A,B) \<Longrightarrow> A \<approx> B"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (erule exI)
 done
 
 (*A \<approx> A*)
 lemmas eqpoll_refl = id_bij [THEN bij_imp_eqpoll, simp]
 
 lemma eqpoll_sym: "X \<approx> Y \<Longrightarrow> Y \<approx> X"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (blast intro: bij_converse_bij)
 done
 
 lemma eqpoll_trans [trans]:
     "\<lbrakk>X \<approx> Y;  Y \<approx> Z\<rbrakk> \<Longrightarrow> X \<approx> Z"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (blast intro: comp_bij)
 done
 
 (** Le-pollence is a partial ordering **)
 
 lemma subset_imp_lepoll: "X<=Y \<Longrightarrow> X \<lesssim> Y"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (rule exI)
 apply (erule id_subset_inj)
 done
 
 lemmas lepoll_refl = subset_refl [THEN subset_imp_lepoll, simp]
 
 lemmas le_imp_lepoll = le_imp_subset [THEN subset_imp_lepoll]
 
 lemma eqpoll_imp_lepoll: "X \<approx> Y \<Longrightarrow> X \<lesssim> Y"
 by (unfold eqpoll_def bij_def lepoll_def, blast)
 
 lemma lepoll_trans [trans]: "\<lbrakk>X \<lesssim> Y;  Y \<lesssim> Z\<rbrakk> \<Longrightarrow> X \<lesssim> Z"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (blast intro: comp_inj)
 done
 
 lemma eq_lepoll_trans [trans]: "\<lbrakk>X \<approx> Y;  Y \<lesssim> Z\<rbrakk> \<Longrightarrow> X \<lesssim> Z"
  by (blast intro: eqpoll_imp_lepoll lepoll_trans)
 
 lemma lepoll_eq_trans [trans]: "\<lbrakk>X \<lesssim> Y;  Y \<approx> Z\<rbrakk> \<Longrightarrow> X \<lesssim> Z"
  by (blast intro: eqpoll_imp_lepoll lepoll_trans)
 
 (*Asymmetry law*)
 lemma eqpollI: "\<lbrakk>X \<lesssim> Y;  Y \<lesssim> X\<rbrakk> \<Longrightarrow> X \<approx> Y"
 apply (unfold lepoll_def eqpoll_def)
 apply (elim exE)
 apply (rule schroeder_bernstein, assumption+)
 done
 
 lemma eqpollE:
     "\<lbrakk>X \<approx> Y; \<lbrakk>X \<lesssim> Y; Y \<lesssim> X\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (blast intro: eqpoll_imp_lepoll eqpoll_sym)
 
 lemma eqpoll_iff: "X \<approx> Y \<longleftrightarrow> X \<lesssim> Y \<and> Y \<lesssim> X"
 by (blast intro: eqpollI elim!: eqpollE)
 
 lemma lepoll_0_is_0: "A \<lesssim> 0 \<Longrightarrow> A = 0"
 apply (unfold lepoll_def inj_def)
 apply (blast dest: apply_type)
 done
 
 (*@{term"0 \<lesssim> Y"}*)
 lemmas empty_lepollI = empty_subsetI [THEN subset_imp_lepoll]
 
 lemma lepoll_0_iff: "A \<lesssim> 0 \<longleftrightarrow> A=0"
 by (blast intro: lepoll_0_is_0 lepoll_refl)
 
 lemma Un_lepoll_Un:
     "\<lbrakk>A \<lesssim> B; C \<lesssim> D; B \<inter> D = 0\<rbrakk> \<Longrightarrow> A \<union> C \<lesssim> B \<union> D"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (blast intro: inj_disjoint_Un)
 done
 
 (*A \<approx> 0 \<Longrightarrow> A=0*)
 lemmas eqpoll_0_is_0 = eqpoll_imp_lepoll [THEN lepoll_0_is_0]
 
 lemma eqpoll_0_iff: "A \<approx> 0 \<longleftrightarrow> A=0"
 by (blast intro: eqpoll_0_is_0 eqpoll_refl)
 
 lemma eqpoll_disjoint_Un:
     "\<lbrakk>A \<approx> B;  C \<approx> D;  A \<inter> C = 0;  B \<inter> D = 0\<rbrakk>
      \<Longrightarrow> A \<union> C \<approx> B \<union> D"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (blast intro: bij_disjoint_Un)
 done
 
 
 subsection\<open>lesspoll: contributions by Krzysztof Grabczewski\<close>
 
 lemma lesspoll_not_refl: "\<not> (i \<prec> i)"
 by (simp add: lesspoll_def)
 
 lemma lesspoll_irrefl [elim!]: "i \<prec> i \<Longrightarrow> P"
 by (simp add: lesspoll_def)
 
 lemma lesspoll_imp_lepoll: "A \<prec> B \<Longrightarrow> A \<lesssim> B"
 by (unfold lesspoll_def, blast)
 
 lemma lepoll_well_ord: "\<lbrakk>A \<lesssim> B; well_ord(B,r)\<rbrakk> \<Longrightarrow> \<exists>s. well_ord(A,s)"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (blast intro: well_ord_rvimage)
 done
 
 lemma lepoll_iff_leqpoll: "A \<lesssim> B \<longleftrightarrow> A \<prec> B | A \<approx> B"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (blast intro!: eqpollI elim!: eqpollE)
 done
 
 lemma inj_not_surj_succ:
   assumes fi: "f \<in> inj(A, succ(m))" and fns: "f \<notin> surj(A, succ(m))" 
   shows "\<exists>f. f \<in> inj(A,m)"
 proof -
   from fi [THEN inj_is_fun] fns 
   obtain y where y: "y \<in> succ(m)" "\<And>x. x\<in>A \<Longrightarrow> f ` x \<noteq> y"
     by (auto simp add: surj_def)
   show ?thesis
     proof 
       show "(\<lambda>z\<in>A. if f`z = m then y else f`z) \<in> inj(A, m)" using y fi
         by (simp add: inj_def) 
            (auto intro!: if_type [THEN lam_type] intro: Pi_type dest: apply_funtype)
       qed
 qed
 
 (** Variations on transitivity **)
 
 lemma lesspoll_trans [trans]:
       "\<lbrakk>X \<prec> Y; Y \<prec> Z\<rbrakk> \<Longrightarrow> X \<prec> Z"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (blast elim!: eqpollE intro: eqpollI lepoll_trans)
 done
 
 lemma lesspoll_trans1 [trans]:
       "\<lbrakk>X \<lesssim> Y; Y \<prec> Z\<rbrakk> \<Longrightarrow> X \<prec> Z"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (blast elim!: eqpollE intro: eqpollI lepoll_trans)
 done
 
 lemma lesspoll_trans2 [trans]:
       "\<lbrakk>X \<prec> Y; Y \<lesssim> Z\<rbrakk> \<Longrightarrow> X \<prec> Z"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (blast elim!: eqpollE intro: eqpollI lepoll_trans)
 done
 
 lemma eq_lesspoll_trans [trans]:
       "\<lbrakk>X \<approx> Y; Y \<prec> Z\<rbrakk> \<Longrightarrow> X \<prec> Z"
   by (blast intro: eqpoll_imp_lepoll lesspoll_trans1)
 
 lemma lesspoll_eq_trans [trans]:
       "\<lbrakk>X \<prec> Y; Y \<approx> Z\<rbrakk> \<Longrightarrow> X \<prec> Z"
   by (blast intro: eqpoll_imp_lepoll lesspoll_trans2)
 
 
 (** \<mu> -- the least number operator [from HOL/Univ.ML] **)
 
 lemma Least_equality:
     "\<lbrakk>P(i);  Ord(i);  \<And>x. x<i \<Longrightarrow> \<not>P(x)\<rbrakk> \<Longrightarrow> (\<mu> x. P(x)) = i"
-apply (unfold Least_def)
+  unfolding Least_def
 apply (rule the_equality, blast)
 apply (elim conjE)
 apply (erule Ord_linear_lt, assumption, blast+)
 done
 
 lemma LeastI: 
   assumes P: "P(i)" and i: "Ord(i)" shows "P(\<mu> x. P(x))"
 proof -
   { from i have "P(i) \<Longrightarrow> P(\<mu> x. P(x))"
       proof (induct i rule: trans_induct)
         case (step i) 
         show ?case
           proof (cases "P(\<mu> a. P(a))")
             case True thus ?thesis .
           next
             case False
             hence "\<And>x. x \<in> i \<Longrightarrow> \<not>P(x)" using step
               by blast
             hence "(\<mu> a. P(a)) = i" using step
               by (blast intro: Least_equality ltD) 
             thus ?thesis using step.prems
               by simp 
           qed
       qed
   }
   thus ?thesis using P .
 qed
 
 text\<open>The proof is almost identical to the one above!\<close>
 lemma Least_le: 
   assumes P: "P(i)" and i: "Ord(i)" shows "(\<mu> x. P(x)) \<le> i"
 proof -
   { from i have "P(i) \<Longrightarrow> (\<mu> x. P(x)) \<le> i"
       proof (induct i rule: trans_induct)
         case (step i) 
         show ?case
           proof (cases "(\<mu> a. P(a)) \<le> i")
             case True thus ?thesis .
           next
             case False
             hence "\<And>x. x \<in> i \<Longrightarrow> \<not> (\<mu> a. P(a)) \<le> i" using step
               by blast
             hence "(\<mu> a. P(a)) = i" using step
               by (blast elim: ltE intro: ltI Least_equality lt_trans1)
             thus ?thesis using step
               by simp 
           qed
       qed
   }
   thus ?thesis using P .
 qed
 
 (*\<mu> really is the smallest*)
 lemma less_LeastE: "\<lbrakk>P(i);  i < (\<mu> x. P(x))\<rbrakk> \<Longrightarrow> Q"
 apply (rule Least_le [THEN [2] lt_trans2, THEN lt_irrefl], assumption+)
 apply (simp add: lt_Ord)
 done
 
 (*Easier to apply than LeastI: conclusion has only one occurrence of P*)
 lemma LeastI2:
     "\<lbrakk>P(i);  Ord(i);  \<And>j. P(j) \<Longrightarrow> Q(j)\<rbrakk> \<Longrightarrow> Q(\<mu> j. P(j))"
 by (blast intro: LeastI )
 
 (*If there is no such P then \<mu> is vacuously 0*)
 lemma Least_0:
     "\<lbrakk>\<not> (\<exists>i. Ord(i) \<and> P(i))\<rbrakk> \<Longrightarrow> (\<mu> x. P(x)) = 0"
-apply (unfold Least_def)
+  unfolding Least_def
 apply (rule the_0, blast)
 done
 
 lemma Ord_Least [intro,simp,TC]: "Ord(\<mu> x. P(x))"
 proof (cases "\<exists>i. Ord(i) \<and> P(i)")
   case True 
   then obtain i where "P(i)" "Ord(i)"  by auto
   hence " (\<mu> x. P(x)) \<le> i"  by (rule Least_le) 
   thus ?thesis
     by (elim ltE)
 next
   case False
   hence "(\<mu> x. P(x)) = 0"  by (rule Least_0)
   thus ?thesis
     by auto
 qed
 
 
 subsection\<open>Basic Properties of Cardinals\<close>
 
 (*Not needed for simplification, but helpful below*)
 lemma Least_cong: "(\<And>y. P(y) \<longleftrightarrow> Q(y)) \<Longrightarrow> (\<mu> x. P(x)) = (\<mu> x. Q(x))"
 by simp
 
 (*Need AC to get @{term"X \<lesssim> Y \<Longrightarrow> |X| \<le> |Y|"};  see well_ord_lepoll_imp_cardinal_le
   Converse also requires AC, but see well_ord_cardinal_eqE*)
 lemma cardinal_cong: "X \<approx> Y \<Longrightarrow> |X| = |Y|"
 apply (unfold eqpoll_def cardinal_def)
 apply (rule Least_cong)
 apply (blast intro: comp_bij bij_converse_bij)
 done
 
 (*Under AC, the premise becomes trivial; one consequence is ||A|| = |A|*)
 lemma well_ord_cardinal_eqpoll:
   assumes r: "well_ord(A,r)" shows "|A| \<approx> A"
 proof (unfold cardinal_def)
   show "(\<mu> i. i \<approx> A) \<approx> A"
     by (best intro: LeastI Ord_ordertype ordermap_bij bij_converse_bij bij_imp_eqpoll r) 
 qed
 
 (* @{term"Ord(A) \<Longrightarrow> |A| \<approx> A"} *)
 lemmas Ord_cardinal_eqpoll = well_ord_Memrel [THEN well_ord_cardinal_eqpoll]
 
 lemma Ord_cardinal_idem: "Ord(A) \<Longrightarrow> ||A|| = |A|"
  by (rule Ord_cardinal_eqpoll [THEN cardinal_cong])
 
 lemma well_ord_cardinal_eqE:
   assumes woX: "well_ord(X,r)" and woY: "well_ord(Y,s)" and eq: "|X| = |Y|"
 shows "X \<approx> Y"
 proof -
   have "X \<approx> |X|" by (blast intro: well_ord_cardinal_eqpoll [OF woX] eqpoll_sym)
   also have "... = |Y|" by (rule eq)
   also have "... \<approx> Y" by (rule well_ord_cardinal_eqpoll [OF woY])
   finally show ?thesis .
 qed
 
 lemma well_ord_cardinal_eqpoll_iff:
      "\<lbrakk>well_ord(X,r);  well_ord(Y,s)\<rbrakk> \<Longrightarrow> |X| = |Y| \<longleftrightarrow> X \<approx> Y"
 by (blast intro: cardinal_cong well_ord_cardinal_eqE)
 
 
 (** Observations from Kunen, page 28 **)
 
 lemma Ord_cardinal_le: "Ord(i) \<Longrightarrow> |i| \<le> i"
-apply (unfold cardinal_def)
+  unfolding cardinal_def
 apply (erule eqpoll_refl [THEN Least_le])
 done
 
 lemma Card_cardinal_eq: "Card(K) \<Longrightarrow> |K| = K"
-apply (unfold Card_def)
+  unfolding Card_def
 apply (erule sym)
 done
 
 (* Could replace the  @{term"\<not>(j \<approx> i)"}  by  @{term"\<not>(i \<preceq> j)"}. *)
 lemma CardI: "\<lbrakk>Ord(i);  \<And>j. j<i \<Longrightarrow> \<not>(j \<approx> i)\<rbrakk> \<Longrightarrow> Card(i)"
 apply (unfold Card_def cardinal_def)
 apply (subst Least_equality)
 apply (blast intro: eqpoll_refl)+
 done
 
 lemma Card_is_Ord: "Card(i) \<Longrightarrow> Ord(i)"
 apply (unfold Card_def cardinal_def)
 apply (erule ssubst)
 apply (rule Ord_Least)
 done
 
 lemma Card_cardinal_le: "Card(K) \<Longrightarrow> K \<le> |K|"
 apply (simp (no_asm_simp) add: Card_is_Ord Card_cardinal_eq)
 done
 
 lemma Ord_cardinal [simp,intro!]: "Ord(|A|)"
-apply (unfold cardinal_def)
+  unfolding cardinal_def
 apply (rule Ord_Least)
 done
 
 text\<open>The cardinals are the initial ordinals.\<close>
 lemma Card_iff_initial: "Card(K) \<longleftrightarrow> Ord(K) \<and> (\<forall>j. j<K \<longrightarrow> \<not> j \<approx> K)"
 proof -
   { fix j
     assume K: "Card(K)" "j \<approx> K"
     assume "j < K"
     also have "... = (\<mu> i. i \<approx> K)" using K
       by (simp add: Card_def cardinal_def)
     finally have "j < (\<mu> i. i \<approx> K)" .
     hence "False" using K
       by (best dest: less_LeastE) 
   }
   then show ?thesis
     by (blast intro: CardI Card_is_Ord) 
 qed
 
 lemma lt_Card_imp_lesspoll: "\<lbrakk>Card(a); i<a\<rbrakk> \<Longrightarrow> i \<prec> a"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (drule Card_iff_initial [THEN iffD1])
 apply (blast intro!: leI [THEN le_imp_lepoll])
 done
 
 lemma Card_0: "Card(0)"
 apply (rule Ord_0 [THEN CardI])
 apply (blast elim!: ltE)
 done
 
 lemma Card_Un: "\<lbrakk>Card(K);  Card(L)\<rbrakk> \<Longrightarrow> Card(K \<union> L)"
 apply (rule Ord_linear_le [of K L])
 apply (simp_all add: subset_Un_iff [THEN iffD1]  Card_is_Ord le_imp_subset
                      subset_Un_iff2 [THEN iffD1])
 done
 
 (*Infinite unions of cardinals?  See Devlin, Lemma 6.7, page 98*)
 
 lemma Card_cardinal [iff]: "Card(|A|)"
 proof (unfold cardinal_def)
   show "Card(\<mu> i. i \<approx> A)"
     proof (cases "\<exists>i. Ord (i) \<and> i \<approx> A")
       case False thus ?thesis           \<comment> \<open>degenerate case\<close>
         by (simp add: Least_0 Card_0)
     next
       case True                         \<comment> \<open>real case: \<^term>\<open>A\<close> is isomorphic to some ordinal\<close>
       then obtain i where i: "Ord(i)" "i \<approx> A" by blast
       show ?thesis
         proof (rule CardI [OF Ord_Least], rule notI)
           fix j
           assume j: "j < (\<mu> i. i \<approx> A)"
           assume "j \<approx> (\<mu> i. i \<approx> A)"
           also have "... \<approx> A" using i by (auto intro: LeastI)
           finally have "j \<approx> A" .
           thus False
             by (rule less_LeastE [OF _ j])
         qed
     qed
 qed
 
 (*Kunen's Lemma 10.5*)
 lemma cardinal_eq_lemma:
   assumes i:"|i| \<le> j" and j: "j \<le> i" shows "|j| = |i|"
 proof (rule eqpollI [THEN cardinal_cong])
   show "j \<lesssim> i" by (rule le_imp_lepoll [OF j])
 next
   have Oi: "Ord(i)" using j by (rule le_Ord2)
   hence "i \<approx> |i|"
     by (blast intro: Ord_cardinal_eqpoll eqpoll_sym)
   also have "... \<lesssim> j"
     by (blast intro: le_imp_lepoll i)
   finally show "i \<lesssim> j" .
 qed
 
 lemma cardinal_mono:
   assumes ij: "i \<le> j" shows "|i| \<le> |j|"
 using Ord_cardinal [of i] Ord_cardinal [of j]
 proof (cases rule: Ord_linear_le)
   case le thus ?thesis .
 next
   case ge
   have i: "Ord(i)" using ij
     by (simp add: lt_Ord)
   have ci: "|i| \<le> j"
     by (blast intro: Ord_cardinal_le ij le_trans i)
   have "|i| = ||i||"
     by (auto simp add: Ord_cardinal_idem i)
   also have "... = |j|"
     by (rule cardinal_eq_lemma [OF ge ci])
   finally have "|i| = |j|" .
   thus ?thesis by simp
 qed
 
 text\<open>Since we have \<^term>\<open>|succ(nat)| \<le> |nat|\<close>, the converse of \<open>cardinal_mono\<close> fails!\<close>
 lemma cardinal_lt_imp_lt: "\<lbrakk>|i| < |j|;  Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> i < j"
 apply (rule Ord_linear2 [of i j], assumption+)
 apply (erule lt_trans2 [THEN lt_irrefl])
 apply (erule cardinal_mono)
 done
 
 lemma Card_lt_imp_lt: "\<lbrakk>|i| < K;  Ord(i);  Card(K)\<rbrakk> \<Longrightarrow> i < K"
   by (simp (no_asm_simp) add: cardinal_lt_imp_lt Card_is_Ord Card_cardinal_eq)
 
 lemma Card_lt_iff: "\<lbrakk>Ord(i);  Card(K)\<rbrakk> \<Longrightarrow> (|i| < K) \<longleftrightarrow> (i < K)"
 by (blast intro: Card_lt_imp_lt Ord_cardinal_le [THEN lt_trans1])
 
 lemma Card_le_iff: "\<lbrakk>Ord(i);  Card(K)\<rbrakk> \<Longrightarrow> (K \<le> |i|) \<longleftrightarrow> (K \<le> i)"
 by (simp add: Card_lt_iff Card_is_Ord Ord_cardinal not_lt_iff_le [THEN iff_sym])
 
 (*Can use AC or finiteness to discharge first premise*)
 lemma well_ord_lepoll_imp_cardinal_le:
   assumes wB: "well_ord(B,r)" and AB: "A \<lesssim> B"
   shows "|A| \<le> |B|"
 using Ord_cardinal [of A] Ord_cardinal [of B]
 proof (cases rule: Ord_linear_le)
   case le thus ?thesis .
 next
   case ge
   from lepoll_well_ord [OF AB wB]
   obtain s where s: "well_ord(A, s)" by blast
   have "B  \<approx> |B|" by (blast intro: wB eqpoll_sym well_ord_cardinal_eqpoll)
   also have "... \<lesssim> |A|" by (rule le_imp_lepoll [OF ge])
   also have "... \<approx> A" by (rule well_ord_cardinal_eqpoll [OF s])
   finally have "B \<lesssim> A" .
   hence "A \<approx> B" by (blast intro: eqpollI AB)
   hence "|A| = |B|" by (rule cardinal_cong)
   thus ?thesis by simp
 qed
 
 lemma lepoll_cardinal_le: "\<lbrakk>A \<lesssim> i; Ord(i)\<rbrakk> \<Longrightarrow> |A| \<le> i"
 apply (rule le_trans)
 apply (erule well_ord_Memrel [THEN well_ord_lepoll_imp_cardinal_le], assumption)
 apply (erule Ord_cardinal_le)
 done
 
 lemma lepoll_Ord_imp_eqpoll: "\<lbrakk>A \<lesssim> i; Ord(i)\<rbrakk> \<Longrightarrow> |A| \<approx> A"
 by (blast intro: lepoll_cardinal_le well_ord_Memrel well_ord_cardinal_eqpoll dest!: lepoll_well_ord)
 
 lemma lesspoll_imp_eqpoll: "\<lbrakk>A \<prec> i; Ord(i)\<rbrakk> \<Longrightarrow> |A| \<approx> A"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (blast intro: lepoll_Ord_imp_eqpoll)
 done
 
 lemma cardinal_subset_Ord: "\<lbrakk>A<=i; Ord(i)\<rbrakk> \<Longrightarrow> |A| \<subseteq> i"
 apply (drule subset_imp_lepoll [THEN lepoll_cardinal_le])
 apply (auto simp add: lt_def)
 apply (blast intro: Ord_trans)
 done
 
 subsection\<open>The finite cardinals\<close>
 
 lemma cons_lepoll_consD:
  "\<lbrakk>cons(u,A) \<lesssim> cons(v,B);  u\<notin>A;  v\<notin>B\<rbrakk> \<Longrightarrow> A \<lesssim> B"
 apply (unfold lepoll_def inj_def, safe)
 apply (rule_tac x = "\<lambda>x\<in>A. if f`x=v then f`u else f`x" in exI)
 apply (rule CollectI)
 (*Proving it's in the function space A->B*)
 apply (rule if_type [THEN lam_type])
 apply (blast dest: apply_funtype)
 apply (blast elim!: mem_irrefl dest: apply_funtype)
 (*Proving it's injective*)
 apply (simp (no_asm_simp))
 apply blast
 done
 
 lemma cons_eqpoll_consD: "\<lbrakk>cons(u,A) \<approx> cons(v,B);  u\<notin>A;  v\<notin>B\<rbrakk> \<Longrightarrow> A \<approx> B"
 apply (simp add: eqpoll_iff)
 apply (blast intro: cons_lepoll_consD)
 done
 
 (*Lemma suggested by Mike Fourman*)
 lemma succ_lepoll_succD: "succ(m) \<lesssim> succ(n) \<Longrightarrow> m \<lesssim> n"
-apply (unfold succ_def)
+  unfolding succ_def
 apply (erule cons_lepoll_consD)
 apply (rule mem_not_refl)+
 done
 
 
 lemma nat_lepoll_imp_le:
      "m \<in> nat \<Longrightarrow> n \<in> nat \<Longrightarrow> m \<lesssim> n \<Longrightarrow> m \<le> n"
 proof (induct m arbitrary: n rule: nat_induct)
   case 0 thus ?case by (blast intro!: nat_0_le)
 next
   case (succ m)
   show ?case  using \<open>n \<in> nat\<close>
     proof (cases rule: natE)
       case 0 thus ?thesis using succ
         by (simp add: lepoll_def inj_def)
     next
       case (succ n') thus ?thesis using succ.hyps \<open> succ(m) \<lesssim> n\<close>
         by (blast intro!: succ_leI dest!: succ_lepoll_succD)
     qed
 qed
 
 lemma nat_eqpoll_iff: "\<lbrakk>m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> m \<approx> n \<longleftrightarrow> m = n"
 apply (rule iffI)
 apply (blast intro: nat_lepoll_imp_le le_anti_sym elim!: eqpollE)
 apply (simp add: eqpoll_refl)
 done
 
 (*The object of all this work: every natural number is a (finite) cardinal*)
 lemma nat_into_Card:
   assumes n: "n \<in> nat" shows "Card(n)"
 proof (unfold Card_def cardinal_def, rule sym)
   have "Ord(n)" using n  by auto
   moreover
   { fix i
     assume "i < n" "i \<approx> n"
     hence False using n
       by (auto simp add: lt_nat_in_nat [THEN nat_eqpoll_iff])
   }
   ultimately show "(\<mu> i. i \<approx> n) = n" by (auto intro!: Least_equality) 
 qed
 
 lemmas cardinal_0 = nat_0I [THEN nat_into_Card, THEN Card_cardinal_eq, iff]
 lemmas cardinal_1 = nat_1I [THEN nat_into_Card, THEN Card_cardinal_eq, iff]
 
 
 (*Part of Kunen's Lemma 10.6*)
 lemma succ_lepoll_natE: "\<lbrakk>succ(n) \<lesssim> n;  n \<in> nat\<rbrakk> \<Longrightarrow> P"
 by (rule nat_lepoll_imp_le [THEN lt_irrefl], auto)
 
 lemma nat_lepoll_imp_ex_eqpoll_n:
      "\<lbrakk>n \<in> nat;  nat \<lesssim> X\<rbrakk> \<Longrightarrow> \<exists>Y. Y \<subseteq> X \<and> n \<approx> Y"
 apply (unfold lepoll_def eqpoll_def)
 apply (fast del: subsetI subsetCE
             intro!: subset_SIs
             dest!: Ord_nat [THEN [2] OrdmemD, THEN [2] restrict_inj]
             elim!: restrict_bij
                    inj_is_fun [THEN fun_is_rel, THEN image_subset])
 done
 
 
 (** \<lesssim>, \<prec> and natural numbers **)
 
 lemma lepoll_succ: "i \<lesssim> succ(i)"
   by (blast intro: subset_imp_lepoll)
 
 lemma lepoll_imp_lesspoll_succ:
   assumes A: "A \<lesssim> m" and m: "m \<in> nat"
   shows "A \<prec> succ(m)"
 proof -
   { assume "A \<approx> succ(m)"
     hence "succ(m) \<approx> A" by (rule eqpoll_sym)
     also have "... \<lesssim> m" by (rule A)
     finally have "succ(m) \<lesssim> m" .
     hence False by (rule succ_lepoll_natE) (rule m) }
   moreover have "A \<lesssim> succ(m)" by (blast intro: lepoll_trans A lepoll_succ)
   ultimately show ?thesis by (auto simp add: lesspoll_def)
 qed
 
 lemma lesspoll_succ_imp_lepoll:
      "\<lbrakk>A \<prec> succ(m); m \<in> nat\<rbrakk> \<Longrightarrow> A \<lesssim> m"
 apply (unfold lesspoll_def lepoll_def eqpoll_def bij_def)
 apply (auto dest: inj_not_surj_succ)
 done
 
 lemma lesspoll_succ_iff: "m \<in> nat \<Longrightarrow> A \<prec> succ(m) \<longleftrightarrow> A \<lesssim> m"
 by (blast intro!: lepoll_imp_lesspoll_succ lesspoll_succ_imp_lepoll)
 
 lemma lepoll_succ_disj: "\<lbrakk>A \<lesssim> succ(m);  m \<in> nat\<rbrakk> \<Longrightarrow> A \<lesssim> m | A \<approx> succ(m)"
 apply (rule disjCI)
 apply (rule lesspoll_succ_imp_lepoll)
 prefer 2 apply assumption
 apply (simp (no_asm_simp) add: lesspoll_def)
 done
 
 lemma lesspoll_cardinal_lt: "\<lbrakk>A \<prec> i; Ord(i)\<rbrakk> \<Longrightarrow> |A| < i"
 apply (unfold lesspoll_def, clarify)
 apply (frule lepoll_cardinal_le, assumption)
 apply (blast intro: well_ord_Memrel well_ord_cardinal_eqpoll [THEN eqpoll_sym]
              dest: lepoll_well_ord  elim!: leE)
 done
 
 
 subsection\<open>The first infinite cardinal: Omega, or nat\<close>
 
 (*This implies Kunen's Lemma 10.6*)
 lemma lt_not_lepoll:
   assumes n: "n<i" "n \<in> nat" shows "\<not> i \<lesssim> n"
 proof -
   { assume i: "i \<lesssim> n"
     have "succ(n) \<lesssim> i" using n
       by (elim ltE, blast intro: Ord_succ_subsetI [THEN subset_imp_lepoll])
     also have "... \<lesssim> n" by (rule i)
     finally have "succ(n) \<lesssim> n" .
     hence False  by (rule succ_lepoll_natE) (rule n) }
   thus ?thesis by auto
 qed
 
 text\<open>A slightly weaker version of \<open>nat_eqpoll_iff\<close>\<close>
 lemma Ord_nat_eqpoll_iff:
   assumes i: "Ord(i)" and n: "n \<in> nat" shows "i \<approx> n \<longleftrightarrow> i=n"
 using i nat_into_Ord [OF n]
 proof (cases rule: Ord_linear_lt)
   case lt
   hence  "i \<in> nat" by (rule lt_nat_in_nat) (rule n)
   thus ?thesis by (simp add: nat_eqpoll_iff n)
 next
   case eq
   thus ?thesis by (simp add: eqpoll_refl)
 next
   case gt
   hence  "\<not> i \<lesssim> n" using n  by (rule lt_not_lepoll)
   hence  "\<not> i \<approx> n" using n  by (blast intro: eqpoll_imp_lepoll)
   moreover have "i \<noteq> n" using \<open>n<i\<close> by auto
   ultimately show ?thesis by blast
 qed
 
 lemma Card_nat: "Card(nat)"
 proof -
   { fix i
     assume i: "i < nat" "i \<approx> nat"
     hence "\<not> nat \<lesssim> i"
       by (simp add: lt_def lt_not_lepoll)
     hence False using i
       by (simp add: eqpoll_iff)
   }
   hence "(\<mu> i. i \<approx> nat) = nat" by (blast intro: Least_equality eqpoll_refl)
   thus ?thesis
     by (auto simp add: Card_def cardinal_def)
 qed
 
 (*Allows showing that |i| is a limit cardinal*)
 lemma nat_le_cardinal: "nat \<le> i \<Longrightarrow> nat \<le> |i|"
 apply (rule Card_nat [THEN Card_cardinal_eq, THEN subst])
 apply (erule cardinal_mono)
 done
 
 lemma n_lesspoll_nat: "n \<in> nat \<Longrightarrow> n \<prec> nat"
   by (blast intro: Ord_nat Card_nat ltI lt_Card_imp_lesspoll)
 
 
 subsection\<open>Towards Cardinal Arithmetic\<close>
 (** Congruence laws for successor, cardinal addition and multiplication **)
 
 (*Congruence law for  cons  under equipollence*)
 lemma cons_lepoll_cong:
     "\<lbrakk>A \<lesssim> B;  b \<notin> B\<rbrakk> \<Longrightarrow> cons(a,A) \<lesssim> cons(b,B)"
 apply (unfold lepoll_def, safe)
 apply (rule_tac x = "\<lambda>y\<in>cons (a,A) . if y=a then b else f`y" in exI)
 apply (rule_tac d = "\<lambda>z. if z \<in> B then converse (f) `z else a" in lam_injective)
 apply (safe elim!: consE')
    apply simp_all
 apply (blast intro: inj_is_fun [THEN apply_type])+
 done
 
 lemma cons_eqpoll_cong:
      "\<lbrakk>A \<approx> B;  a \<notin> A;  b \<notin> B\<rbrakk> \<Longrightarrow> cons(a,A) \<approx> cons(b,B)"
 by (simp add: eqpoll_iff cons_lepoll_cong)
 
 lemma cons_lepoll_cons_iff:
      "\<lbrakk>a \<notin> A;  b \<notin> B\<rbrakk> \<Longrightarrow> cons(a,A) \<lesssim> cons(b,B)  \<longleftrightarrow>  A \<lesssim> B"
 by (blast intro: cons_lepoll_cong cons_lepoll_consD)
 
 lemma cons_eqpoll_cons_iff:
      "\<lbrakk>a \<notin> A;  b \<notin> B\<rbrakk> \<Longrightarrow> cons(a,A) \<approx> cons(b,B)  \<longleftrightarrow>  A \<approx> B"
 by (blast intro: cons_eqpoll_cong cons_eqpoll_consD)
 
 lemma singleton_eqpoll_1: "{a} \<approx> 1"
-apply (unfold succ_def)
+  unfolding succ_def
 apply (blast intro!: eqpoll_refl [THEN cons_eqpoll_cong])
 done
 
 lemma cardinal_singleton: "|{a}| = 1"
 apply (rule singleton_eqpoll_1 [THEN cardinal_cong, THEN trans])
 apply (simp (no_asm) add: nat_into_Card [THEN Card_cardinal_eq])
 done
 
 lemma not_0_is_lepoll_1: "A \<noteq> 0 \<Longrightarrow> 1 \<lesssim> A"
 apply (erule not_emptyE)
 apply (rule_tac a = "cons (x, A-{x}) " in subst)
 apply (rule_tac [2] a = "cons(0,0)" and P= "\<lambda>y. y \<lesssim> cons (x, A-{x})" in subst)
 prefer 3 apply (blast intro: cons_lepoll_cong subset_imp_lepoll, auto)
 done
 
 (*Congruence law for  succ  under equipollence*)
 lemma succ_eqpoll_cong: "A \<approx> B \<Longrightarrow> succ(A) \<approx> succ(B)"
-apply (unfold succ_def)
+  unfolding succ_def
 apply (simp add: cons_eqpoll_cong mem_not_refl)
 done
 
 (*Congruence law for + under equipollence*)
 lemma sum_eqpoll_cong: "\<lbrakk>A \<approx> C;  B \<approx> D\<rbrakk> \<Longrightarrow> A+B \<approx> C+D"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (blast intro!: sum_bij)
 done
 
 (*Congruence law for * under equipollence*)
 lemma prod_eqpoll_cong:
     "\<lbrakk>A \<approx> C;  B \<approx> D\<rbrakk> \<Longrightarrow> A*B \<approx> C*D"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (blast intro!: prod_bij)
 done
 
 lemma inj_disjoint_eqpoll:
     "\<lbrakk>f \<in> inj(A,B);  A \<inter> B = 0\<rbrakk> \<Longrightarrow> A \<union> (B - range(f)) \<approx> B"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule_tac c = "\<lambda>x. if x \<in> A then f`x else x"
             and d = "\<lambda>y. if y \<in> range (f) then converse (f) `y else y"
        in lam_bijective)
 apply (blast intro!: if_type inj_is_fun [THEN apply_type])
 apply (simp (no_asm_simp) add: inj_converse_fun [THEN apply_funtype])
 apply (safe elim!: UnE')
    apply (simp_all add: inj_is_fun [THEN apply_rangeI])
 apply (blast intro: inj_converse_fun [THEN apply_type])+
 done
 
 
 subsection\<open>Lemmas by Krzysztof Grabczewski\<close>
 
 (*New proofs using cons_lepoll_cons. Could generalise from succ to cons.*)
 
 text\<open>If \<^term>\<open>A\<close> has at most \<^term>\<open>n+1\<close> elements and \<^term>\<open>a \<in> A\<close>
       then \<^term>\<open>A-{a}\<close> has at most \<^term>\<open>n\<close>.\<close>
 lemma Diff_sing_lepoll:
       "\<lbrakk>a \<in> A;  A \<lesssim> succ(n)\<rbrakk> \<Longrightarrow> A - {a} \<lesssim> n"
-apply (unfold succ_def)
+  unfolding succ_def
 apply (rule cons_lepoll_consD)
 apply (rule_tac [3] mem_not_refl)
 apply (erule cons_Diff [THEN ssubst], safe)
 done
 
 text\<open>If \<^term>\<open>A\<close> has at least \<^term>\<open>n+1\<close> elements then \<^term>\<open>A-{a}\<close> has at least \<^term>\<open>n\<close>.\<close>
 lemma lepoll_Diff_sing:
   assumes A: "succ(n) \<lesssim> A" shows "n \<lesssim> A - {a}"
 proof -
   have "cons(n,n) \<lesssim> A" using A
     by (unfold succ_def)
   also have "... \<lesssim> cons(a, A-{a})"
     by (blast intro: subset_imp_lepoll)
   finally have "cons(n,n) \<lesssim> cons(a, A-{a})" .
   thus ?thesis
     by (blast intro: cons_lepoll_consD mem_irrefl)
 qed
 
 lemma Diff_sing_eqpoll: "\<lbrakk>a \<in> A; A \<approx> succ(n)\<rbrakk> \<Longrightarrow> A - {a} \<approx> n"
 by (blast intro!: eqpollI
           elim!: eqpollE
           intro: Diff_sing_lepoll lepoll_Diff_sing)
 
 lemma lepoll_1_is_sing: "\<lbrakk>A \<lesssim> 1; a \<in> A\<rbrakk> \<Longrightarrow> A = {a}"
 apply (frule Diff_sing_lepoll, assumption)
 apply (drule lepoll_0_is_0)
 apply (blast elim: equalityE)
 done
 
 lemma Un_lepoll_sum: "A \<union> B \<lesssim> A+B"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (rule_tac x = "\<lambda>x\<in>A \<union> B. if x\<in>A then Inl (x) else Inr (x)" in exI)
 apply (rule_tac d = "\<lambda>z. snd (z)" in lam_injective)
 apply force
 apply (simp add: Inl_def Inr_def)
 done
 
 lemma well_ord_Un:
      "\<lbrakk>well_ord(X,R); well_ord(Y,S)\<rbrakk> \<Longrightarrow> \<exists>T. well_ord(X \<union> Y, T)"
 by (erule well_ord_radd [THEN Un_lepoll_sum [THEN lepoll_well_ord]],
     assumption)
 
 (*Krzysztof Grabczewski*)
 lemma disj_Un_eqpoll_sum: "A \<inter> B = 0 \<Longrightarrow> A \<union> B \<approx> A + B"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule_tac x = "\<lambda>a\<in>A \<union> B. if a \<in> A then Inl (a) else Inr (a)" in exI)
 apply (rule_tac d = "\<lambda>z. case (\<lambda>x. x, \<lambda>x. x, z)" in lam_bijective)
 apply auto
 done
 
 
 subsection \<open>Finite and infinite sets\<close>
 
 lemma eqpoll_imp_Finite_iff: "A \<approx> B \<Longrightarrow> Finite(A) \<longleftrightarrow> Finite(B)"
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (blast intro: eqpoll_trans eqpoll_sym)
 done
 
 lemma Finite_0 [simp]: "Finite(0)"
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (blast intro!: eqpoll_refl nat_0I)
 done
 
 lemma Finite_cons: "Finite(x) \<Longrightarrow> Finite(cons(y,x))"
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (case_tac "y \<in> x")
 apply (simp add: cons_absorb)
 apply (erule bexE)
 apply (rule bexI)
 apply (erule_tac [2] nat_succI)
 apply (simp (no_asm_simp) add: succ_def cons_eqpoll_cong mem_not_refl)
 done
 
 lemma Finite_succ: "Finite(x) \<Longrightarrow> Finite(succ(x))"
-apply (unfold succ_def)
+  unfolding succ_def
 apply (erule Finite_cons)
 done
 
 lemma lepoll_nat_imp_Finite:
   assumes A: "A \<lesssim> n" and n: "n \<in> nat" shows "Finite(A)"
 proof -
   have "A \<lesssim> n \<Longrightarrow> Finite(A)" using n
     proof (induct n)
       case 0
       hence "A = 0" by (rule lepoll_0_is_0) 
       thus ?case by simp
     next
       case (succ n)
       hence "A \<lesssim> n \<or> A \<approx> succ(n)" by (blast dest: lepoll_succ_disj)
       thus ?case using succ by (auto simp add: Finite_def) 
     qed
   thus ?thesis using A .
 qed
 
 lemma lesspoll_nat_is_Finite:
      "A \<prec> nat \<Longrightarrow> Finite(A)"
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (blast dest: ltD lesspoll_cardinal_lt
                    lesspoll_imp_eqpoll [THEN eqpoll_sym])
 done
 
 lemma lepoll_Finite:
   assumes Y: "Y \<lesssim> X" and X: "Finite(X)" shows "Finite(Y)"
 proof -
   obtain n where n: "n \<in> nat" "X \<approx> n" using X
     by (auto simp add: Finite_def)
   have "Y \<lesssim> X"         by (rule Y)
   also have "... \<approx> n"  by (rule n)
   finally have "Y \<lesssim> n" .
   thus ?thesis using n by (simp add: lepoll_nat_imp_Finite)
 qed
 
 lemmas subset_Finite = subset_imp_lepoll [THEN lepoll_Finite]
 
 lemma Finite_cons_iff [iff]: "Finite(cons(y,x)) \<longleftrightarrow> Finite(x)"
 by (blast intro: Finite_cons subset_Finite)
 
 lemma Finite_succ_iff [iff]: "Finite(succ(x)) \<longleftrightarrow> Finite(x)"
 by (simp add: succ_def)
 
 lemma Finite_Int: "Finite(A) | Finite(B) \<Longrightarrow> Finite(A \<inter> B)"
 by (blast intro: subset_Finite)
 
 lemmas Finite_Diff = Diff_subset [THEN subset_Finite]
 
 lemma nat_le_infinite_Ord:
       "\<lbrakk>Ord(i);  \<not> Finite(i)\<rbrakk> \<Longrightarrow> nat \<le> i"
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (erule Ord_nat [THEN [2] Ord_linear2])
 prefer 2 apply assumption
 apply (blast intro!: eqpoll_refl elim!: ltE)
 done
 
 lemma Finite_imp_well_ord:
     "Finite(A) \<Longrightarrow> \<exists>r. well_ord(A,r)"
 apply (unfold Finite_def eqpoll_def)
 apply (blast intro: well_ord_rvimage bij_is_inj well_ord_Memrel nat_into_Ord)
 done
 
 lemma succ_lepoll_imp_not_empty: "succ(x) \<lesssim> y \<Longrightarrow> y \<noteq> 0"
 by (fast dest!: lepoll_0_is_0)
 
 lemma eqpoll_succ_imp_not_empty: "x \<approx> succ(n) \<Longrightarrow> x \<noteq> 0"
 by (fast elim!: eqpoll_sym [THEN eqpoll_0_is_0, THEN succ_neq_0])
 
 lemma Finite_Fin_lemma [rule_format]:
      "n \<in> nat \<Longrightarrow> \<forall>A. (A\<approx>n \<and> A \<subseteq> X) \<longrightarrow> A \<in> Fin(X)"
 apply (induct_tac n)
 apply (rule allI)
 apply (fast intro!: Fin.emptyI dest!: eqpoll_imp_lepoll [THEN lepoll_0_is_0])
 apply (rule allI)
 apply (rule impI)
 apply (erule conjE)
 apply (rule eqpoll_succ_imp_not_empty [THEN not_emptyE], assumption)
 apply (frule Diff_sing_eqpoll, assumption)
 apply (erule allE)
 apply (erule impE, fast)
 apply (drule subsetD, assumption)
 apply (drule Fin.consI, assumption)
 apply (simp add: cons_Diff)
 done
 
 lemma Finite_Fin: "\<lbrakk>Finite(A); A \<subseteq> X\<rbrakk> \<Longrightarrow> A \<in> Fin(X)"
 by (unfold Finite_def, blast intro: Finite_Fin_lemma)
 
 lemma Fin_lemma [rule_format]: "n \<in> nat \<Longrightarrow> \<forall>A. A \<approx> n \<longrightarrow> A \<in> Fin(A)"
 apply (induct_tac n)
 apply (simp add: eqpoll_0_iff, clarify)
 apply (subgoal_tac "\<exists>u. u \<in> A")
 apply (erule exE)
 apply (rule Diff_sing_eqpoll [elim_format])
 prefer 2 apply assumption
 apply assumption
 apply (rule_tac b = A in cons_Diff [THEN subst], assumption)
 apply (rule Fin.consI, blast)
 apply (blast intro: subset_consI [THEN Fin_mono, THEN subsetD])
 (*Now for the lemma assumed above*)
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (blast intro: bij_converse_bij [THEN bij_is_fun, THEN apply_type])
 done
 
 lemma Finite_into_Fin: "Finite(A) \<Longrightarrow> A \<in> Fin(A)"
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (blast intro: Fin_lemma)
 done
 
 lemma Fin_into_Finite: "A \<in> Fin(U) \<Longrightarrow> Finite(A)"
 by (fast intro!: Finite_0 Finite_cons elim: Fin_induct)
 
 lemma Finite_Fin_iff: "Finite(A) \<longleftrightarrow> A \<in> Fin(A)"
 by (blast intro: Finite_into_Fin Fin_into_Finite)
 
 lemma Finite_Un: "\<lbrakk>Finite(A); Finite(B)\<rbrakk> \<Longrightarrow> Finite(A \<union> B)"
 by (blast intro!: Fin_into_Finite Fin_UnI
           dest!: Finite_into_Fin
           intro: Un_upper1 [THEN Fin_mono, THEN subsetD]
                  Un_upper2 [THEN Fin_mono, THEN subsetD])
 
 lemma Finite_Un_iff [simp]: "Finite(A \<union> B) \<longleftrightarrow> (Finite(A) \<and> Finite(B))"
 by (blast intro: subset_Finite Finite_Un)
 
 text\<open>The converse must hold too.\<close>
 lemma Finite_Union: "\<lbrakk>\<forall>y\<in>X. Finite(y);  Finite(X)\<rbrakk> \<Longrightarrow> Finite(\<Union>(X))"
 apply (simp add: Finite_Fin_iff)
 apply (rule Fin_UnionI)
 apply (erule Fin_induct, simp)
 apply (blast intro: Fin.consI Fin_mono [THEN [2] rev_subsetD])
 done
 
 (* Induction principle for Finite(A), by Sidi Ehmety *)
 lemma Finite_induct [case_names 0 cons, induct set: Finite]:
 "\<lbrakk>Finite(A); P(0);
     \<And>x B.   \<lbrakk>Finite(B); x \<notin> B; P(B)\<rbrakk> \<Longrightarrow> P(cons(x, B))\<rbrakk>
  \<Longrightarrow> P(A)"
 apply (erule Finite_into_Fin [THEN Fin_induct])
 apply (blast intro: Fin_into_Finite)+
 done
 
 (*Sidi Ehmety.  The contrapositive says \<not>Finite(A) \<Longrightarrow> \<not>Finite(A-{a}) *)
 lemma Diff_sing_Finite: "Finite(A - {a}) \<Longrightarrow> Finite(A)"
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (case_tac "a \<in> A")
 apply (subgoal_tac [2] "A-{a}=A", auto)
 apply (rule_tac x = "succ (n) " in bexI)
 apply (subgoal_tac "cons (a, A - {a}) = A \<and> cons (n, n) = succ (n) ")
 apply (drule_tac a = a and b = n in cons_eqpoll_cong)
 apply (auto dest: mem_irrefl)
 done
 
 (*Sidi Ehmety.  And the contrapositive of this says
    \<lbrakk>\<not>Finite(A); Finite(B)\<rbrakk> \<Longrightarrow> \<not>Finite(A-B) *)
 lemma Diff_Finite [rule_format]: "Finite(B) \<Longrightarrow> Finite(A-B) \<longrightarrow> Finite(A)"
 apply (erule Finite_induct, auto)
 apply (case_tac "x \<in> A")
  apply (subgoal_tac [2] "A-cons (x, B) = A - B")
 apply (subgoal_tac "A - cons (x, B) = (A - B) - {x}", simp)
 apply (drule Diff_sing_Finite, auto)
 done
 
 lemma Finite_RepFun: "Finite(A) \<Longrightarrow> Finite(RepFun(A,f))"
 by (erule Finite_induct, simp_all)
 
 lemma Finite_RepFun_iff_lemma [rule_format]:
      "\<lbrakk>Finite(x); \<And>x y. f(x)=f(y) \<Longrightarrow> x=y\<rbrakk>
       \<Longrightarrow> \<forall>A. x = RepFun(A,f) \<longrightarrow> Finite(A)"
 apply (erule Finite_induct)
  apply clarify
  apply (case_tac "A=0", simp)
  apply (blast del: allE, clarify)
 apply (subgoal_tac "\<exists>z\<in>A. x = f(z)")
  prefer 2 apply (blast del: allE elim: equalityE, clarify)
 apply (subgoal_tac "B = {f(u) . u \<in> A - {z}}")
  apply (blast intro: Diff_sing_Finite)
 apply (thin_tac "\<forall>A. P(A) \<longrightarrow> Finite(A)" for P)
 apply (rule equalityI)
  apply (blast intro: elim: equalityE)
 apply (blast intro: elim: equalityCE)
 done
 
 text\<open>I don't know why, but if the premise is expressed using meta-connectives
 then  the simplifier cannot prove it automatically in conditional rewriting.\<close>
 lemma Finite_RepFun_iff:
      "(\<forall>x y. f(x)=f(y) \<longrightarrow> x=y) \<Longrightarrow> Finite(RepFun(A,f)) \<longleftrightarrow> Finite(A)"
 by (blast intro: Finite_RepFun Finite_RepFun_iff_lemma [of _ f])
 
 lemma Finite_Pow: "Finite(A) \<Longrightarrow> Finite(Pow(A))"
 apply (erule Finite_induct)
 apply (simp_all add: Pow_insert Finite_Un Finite_RepFun)
 done
 
 lemma Finite_Pow_imp_Finite: "Finite(Pow(A)) \<Longrightarrow> Finite(A)"
 apply (subgoal_tac "Finite({{x} . x \<in> A})")
  apply (simp add: Finite_RepFun_iff )
 apply (blast intro: subset_Finite)
 done
 
 lemma Finite_Pow_iff [iff]: "Finite(Pow(A)) \<longleftrightarrow> Finite(A)"
 by (blast intro: Finite_Pow Finite_Pow_imp_Finite)
 
 lemma Finite_cardinal_iff:
   assumes i: "Ord(i)" shows "Finite(|i|) \<longleftrightarrow> Finite(i)"
   by (auto simp add: Finite_def) (blast intro: eqpoll_trans eqpoll_sym Ord_cardinal_eqpoll [OF i])+
 
 
 (*Krzysztof Grabczewski's proof that the converse of a finite, well-ordered
   set is well-ordered.  Proofs simplified by lcp. *)
 
 lemma nat_wf_on_converse_Memrel: "n \<in> nat \<Longrightarrow> wf[n](converse(Memrel(n)))"
 proof (induct n rule: nat_induct)
   case 0 thus ?case by (blast intro: wf_onI)
 next
   case (succ x)
   hence wfx: "\<And>Z. Z = 0 \<or> (\<exists>z\<in>Z. \<forall>y. z \<in> y \<and> z \<in> x \<and> y \<in> x \<and> z \<in> x \<longrightarrow> y \<notin> Z)"
     by (simp add: wf_on_def wf_def)  \<comment> \<open>not easy to erase the duplicate \<^term>\<open>z \<in> x\<close>!\<close>
   show ?case
     proof (rule wf_onI)
       fix Z u
       assume Z: "u \<in> Z" "\<forall>z\<in>Z. \<exists>y\<in>Z. \<langle>y, z\<rangle> \<in> converse(Memrel(succ(x)))"
       show False 
         proof (cases "x \<in> Z")
           case True thus False using Z
             by (blast elim: mem_irrefl mem_asym)
           next
           case False thus False using wfx [of Z] Z
             by blast
         qed
     qed
 qed
 
 lemma nat_well_ord_converse_Memrel: "n \<in> nat \<Longrightarrow> well_ord(n,converse(Memrel(n)))"
 apply (frule Ord_nat [THEN Ord_in_Ord, THEN well_ord_Memrel])
 apply (simp add: well_ord_def tot_ord_converse nat_wf_on_converse_Memrel) 
 done
 
 lemma well_ord_converse:
      "\<lbrakk>well_ord(A,r);
         well_ord(ordertype(A,r), converse(Memrel(ordertype(A, r))))\<rbrakk>
       \<Longrightarrow> well_ord(A,converse(r))"
 apply (rule well_ord_Int_iff [THEN iffD1])
 apply (frule ordermap_bij [THEN bij_is_inj, THEN well_ord_rvimage], assumption)
 apply (simp add: rvimage_converse converse_Int converse_prod
                  ordertype_ord_iso [THEN ord_iso_rvimage_eq])
 done
 
 lemma ordertype_eq_n:
   assumes r: "well_ord(A,r)" and A: "A \<approx> n" and n: "n \<in> nat"
   shows "ordertype(A,r) = n"
 proof -
   have "ordertype(A,r) \<approx> A"
     by (blast intro: bij_imp_eqpoll bij_converse_bij ordermap_bij r)
   also have "... \<approx> n" by (rule A)
   finally have "ordertype(A,r) \<approx> n" .
   thus ?thesis
     by (simp add: Ord_nat_eqpoll_iff Ord_ordertype n r)
 qed
 
 lemma Finite_well_ord_converse:
     "\<lbrakk>Finite(A);  well_ord(A,r)\<rbrakk> \<Longrightarrow> well_ord(A,converse(r))"
-apply (unfold Finite_def)
+  unfolding Finite_def
 apply (rule well_ord_converse, assumption)
 apply (blast dest: ordertype_eq_n intro!: nat_well_ord_converse_Memrel)
 done
 
 lemma nat_into_Finite: "n \<in> nat \<Longrightarrow> Finite(n)"
   by (auto simp add: Finite_def intro: eqpoll_refl) 
 
 lemma nat_not_Finite: "\<not> Finite(nat)"
 proof -
   { fix n
     assume n: "n \<in> nat" "nat \<approx> n"
     have "n \<in> nat"    by (rule n)
     also have "... = n" using n
       by (simp add: Ord_nat_eqpoll_iff Ord_nat)
     finally have "n \<in> n" .
     hence False
       by (blast elim: mem_irrefl)
   }
   thus ?thesis
     by (auto simp add: Finite_def)
 qed
 
 end
diff --git a/src/ZF/CardinalArith.thy b/src/ZF/CardinalArith.thy
--- a/src/ZF/CardinalArith.thy
+++ b/src/ZF/CardinalArith.thy
@@ -1,940 +1,940 @@
 (*  Title:      ZF/CardinalArith.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section\<open>Cardinal Arithmetic Without the Axiom of Choice\<close>
 
 theory CardinalArith imports Cardinal OrderArith ArithSimp Finite begin
 
 definition
   InfCard       :: "i\<Rightarrow>o"  where
     "InfCard(i) \<equiv> Card(i) \<and> nat \<le> i"
 
 definition
   cmult         :: "[i,i]\<Rightarrow>i"       (infixl \<open>\<otimes>\<close> 70)  where
     "i \<otimes> j \<equiv> |i*j|"
 
 definition
   cadd          :: "[i,i]\<Rightarrow>i"       (infixl \<open>\<oplus>\<close> 65)  where
     "i \<oplus> j \<equiv> |i+j|"
 
 definition
   csquare_rel   :: "i\<Rightarrow>i"  where
     "csquare_rel(K) \<equiv>
           rvimage(K*K,
                   lam \<langle>x,y\<rangle>:K*K. <x \<union> y, x, y>,
                   rmult(K,Memrel(K), K*K, rmult(K,Memrel(K), K,Memrel(K))))"
 
 definition
   jump_cardinal :: "i\<Rightarrow>i"  where
     \<comment> \<open>This definition is more complex than Kunen's but it more easily proved to
         be a cardinal\<close>
     "jump_cardinal(K) \<equiv>
          \<Union>X\<in>Pow(K). {z. r \<in> Pow(K*K), well_ord(X,r) \<and> z = ordertype(X,r)}"
 
 definition
   csucc         :: "i\<Rightarrow>i"  where
     \<comment> \<open>needed because \<^term>\<open>jump_cardinal(K)\<close> might not be the successor
         of \<^term>\<open>K\<close>\<close>
     "csucc(K) \<equiv> \<mu> L. Card(L) \<and> K<L"
 
 
 lemma Card_Union [simp,intro,TC]:
   assumes A: "\<And>x. x\<in>A \<Longrightarrow> Card(x)" shows "Card(\<Union>(A))"
 proof (rule CardI)
   show "Ord(\<Union>A)" using A
     by (simp add: Card_is_Ord)
 next
   fix j
   assume j: "j < \<Union>A"
   hence "\<exists>c\<in>A. j < c \<and> Card(c)" using A
     by (auto simp add: lt_def intro: Card_is_Ord)
   then obtain c where c: "c\<in>A" "j < c" "Card(c)"
     by blast
   hence jls: "j \<prec> c"
     by (simp add: lt_Card_imp_lesspoll)
   { assume eqp: "j \<approx> \<Union>A"
     have  "c \<lesssim> \<Union>A" using c
       by (blast intro: subset_imp_lepoll)
     also have "... \<approx> j"  by (rule eqpoll_sym [OF eqp])
     also have "... \<prec> c"  by (rule jls)
     finally have "c \<prec> c" .
     hence False
       by auto
   } thus "\<not> j \<approx> \<Union>A" by blast
 qed
 
 lemma Card_UN: "(\<And>x. x \<in> A \<Longrightarrow> Card(K(x))) \<Longrightarrow> Card(\<Union>x\<in>A. K(x))"
   by blast
 
 lemma Card_OUN [simp,intro,TC]:
      "(\<And>x. x \<in> A \<Longrightarrow> Card(K(x))) \<Longrightarrow> Card(\<Union>x<A. K(x))"
   by (auto simp add: OUnion_def Card_0)
 
 lemma in_Card_imp_lesspoll: "\<lbrakk>Card(K); b \<in> K\<rbrakk> \<Longrightarrow> b \<prec> K"
-apply (unfold lesspoll_def)
+  unfolding lesspoll_def
 apply (simp add: Card_iff_initial)
 apply (fast intro!: le_imp_lepoll ltI leI)
 done
 
 
 subsection\<open>Cardinal addition\<close>
 
 text\<open>Note: Could omit proving the algebraic laws for cardinal addition and
 multiplication.  On finite cardinals these operations coincide with
 addition and multiplication of natural numbers; on infinite cardinals they
 coincide with union (maximum).  Either way we get most laws for free.\<close>
 
 subsubsection\<open>Cardinal addition is commutative\<close>
 
 lemma sum_commute_eqpoll: "A+B \<approx> B+A"
 proof (unfold eqpoll_def, rule exI)
   show "(\<lambda>z\<in>A+B. case(Inr,Inl,z)) \<in> bij(A+B, B+A)"
     by (auto intro: lam_bijective [where d = "case(Inr,Inl)"])
 qed
 
 lemma cadd_commute: "i \<oplus> j = j \<oplus> i"
-apply (unfold cadd_def)
+  unfolding cadd_def
 apply (rule sum_commute_eqpoll [THEN cardinal_cong])
 done
 
 subsubsection\<open>Cardinal addition is associative\<close>
 
 lemma sum_assoc_eqpoll: "(A+B)+C \<approx> A+(B+C)"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule sum_assoc_bij)
 done
 
 text\<open>Unconditional version requires AC\<close>
 lemma well_ord_cadd_assoc:
   assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
   shows "(i \<oplus> j) \<oplus> k = i \<oplus> (j \<oplus> k)"
 proof (unfold cadd_def, rule cardinal_cong)
   have "|i + j| + k \<approx> (i + j) + k"
     by (blast intro: sum_eqpoll_cong well_ord_cardinal_eqpoll eqpoll_refl well_ord_radd i j)
   also have "...  \<approx> i + (j + k)"
     by (rule sum_assoc_eqpoll)
   also have "...  \<approx> i + |j + k|"
     by (blast intro: sum_eqpoll_cong well_ord_cardinal_eqpoll eqpoll_refl well_ord_radd j k eqpoll_sym)
   finally show "|i + j| + k \<approx> i + |j + k|" .
 qed
 
 
 subsubsection\<open>0 is the identity for addition\<close>
 
 lemma sum_0_eqpoll: "0+A \<approx> A"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule bij_0_sum)
 done
 
 lemma cadd_0 [simp]: "Card(K) \<Longrightarrow> 0 \<oplus> K = K"
-apply (unfold cadd_def)
+  unfolding cadd_def
 apply (simp add: sum_0_eqpoll [THEN cardinal_cong] Card_cardinal_eq)
 done
 
 subsubsection\<open>Addition by another cardinal\<close>
 
 lemma sum_lepoll_self: "A \<lesssim> A+B"
 proof (unfold lepoll_def, rule exI)
   show "(\<lambda>x\<in>A. Inl (x)) \<in> inj(A, A + B)"
     by (simp add: inj_def)
 qed
 
 (*Could probably weaken the premises to well_ord(K,r), or removing using AC*)
 
 lemma cadd_le_self:
   assumes K: "Card(K)" and L: "Ord(L)" shows "K \<le> (K \<oplus> L)"
 proof (unfold cadd_def)
   have "K \<le> |K|"
     by (rule Card_cardinal_le [OF K])
   moreover have "|K| \<le> |K + L|" using K L
     by (blast intro: well_ord_lepoll_imp_cardinal_le sum_lepoll_self
                      well_ord_radd well_ord_Memrel Card_is_Ord)
   ultimately show "K \<le> |K + L|"
     by (blast intro: le_trans)
 qed
 
 subsubsection\<open>Monotonicity of addition\<close>
 
 lemma sum_lepoll_mono:
      "\<lbrakk>A \<lesssim> C;  B \<lesssim> D\<rbrakk> \<Longrightarrow> A + B \<lesssim> C + D"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (elim exE)
 apply (rule_tac x = "\<lambda>z\<in>A+B. case (\<lambda>w. Inl(f`w), \<lambda>y. Inr(fa`y), z)" in exI)
 apply (rule_tac d = "case (\<lambda>w. Inl(converse(f) `w), \<lambda>y. Inr(converse(fa) ` y))"
        in lam_injective)
 apply (typecheck add: inj_is_fun, auto)
 done
 
 lemma cadd_le_mono:
     "\<lbrakk>K' \<le> K;  L' \<le> L\<rbrakk> \<Longrightarrow> (K' \<oplus> L') \<le> (K \<oplus> L)"
-apply (unfold cadd_def)
+  unfolding cadd_def
 apply (safe dest!: le_subset_iff [THEN iffD1])
 apply (rule well_ord_lepoll_imp_cardinal_le)
 apply (blast intro: well_ord_radd well_ord_Memrel)
 apply (blast intro: sum_lepoll_mono subset_imp_lepoll)
 done
 
 subsubsection\<open>Addition of finite cardinals is "ordinary" addition\<close>
 
 lemma sum_succ_eqpoll: "succ(A)+B \<approx> succ(A+B)"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule_tac c = "\<lambda>z. if z=Inl (A) then A+B else z"
             and d = "\<lambda>z. if z=A+B then Inl (A) else z" in lam_bijective)
    apply simp_all
 apply (blast dest: sym [THEN eq_imp_not_mem] elim: mem_irrefl)+
 done
 
 (*Pulling the  succ(...)  outside the |...| requires m, n \<in> nat  *)
 (*Unconditional version requires AC*)
 lemma cadd_succ_lemma:
   assumes "Ord(m)" "Ord(n)" shows "succ(m) \<oplus> n = |succ(m \<oplus> n)|"
 proof (unfold cadd_def)
   have [intro]: "m + n \<approx> |m + n|" using assms
     by (blast intro: eqpoll_sym well_ord_cardinal_eqpoll well_ord_radd well_ord_Memrel)
 
   have "|succ(m) + n| = |succ(m + n)|"
     by (rule sum_succ_eqpoll [THEN cardinal_cong])
   also have "... = |succ(|m + n|)|"
     by (blast intro: succ_eqpoll_cong cardinal_cong)
   finally show "|succ(m) + n| = |succ(|m + n|)|" .
 qed
 
 lemma nat_cadd_eq_add:
   assumes m: "m \<in> nat" and [simp]: "n \<in> nat" shows"m \<oplus> n = m #+ n"
 using m
 proof (induct m)
   case 0 thus ?case by (simp add: nat_into_Card cadd_0)
 next
   case (succ m) thus ?case by (simp add: cadd_succ_lemma nat_into_Card Card_cardinal_eq)
 qed
 
 
 subsection\<open>Cardinal multiplication\<close>
 
 subsubsection\<open>Cardinal multiplication is commutative\<close>
 
 lemma prod_commute_eqpoll: "A*B \<approx> B*A"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule_tac c = "\<lambda>\<langle>x,y\<rangle>.\<langle>y,x\<rangle>" and d = "\<lambda>\<langle>x,y\<rangle>.\<langle>y,x\<rangle>" in lam_bijective,
        auto)
 done
 
 lemma cmult_commute: "i \<otimes> j = j \<otimes> i"
-apply (unfold cmult_def)
+  unfolding cmult_def
 apply (rule prod_commute_eqpoll [THEN cardinal_cong])
 done
 
 subsubsection\<open>Cardinal multiplication is associative\<close>
 
 lemma prod_assoc_eqpoll: "(A*B)*C \<approx> A*(B*C)"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule prod_assoc_bij)
 done
 
 text\<open>Unconditional version requires AC\<close>
 lemma well_ord_cmult_assoc:
   assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
   shows "(i \<otimes> j) \<otimes> k = i \<otimes> (j \<otimes> k)"
 proof (unfold cmult_def, rule cardinal_cong)
   have "|i * j| * k \<approx> (i * j) * k"
     by (blast intro: prod_eqpoll_cong well_ord_cardinal_eqpoll eqpoll_refl well_ord_rmult i j)
   also have "...  \<approx> i * (j * k)"
     by (rule prod_assoc_eqpoll)
   also have "...  \<approx> i * |j * k|"
     by (blast intro: prod_eqpoll_cong well_ord_cardinal_eqpoll eqpoll_refl well_ord_rmult j k eqpoll_sym)
   finally show "|i * j| * k \<approx> i * |j * k|" .
 qed
 
 subsubsection\<open>Cardinal multiplication distributes over addition\<close>
 
 lemma sum_prod_distrib_eqpoll: "(A+B)*C \<approx> (A*C)+(B*C)"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule sum_prod_distrib_bij)
 done
 
 lemma well_ord_cadd_cmult_distrib:
   assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
   shows "(i \<oplus> j) \<otimes> k = (i \<otimes> k) \<oplus> (j \<otimes> k)"
 proof (unfold cadd_def cmult_def, rule cardinal_cong)
   have "|i + j| * k \<approx> (i + j) * k"
     by (blast intro: prod_eqpoll_cong well_ord_cardinal_eqpoll eqpoll_refl well_ord_radd i j)
   also have "...  \<approx> i * k + j * k"
     by (rule sum_prod_distrib_eqpoll)
   also have "...  \<approx> |i * k| + |j * k|"
     by (blast intro: sum_eqpoll_cong well_ord_cardinal_eqpoll well_ord_rmult i j k eqpoll_sym)
   finally show "|i + j| * k \<approx> |i * k| + |j * k|" .
 qed
 
 subsubsection\<open>Multiplication by 0 yields 0\<close>
 
 lemma prod_0_eqpoll: "0*A \<approx> 0"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule lam_bijective, safe)
 done
 
 lemma cmult_0 [simp]: "0 \<otimes> i = 0"
 by (simp add: cmult_def prod_0_eqpoll [THEN cardinal_cong])
 
 subsubsection\<open>1 is the identity for multiplication\<close>
 
 lemma prod_singleton_eqpoll: "{x}*A \<approx> A"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule singleton_prod_bij [THEN bij_converse_bij])
 done
 
 lemma cmult_1 [simp]: "Card(K) \<Longrightarrow> 1 \<otimes> K = K"
 apply (unfold cmult_def succ_def)
 apply (simp add: prod_singleton_eqpoll [THEN cardinal_cong] Card_cardinal_eq)
 done
 
 subsection\<open>Some inequalities for multiplication\<close>
 
 lemma prod_square_lepoll: "A \<lesssim> A*A"
 apply (unfold lepoll_def inj_def)
 apply (rule_tac x = "\<lambda>x\<in>A. \<langle>x,x\<rangle>" in exI, simp)
 done
 
 (*Could probably weaken the premise to well_ord(K,r), or remove using AC*)
 lemma cmult_square_le: "Card(K) \<Longrightarrow> K \<le> K \<otimes> K"
-apply (unfold cmult_def)
+  unfolding cmult_def
 apply (rule le_trans)
 apply (rule_tac [2] well_ord_lepoll_imp_cardinal_le)
 apply (rule_tac [3] prod_square_lepoll)
 apply (simp add: le_refl Card_is_Ord Card_cardinal_eq)
 apply (blast intro: well_ord_rmult well_ord_Memrel Card_is_Ord)
 done
 
 subsubsection\<open>Multiplication by a non-zero cardinal\<close>
 
 lemma prod_lepoll_self: "b \<in> B \<Longrightarrow> A \<lesssim> A*B"
 apply (unfold lepoll_def inj_def)
 apply (rule_tac x = "\<lambda>x\<in>A. \<langle>x,b\<rangle>" in exI, simp)
 done
 
 (*Could probably weaken the premises to well_ord(K,r), or removing using AC*)
 lemma cmult_le_self:
     "\<lbrakk>Card(K);  Ord(L);  0<L\<rbrakk> \<Longrightarrow> K \<le> (K \<otimes> L)"
-apply (unfold cmult_def)
+  unfolding cmult_def
 apply (rule le_trans [OF Card_cardinal_le well_ord_lepoll_imp_cardinal_le])
   apply assumption
  apply (blast intro: well_ord_rmult well_ord_Memrel Card_is_Ord)
 apply (blast intro: prod_lepoll_self ltD)
 done
 
 subsubsection\<open>Monotonicity of multiplication\<close>
 
 lemma prod_lepoll_mono:
      "\<lbrakk>A \<lesssim> C;  B \<lesssim> D\<rbrakk> \<Longrightarrow> A * B  \<lesssim>  C * D"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (elim exE)
 apply (rule_tac x = "lam \<langle>w,y\<rangle>:A*B. <f`w, fa`y>" in exI)
 apply (rule_tac d = "\<lambda>\<langle>w,y\<rangle>. <converse (f) `w, converse (fa) `y>"
        in lam_injective)
 apply (typecheck add: inj_is_fun, auto)
 done
 
 lemma cmult_le_mono:
     "\<lbrakk>K' \<le> K;  L' \<le> L\<rbrakk> \<Longrightarrow> (K' \<otimes> L') \<le> (K \<otimes> L)"
-apply (unfold cmult_def)
+  unfolding cmult_def
 apply (safe dest!: le_subset_iff [THEN iffD1])
 apply (rule well_ord_lepoll_imp_cardinal_le)
  apply (blast intro: well_ord_rmult well_ord_Memrel)
 apply (blast intro: prod_lepoll_mono subset_imp_lepoll)
 done
 
 subsection\<open>Multiplication of finite cardinals is "ordinary" multiplication\<close>
 
 lemma prod_succ_eqpoll: "succ(A)*B \<approx> B + A*B"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (rule_tac c = "\<lambda>\<langle>x,y\<rangle>. if x=A then Inl (y) else Inr (\<langle>x,y\<rangle>)"
             and d = "case (\<lambda>y. \<langle>A,y\<rangle>, \<lambda>z. z)" in lam_bijective)
 apply safe
 apply (simp_all add: succI2 if_type mem_imp_not_eq)
 done
 
 (*Unconditional version requires AC*)
 lemma cmult_succ_lemma:
     "\<lbrakk>Ord(m);  Ord(n)\<rbrakk> \<Longrightarrow> succ(m) \<otimes> n = n \<oplus> (m \<otimes> n)"
 apply (unfold cmult_def cadd_def)
 apply (rule prod_succ_eqpoll [THEN cardinal_cong, THEN trans])
 apply (rule cardinal_cong [symmetric])
 apply (rule sum_eqpoll_cong [OF eqpoll_refl well_ord_cardinal_eqpoll])
 apply (blast intro: well_ord_rmult well_ord_Memrel)
 done
 
 lemma nat_cmult_eq_mult: "\<lbrakk>m \<in> nat;  n \<in> nat\<rbrakk> \<Longrightarrow> m \<otimes> n = m#*n"
 apply (induct_tac m)
 apply (simp_all add: cmult_succ_lemma nat_cadd_eq_add)
 done
 
 lemma cmult_2: "Card(n) \<Longrightarrow> 2 \<otimes> n = n \<oplus> n"
 by (simp add: cmult_succ_lemma Card_is_Ord cadd_commute [of _ 0])
 
 lemma sum_lepoll_prod:
   assumes C: "2 \<lesssim> C" shows "B+B \<lesssim> C*B"
 proof -
   have "B+B \<lesssim> 2*B"
     by (simp add: sum_eq_2_times)
   also have "... \<lesssim> C*B"
     by (blast intro: prod_lepoll_mono lepoll_refl C)
   finally show "B+B \<lesssim> C*B" .
 qed
 
 lemma lepoll_imp_sum_lepoll_prod: "\<lbrakk>A \<lesssim> B; 2 \<lesssim> A\<rbrakk> \<Longrightarrow> A+B \<lesssim> A*B"
 by (blast intro: sum_lepoll_mono sum_lepoll_prod lepoll_trans lepoll_refl)
 
 
 subsection\<open>Infinite Cardinals are Limit Ordinals\<close>
 
 (*This proof is modelled upon one assuming nat<=A, with injection
   \<lambda>z\<in>cons(u,A). if z=u then 0 else if z \<in> nat then succ(z) else z
   and inverse \<lambda>y. if y \<in> nat then nat_case(u, \<lambda>z. z, y) else y.  \
   If f \<in> inj(nat,A) then range(f) behaves like the natural numbers.*)
 lemma nat_cons_lepoll: "nat \<lesssim> A \<Longrightarrow> cons(u,A) \<lesssim> A"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (erule exE)
 apply (rule_tac x =
           "\<lambda>z\<in>cons (u,A).
              if z=u then f`0
              else if z \<in> range (f) then f`succ (converse (f) `z) else z"
        in exI)
 apply (rule_tac d =
           "\<lambda>y. if y \<in> range(f) then nat_case (u, \<lambda>z. f`z, converse(f) `y)
                               else y"
        in lam_injective)
 apply (fast intro!: if_type apply_type intro: inj_is_fun inj_converse_fun)
 apply (simp add: inj_is_fun [THEN apply_rangeI]
                  inj_converse_fun [THEN apply_rangeI]
                  inj_converse_fun [THEN apply_funtype])
 done
 
 lemma nat_cons_eqpoll: "nat \<lesssim> A \<Longrightarrow> cons(u,A) \<approx> A"
 apply (erule nat_cons_lepoll [THEN eqpollI])
 apply (rule subset_consI [THEN subset_imp_lepoll])
 done
 
 (*Specialized version required below*)
 lemma nat_succ_eqpoll: "nat \<subseteq> A \<Longrightarrow> succ(A) \<approx> A"
-apply (unfold succ_def)
+  unfolding succ_def
 apply (erule subset_imp_lepoll [THEN nat_cons_eqpoll])
 done
 
 lemma InfCard_nat: "InfCard(nat)"
-apply (unfold InfCard_def)
+  unfolding InfCard_def
 apply (blast intro: Card_nat le_refl Card_is_Ord)
 done
 
 lemma InfCard_is_Card: "InfCard(K) \<Longrightarrow> Card(K)"
-apply (unfold InfCard_def)
+  unfolding InfCard_def
 apply (erule conjunct1)
 done
 
 lemma InfCard_Un:
     "\<lbrakk>InfCard(K);  Card(L)\<rbrakk> \<Longrightarrow> InfCard(K \<union> L)"
-apply (unfold InfCard_def)
+  unfolding InfCard_def
 apply (simp add: Card_Un Un_upper1_le [THEN [2] le_trans]  Card_is_Ord)
 done
 
 (*Kunen's Lemma 10.11*)
 lemma InfCard_is_Limit: "InfCard(K) \<Longrightarrow> Limit(K)"
-apply (unfold InfCard_def)
+  unfolding InfCard_def
 apply (erule conjE)
 apply (frule Card_is_Ord)
 apply (rule ltI [THEN non_succ_LimitI])
 apply (erule le_imp_subset [THEN subsetD])
 apply (safe dest!: Limit_nat [THEN Limit_le_succD])
-apply (unfold Card_def)
+  unfolding Card_def
 apply (drule trans)
 apply (erule le_imp_subset [THEN nat_succ_eqpoll, THEN cardinal_cong])
 apply (erule Ord_cardinal_le [THEN lt_trans2, THEN lt_irrefl])
 apply (rule le_eqI, assumption)
 apply (rule Ord_cardinal)
 done
 
 
 (*** An infinite cardinal equals its square (Kunen, Thm 10.12, page 29) ***)
 
 (*A general fact about ordermap*)
 lemma ordermap_eqpoll_pred:
     "\<lbrakk>well_ord(A,r);  x \<in> A\<rbrakk> \<Longrightarrow> ordermap(A,r)`x \<approx> Order.pred(A,x,r)"
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (rule exI)
 apply (simp add: ordermap_eq_image well_ord_is_wf)
 apply (erule ordermap_bij [THEN bij_is_inj, THEN restrict_bij,
                            THEN bij_converse_bij])
 apply (rule pred_subset)
 done
 
 subsubsection\<open>Establishing the well-ordering\<close>
 
 lemma well_ord_csquare:
   assumes K: "Ord(K)" shows "well_ord(K*K, csquare_rel(K))"
 proof (unfold csquare_rel_def, rule well_ord_rvimage)
   show "(\<lambda>\<langle>x,y\<rangle>\<in>K \<times> K. \<langle>x \<union> y, x, y\<rangle>) \<in> inj(K \<times> K, K \<times> K \<times> K)" using K
     by (force simp add: inj_def intro: lam_type Un_least_lt [THEN ltD] ltI)
 next
   show "well_ord(K \<times> K \<times> K, rmult(K, Memrel(K), K \<times> K, rmult(K, Memrel(K), K, Memrel(K))))"
     using K by (blast intro: well_ord_rmult well_ord_Memrel)
 qed
 
 subsubsection\<open>Characterising initial segments of the well-ordering\<close>
 
 lemma csquareD:
  "\<lbrakk><\<langle>x,y\<rangle>, \<langle>z,z\<rangle>> \<in> csquare_rel(K);  x<K;  y<K;  z<K\<rbrakk> \<Longrightarrow> x \<le> z \<and> y \<le> z"
-apply (unfold csquare_rel_def)
+  unfolding csquare_rel_def
 apply (erule rev_mp)
 apply (elim ltE)
 apply (simp add: rvimage_iff Un_absorb Un_least_mem_iff ltD)
 apply (safe elim!: mem_irrefl intro!: Un_upper1_le Un_upper2_le)
 apply (simp_all add: lt_def succI2)
 done
 
 lemma pred_csquare_subset:
     "z<K \<Longrightarrow> Order.pred(K*K, \<langle>z,z\<rangle>, csquare_rel(K)) \<subseteq> succ(z)*succ(z)"
 apply (unfold Order.pred_def)
 apply (safe del: SigmaI dest!: csquareD)
 apply (unfold lt_def, auto)
 done
 
 lemma csquare_ltI:
  "\<lbrakk>x<z;  y<z;  z<K\<rbrakk> \<Longrightarrow>  <\<langle>x,y\<rangle>, \<langle>z,z\<rangle>> \<in> csquare_rel(K)"
-apply (unfold csquare_rel_def)
+  unfolding csquare_rel_def
 apply (subgoal_tac "x<K \<and> y<K")
  prefer 2 apply (blast intro: lt_trans)
 apply (elim ltE)
 apply (simp add: rvimage_iff Un_absorb Un_least_mem_iff ltD)
 done
 
 (*Part of the traditional proof.  UNUSED since it's harder to prove \<and> apply *)
 lemma csquare_or_eqI:
  "\<lbrakk>x \<le> z;  y \<le> z;  z<K\<rbrakk> \<Longrightarrow> <\<langle>x,y\<rangle>, \<langle>z,z\<rangle>> \<in> csquare_rel(K) | x=z \<and> y=z"
-apply (unfold csquare_rel_def)
+  unfolding csquare_rel_def
 apply (subgoal_tac "x<K \<and> y<K")
  prefer 2 apply (blast intro: lt_trans1)
 apply (elim ltE)
 apply (simp add: rvimage_iff Un_absorb Un_least_mem_iff ltD)
 apply (elim succE)
 apply (simp_all add: subset_Un_iff [THEN iff_sym]
                      subset_Un_iff2 [THEN iff_sym] OrdmemD)
 done
 
 subsubsection\<open>The cardinality of initial segments\<close>
 
 lemma ordermap_z_lt:
       "\<lbrakk>Limit(K);  x<K;  y<K;  z=succ(x \<union> y)\<rbrakk> \<Longrightarrow>
           ordermap(K*K, csquare_rel(K)) ` \<langle>x,y\<rangle> <
           ordermap(K*K, csquare_rel(K)) ` \<langle>z,z\<rangle>"
 apply (subgoal_tac "z<K \<and> well_ord (K*K, csquare_rel (K))")
 prefer 2 apply (blast intro!: Un_least_lt Limit_has_succ
                               Limit_is_Ord [THEN well_ord_csquare], clarify)
 apply (rule csquare_ltI [THEN ordermap_mono, THEN ltI])
 apply (erule_tac [4] well_ord_is_wf)
 apply (blast intro!: Un_upper1_le Un_upper2_le Ord_ordermap elim!: ltE)+
 done
 
 text\<open>Kunen: "each \<^term>\<open>\<langle>x,y\<rangle> \<in> K \<times> K\<close> has no more than \<^term>\<open>z \<times> z\<close> predecessors..." (page 29)\<close>
 lemma ordermap_csquare_le:
   assumes K: "Limit(K)" and x: "x<K" and y: " y<K"
   defines "z \<equiv> succ(x \<union> y)"
   shows "|ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle>| \<le> |succ(z)| \<otimes> |succ(z)|"
 proof (unfold cmult_def, rule well_ord_lepoll_imp_cardinal_le)
   show "well_ord(|succ(z)| \<times> |succ(z)|,
                  rmult(|succ(z)|, Memrel(|succ(z)|), |succ(z)|, Memrel(|succ(z)|)))"
     by (blast intro: Ord_cardinal well_ord_Memrel well_ord_rmult)
 next
   have zK: "z<K" using x y K z_def
     by (blast intro: Un_least_lt Limit_has_succ)
   hence oz: "Ord(z)" by (elim ltE)
   have "ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle> \<lesssim> ordermap(K \<times> K, csquare_rel(K)) ` \<langle>z,z\<rangle>"
     using z_def
     by (blast intro: ordermap_z_lt leI le_imp_lepoll K x y)
   also have "... \<approx>  Order.pred(K \<times> K, \<langle>z,z\<rangle>, csquare_rel(K))"
     proof (rule ordermap_eqpoll_pred)
       show "well_ord(K \<times> K, csquare_rel(K))" using K
         by (rule Limit_is_Ord [THEN well_ord_csquare])
     next
       show "\<langle>z, z\<rangle> \<in> K \<times> K" using zK
         by (blast intro: ltD)
     qed
   also have "...  \<lesssim> succ(z) \<times> succ(z)" using zK
     by (rule pred_csquare_subset [THEN subset_imp_lepoll])
   also have "... \<approx> |succ(z)| \<times> |succ(z)|" using oz
     by (blast intro: prod_eqpoll_cong Ord_succ Ord_cardinal_eqpoll eqpoll_sym)
   finally show "ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle> \<lesssim> |succ(z)| \<times> |succ(z)|" .
 qed
 
 text\<open>Kunen: "... so the order type is \<open>\<le>\<close> K"\<close>
 lemma ordertype_csquare_le:
   assumes IK: "InfCard(K)" and eq: "\<And>y. y\<in>K \<Longrightarrow> InfCard(y) \<Longrightarrow> y \<otimes> y = y"
   shows "ordertype(K*K, csquare_rel(K)) \<le> K"
 proof -
   have  CK: "Card(K)" using IK by (rule InfCard_is_Card)
   hence OK: "Ord(K)"  by (rule Card_is_Ord)
   moreover have "Ord(ordertype(K \<times> K, csquare_rel(K)))" using OK
     by (rule well_ord_csquare [THEN Ord_ordertype])
   ultimately show ?thesis
   proof (rule all_lt_imp_le)
     fix i
     assume i: "i < ordertype(K \<times> K, csquare_rel(K))"
     hence Oi: "Ord(i)" by (elim ltE)
     obtain x y where x: "x \<in> K" and y: "y \<in> K"
                  and ieq: "i = ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle>"
       using i by (auto simp add: ordertype_unfold elim: ltE)
     hence xy: "Ord(x)" "Ord(y)" "x < K" "y < K" using OK
       by (blast intro: Ord_in_Ord ltI)+
     hence ou: "Ord(x \<union> y)"
       by (simp add: Ord_Un)
     show "i < K"
       proof (rule Card_lt_imp_lt [OF _ Oi CK])
         have "|i| \<le> |succ(succ(x \<union> y))| \<otimes> |succ(succ(x \<union> y))|" using IK xy
           by (auto simp add: ieq intro: InfCard_is_Limit [THEN ordermap_csquare_le])
         moreover have "|succ(succ(x \<union> y))| \<otimes> |succ(succ(x \<union> y))| < K"
           proof (cases rule: Ord_linear2 [OF ou Ord_nat])
             assume "x \<union> y < nat"
             hence "|succ(succ(x \<union> y))| \<otimes> |succ(succ(x \<union> y))| \<in> nat"
               by (simp add: lt_def nat_cmult_eq_mult nat_succI mult_type
                          nat_into_Card [THEN Card_cardinal_eq]  Ord_nat)
             also have "... \<subseteq> K" using IK
               by (simp add: InfCard_def le_imp_subset)
             finally show "|succ(succ(x \<union> y))| \<otimes> |succ(succ(x \<union> y))| < K"
               by (simp add: ltI OK)
           next
             assume natxy: "nat \<le> x \<union> y"
             hence seq: "|succ(succ(x \<union> y))| = |x \<union> y|" using xy
               by (simp add: le_imp_subset nat_succ_eqpoll [THEN cardinal_cong] le_succ_iff)
             also have "... < K" using xy
               by (simp add: Un_least_lt Ord_cardinal_le [THEN lt_trans1])
             finally have "|succ(succ(x \<union> y))| < K" .
             moreover have "InfCard(|succ(succ(x \<union> y))|)" using xy natxy
               by (simp add: seq InfCard_def Card_cardinal nat_le_cardinal)
             ultimately show ?thesis  by (simp add: eq ltD)
           qed
         ultimately show "|i| < K" by (blast intro: lt_trans1)
     qed
   qed
 qed
 
 (*Main result: Kunen's Theorem 10.12*)
 lemma InfCard_csquare_eq:
   assumes IK: "InfCard(K)" shows "K \<otimes> K = K"
 proof -
   have  OK: "Ord(K)" using IK by (simp add: Card_is_Ord InfCard_is_Card)
   show "K \<otimes> K = K" using OK IK
   proof (induct rule: trans_induct)
     case (step i)
     show "i \<otimes> i = i"
     proof (rule le_anti_sym)
       have "|i \<times> i| = |ordertype(i \<times> i, csquare_rel(i))|"
         by (rule cardinal_cong,
           simp add: step.hyps well_ord_csquare [THEN ordermap_bij, THEN bij_imp_eqpoll])
       hence "i \<otimes> i \<le> ordertype(i \<times> i, csquare_rel(i))"
         by (simp add: step.hyps cmult_def Ord_cardinal_le well_ord_csquare [THEN Ord_ordertype])
       moreover
       have "ordertype(i \<times> i, csquare_rel(i)) \<le> i" using step
         by (simp add: ordertype_csquare_le)
       ultimately show "i \<otimes> i \<le> i" by (rule le_trans)
     next
       show "i \<le> i \<otimes> i" using step
         by (blast intro: cmult_square_le InfCard_is_Card)
     qed
   qed
 qed
 
 (*Corollary for arbitrary well-ordered sets (all sets, assuming AC)*)
 lemma well_ord_InfCard_square_eq:
   assumes r: "well_ord(A,r)" and I: "InfCard(|A|)" shows "A \<times> A \<approx> A"
 proof -
   have "A \<times> A \<approx> |A| \<times> |A|"
     by (blast intro: prod_eqpoll_cong well_ord_cardinal_eqpoll eqpoll_sym r)
   also have "... \<approx> A"
     proof (rule well_ord_cardinal_eqE [OF _ r])
       show "well_ord(|A| \<times> |A|, rmult(|A|, Memrel(|A|), |A|, Memrel(|A|)))"
         by (blast intro: Ord_cardinal well_ord_rmult well_ord_Memrel r)
     next
       show "||A| \<times> |A|| = |A|" using InfCard_csquare_eq I
         by (simp add: cmult_def)
     qed
   finally show ?thesis .
 qed
 
 lemma InfCard_square_eqpoll: "InfCard(K) \<Longrightarrow> K \<times> K \<approx> K"
 apply (rule well_ord_InfCard_square_eq)
  apply (erule InfCard_is_Card [THEN Card_is_Ord, THEN well_ord_Memrel])
 apply (simp add: InfCard_is_Card [THEN Card_cardinal_eq])
 done
 
 lemma Inf_Card_is_InfCard: "\<lbrakk>Card(i); \<not> Finite(i)\<rbrakk> \<Longrightarrow> InfCard(i)"
 by (simp add: InfCard_def Card_is_Ord [THEN nat_le_infinite_Ord])
 
 subsubsection\<open>Toward's Kunen's Corollary 10.13 (1)\<close>
 
 lemma InfCard_le_cmult_eq: "\<lbrakk>InfCard(K);  L \<le> K;  0<L\<rbrakk> \<Longrightarrow> K \<otimes> L = K"
 apply (rule le_anti_sym)
  prefer 2
  apply (erule ltE, blast intro: cmult_le_self InfCard_is_Card)
 apply (frule InfCard_is_Card [THEN Card_is_Ord, THEN le_refl])
 apply (rule cmult_le_mono [THEN le_trans], assumption+)
 apply (simp add: InfCard_csquare_eq)
 done
 
 (*Corollary 10.13 (1), for cardinal multiplication*)
 lemma InfCard_cmult_eq: "\<lbrakk>InfCard(K);  InfCard(L)\<rbrakk> \<Longrightarrow> K \<otimes> L = K \<union> L"
 apply (rule_tac i = K and j = L in Ord_linear_le)
 apply (typecheck add: InfCard_is_Card Card_is_Ord)
 apply (rule cmult_commute [THEN ssubst])
 apply (rule Un_commute [THEN ssubst])
 apply (simp_all add: InfCard_is_Limit [THEN Limit_has_0] InfCard_le_cmult_eq
                      subset_Un_iff2 [THEN iffD1] le_imp_subset)
 done
 
 lemma InfCard_cdouble_eq: "InfCard(K) \<Longrightarrow> K \<oplus> K = K"
 apply (simp add: cmult_2 [symmetric] InfCard_is_Card cmult_commute)
 apply (simp add: InfCard_le_cmult_eq InfCard_is_Limit Limit_has_0 Limit_has_succ)
 done
 
 (*Corollary 10.13 (1), for cardinal addition*)
 lemma InfCard_le_cadd_eq: "\<lbrakk>InfCard(K);  L \<le> K\<rbrakk> \<Longrightarrow> K \<oplus> L = K"
 apply (rule le_anti_sym)
  prefer 2
  apply (erule ltE, blast intro: cadd_le_self InfCard_is_Card)
 apply (frule InfCard_is_Card [THEN Card_is_Ord, THEN le_refl])
 apply (rule cadd_le_mono [THEN le_trans], assumption+)
 apply (simp add: InfCard_cdouble_eq)
 done
 
 lemma InfCard_cadd_eq: "\<lbrakk>InfCard(K);  InfCard(L)\<rbrakk> \<Longrightarrow> K \<oplus> L = K \<union> L"
 apply (rule_tac i = K and j = L in Ord_linear_le)
 apply (typecheck add: InfCard_is_Card Card_is_Ord)
 apply (rule cadd_commute [THEN ssubst])
 apply (rule Un_commute [THEN ssubst])
 apply (simp_all add: InfCard_le_cadd_eq subset_Un_iff2 [THEN iffD1] le_imp_subset)
 done
 
 (*The other part, Corollary 10.13 (2), refers to the cardinality of the set
   of all n-tuples of elements of K.  A better version for the Isabelle theory
   might be  InfCard(K) \<Longrightarrow> |list(K)| = K.
 *)
 
 subsection\<open>For Every Cardinal Number There Exists A Greater One\<close>
 
 text\<open>This result is Kunen's Theorem 10.16, which would be trivial using AC\<close>
 
 lemma Ord_jump_cardinal: "Ord(jump_cardinal(K))"
-apply (unfold jump_cardinal_def)
+  unfolding jump_cardinal_def
 apply (rule Ord_is_Transset [THEN [2] OrdI])
  prefer 2 apply (blast intro!: Ord_ordertype)
-apply (unfold Transset_def)
+  unfolding Transset_def
 apply (safe del: subsetI)
 apply (simp add: ordertype_pred_unfold, safe)
 apply (rule UN_I)
 apply (rule_tac [2] ReplaceI)
    prefer 4 apply (blast intro: well_ord_subset elim!: predE)+
 done
 
 (*Allows selective unfolding.  Less work than deriving intro/elim rules*)
 lemma jump_cardinal_iff:
      "i \<in> jump_cardinal(K) \<longleftrightarrow>
       (\<exists>r X. r \<subseteq> K*K \<and> X \<subseteq> K \<and> well_ord(X,r) \<and> i = ordertype(X,r))"
-apply (unfold jump_cardinal_def)
+  unfolding jump_cardinal_def
 apply (blast del: subsetI)
 done
 
 (*The easy part of Theorem 10.16: jump_cardinal(K) exceeds K*)
 lemma K_lt_jump_cardinal: "Ord(K) \<Longrightarrow> K < jump_cardinal(K)"
 apply (rule Ord_jump_cardinal [THEN [2] ltI])
 apply (rule jump_cardinal_iff [THEN iffD2])
 apply (rule_tac x="Memrel(K)" in exI)
 apply (rule_tac x=K in exI)
 apply (simp add: ordertype_Memrel well_ord_Memrel)
 apply (simp add: Memrel_def subset_iff)
 done
 
 (*The proof by contradiction: the bijection f yields a wellordering of X
   whose ordertype is jump_cardinal(K).  *)
 lemma Card_jump_cardinal_lemma:
      "\<lbrakk>well_ord(X,r);  r \<subseteq> K * K;  X \<subseteq> K;
          f \<in> bij(ordertype(X,r), jump_cardinal(K))\<rbrakk>
       \<Longrightarrow> jump_cardinal(K) \<in> jump_cardinal(K)"
 apply (subgoal_tac "f O ordermap (X,r) \<in> bij (X, jump_cardinal (K))")
  prefer 2 apply (blast intro: comp_bij ordermap_bij)
 apply (rule jump_cardinal_iff [THEN iffD2])
 apply (intro exI conjI)
 apply (rule subset_trans [OF rvimage_type Sigma_mono], assumption+)
 apply (erule bij_is_inj [THEN well_ord_rvimage])
 apply (rule Ord_jump_cardinal [THEN well_ord_Memrel])
 apply (simp add: well_ord_Memrel [THEN [2] bij_ordertype_vimage]
                  ordertype_Memrel Ord_jump_cardinal)
 done
 
 (*The hard part of Theorem 10.16: jump_cardinal(K) is itself a cardinal*)
 lemma Card_jump_cardinal: "Card(jump_cardinal(K))"
 apply (rule Ord_jump_cardinal [THEN CardI])
-apply (unfold eqpoll_def)
+  unfolding eqpoll_def
 apply (safe dest!: ltD jump_cardinal_iff [THEN iffD1])
 apply (blast intro: Card_jump_cardinal_lemma [THEN mem_irrefl])
 done
 
 subsection\<open>Basic Properties of Successor Cardinals\<close>
 
 lemma csucc_basic: "Ord(K) \<Longrightarrow> Card(csucc(K)) \<and> K < csucc(K)"
-apply (unfold csucc_def)
+  unfolding csucc_def
 apply (rule LeastI)
 apply (blast intro: Card_jump_cardinal K_lt_jump_cardinal Ord_jump_cardinal)+
 done
 
 lemmas Card_csucc = csucc_basic [THEN conjunct1]
 
 lemmas lt_csucc = csucc_basic [THEN conjunct2]
 
 lemma Ord_0_lt_csucc: "Ord(K) \<Longrightarrow> 0 < csucc(K)"
 by (blast intro: Ord_0_le lt_csucc lt_trans1)
 
 lemma csucc_le: "\<lbrakk>Card(L);  K<L\<rbrakk> \<Longrightarrow> csucc(K) \<le> L"
-apply (unfold csucc_def)
+  unfolding csucc_def
 apply (rule Least_le)
 apply (blast intro: Card_is_Ord)+
 done
 
 lemma lt_csucc_iff: "\<lbrakk>Ord(i); Card(K)\<rbrakk> \<Longrightarrow> i < csucc(K) \<longleftrightarrow> |i| \<le> K"
 apply (rule iffI)
 apply (rule_tac [2] Card_lt_imp_lt)
 apply (erule_tac [2] lt_trans1)
 apply (simp_all add: lt_csucc Card_csucc Card_is_Ord)
 apply (rule notI [THEN not_lt_imp_le])
 apply (rule Card_cardinal [THEN csucc_le, THEN lt_trans1, THEN lt_irrefl], assumption)
 apply (rule Ord_cardinal_le [THEN lt_trans1])
 apply (simp_all add: Ord_cardinal Card_is_Ord)
 done
 
 lemma Card_lt_csucc_iff:
      "\<lbrakk>Card(K'); Card(K)\<rbrakk> \<Longrightarrow> K' < csucc(K) \<longleftrightarrow> K' \<le> K"
 by (simp add: lt_csucc_iff Card_cardinal_eq Card_is_Ord)
 
 lemma InfCard_csucc: "InfCard(K) \<Longrightarrow> InfCard(csucc(K))"
 by (simp add: InfCard_def Card_csucc Card_is_Ord
               lt_csucc [THEN leI, THEN [2] le_trans])
 
 
 subsubsection\<open>Removing elements from a finite set decreases its cardinality\<close>
 
 lemma Finite_imp_cardinal_cons [simp]:
   assumes FA: "Finite(A)" and a: "a\<notin>A" shows "|cons(a,A)| = succ(|A|)"
 proof -
   { fix X
     have "Finite(X) \<Longrightarrow> a \<notin> X \<Longrightarrow> cons(a,X) \<lesssim> X \<Longrightarrow> False"
       proof (induct X rule: Finite_induct)
         case 0 thus False  by (simp add: lepoll_0_iff)
       next
         case (cons x Y)
         hence "cons(x, cons(a, Y)) \<lesssim> cons(x, Y)" by (simp add: cons_commute)
         hence "cons(a, Y) \<lesssim> Y" using cons        by (blast dest: cons_lepoll_consD)
         thus False using cons by auto
       qed
   }
   hence [simp]: "\<not> cons(a,A) \<lesssim> A" using a FA by auto
   have [simp]: "|A| \<approx> A" using Finite_imp_well_ord [OF FA]
     by (blast intro: well_ord_cardinal_eqpoll)
   have "(\<mu> i. i \<approx> cons(a, A)) = succ(|A|)"
     proof (rule Least_equality [OF _ _ notI])
       show "succ(|A|) \<approx> cons(a, A)"
         by (simp add: succ_def cons_eqpoll_cong mem_not_refl a)
     next
       show "Ord(succ(|A|))" by simp
     next
       fix i
       assume i: "i \<le> |A|" "i \<approx> cons(a, A)"
       have "cons(a, A) \<approx> i" by (rule eqpoll_sym) (rule i)
       also have "... \<lesssim> |A|" by (rule le_imp_lepoll) (rule i)
       also have "... \<approx> A"   by simp
       finally have "cons(a, A) \<lesssim> A" .
       thus False by simp
     qed
   thus ?thesis by (simp add: cardinal_def)
 qed
 
 lemma Finite_imp_succ_cardinal_Diff:
      "\<lbrakk>Finite(A);  a \<in> A\<rbrakk> \<Longrightarrow> succ(|A-{a}|) = |A|"
 apply (rule_tac b = A in cons_Diff [THEN subst], assumption)
 apply (simp add: Finite_imp_cardinal_cons Diff_subset [THEN subset_Finite])
 apply (simp add: cons_Diff)
 done
 
 lemma Finite_imp_cardinal_Diff: "\<lbrakk>Finite(A);  a \<in> A\<rbrakk> \<Longrightarrow> |A-{a}| < |A|"
 apply (rule succ_leE)
 apply (simp add: Finite_imp_succ_cardinal_Diff)
 done
 
 lemma Finite_cardinal_in_nat [simp]: "Finite(A) \<Longrightarrow> |A| \<in> nat"
 proof (induct rule: Finite_induct)
   case 0 thus ?case by (simp add: cardinal_0)
 next
   case (cons x A) thus ?case by (simp add: Finite_imp_cardinal_cons)
 qed
 
 lemma card_Un_Int:
      "\<lbrakk>Finite(A); Finite(B)\<rbrakk> \<Longrightarrow> |A| #+ |B| = |A \<union> B| #+ |A \<inter> B|"
 apply (erule Finite_induct, simp)
 apply (simp add: Finite_Int cons_absorb Un_cons Int_cons_left)
 done
 
 lemma card_Un_disjoint:
      "\<lbrakk>Finite(A); Finite(B); A \<inter> B = 0\<rbrakk> \<Longrightarrow> |A \<union> B| = |A| #+ |B|"
 by (simp add: Finite_Un card_Un_Int)
 
 lemma card_partition:
   assumes FC: "Finite(C)"
   shows
      "Finite (\<Union> C) \<Longrightarrow>
         (\<forall>c\<in>C. |c| = k) \<Longrightarrow>
         (\<forall>c1 \<in> C. \<forall>c2 \<in> C. c1 \<noteq> c2 \<longrightarrow> c1 \<inter> c2 = 0) \<Longrightarrow>
         k #* |C| = |\<Union> C|"
 using FC
 proof (induct rule: Finite_induct)
   case 0 thus ?case by simp
 next
   case (cons x B)
   hence "x \<inter> \<Union>B = 0" by auto
   thus ?case using cons
     by (auto simp add: card_Un_disjoint)
 qed
 
 
 subsubsection\<open>Theorems by Krzysztof Grabczewski, proofs by lcp\<close>
 
 lemmas nat_implies_well_ord = nat_into_Ord [THEN well_ord_Memrel]
 
 lemma nat_sum_eqpoll_sum:
   assumes m: "m \<in> nat" and n: "n \<in> nat" shows "m + n \<approx> m #+ n"
 proof -
   have "m + n \<approx> |m+n|" using m n
     by (blast intro: nat_implies_well_ord well_ord_radd well_ord_cardinal_eqpoll eqpoll_sym)
   also have "... = m #+ n" using m n
     by (simp add: nat_cadd_eq_add [symmetric] cadd_def)
   finally show ?thesis .
 qed
 
 lemma Ord_subset_natD [rule_format]: "Ord(i) \<Longrightarrow> i \<subseteq> nat \<Longrightarrow> i \<in> nat | i=nat"
 proof (induct i rule: trans_induct3)
   case 0 thus ?case by auto
 next
   case (succ i) thus ?case by auto
 next
   case (limit l) thus ?case
     by (blast dest: nat_le_Limit le_imp_subset)
 qed
 
 lemma Ord_nat_subset_into_Card: "\<lbrakk>Ord(i); i \<subseteq> nat\<rbrakk> \<Longrightarrow> Card(i)"
   by (blast dest: Ord_subset_natD intro: Card_nat nat_into_Card)
 
 end
diff --git a/src/ZF/Coind/ECR.thy b/src/ZF/Coind/ECR.thy
--- a/src/ZF/Coind/ECR.thy
+++ b/src/ZF/Coind/ECR.thy
@@ -1,167 +1,167 @@
 (*  Title:      ZF/Coind/ECR.thy
     Author:     Jacob Frost, Cambridge University Computer Laboratory
     Copyright   1995  University of Cambridge
 *)
 
 theory ECR imports Static Dynamic begin
 
 (* The extended correspondence relation *)
 
 consts
   HasTyRel :: i
 coinductive
   domains "HasTyRel" \<subseteq> "Val * Ty"
   intros
     htr_constI [intro!]:
       "\<lbrakk>c \<in> Const; t \<in> Ty; isof(c,t)\<rbrakk> \<Longrightarrow> <v_const(c),t> \<in> HasTyRel"
     htr_closI [intro]:
       "\<lbrakk>x \<in> ExVar; e \<in> Exp; t \<in> Ty; ve \<in> ValEnv; te \<in> TyEnv; 
           <te,e_fn(x,e),t> \<in> ElabRel;  
           ve_dom(ve) = te_dom(te);   
           {<ve_app(ve,y),te_app(te,y)>.y \<in> ve_dom(ve)} \<in> Pow(HasTyRel)\<rbrakk> 
        \<Longrightarrow> <v_clos(x,e,ve),t> \<in> HasTyRel" 
   monos  Pow_mono
   type_intros Val_ValEnv.intros
   
 (* Pointwise extension to environments *)
  
 definition
   hastyenv :: "[i,i] \<Rightarrow> o"  where
     "hastyenv(ve,te) \<equiv>                        
          ve_dom(ve) = te_dom(te) \<and>          
          (\<forall>x \<in> ve_dom(ve). <ve_app(ve,x),te_app(te,x)> \<in> HasTyRel)"
 
 (* Specialised co-induction rule *)
 
 lemma htr_closCI [intro]:
      "\<lbrakk>x \<in> ExVar; e \<in> Exp; t \<in> Ty; ve \<in> ValEnv; te \<in> TyEnv;   
          <te, e_fn(x, e), t> \<in> ElabRel; ve_dom(ve) = te_dom(te);  
          {<ve_app(ve,y),te_app(te,y)>.y \<in> ve_dom(ve)} \<in>
            Pow({<v_clos(x,e,ve),t>} \<union> HasTyRel)\<rbrakk>     
       \<Longrightarrow> <v_clos(x, e, ve),t> \<in> HasTyRel"
 apply (rule singletonI [THEN HasTyRel.coinduct], auto)
 done
 
 (* Specialised elimination rules *)
 
 inductive_cases
     htr_constE [elim!]: "<v_const(c),t> \<in> HasTyRel"
   and htr_closE [elim]: "<v_clos(x,e,ve),t> \<in> HasTyRel"
 
 
 (* Properties of the pointwise extension to environments *)
 
 lemmas HasTyRel_non_zero =
        HasTyRel.dom_subset [THEN subsetD, THEN SigmaD1, THEN ValNEE]
 
 lemma hastyenv_owr: 
   "\<lbrakk>ve \<in> ValEnv; te \<in> TyEnv; hastyenv(ve,te); \<langle>v,t\<rangle> \<in> HasTyRel\<rbrakk> 
    \<Longrightarrow> hastyenv(ve_owr(ve,x,v),te_owr(te,x,t))"
 by (auto simp add: hastyenv_def ve_app_owr HasTyRel_non_zero)
 
 lemma basic_consistency_lem: 
   "\<lbrakk>ve \<in> ValEnv; te \<in> TyEnv; isofenv(ve,te)\<rbrakk> \<Longrightarrow> hastyenv(ve,te)"
 apply (unfold isofenv_def hastyenv_def)
 apply (force intro: te_appI ve_domI) 
 done
 
 
 (* ############################################################ *)
 (* The Consistency theorem                                      *)
 (* ############################################################ *)
 
 lemma consistency_const:
      "\<lbrakk>c \<in> Const; hastyenv(ve,te);<te,e_const(c),t> \<in> ElabRel\<rbrakk> 
       \<Longrightarrow> <v_const(c), t> \<in> HasTyRel"
 by blast
 
 
 lemma consistency_var: 
   "\<lbrakk>x \<in> ve_dom(ve); hastyenv(ve,te); <te,e_var(x),t> \<in> ElabRel\<rbrakk> \<Longrightarrow>      
    <ve_app(ve,x),t> \<in> HasTyRel"
 by (unfold hastyenv_def, blast)
 
 lemma consistency_fn: 
   "\<lbrakk>ve \<in> ValEnv; x \<in> ExVar; e \<in> Exp; hastyenv(ve,te);        
            <te,e_fn(x,e),t> \<in> ElabRel   
 \<rbrakk> \<Longrightarrow> <v_clos(x, e, ve), t> \<in> HasTyRel"
 by (unfold hastyenv_def, blast)
 
 declare ElabRel.dom_subset [THEN subsetD, dest]
 
 declare Ty.intros [simp, intro!]
 declare TyEnv.intros [simp, intro!]
 declare Val_ValEnv.intros [simp, intro!]
 
 lemma consistency_fix: 
   "\<lbrakk>ve \<in> ValEnv; x \<in> ExVar; e \<in> Exp; f \<in> ExVar; cl \<in> Val;                
       v_clos(x,e,ve_owr(ve,f,cl)) = cl;                           
       hastyenv(ve,te); <te,e_fix(f,x,e),t> \<in> ElabRel\<rbrakk> \<Longrightarrow>        
    \<langle>cl,t\<rangle> \<in> HasTyRel"
-apply (unfold hastyenv_def)
+  unfolding hastyenv_def
 apply (erule elab_fixE, safe)
 apply hypsubst_thin
 apply (rule subst, assumption) 
 apply (rule_tac te="te_owr(te, f, t_fun(t1, t2))" in htr_closCI)
 apply simp_all
 apply (blast intro: ve_owrI) 
 apply (rule ElabRel.fnI)
 apply (simp_all add: ValNEE, force)
 done
 
 
 lemma consistency_app1:
  "\<lbrakk>ve \<in> ValEnv; e1 \<in> Exp; e2 \<in> Exp; c1 \<in> Const; c2 \<in> Const;    
      <ve,e1,v_const(c1)> \<in> EvalRel;                       
      \<forall>t te.                                          
        hastyenv(ve,te) \<longrightarrow> <te,e1,t> \<in> ElabRel \<longrightarrow> <v_const(c1),t> \<in> HasTyRel;
      <ve, e2, v_const(c2)> \<in> EvalRel;                   
      \<forall>t te.                                          
        hastyenv(ve,te) \<longrightarrow> <te,e2,t> \<in> ElabRel \<longrightarrow> <v_const(c2),t> \<in> HasTyRel;
      hastyenv(ve, te);                                  
      <te,e_app(e1,e2),t> \<in> ElabRel\<rbrakk> 
   \<Longrightarrow> <v_const(c_app(c1, c2)),t> \<in> HasTyRel"
 by (blast intro!: c_appI intro: isof_app)
 
 lemma consistency_app2:
  "\<lbrakk>ve \<in> ValEnv; vem \<in> ValEnv; e1 \<in> Exp; e2 \<in> Exp; em \<in> Exp; xm \<in> ExVar; 
      v \<in> Val;   
      <ve,e1,v_clos(xm,em,vem)> \<in> EvalRel;        
      \<forall>t te. hastyenv(ve,te) \<longrightarrow>                     
             <te,e1,t> \<in> ElabRel \<longrightarrow> <v_clos(xm,em,vem),t> \<in> HasTyRel;         
      <ve,e2,v2> \<in> EvalRel;                       
      \<forall>t te. hastyenv(ve,te) \<longrightarrow> <te,e2,t> \<in> ElabRel \<longrightarrow> \<langle>v2,t\<rangle> \<in> HasTyRel;
      <ve_owr(vem,xm,v2),em,v> \<in> EvalRel;         
      \<forall>t te. hastyenv(ve_owr(vem,xm,v2),te) \<longrightarrow>      
             <te,em,t> \<in> ElabRel \<longrightarrow> \<langle>v,t\<rangle> \<in> HasTyRel;
      hastyenv(ve,te); <te,e_app(e1,e2),t> \<in> ElabRel\<rbrakk> 
    \<Longrightarrow> \<langle>v,t\<rangle> \<in> HasTyRel"
 apply (erule elab_appE)
 apply (drule spec [THEN spec, THEN mp, THEN mp], assumption+)
 apply (drule spec [THEN spec, THEN mp, THEN mp], assumption+)
 apply (erule htr_closE)
 apply (erule elab_fnE, simp)
 apply clarify
 apply (drule spec [THEN spec, THEN mp, THEN mp])
 prefer 2 apply assumption+
 apply (rule hastyenv_owr, assumption)
 apply assumption 
 apply (simp add: hastyenv_def, blast+)
 done
 
 lemma consistency [rule_format]:
    "<ve,e,v> \<in> EvalRel 
     \<Longrightarrow> (\<forall>t te. hastyenv(ve,te) \<longrightarrow> <te,e,t> \<in> ElabRel \<longrightarrow> \<langle>v,t\<rangle> \<in> HasTyRel)"
 apply (erule EvalRel.induct)
 apply (simp_all add: consistency_const consistency_var consistency_fn 
                      consistency_fix consistency_app1)
 apply (blast intro: consistency_app2)
 done
 
 lemma basic_consistency:
      "\<lbrakk>ve \<in> ValEnv; te \<in> TyEnv; isofenv(ve,te);                    
          <ve,e,v_const(c)> \<in> EvalRel; <te,e,t> \<in> ElabRel\<rbrakk> 
       \<Longrightarrow> isof(c,t)"
 by (blast dest: consistency intro!: basic_consistency_lem)
 
 end
diff --git a/src/ZF/Coind/Map.thy b/src/ZF/Coind/Map.thy
--- a/src/ZF/Coind/Map.thy
+++ b/src/ZF/Coind/Map.thy
@@ -1,184 +1,184 @@
 (*  Title:      ZF/Coind/Map.thy
     Author:     Jacob Frost, Cambridge University Computer Laboratory
     Copyright   1995  University of Cambridge
 
 Some sample proofs of inclusions for the final coalgebra "U" (by lcp).
 *)
 
 theory Map imports ZF begin
 
 definition
   TMap :: "[i,i] \<Rightarrow> i"  where
    "TMap(A,B) \<equiv> {m \<in> Pow(A*\<Union>(B)).\<forall>a \<in> A. m``{a} \<in> B}"
 
 definition
   PMap :: "[i,i] \<Rightarrow> i"  where
    "PMap(A,B) \<equiv> TMap(A,cons(0,B))"
 
 (* Note: 0 \<in> B \<Longrightarrow> TMap(A,B) = PMap(A,B) *)
   
 definition
   map_emp :: i  where
    "map_emp \<equiv> 0"
 
 definition
   map_owr :: "[i,i,i]\<Rightarrow>i"  where
    "map_owr(m,a,b) \<equiv> \<Sum>x \<in> {a} \<union> domain(m). if x=a then b else m``{x}"
 
 definition
   map_app :: "[i,i]\<Rightarrow>i"  where
    "map_app(m,a) \<equiv> m``{a}"
   
 lemma "{0,1} \<subseteq> {1} \<union> TMap(I, {0,1})"
 by (unfold TMap_def, blast)
 
 lemma "{0} \<union> TMap(I,1) \<subseteq> {1} \<union> TMap(I, {0} \<union> TMap(I,1))"
 by (unfold TMap_def, blast)
 
 lemma "{0,1} \<union> TMap(I,2) \<subseteq> {1} \<union> TMap(I, {0,1} \<union> TMap(I,2))"
 by (unfold TMap_def, blast)
 
 (*A bit too slow.
 lemma "{0,1} \<union> TMap(I,TMap(I,2)) \<union> TMap(I,2) \<subseteq>  
        {1} \<union> TMap(I, {0,1} \<union> TMap(I,TMap(I,2)) \<union> TMap(I,2))"
 by (unfold TMap_def, blast)
 *)
 
 (* ############################################################ *)
 (* Lemmas                                                       *)
 (* ############################################################ *)
 
 lemma qbeta_if: "Sigma(A,B)``{a} = (if a \<in> A then B(a) else 0)"
 by auto
 
 lemma qbeta: "a \<in> A \<Longrightarrow> Sigma(A,B)``{a} = B(a)"
 by fast
 
 lemma qbeta_emp: "a\<notin>A \<Longrightarrow> Sigma(A,B)``{a} = 0"
 by fast
 
 lemma image_Sigma1: "a \<notin> A \<Longrightarrow> Sigma(A,B)``{a}=0"
 by fast
 
 
 (* ############################################################ *)
 (* Inclusion in Quine Universes                                 *)
 (* ############################################################ *)
 
 (* Lemmas *)
 
 lemma MapQU_lemma: 
     "A \<subseteq> univ(X) \<Longrightarrow> Pow(A * \<Union>(quniv(X))) \<subseteq> quniv(X)"
-apply (unfold quniv_def)
+  unfolding quniv_def
 apply (rule Pow_mono)
 apply (rule subset_trans [OF Sigma_mono product_univ])
 apply (erule subset_trans)
 apply (rule arg_subset_eclose [THEN univ_mono])
 apply (simp add: Union_Pow_eq)
 done
 
 (* Theorems *)
 
 lemma mapQU:
   "\<lbrakk>m \<in> PMap(A,quniv(B)); \<And>x. x \<in> A \<Longrightarrow> x \<in> univ(B)\<rbrakk> \<Longrightarrow> m \<in> quniv(B)"
 apply (unfold PMap_def TMap_def)
 apply (blast intro!: MapQU_lemma [THEN subsetD]) 
 done
 
 (* ############################################################ *)
 (* Monotonicity                                                 *)
 (* ############################################################ *)
 
 lemma PMap_mono: "B \<subseteq> C \<Longrightarrow> PMap(A,B)<=PMap(A,C)"
 by (unfold PMap_def TMap_def, blast)
 
 
 (* ############################################################ *)
 (* Introduction Rules                                           *)
 (* ############################################################ *)
 
 (** map_emp **)
 
 lemma pmap_empI: "map_emp \<in> PMap(A,B)"
 by (unfold map_emp_def PMap_def TMap_def, auto)
 
 (** map_owr **)
 
 lemma pmap_owrI: 
   "\<lbrakk>m \<in> PMap(A,B); a \<in> A; b \<in> B\<rbrakk>  \<Longrightarrow> map_owr(m,a,b):PMap(A,B)"
 apply (unfold map_owr_def PMap_def TMap_def, safe)
 apply (simp_all add: if_iff, auto)
 (*Remaining subgoal*)
 apply (rule excluded_middle [THEN disjE])
 apply (erule image_Sigma1)
 apply (drule_tac psi = "uu \<notin> B" for uu in asm_rl)
 apply (auto simp add: qbeta)
 done
 
 (** map_app **)
 
 lemma tmap_app_notempty: 
   "\<lbrakk>m \<in> TMap(A,B); a \<in> domain(m)\<rbrakk> \<Longrightarrow> map_app(m,a) \<noteq>0"
 by (unfold TMap_def map_app_def, blast)
 
 lemma tmap_appI: 
   "\<lbrakk>m \<in> TMap(A,B); a \<in> domain(m)\<rbrakk> \<Longrightarrow> map_app(m,a):B"
 by (unfold TMap_def map_app_def domain_def, blast)
 
 lemma pmap_appI: 
   "\<lbrakk>m \<in> PMap(A,B); a \<in> domain(m)\<rbrakk> \<Longrightarrow> map_app(m,a):B"
-apply (unfold PMap_def)
+  unfolding PMap_def
 apply (frule tmap_app_notempty, assumption)
 apply (drule tmap_appI, auto)
 done
 
 (** domain **)
 
 lemma tmap_domainD: 
   "\<lbrakk>m \<in> TMap(A,B); a \<in> domain(m)\<rbrakk> \<Longrightarrow> a \<in> A"
 by (unfold TMap_def, blast)
 
 lemma pmap_domainD: 
   "\<lbrakk>m \<in> PMap(A,B); a \<in> domain(m)\<rbrakk> \<Longrightarrow> a \<in> A"
 by (unfold PMap_def TMap_def, blast)
 
 
 (* ############################################################ *)
 (* Equalities                                                   *)
 (* ############################################################ *)
 
 (** Domain **)
 
 (* Lemmas *)
 
 lemma domain_UN: "domain(\<Union>x \<in> A. B(x)) = (\<Union>x \<in> A. domain(B(x)))"
 by fast
 
 
 lemma domain_Sigma: "domain(Sigma(A,B)) = {x \<in> A. \<exists>y. y \<in> B(x)}"
 by blast
 
 (* Theorems *)
 
 lemma map_domain_emp: "domain(map_emp) = 0"
 by (unfold map_emp_def, blast)
 
 lemma map_domain_owr: 
   "b \<noteq> 0 \<Longrightarrow> domain(map_owr(f,a,b)) = {a} \<union> domain(f)"
-apply (unfold map_owr_def)
+  unfolding map_owr_def
 apply (auto simp add: domain_Sigma)
 done
 
 (** Application **)
 
 lemma map_app_owr: 
   "map_app(map_owr(f,a,b),c) = (if c=a then b else map_app(f,c))"
 by (simp add: qbeta_if  map_app_def map_owr_def, blast)
 
 lemma map_app_owr1: "map_app(map_owr(f,a,b),a) = b"
 by (simp add: map_app_owr)
 
 lemma map_app_owr2: "c \<noteq> a \<Longrightarrow> map_app(map_owr(f,a,b),c)= map_app(f,c)"
 by (simp add: map_app_owr)
 
 end
diff --git a/src/ZF/Coind/Values.thy b/src/ZF/Coind/Values.thy
--- a/src/ZF/Coind/Values.thy
+++ b/src/ZF/Coind/Values.thy
@@ -1,115 +1,115 @@
 (*  Title:      ZF/Coind/Values.thy
     Author:     Jacob Frost, Cambridge University Computer Laboratory
     Copyright   1995  University of Cambridge
 *)
 
 theory Values imports Language Map begin
 
 (* Values, values environments and associated operators *)
 
 consts
   Val  :: i
   ValEnv  :: i
   Val_ValEnv  :: i
 
 codatatype
     "Val" = v_const ("c \<in> Const")
           | v_clos ("x \<in> ExVar","e \<in> Exp","ve \<in> ValEnv")
   and
     "ValEnv" = ve_mk ("m \<in> PMap(ExVar,Val)")
   monos       PMap_mono
   type_intros  A_into_univ mapQU
 
 consts
   ve_owr :: "[i,i,i] \<Rightarrow> i"
   ve_dom :: "i\<Rightarrow>i"
   ve_app :: "[i,i] \<Rightarrow> i"
 
 
 primrec "ve_owr(ve_mk(m), x, v) = ve_mk(map_owr(m,x,v))"
 
 primrec "ve_dom(ve_mk(m)) = domain(m)"
 
 primrec "ve_app(ve_mk(m), a) = map_app(m,a)"
 
 definition
   ve_emp :: i  where
    "ve_emp \<equiv> ve_mk(map_emp)"
 
 
 (* Elimination rules *)
 
 lemma ValEnvE:
   "\<lbrakk>ve \<in> ValEnv; \<And>m.\<lbrakk>ve=ve_mk(m); m \<in> PMap(ExVar,Val)\<rbrakk> \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
 apply (unfold Part_def Val_def ValEnv_def, clarify) 
 apply (erule Val_ValEnv.cases) 
 apply (auto simp add: Val_def Part_def Val_ValEnv.con_defs)
 done
 
 lemma ValE:
   "\<lbrakk>v \<in> Val;  
       \<And>c. \<lbrakk>v = v_const(c); c \<in> Const\<rbrakk> \<Longrightarrow> Q; 
       \<And>e ve x.  
         \<lbrakk>v = v_clos(x,e,ve); x \<in> ExVar; e \<in> Exp; ve \<in> ValEnv\<rbrakk> \<Longrightarrow> Q  
 \<rbrakk> \<Longrightarrow>  
    Q"
 apply (unfold Part_def Val_def ValEnv_def, clarify) 
 apply (erule Val_ValEnv.cases) 
 apply (auto simp add: ValEnv_def Part_def Val_ValEnv.con_defs)
 done
 
 (* Nonempty sets *)
 
 lemma v_closNE [simp]: "v_clos(x,e,ve) \<noteq> 0"
 by (unfold QPair_def QInl_def QInr_def Val_ValEnv.con_defs, blast)
 
 declare v_closNE [THEN notE, elim!]
 
 
 lemma v_constNE [simp]: "c \<in> Const \<Longrightarrow> v_const(c) \<noteq> 0"
 apply (unfold QPair_def QInl_def QInr_def Val_ValEnv.con_defs)
 apply (drule constNEE, auto)
 done
 
 
 (* Proving that the empty set is not a value *)
 
 lemma ValNEE: "v \<in> Val \<Longrightarrow> v \<noteq> 0"
 by (erule ValE, auto)
 
 (* Equalities for value environments *)
 
 lemma ve_dom_owr [simp]:
      "\<lbrakk>ve \<in> ValEnv; v \<noteq>0\<rbrakk> \<Longrightarrow> ve_dom(ve_owr(ve,x,v)) = ve_dom(ve) \<union> {x}"
 apply (erule ValEnvE)
 apply (auto simp add: map_domain_owr)
 done
 
 lemma ve_app_owr [simp]:
      "ve \<in> ValEnv  
       \<Longrightarrow> ve_app(ve_owr(ve,y,v),x) = (if x=y then v else ve_app(ve,x))"
 by (erule ValEnvE, simp add: map_app_owr)
 
 (* Introduction rules for operators on value environments *)
 
 lemma ve_appI: "\<lbrakk>ve \<in> ValEnv; x \<in> ve_dom(ve)\<rbrakk> \<Longrightarrow> ve_app(ve,x):Val"
 by (erule ValEnvE, simp add: pmap_appI) 
 
 lemma ve_domI: "\<lbrakk>ve \<in> ValEnv; x \<in> ve_dom(ve)\<rbrakk> \<Longrightarrow> x \<in> ExVar"
 apply (erule ValEnvE, simp) 
 apply (blast dest: pmap_domainD)
 done
 
 lemma ve_empI: "ve_emp \<in> ValEnv"
-apply (unfold ve_emp_def)
+  unfolding ve_emp_def
 apply (rule Val_ValEnv.intros)
 apply (rule pmap_empI)
 done
 
 lemma ve_owrI:
      "\<lbrakk>ve \<in> ValEnv; x \<in> ExVar; v \<in> Val\<rbrakk> \<Longrightarrow> ve_owr(ve,x,v):ValEnv"
 apply (erule ValEnvE, simp)
 apply (blast intro: pmap_owrI Val_ValEnv.intros)
 done
 
 end
diff --git a/src/ZF/Constructible/AC_in_L.thy b/src/ZF/Constructible/AC_in_L.thy
--- a/src/ZF/Constructible/AC_in_L.thy
+++ b/src/ZF/Constructible/AC_in_L.thy
@@ -1,479 +1,479 @@
 (*  Title:      ZF/Constructible/AC_in_L.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
 *)
 
 section \<open>The Axiom of Choice Holds in L!\<close>
 
 theory AC_in_L imports Formula Separation begin
 
 subsection\<open>Extending a Wellordering over a List -- Lexicographic Power\<close>
 
 text\<open>This could be moved into a library.\<close>
 
 consts
   rlist   :: "[i,i]\<Rightarrow>i"
 
 inductive
   domains "rlist(A,r)" \<subseteq> "list(A) * list(A)"
   intros
     shorterI:
       "\<lbrakk>length(l') < length(l); l' \<in> list(A); l \<in> list(A)\<rbrakk>
        \<Longrightarrow> <l', l> \<in> rlist(A,r)"
 
     sameI:
       "\<lbrakk><l',l> \<in> rlist(A,r); a \<in> A\<rbrakk>
        \<Longrightarrow> <Cons(a,l'), Cons(a,l)> \<in> rlist(A,r)"
 
     diffI:
       "\<lbrakk>length(l') = length(l); <a',a> \<in> r;
           l' \<in> list(A); l \<in> list(A); a' \<in> A; a \<in> A\<rbrakk>
        \<Longrightarrow> <Cons(a',l'), Cons(a,l)> \<in> rlist(A,r)"
   type_intros list.intros
 
 
 subsubsection\<open>Type checking\<close>
 
 lemmas rlist_type = rlist.dom_subset
 
 lemmas field_rlist = rlist_type [THEN field_rel_subset]
 
 subsubsection\<open>Linearity\<close>
 
 lemma rlist_Nil_Cons [intro]:
     "\<lbrakk>a \<in> A; l \<in> list(A)\<rbrakk> \<Longrightarrow> <[], Cons(a,l)> \<in> rlist(A, r)"
 by (simp add: shorterI)
 
 lemma linear_rlist:
   assumes r: "linear(A,r)" shows "linear(list(A),rlist(A,r))"
 proof -
   { fix xs ys
     have "xs \<in> list(A) \<Longrightarrow> ys \<in> list(A) \<Longrightarrow> \<langle>xs,ys\<rangle> \<in> rlist(A,r) \<or> xs = ys \<or> \<langle>ys,xs\<rangle> \<in> rlist(A, r) "
     proof (induct xs arbitrary: ys rule: list.induct)
       case Nil 
       thus ?case by (induct ys rule: list.induct) (auto simp add: shorterI)
     next
       case (Cons x xs)
       { fix y ys
         assume "y \<in> A" and "ys \<in> list(A)"
         with Cons
         have "\<langle>Cons(x,xs),Cons(y,ys)\<rangle> \<in> rlist(A,r) \<or> x=y \<and> xs = ys \<or> \<langle>Cons(y,ys), Cons(x,xs)\<rangle> \<in> rlist(A,r)" 
           apply (rule_tac i = "length(xs)" and j = "length(ys)" in Ord_linear_lt)
           apply (simp_all add: shorterI)
           apply (rule linearE [OF r, of x y]) 
           apply (auto simp add: diffI intro: sameI) 
           done
       }
       note yConsCase = this
       show ?case using \<open>ys \<in> list(A)\<close>
         by (cases rule: list.cases) (simp_all add: Cons rlist_Nil_Cons yConsCase) 
     qed
   }
   thus ?thesis by (simp add: linear_def) 
 qed
 
 
 subsubsection\<open>Well-foundedness\<close>
 
 text\<open>Nothing preceeds Nil in this ordering.\<close>
 inductive_cases rlist_NilE: " <l,[]> \<in> rlist(A,r)"
 
 inductive_cases rlist_ConsE: " <l', Cons(x,l)> \<in> rlist(A,r)"
 
 lemma not_rlist_Nil [simp]: " <l,[]> \<notin> rlist(A,r)"
 by (blast intro: elim: rlist_NilE)
 
 lemma rlist_imp_length_le: "<l',l> \<in> rlist(A,r) \<Longrightarrow> length(l') \<le> length(l)"
 apply (erule rlist.induct)
 apply (simp_all add: leI)
 done
 
 lemma wf_on_rlist_n:
   "\<lbrakk>n \<in> nat; wf[A](r)\<rbrakk> \<Longrightarrow> wf[{l \<in> list(A). length(l) = n}](rlist(A,r))"
 apply (induct_tac n)
  apply (rule wf_onI2, simp)
 apply (rule wf_onI2, clarify)
 apply (erule_tac a=y in list.cases, clarify)
  apply (simp (no_asm_use))
 apply clarify
 apply (simp (no_asm_use))
 apply (subgoal_tac "\<forall>l2 \<in> list(A). length(l2) = x \<longrightarrow> Cons(a,l2) \<in> B", blast)
 apply (erule_tac a=a in wf_on_induct, assumption)
 apply (rule ballI)
 apply (rule impI)
 apply (erule_tac a=l2 in wf_on_induct, blast, clarify)
 apply (rename_tac a' l2 l')
 apply (drule_tac x="Cons(a',l')" in bspec, typecheck)
 apply simp
 apply (erule mp, clarify)
 apply (erule rlist_ConsE, auto)
 done
 
 lemma list_eq_UN_length: "list(A) = (\<Union>n\<in>nat. {l \<in> list(A). length(l) = n})"
 by (blast intro: length_type)
 
 
 lemma wf_on_rlist: "wf[A](r) \<Longrightarrow> wf[list(A)](rlist(A,r))"
 apply (subst list_eq_UN_length)
 apply (rule wf_on_Union)
   apply (rule wf_imp_wf_on [OF wf_Memrel [of nat]])
  apply (simp add: wf_on_rlist_n)
 apply (frule rlist_type [THEN subsetD])
 apply (simp add: length_type)
 apply (drule rlist_imp_length_le)
 apply (erule leE)
 apply (simp_all add: lt_def)
 done
 
 
 lemma wf_rlist: "wf(r) \<Longrightarrow> wf(rlist(field(r),r))"
 apply (simp add: wf_iff_wf_on_field)
 apply (rule wf_on_subset_A [OF _ field_rlist])
 apply (blast intro: wf_on_rlist)
 done
 
 lemma well_ord_rlist:
      "well_ord(A,r) \<Longrightarrow> well_ord(list(A), rlist(A,r))"
 apply (rule well_ordI)
 apply (simp add: well_ord_def wf_on_rlist)
 apply (simp add: well_ord_def tot_ord_def linear_rlist)
 done
 
 
 subsection\<open>An Injection from Formulas into the Natural Numbers\<close>
 
 text\<open>There is a well-known bijection between \<^term>\<open>nat*nat\<close> and \<^term>\<open>nat\<close> given by the expression f(m,n) = triangle(m+n) + m, where triangle(k)
 enumerates the triangular numbers and can be defined by triangle(0)=0,
 triangle(succ(k)) = succ(k + triangle(k)).  Some small amount of effort is
 needed to show that f is a bijection.  We already know that such a bijection exists by the theorem \<open>well_ord_InfCard_square_eq\<close>:
 @{thm[display] well_ord_InfCard_square_eq[no_vars]}
 
 However, this result merely states that there is a bijection between the two
 sets.  It provides no means of naming a specific bijection.  Therefore, we
 conduct the proofs under the assumption that a bijection exists.  The simplest
 way to organize this is to use a locale.\<close>
 
 text\<open>Locale for any arbitrary injection between \<^term>\<open>nat*nat\<close>
       and \<^term>\<open>nat\<close>\<close>
 locale Nat_Times_Nat =
   fixes fn
   assumes fn_inj: "fn \<in> inj(nat*nat, nat)"
 
 
 consts   enum :: "[i,i]\<Rightarrow>i"
 primrec
   "enum(f, Member(x,y)) = f ` <0, f ` \<langle>x,y\<rangle>>"
   "enum(f, Equal(x,y)) = f ` <1, f ` \<langle>x,y\<rangle>>"
   "enum(f, Nand(p,q)) = f ` <2, f ` <enum(f,p), enum(f,q)>>"
   "enum(f, Forall(p)) = f ` <succ(2), enum(f,p)>"
 
 lemma (in Nat_Times_Nat) fn_type [TC,simp]:
     "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> fn`\<langle>x,y\<rangle> \<in> nat"
 by (blast intro: inj_is_fun [OF fn_inj] apply_funtype)
 
 lemma (in Nat_Times_Nat) fn_iff:
     "\<lbrakk>x \<in> nat; y \<in> nat; u \<in> nat; v \<in> nat\<rbrakk>
      \<Longrightarrow> (fn`\<langle>x,y\<rangle> = fn`\<langle>u,v\<rangle>) \<longleftrightarrow> (x=u \<and> y=v)"
 by (blast dest: inj_apply_equality [OF fn_inj])
 
 lemma (in Nat_Times_Nat) enum_type [TC,simp]:
     "p \<in> formula \<Longrightarrow> enum(fn,p) \<in> nat"
 by (induct_tac p, simp_all)
 
 lemma (in Nat_Times_Nat) enum_inject [rule_format]:
     "p \<in> formula \<Longrightarrow> \<forall>q\<in>formula. enum(fn,p) = enum(fn,q) \<longrightarrow> p=q"
 apply (induct_tac p, simp_all)
    apply (rule ballI)
    apply (erule formula.cases)
    apply (simp_all add: fn_iff)
   apply (rule ballI)
   apply (erule formula.cases)
   apply (simp_all add: fn_iff)
  apply (rule ballI)
  apply (erule_tac a=qa in formula.cases)
  apply (simp_all add: fn_iff)
  apply blast
 apply (rule ballI)
 apply (erule_tac a=q in formula.cases)
 apply (simp_all add: fn_iff, blast)
 done
 
 lemma (in Nat_Times_Nat) inj_formula_nat:
     "(\<lambda>p \<in> formula. enum(fn,p)) \<in> inj(formula, nat)"
 apply (simp add: inj_def lam_type)
 apply (blast intro: enum_inject)
 done
 
 lemma (in Nat_Times_Nat) well_ord_formula:
     "well_ord(formula, measure(formula, enum(fn)))"
 apply (rule well_ord_measure, simp)
 apply (blast intro: enum_inject)
 done
 
 lemmas nat_times_nat_lepoll_nat =
     InfCard_nat [THEN InfCard_square_eqpoll, THEN eqpoll_imp_lepoll]
 
 
 text\<open>Not needed--but interesting?\<close>
 theorem formula_lepoll_nat: "formula \<lesssim> nat"
 apply (insert nat_times_nat_lepoll_nat)
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (blast intro: Nat_Times_Nat.inj_formula_nat Nat_Times_Nat.intro)
 done
 
 
 subsection\<open>Defining the Wellordering on \<^term>\<open>DPow(A)\<close>\<close>
 
 text\<open>The objective is to build a wellordering on \<^term>\<open>DPow(A)\<close> from a
 given one on \<^term>\<open>A\<close>.  We first introduce wellorderings for environments,
 which are lists built over \<^term>\<open>A\<close>.  We combine it with the enumeration of
 formulas.  The order type of the resulting wellordering gives us a map from
 (environment, formula) pairs into the ordinals.  For each member of \<^term>\<open>DPow(A)\<close>, we take the minimum such ordinal.\<close>
 
 definition
   env_form_r :: "[i,i,i]\<Rightarrow>i" where
     \<comment> \<open>wellordering on (environment, formula) pairs\<close>
    "env_form_r(f,r,A) \<equiv>
       rmult(list(A), rlist(A, r),
             formula, measure(formula, enum(f)))"
 
 definition
   env_form_map :: "[i,i,i,i]\<Rightarrow>i" where
     \<comment> \<open>map from (environment, formula) pairs to ordinals\<close>
    "env_form_map(f,r,A,z)
       \<equiv> ordermap(list(A) * formula, env_form_r(f,r,A)) ` z"
 
 definition
   DPow_ord :: "[i,i,i,i,i]\<Rightarrow>o" where
     \<comment> \<open>predicate that holds if \<^term>\<open>k\<close> is a valid index for \<^term>\<open>X\<close>\<close>
    "DPow_ord(f,r,A,X,k) \<equiv>
            \<exists>env \<in> list(A). \<exists>p \<in> formula.
              arity(p) \<le> succ(length(env)) \<and>
              X = {x\<in>A. sats(A, p, Cons(x,env))} \<and>
              env_form_map(f,r,A,\<langle>env,p\<rangle>) = k"
 
 definition
   DPow_least :: "[i,i,i,i]\<Rightarrow>i" where
     \<comment> \<open>function yielding the smallest index for \<^term>\<open>X\<close>\<close>
    "DPow_least(f,r,A,X) \<equiv> \<mu> k. DPow_ord(f,r,A,X,k)"
 
 definition
   DPow_r :: "[i,i,i]\<Rightarrow>i" where
     \<comment> \<open>a wellordering on \<^term>\<open>DPow(A)\<close>\<close>
    "DPow_r(f,r,A) \<equiv> measure(DPow(A), DPow_least(f,r,A))"
 
 
 lemma (in Nat_Times_Nat) well_ord_env_form_r:
     "well_ord(A,r)
      \<Longrightarrow> well_ord(list(A) * formula, env_form_r(fn,r,A))"
 by (simp add: env_form_r_def well_ord_rmult well_ord_rlist well_ord_formula)
 
 lemma (in Nat_Times_Nat) Ord_env_form_map:
     "\<lbrakk>well_ord(A,r); z \<in> list(A) * formula\<rbrakk>
      \<Longrightarrow> Ord(env_form_map(fn,r,A,z))"
 by (simp add: env_form_map_def Ord_ordermap well_ord_env_form_r)
 
 lemma DPow_imp_ex_DPow_ord:
     "X \<in> DPow(A) \<Longrightarrow> \<exists>k. DPow_ord(fn,r,A,X,k)"
 apply (simp add: DPow_ord_def)
 apply (blast dest!: DPowD)
 done
 
 lemma (in Nat_Times_Nat) DPow_ord_imp_Ord:
      "\<lbrakk>DPow_ord(fn,r,A,X,k); well_ord(A,r)\<rbrakk> \<Longrightarrow> Ord(k)"
 apply (simp add: DPow_ord_def, clarify)
 apply (simp add: Ord_env_form_map)
 done
 
 lemma (in Nat_Times_Nat) DPow_imp_DPow_least:
     "\<lbrakk>X \<in> DPow(A); well_ord(A,r)\<rbrakk>
      \<Longrightarrow> DPow_ord(fn, r, A, X, DPow_least(fn,r,A,X))"
 apply (simp add: DPow_least_def)
 apply (blast dest: DPow_imp_ex_DPow_ord intro: DPow_ord_imp_Ord LeastI)
 done
 
 lemma (in Nat_Times_Nat) env_form_map_inject:
     "\<lbrakk>env_form_map(fn,r,A,u) = env_form_map(fn,r,A,v); well_ord(A,r);
        u \<in> list(A) * formula;  v \<in> list(A) * formula\<rbrakk>
      \<Longrightarrow> u=v"
 apply (simp add: env_form_map_def)
 apply (rule inj_apply_equality [OF bij_is_inj, OF ordermap_bij,
                                 OF well_ord_env_form_r], assumption+)
 done
 
 lemma (in Nat_Times_Nat) DPow_ord_unique:
     "\<lbrakk>DPow_ord(fn,r,A,X,k); DPow_ord(fn,r,A,Y,k); well_ord(A,r)\<rbrakk>
      \<Longrightarrow> X=Y"
 apply (simp add: DPow_ord_def, clarify)
 apply (drule env_form_map_inject, auto)
 done
 
 lemma (in Nat_Times_Nat) well_ord_DPow_r:
     "well_ord(A,r) \<Longrightarrow> well_ord(DPow(A), DPow_r(fn,r,A))"
 apply (simp add: DPow_r_def)
 apply (rule well_ord_measure)
  apply (simp add: DPow_least_def)
 apply (drule DPow_imp_DPow_least, assumption)+
 apply simp
 apply (blast intro: DPow_ord_unique)
 done
 
 lemma (in Nat_Times_Nat) DPow_r_type:
     "DPow_r(fn,r,A) \<subseteq> DPow(A) * DPow(A)"
 by (simp add: DPow_r_def measure_def, blast)
 
 
 subsection\<open>Limit Construction for Well-Orderings\<close>
 
 text\<open>Now we work towards the transfinite definition of wellorderings for
 \<^term>\<open>Lset(i)\<close>.  We assume as an inductive hypothesis that there is a family
 of wellorderings for smaller ordinals.\<close>
 
 definition
   rlimit :: "[i,i\<Rightarrow>i]\<Rightarrow>i" where
   \<comment> \<open>Expresses the wellordering at limit ordinals.  The conditional
       lets us remove the premise \<^term>\<open>Limit(i)\<close> from some theorems.\<close>
     "rlimit(i,r) \<equiv>
        if Limit(i) then 
          {z: Lset(i) * Lset(i).
           \<exists>x' x. z = <x',x> \<and>
                  (lrank(x') < lrank(x) |
                   (lrank(x') = lrank(x) \<and> <x',x> \<in> r(succ(lrank(x)))))}
        else 0"
 
 definition
   Lset_new :: "i\<Rightarrow>i" where
   \<comment> \<open>This constant denotes the set of elements introduced at level
       \<^term>\<open>succ(i)\<close>\<close>
     "Lset_new(i) \<equiv> {x \<in> Lset(succ(i)). lrank(x) = i}"
 
 lemma Limit_Lset_eq2:
     "Limit(i) \<Longrightarrow> Lset(i) = (\<Union>j\<in>i. Lset_new(j))"
 apply (simp add: Limit_Lset_eq)
 apply (rule equalityI)
  apply safe
  apply (subgoal_tac "Ord(y)")
   prefer 2 apply (blast intro: Ord_in_Ord Limit_is_Ord)
  apply (simp_all add: Limit_is_Ord Lset_iff_lrank_lt Lset_new_def
                       Ord_mem_iff_lt)
  apply (blast intro: lt_trans)
 apply (rule_tac x = "succ(lrank(x))" in bexI)
  apply (simp)
 apply (blast intro: Limit_has_succ ltD)
 done
 
 lemma wf_on_Lset:
     "wf[Lset(succ(j))](r(succ(j))) \<Longrightarrow> wf[Lset_new(j)](rlimit(i,r))"
 apply (simp add: wf_on_def Lset_new_def)
 apply (erule wf_subset)
 apply (simp add: rlimit_def, force)
 done
 
 lemma wf_on_rlimit:
     "(\<forall>j<i. wf[Lset(j)](r(j))) \<Longrightarrow> wf[Lset(i)](rlimit(i,r))"
 apply (case_tac "Limit(i)") 
  prefer 2
  apply (simp add: rlimit_def wf_on_any_0)
 apply (simp add: Limit_Lset_eq2)
 apply (rule wf_on_Union)
   apply (rule wf_imp_wf_on [OF wf_Memrel [of i]])
  apply (blast intro: wf_on_Lset Limit_has_succ Limit_is_Ord ltI)
 apply (force simp add: rlimit_def Limit_is_Ord Lset_iff_lrank_lt Lset_new_def
                        Ord_mem_iff_lt)
 done
 
 lemma linear_rlimit:
     "\<lbrakk>Limit(i); \<forall>j<i. linear(Lset(j), r(j))\<rbrakk>
      \<Longrightarrow> linear(Lset(i), rlimit(i,r))"
 apply (frule Limit_is_Ord)
 apply (simp add: Limit_Lset_eq2 Lset_new_def)
 apply (simp add: linear_def rlimit_def Ball_def lt_Ord Lset_iff_lrank_lt)
 apply (simp add: ltI, clarify)
 apply (rename_tac u v)
 apply (rule_tac i="lrank(u)" and j="lrank(v)" in Ord_linear_lt, simp_all) 
 apply (drule_tac x="succ(lrank(u) \<union> lrank(v))" in ospec)
  apply (simp add: ltI)
 apply (drule_tac x=u in spec, simp)
 apply (drule_tac x=v in spec, simp)
 done
 
 lemma well_ord_rlimit:
     "\<lbrakk>Limit(i); \<forall>j<i. well_ord(Lset(j), r(j))\<rbrakk>
      \<Longrightarrow> well_ord(Lset(i), rlimit(i,r))"
 by (blast intro: well_ordI wf_on_rlimit well_ord_is_wf
                            linear_rlimit well_ord_is_linear)
 
 lemma rlimit_cong:
      "(\<And>j. j<i \<Longrightarrow> r'(j) = r(j)) \<Longrightarrow> rlimit(i,r) = rlimit(i,r')"
 apply (simp add: rlimit_def, clarify) 
 apply (rule refl iff_refl Collect_cong ex_cong conj_cong)+
 apply (simp add: Limit_is_Ord Lset_lrank_lt)
 done
 
 
 subsection\<open>Transfinite Definition of the Wellordering on \<^term>\<open>L\<close>\<close>
 
 definition
   L_r :: "[i, i] \<Rightarrow> i" where
   "L_r(f) \<equiv> \<lambda>i.
       transrec3(i, 0, \<lambda>x r. DPow_r(f, r, Lset(x)), 
                 \<lambda>x r. rlimit(x, \<lambda>y. r`y))"
 
 subsubsection\<open>The Corresponding Recursion Equations\<close>
 lemma [simp]: "L_r(f,0) = 0"
 by (simp add: L_r_def)
 
 lemma [simp]: "L_r(f, succ(i)) = DPow_r(f, L_r(f,i), Lset(i))"
 by (simp add: L_r_def)
 
 text\<open>The limit case is non-trivial because of the distinction between
 object-level and meta-level abstraction.\<close>
 lemma [simp]: "Limit(i) \<Longrightarrow> L_r(f,i) = rlimit(i, L_r(f))"
 by (simp cong: rlimit_cong add: transrec3_Limit L_r_def ltD)
 
 lemma (in Nat_Times_Nat) L_r_type:
     "Ord(i) \<Longrightarrow> L_r(fn,i) \<subseteq> Lset(i) * Lset(i)"
 apply (induct i rule: trans_induct3)
   apply (simp_all add: Lset_succ DPow_r_type well_ord_DPow_r rlimit_def
                        Transset_subset_DPow [OF Transset_Lset], blast)
 done
 
 lemma (in Nat_Times_Nat) well_ord_L_r:
     "Ord(i) \<Longrightarrow> well_ord(Lset(i), L_r(fn,i))"
 apply (induct i rule: trans_induct3)
 apply (simp_all add: well_ord0 Lset_succ L_r_type well_ord_DPow_r
                      well_ord_rlimit ltD)
 done
 
 lemma well_ord_L_r:
     "Ord(i) \<Longrightarrow> \<exists>r. well_ord(Lset(i), r)"
 apply (insert nat_times_nat_lepoll_nat)
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (blast intro: Nat_Times_Nat.well_ord_L_r Nat_Times_Nat.intro)
 done
 
 
 text\<open>Every constructible set is well-ordered! Therefore the Wellordering Theorem and
       the Axiom of Choice hold in \<^term>\<open>L\<close>\<And>\<close>
 theorem L_implies_AC: assumes x: "L(x)" shows "\<exists>r. well_ord(x,r)"
   using Transset_Lset x
 apply (simp add: Transset_def L_def)
 apply (blast dest!: well_ord_L_r intro: well_ord_subset)
 done
 
 interpretation L: M_basic L by (rule M_basic_L)
 
 theorem "\<forall>x[L]. \<exists>r. wellordered(L,x,r)"
 proof 
   fix x
   assume "L(x)"
   then obtain r where "well_ord(x,r)" 
     by (blast dest: L_implies_AC) 
   thus "\<exists>r. wellordered(L,x,r)" 
     by (blast intro: L.well_ord_imp_relativized)
 qed
 
 text\<open>In order to prove \<^term>\<open> \<exists>r[L]. wellordered(L,x,r)\<close>, it's necessary to know 
 that \<^term>\<open>r\<close> is actually constructible. It follows from the assumption ``\<^term>\<open>V\<close> equals \<^term>\<open>L''\<close>, 
 but this reasoning doesn't appear to work in Isabelle.\<close>
 
 end
diff --git a/src/ZF/Constructible/DPow_absolute.thy b/src/ZF/Constructible/DPow_absolute.thy
--- a/src/ZF/Constructible/DPow_absolute.thy
+++ b/src/ZF/Constructible/DPow_absolute.thy
@@ -1,627 +1,627 @@
 (*  Title:      ZF/Constructible/DPow_absolute.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
 *)
 
 section \<open>Absoluteness for the Definable Powerset Function\<close>
 
 
 theory DPow_absolute imports Satisfies_absolute begin
 
 
 subsection\<open>Preliminary Internalizations\<close>
 
 subsubsection\<open>The Operator \<^term>\<open>is_formula_rec\<close>\<close>
 
 text\<open>The three arguments of \<^term>\<open>p\<close> are always 2, 1, 0.  It is buried
    within 11 quantifiers\<And>\<close>
 
 (* is_formula_rec :: "[i\<Rightarrow>o, [i,i,i]\<Rightarrow>o, i, i] \<Rightarrow> o"
    "is_formula_rec(M,MH,p,z)  \<equiv>
       \<exists>dp[M]. \<exists>i[M]. \<exists>f[M]. finite_ordinal(M,dp) \<and> is_depth(M,p,dp) \<and> 
        2       1      0
              successor(M,dp,i) \<and> fun_apply(M,f,p,z) \<and> is_transrec(M,MH,i,f)"
 *)
 
 definition
   formula_rec_fm :: "[i, i, i]\<Rightarrow>i" where
  "formula_rec_fm(mh,p,z) \<equiv> 
     Exists(Exists(Exists(
       And(finite_ordinal_fm(2),
        And(depth_fm(p#+3,2),
         And(succ_fm(2,1), 
           And(fun_apply_fm(0,p#+3,z#+3), is_transrec_fm(mh,1,0))))))))"
 
 lemma is_formula_rec_type [TC]:
      "\<lbrakk>p \<in> formula; x \<in> nat; z \<in> nat\<rbrakk>
       \<Longrightarrow> formula_rec_fm(p,x,z) \<in> formula"
 by (simp add: formula_rec_fm_def) 
 
 lemma sats_formula_rec_fm:
   assumes MH_iff_sats: 
       "\<And>a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10. 
         \<lbrakk>a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A; a4\<in>A; a5\<in>A; a6\<in>A; a7\<in>A; a8\<in>A; a9\<in>A; a10\<in>A\<rbrakk>
         \<Longrightarrow> MH(a2, a1, a0) \<longleftrightarrow> 
             sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,
                           Cons(a4,Cons(a5,Cons(a6,Cons(a7,
                                   Cons(a8,Cons(a9,Cons(a10,env))))))))))))"
   shows 
       "\<lbrakk>x \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> sats(A, formula_rec_fm(p,x,z), env) \<longleftrightarrow> 
            is_formula_rec(##A, MH, nth(x,env), nth(z,env))"
 by (simp add: formula_rec_fm_def sats_is_transrec_fm is_formula_rec_def 
               MH_iff_sats [THEN iff_sym])
 
 lemma formula_rec_iff_sats:
   assumes MH_iff_sats: 
       "\<And>a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10. 
         \<lbrakk>a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A; a4\<in>A; a5\<in>A; a6\<in>A; a7\<in>A; a8\<in>A; a9\<in>A; a10\<in>A\<rbrakk>
         \<Longrightarrow> MH(a2, a1, a0) \<longleftrightarrow> 
             sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,
                           Cons(a4,Cons(a5,Cons(a6,Cons(a7,
                                   Cons(a8,Cons(a9,Cons(a10,env))))))))))))"
   shows
   "\<lbrakk>nth(i,env) = x; nth(k,env) = z; 
       i \<in> nat; k \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> is_formula_rec(##A, MH, x, z) \<longleftrightarrow> sats(A, formula_rec_fm(p,i,k), env)" 
 by (simp add: sats_formula_rec_fm [OF MH_iff_sats])
 
 theorem formula_rec_reflection:
   assumes MH_reflection:
     "\<And>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_formula_rec(L, MH(L,x), f(x), h(x)), 
                \<lambda>i x. is_formula_rec(##Lset(i), MH(##Lset(i),x), f(x), h(x))]"
 apply (simp (no_asm_use) only: is_formula_rec_def)
 apply (intro FOL_reflections function_reflections fun_plus_reflections
              depth_reflection is_transrec_reflection MH_reflection)
 done
 
 
 subsubsection\<open>The Operator \<^term>\<open>is_satisfies\<close>\<close>
 
 (* is_satisfies(M,A,p,z) \<equiv> is_formula_rec (M, satisfies_MH(M,A), p, z) *)
 definition
   satisfies_fm :: "[i,i,i]\<Rightarrow>i" where
     "satisfies_fm(x) \<equiv> formula_rec_fm (satisfies_MH_fm(x#+5#+6, 2, 1, 0))"
 
 lemma is_satisfies_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> satisfies_fm(x,y,z) \<in> formula"
 by (simp add: satisfies_fm_def)
 
 lemma sats_satisfies_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, satisfies_fm(x,y,z), env) \<longleftrightarrow>
         is_satisfies(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: satisfies_fm_def is_satisfies_def sats_formula_rec_fm)
 
 lemma satisfies_iff_sats:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> is_satisfies(##A, x, y, z) \<longleftrightarrow> sats(A, satisfies_fm(i,j,k), env)"
 by (simp)
 
 theorem satisfies_reflection:
      "REFLECTS[\<lambda>x. is_satisfies(L,f(x),g(x),h(x)),
                \<lambda>i x. is_satisfies(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: is_satisfies_def)
 apply (intro formula_rec_reflection satisfies_MH_reflection)
 done
 
 
 subsection \<open>Relativization of the Operator \<^term>\<open>DPow'\<close>\<close>
 
 lemma DPow'_eq: 
   "DPow'(A) = {z . ep \<in> list(A) * formula, 
                     \<exists>env \<in> list(A). \<exists>p \<in> formula. 
                        ep = \<langle>env,p\<rangle> \<and> z = {x\<in>A. sats(A, p, Cons(x,env))}}"
 by (simp add: DPow'_def, blast) 
 
 
 text\<open>Relativize the use of \<^term>\<open>sats\<close> within \<^term>\<open>DPow'\<close>
 (the comprehension).\<close>
 definition
   is_DPow_sats :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
    "is_DPow_sats(M,A,env,p,x) \<equiv>
       \<forall>n1[M]. \<forall>e[M]. \<forall>sp[M]. 
              is_satisfies(M,A,p,sp) \<longrightarrow> is_Cons(M,x,env,e) \<longrightarrow> 
              fun_apply(M, sp, e, n1) \<longrightarrow> number1(M, n1)"
 
 lemma (in M_satisfies) DPow_sats_abs:
     "\<lbrakk>M(A); env \<in> list(A); p \<in> formula; M(x)\<rbrakk>
     \<Longrightarrow> is_DPow_sats(M,A,env,p,x) \<longleftrightarrow> sats(A, p, Cons(x,env))"
 apply (subgoal_tac "M(env)") 
  apply (simp add: is_DPow_sats_def satisfies_closed satisfies_abs) 
 apply (blast dest: transM) 
 done
 
 lemma (in M_satisfies) Collect_DPow_sats_abs:
     "\<lbrakk>M(A); env \<in> list(A); p \<in> formula\<rbrakk>
     \<Longrightarrow> Collect(A, is_DPow_sats(M,A,env,p)) = 
         {x \<in> A. sats(A, p, Cons(x,env))}"
 by (simp add: DPow_sats_abs transM [of _ A])
 
 
 subsubsection\<open>The Operator \<^term>\<open>is_DPow_sats\<close>, Internalized\<close>
 
 (* is_DPow_sats(M,A,env,p,x) \<equiv>
       \<forall>n1[M]. \<forall>e[M]. \<forall>sp[M]. 
              is_satisfies(M,A,p,sp) \<longrightarrow> is_Cons(M,x,env,e) \<longrightarrow> 
              fun_apply(M, sp, e, n1) \<longrightarrow> number1(M, n1) *)
 
 definition
   DPow_sats_fm :: "[i,i,i,i]\<Rightarrow>i" where
   "DPow_sats_fm(A,env,p,x) \<equiv>
    Forall(Forall(Forall(
      Implies(satisfies_fm(A#+3,p#+3,0), 
        Implies(Cons_fm(x#+3,env#+3,1), 
          Implies(fun_apply_fm(0,1,2), number1_fm(2)))))))"
 
 lemma is_DPow_sats_type [TC]:
      "\<lbrakk>A \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk>
       \<Longrightarrow> DPow_sats_fm(A,x,y,z) \<in> formula"
 by (simp add: DPow_sats_fm_def)
 
 lemma sats_DPow_sats_fm [simp]:
    "\<lbrakk>u \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, DPow_sats_fm(u,x,y,z), env) \<longleftrightarrow>
         is_DPow_sats(##A, nth(u,env), nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: DPow_sats_fm_def is_DPow_sats_def)
 
 lemma DPow_sats_iff_sats:
   "\<lbrakk>nth(u,env) = nu; nth(x,env) = nx; nth(y,env) = ny; nth(z,env) = nz;
       u \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> is_DPow_sats(##A,nu,nx,ny,nz) \<longleftrightarrow>
        sats(A, DPow_sats_fm(u,x,y,z), env)"
 by simp
 
 theorem DPow_sats_reflection:
      "REFLECTS[\<lambda>x. is_DPow_sats(L,f(x),g(x),h(x),g'(x)),
                \<lambda>i x. is_DPow_sats(##Lset(i),f(x),g(x),h(x),g'(x))]"
-apply (unfold is_DPow_sats_def) 
+  unfolding is_DPow_sats_def 
 apply (intro FOL_reflections function_reflections extra_reflections
              satisfies_reflection)
 done
 
 
 subsection\<open>A Locale for Relativizing the Operator \<^term>\<open>DPow'\<close>\<close>
 
 locale M_DPow = M_satisfies +
  assumes sep:
    "\<lbrakk>M(A); env \<in> list(A); p \<in> formula\<rbrakk>
     \<Longrightarrow> separation(M, \<lambda>x. is_DPow_sats(M,A,env,p,x))"
  and rep: 
     "M(A)
     \<Longrightarrow> strong_replacement (M, 
          \<lambda>ep z. \<exists>env[M]. \<exists>p[M]. mem_formula(M,p) \<and> mem_list(M,A,env) \<and>
                   pair(M,env,p,ep) \<and> 
                   is_Collect(M, A, \<lambda>x. is_DPow_sats(M,A,env,p,x), z))"
 
 lemma (in M_DPow) sep':
    "\<lbrakk>M(A); env \<in> list(A); p \<in> formula\<rbrakk>
     \<Longrightarrow> separation(M, \<lambda>x. sats(A, p, Cons(x,env)))"
 by (insert sep [of A env p], simp add: DPow_sats_abs)
 
 lemma (in M_DPow) rep':
    "M(A)
     \<Longrightarrow> strong_replacement (M, 
          \<lambda>ep z. \<exists>env\<in>list(A). \<exists>p\<in>formula.
                   ep = \<langle>env,p\<rangle> \<and> z = {x \<in> A . sats(A, p, Cons(x, env))})" 
 by (insert rep [of A], simp add: Collect_DPow_sats_abs) 
 
 
 lemma univalent_pair_eq:
      "univalent (M, A, \<lambda>xy z. \<exists>x\<in>B. \<exists>y\<in>C. xy = \<langle>x,y\<rangle> \<and> z = f(x,y))"
 by (simp add: univalent_def, blast) 
 
 lemma (in M_DPow) DPow'_closed: "M(A) \<Longrightarrow> M(DPow'(A))"
 apply (simp add: DPow'_eq)
 apply (fast intro: rep' sep' univalent_pair_eq)  
 done
 
 text\<open>Relativization of the Operator \<^term>\<open>DPow'\<close>\<close>
 definition 
   is_DPow' :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
     "is_DPow'(M,A,Z) \<equiv> 
        \<forall>X[M]. X \<in> Z \<longleftrightarrow> 
          subset(M,X,A) \<and> 
            (\<exists>env[M]. \<exists>p[M]. mem_formula(M,p) \<and> mem_list(M,A,env) \<and>
                     is_Collect(M, A, is_DPow_sats(M,A,env,p), X))"
 
 lemma (in M_DPow) DPow'_abs:
     "\<lbrakk>M(A); M(Z)\<rbrakk> \<Longrightarrow> is_DPow'(M,A,Z) \<longleftrightarrow> Z = DPow'(A)"
 apply (rule iffI)
  prefer 2 apply (simp add: is_DPow'_def DPow'_def Collect_DPow_sats_abs) 
 apply (rule M_equalityI) 
 apply (simp add: is_DPow'_def DPow'_def Collect_DPow_sats_abs, assumption)
 apply (erule DPow'_closed)
 done
 
 
 subsection\<open>Instantiating the Locale \<open>M_DPow\<close>\<close>
 
 subsubsection\<open>The Instance of Separation\<close>
 
 lemma DPow_separation:
     "\<lbrakk>L(A); env \<in> list(A); p \<in> formula\<rbrakk>
      \<Longrightarrow> separation(L, \<lambda>x. is_DPow_sats(L,A,env,p,x))"
 apply (rule gen_separation_multi [OF DPow_sats_reflection, of "{A,env,p}"], 
        auto intro: transL)
 apply (rule_tac env="[A,env,p]" in DPow_LsetI)
 apply (rule DPow_sats_iff_sats sep_rules | simp)+
 done
 
 
 
 subsubsection\<open>The Instance of Replacement\<close>
 
 lemma DPow_replacement_Reflects:
  "REFLECTS [\<lambda>x. \<exists>u[L]. u \<in> B \<and>
              (\<exists>env[L]. \<exists>p[L].
                mem_formula(L,p) \<and> mem_list(L,A,env) \<and> pair(L,env,p,u) \<and>
                is_Collect (L, A, is_DPow_sats(L,A,env,p), x)),
     \<lambda>i x. \<exists>u \<in> Lset(i). u \<in> B \<and>
              (\<exists>env \<in> Lset(i). \<exists>p \<in> Lset(i).
                mem_formula(##Lset(i),p) \<and> mem_list(##Lset(i),A,env) \<and> 
                pair(##Lset(i),env,p,u) \<and>
                is_Collect (##Lset(i), A, is_DPow_sats(##Lset(i),A,env,p), x))]"
-apply (unfold is_Collect_def) 
+  unfolding is_Collect_def 
 apply (intro FOL_reflections function_reflections mem_formula_reflection
           mem_list_reflection DPow_sats_reflection)
 done
 
 lemma DPow_replacement:
     "L(A)
     \<Longrightarrow> strong_replacement (L, 
          \<lambda>ep z. \<exists>env[L]. \<exists>p[L]. mem_formula(L,p) \<and> mem_list(L,A,env) \<and>
                   pair(L,env,p,ep) \<and> 
                   is_Collect(L, A, \<lambda>x. is_DPow_sats(L,A,env,p,x), z))"
 apply (rule strong_replacementI)
 apply (rule_tac u="{A,B}" 
          in gen_separation_multi [OF DPow_replacement_Reflects], 
        auto)
-apply (unfold is_Collect_def) 
+  unfolding is_Collect_def 
 apply (rule_tac env="[A,B]" in DPow_LsetI)
 apply (rule sep_rules mem_formula_iff_sats mem_list_iff_sats 
             DPow_sats_iff_sats | simp)+
 done
 
 
 subsubsection\<open>Actually Instantiating the Locale\<close>
 
 lemma M_DPow_axioms_L: "M_DPow_axioms(L)"
   apply (rule M_DPow_axioms.intro)
    apply (assumption | rule DPow_separation DPow_replacement)+
   done
 
 theorem M_DPow_L: "M_DPow(L)"
   apply (rule M_DPow.intro)
    apply (rule M_satisfies_L)
   apply (rule M_DPow_axioms_L)
   done
 
 lemmas DPow'_closed [intro, simp] = M_DPow.DPow'_closed [OF M_DPow_L]
   and DPow'_abs [intro, simp] = M_DPow.DPow'_abs [OF M_DPow_L]
 
 
 subsubsection\<open>The Operator \<^term>\<open>is_Collect\<close>\<close>
 
 text\<open>The formula \<^term>\<open>is_P\<close> has one free variable, 0, and it is
 enclosed within a single quantifier.\<close>
 
 (* is_Collect :: "[i\<Rightarrow>o,i,i\<Rightarrow>o,i] \<Rightarrow> o"
     "is_Collect(M,A,P,z) \<equiv> \<forall>x[M]. x \<in> z \<longleftrightarrow> x \<in> A \<and> P(x)" *)
 
 definition
   Collect_fm :: "[i, i, i]\<Rightarrow>i" where
  "Collect_fm(A,is_P,z) \<equiv> 
         Forall(Iff(Member(0,succ(z)),
                    And(Member(0,succ(A)), is_P)))"
 
 lemma is_Collect_type [TC]:
      "\<lbrakk>is_P \<in> formula; x \<in> nat; y \<in> nat\<rbrakk> 
       \<Longrightarrow> Collect_fm(x,is_P,y) \<in> formula"
 by (simp add: Collect_fm_def)
 
 lemma sats_Collect_fm:
   assumes is_P_iff_sats: 
       "\<And>a. a \<in> A \<Longrightarrow> is_P(a) \<longleftrightarrow> sats(A, p, Cons(a, env))"
   shows 
       "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> sats(A, Collect_fm(x,p,y), env) \<longleftrightarrow>
            is_Collect(##A, nth(x,env), is_P, nth(y,env))"
 by (simp add: Collect_fm_def is_Collect_def is_P_iff_sats [THEN iff_sym])
 
 lemma Collect_iff_sats:
   assumes is_P_iff_sats: 
       "\<And>a. a \<in> A \<Longrightarrow> is_P(a) \<longleftrightarrow> sats(A, p, Cons(a, env))"
   shows 
   "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
       i \<in> nat; j \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> is_Collect(##A, x, is_P, y) \<longleftrightarrow> sats(A, Collect_fm(i,p,j), env)"
 by (simp add: sats_Collect_fm [OF is_P_iff_sats])
 
 
 text\<open>The second argument of \<^term>\<open>is_P\<close> gives it direct access to \<^term>\<open>x\<close>,
   which is essential for handling free variable references.\<close>
 theorem Collect_reflection:
   assumes is_P_reflection:
     "\<And>h f g. REFLECTS[\<lambda>x. is_P(L, f(x), g(x)),
                      \<lambda>i x. is_P(##Lset(i), f(x), g(x))]"
   shows "REFLECTS[\<lambda>x. is_Collect(L, f(x), is_P(L,x), g(x)),
                \<lambda>i x. is_Collect(##Lset(i), f(x), is_P(##Lset(i), x), g(x))]"
 apply (simp (no_asm_use) only: is_Collect_def)
 apply (intro FOL_reflections is_P_reflection)
 done
 
 
 subsubsection\<open>The Operator \<^term>\<open>is_Replace\<close>\<close>
 
 text\<open>BEWARE!  The formula \<^term>\<open>is_P\<close> has free variables 0, 1
  and not the usual 1, 0!  It is enclosed within two quantifiers.\<close>
 
 (*  is_Replace :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>o,i] \<Rightarrow> o"
     "is_Replace(M,A,P,z) \<equiv> \<forall>u[M]. u \<in> z \<longleftrightarrow> (\<exists>x[M]. x\<in>A \<and> P(x,u))" *)
 
 definition
   Replace_fm :: "[i, i, i]\<Rightarrow>i" where
   "Replace_fm(A,is_P,z) \<equiv> 
         Forall(Iff(Member(0,succ(z)),
                    Exists(And(Member(0,A#+2), is_P))))"
 
 lemma is_Replace_type [TC]:
      "\<lbrakk>is_P \<in> formula; x \<in> nat; y \<in> nat\<rbrakk> 
       \<Longrightarrow> Replace_fm(x,is_P,y) \<in> formula"
 by (simp add: Replace_fm_def)
 
 lemma sats_Replace_fm:
   assumes is_P_iff_sats: 
       "\<And>a b. \<lbrakk>a \<in> A; b \<in> A\<rbrakk> 
               \<Longrightarrow> is_P(a,b) \<longleftrightarrow> sats(A, p, Cons(a,Cons(b,env)))"
   shows 
       "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> sats(A, Replace_fm(x,p,y), env) \<longleftrightarrow>
            is_Replace(##A, nth(x,env), is_P, nth(y,env))"
 by (simp add: Replace_fm_def is_Replace_def is_P_iff_sats [THEN iff_sym])
 
 lemma Replace_iff_sats:
   assumes is_P_iff_sats: 
       "\<And>a b. \<lbrakk>a \<in> A; b \<in> A\<rbrakk> 
               \<Longrightarrow> is_P(a,b) \<longleftrightarrow> sats(A, p, Cons(a,Cons(b,env)))"
   shows 
   "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
       i \<in> nat; j \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> is_Replace(##A, x, is_P, y) \<longleftrightarrow> sats(A, Replace_fm(i,p,j), env)"
 by (simp add: sats_Replace_fm [OF is_P_iff_sats])
 
 
 text\<open>The second argument of \<^term>\<open>is_P\<close> gives it direct access to \<^term>\<open>x\<close>,
   which is essential for handling free variable references.\<close>
 theorem Replace_reflection:
   assumes is_P_reflection:
     "\<And>h f g. REFLECTS[\<lambda>x. is_P(L, f(x), g(x), h(x)),
                      \<lambda>i x. is_P(##Lset(i), f(x), g(x), h(x))]"
   shows "REFLECTS[\<lambda>x. is_Replace(L, f(x), is_P(L,x), g(x)),
                \<lambda>i x. is_Replace(##Lset(i), f(x), is_P(##Lset(i), x), g(x))]"
 apply (simp (no_asm_use) only: is_Replace_def)
 apply (intro FOL_reflections is_P_reflection)
 done
 
 
 
 subsubsection\<open>The Operator \<^term>\<open>is_DPow'\<close>, Internalized\<close>
 
 (*  "is_DPow'(M,A,Z) \<equiv> 
        \<forall>X[M]. X \<in> Z \<longleftrightarrow> 
          subset(M,X,A) \<and> 
            (\<exists>env[M]. \<exists>p[M]. mem_formula(M,p) \<and> mem_list(M,A,env) \<and>
                     is_Collect(M, A, is_DPow_sats(M,A,env,p), X))" *)
 
 definition
   DPow'_fm :: "[i,i]\<Rightarrow>i" where
     "DPow'_fm(A,Z) \<equiv> 
       Forall(
        Iff(Member(0,succ(Z)),
         And(subset_fm(0,succ(A)),
          Exists(Exists(
           And(mem_formula_fm(0),
            And(mem_list_fm(A#+3,1),
             Collect_fm(A#+3, 
                        DPow_sats_fm(A#+4, 2, 1, 0), 2))))))))"
 
 lemma is_DPow'_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> DPow'_fm(x,y) \<in> formula"
 by (simp add: DPow'_fm_def)
 
 lemma sats_DPow'_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, DPow'_fm(x,y), env) \<longleftrightarrow>
         is_DPow'(##A, nth(x,env), nth(y,env))"
 by (simp add: DPow'_fm_def is_DPow'_def sats_subset_fm' sats_Collect_fm)
 
 lemma DPow'_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y; 
           i \<in> nat; j \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> is_DPow'(##A, x, y) \<longleftrightarrow> sats(A, DPow'_fm(i,j), env)"
 by (simp)
 
 theorem DPow'_reflection:
      "REFLECTS[\<lambda>x. is_DPow'(L,f(x),g(x)),
                \<lambda>i x. is_DPow'(##Lset(i),f(x),g(x))]"
 apply (simp only: is_DPow'_def)
 apply (intro FOL_reflections function_reflections mem_formula_reflection
              mem_list_reflection Collect_reflection DPow_sats_reflection)
 done
 
 
 subsection\<open>A Locale for Relativizing the Operator \<^term>\<open>Lset\<close>\<close>
 
 definition
   transrec_body :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
     "transrec_body(M,g,x) \<equiv>
       \<lambda>y z. \<exists>gy[M]. y \<in> x \<and> fun_apply(M,g,y,gy) \<and> is_DPow'(M,gy,z)"
 
 lemma (in M_DPow) transrec_body_abs:
      "\<lbrakk>M(x); M(g); M(z)\<rbrakk>
     \<Longrightarrow> transrec_body(M,g,x,y,z) \<longleftrightarrow> y \<in> x \<and> z = DPow'(g`y)"
 by (simp add: transrec_body_def DPow'_abs transM [of _ x])
 
 locale M_Lset = M_DPow +
  assumes strong_rep:
    "\<lbrakk>M(x); M(g)\<rbrakk> \<Longrightarrow> strong_replacement(M, \<lambda>y z. transrec_body(M,g,x,y,z))"
  and transrec_rep: 
     "M(i) \<Longrightarrow> transrec_replacement(M, \<lambda>x f u. 
               \<exists>r[M]. is_Replace(M, x, transrec_body(M,f,x), r) \<and> 
                      big_union(M, r, u), i)"
 
 
 lemma (in M_Lset) strong_rep':
    "\<lbrakk>M(x); M(g)\<rbrakk>
     \<Longrightarrow> strong_replacement(M, \<lambda>y z. y \<in> x \<and> z = DPow'(g`y))"
 by (insert strong_rep [of x g], simp add: transrec_body_abs)
 
 lemma (in M_Lset) DPow_apply_closed:
    "\<lbrakk>M(f); M(x); y\<in>x\<rbrakk> \<Longrightarrow> M(DPow'(f`y))"
 by (blast intro: DPow'_closed dest: transM) 
 
 lemma (in M_Lset) RepFun_DPow_apply_closed:
    "\<lbrakk>M(f); M(x)\<rbrakk> \<Longrightarrow> M({DPow'(f`y). y\<in>x})"
 by (blast intro: DPow_apply_closed RepFun_closed2 strong_rep') 
 
 lemma (in M_Lset) RepFun_DPow_abs:
      "\<lbrakk>M(x); M(f); M(r)\<rbrakk>
       \<Longrightarrow> is_Replace(M, x, \<lambda>y z. transrec_body(M,f,x,y,z), r) \<longleftrightarrow>
           r =  {DPow'(f`y). y\<in>x}"
 apply (simp add: transrec_body_abs RepFun_def) 
 apply (rule iff_trans) 
 apply (rule Replace_abs) 
 apply (simp_all add: DPow_apply_closed strong_rep') 
 done
 
 lemma (in M_Lset) transrec_rep':
    "M(i) \<Longrightarrow> transrec_replacement(M, \<lambda>x f u. u = (\<Union>y\<in>x. DPow'(f ` y)), i)"
 apply (insert transrec_rep [of i]) 
 apply (simp add: RepFun_DPow_apply_closed RepFun_DPow_abs 
        transrec_replacement_def) 
 done
 
 
 text\<open>Relativization of the Operator \<^term>\<open>Lset\<close>\<close>
 
 definition
   is_Lset :: "[i\<Rightarrow>o, i, i] \<Rightarrow> o" where
    \<comment> \<open>We can use the term language below because \<^term>\<open>is_Lset\<close> will
        not have to be internalized: it isn't used in any instance of
        separation.\<close>
    "is_Lset(M,a,z) \<equiv> is_transrec(M, \<lambda>x f u. u = (\<Union>y\<in>x. DPow'(f`y)), a, z)"
 
 lemma (in M_Lset) Lset_abs:
   "\<lbrakk>Ord(i);  M(i);  M(z)\<rbrakk> 
    \<Longrightarrow> is_Lset(M,i,z) \<longleftrightarrow> z = Lset(i)"
 apply (simp add: is_Lset_def Lset_eq_transrec_DPow') 
 apply (rule transrec_abs)  
 apply (simp_all add: transrec_rep' relation2_def RepFun_DPow_apply_closed)
 done
 
 lemma (in M_Lset) Lset_closed:
   "\<lbrakk>Ord(i);  M(i)\<rbrakk> \<Longrightarrow> M(Lset(i))"
 apply (simp add: Lset_eq_transrec_DPow') 
 apply (rule transrec_closed [OF transrec_rep']) 
 apply (simp_all add: relation2_def RepFun_DPow_apply_closed)
 done
 
 
 subsection\<open>Instantiating the Locale \<open>M_Lset\<close>\<close>
 
 subsubsection\<open>The First Instance of Replacement\<close>
 
 lemma strong_rep_Reflects:
  "REFLECTS [\<lambda>u. \<exists>v[L]. v \<in> B \<and> (\<exists>gy[L].
                           v \<in> x \<and> fun_apply(L,g,v,gy) \<and> is_DPow'(L,gy,u)),
    \<lambda>i u. \<exists>v \<in> Lset(i). v \<in> B \<and> (\<exists>gy \<in> Lset(i).
             v \<in> x \<and> fun_apply(##Lset(i),g,v,gy) \<and> is_DPow'(##Lset(i),gy,u))]"
 by (intro FOL_reflections function_reflections DPow'_reflection)
 
 lemma strong_rep:
    "\<lbrakk>L(x); L(g)\<rbrakk> \<Longrightarrow> strong_replacement(L, \<lambda>y z. transrec_body(L,g,x,y,z))"
-apply (unfold transrec_body_def)  
+  unfolding transrec_body_def  
 apply (rule strong_replacementI) 
 apply (rule_tac u="{x,g,B}" 
          in gen_separation_multi [OF strong_rep_Reflects], auto)
 apply (rule_tac env="[x,g,B]" in DPow_LsetI)
 apply (rule sep_rules DPow'_iff_sats | simp)+
 done
 
 
 subsubsection\<open>The Second Instance of Replacement\<close>
 
 lemma transrec_rep_Reflects:
  "REFLECTS [\<lambda>x. \<exists>v[L]. v \<in> B \<and>
               (\<exists>y[L]. pair(L,v,y,x) \<and>
              is_wfrec (L, \<lambda>x f u. \<exists>r[L].
                 is_Replace (L, x, \<lambda>y z. 
                      \<exists>gy[L]. y \<in> x \<and> fun_apply(L,f,y,gy) \<and> 
                       is_DPow'(L,gy,z), r) \<and> big_union(L,r,u), mr, v, y)),
     \<lambda>i x. \<exists>v \<in> Lset(i). v \<in> B \<and>
               (\<exists>y \<in> Lset(i). pair(##Lset(i),v,y,x) \<and>
              is_wfrec (##Lset(i), \<lambda>x f u. \<exists>r \<in> Lset(i).
                 is_Replace (##Lset(i), x, \<lambda>y z. 
                      \<exists>gy \<in> Lset(i). y \<in> x \<and> fun_apply(##Lset(i),f,y,gy) \<and> 
                       is_DPow'(##Lset(i),gy,z), r) \<and> 
                       big_union(##Lset(i),r,u), mr, v, y))]" 
 apply (simp only: rex_setclass_is_bex [symmetric])
   \<comment> \<open>Convert \<open>\<exists>y\<in>Lset(i)\<close> to \<open>\<exists>y[##Lset(i)]\<close> within the body
        of the \<^term>\<open>is_wfrec\<close> application.\<close>
 apply (intro FOL_reflections function_reflections 
           is_wfrec_reflection Replace_reflection DPow'_reflection) 
 done
 
 
 lemma transrec_rep: 
     "\<lbrakk>L(j)\<rbrakk>
     \<Longrightarrow> transrec_replacement(L, \<lambda>x f u. 
               \<exists>r[L]. is_Replace(L, x, transrec_body(L,f,x), r) \<and> 
                      big_union(L, r, u), j)"
 apply (rule L.transrec_replacementI, assumption)
-apply (unfold transrec_body_def)  
+  unfolding transrec_body_def  
 apply (rule strong_replacementI)
 apply (rule_tac u="{j,B,Memrel(eclose({j}))}" 
          in gen_separation_multi [OF transrec_rep_Reflects], auto)
 apply (rule_tac env="[j,B,Memrel(eclose({j}))]" in DPow_LsetI)
 apply (rule sep_rules is_wfrec_iff_sats Replace_iff_sats DPow'_iff_sats | 
        simp)+
 done
 
 
 subsubsection\<open>Actually Instantiating \<open>M_Lset\<close>\<close>
 
 lemma M_Lset_axioms_L: "M_Lset_axioms(L)"
   apply (rule M_Lset_axioms.intro)
        apply (assumption | rule strong_rep transrec_rep)+
   done
 
 theorem M_Lset_L: "M_Lset(L)"
   apply (rule M_Lset.intro) 
    apply (rule M_DPow_L)
   apply (rule M_Lset_axioms_L) 
   done
 
 text\<open>Finally: the point of the whole theory!\<close>
 lemmas Lset_closed = M_Lset.Lset_closed [OF M_Lset_L]
    and Lset_abs = M_Lset.Lset_abs [OF M_Lset_L]
 
 
 subsection\<open>The Notion of Constructible Set\<close>
 
 definition
   constructible :: "[i\<Rightarrow>o,i] \<Rightarrow> o" where
     "constructible(M,x) \<equiv>
        \<exists>i[M]. \<exists>Li[M]. ordinal(M,i) \<and> is_Lset(M,i,Li) \<and> x \<in> Li"
 
 theorem V_equals_L_in_L:
   "L(x) \<longleftrightarrow> constructible(L,x)"
 apply (simp add: constructible_def Lset_abs Lset_closed)
 apply (simp add: L_def)
 apply (blast intro: Ord_in_L) 
 done
 
 end
diff --git a/src/ZF/Constructible/Formula.thy b/src/ZF/Constructible/Formula.thy
--- a/src/ZF/Constructible/Formula.thy
+++ b/src/ZF/Constructible/Formula.thy
@@ -1,1040 +1,1040 @@
 (*  Title:      ZF/Constructible/Formula.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
 *)
 
 section \<open>First-Order Formulas and the Definition of the Class L\<close>
 
 theory Formula imports ZF begin
 
 subsection\<open>Internalized formulas of FOL\<close>
 
 text\<open>De Bruijn representation.
   Unbound variables get their denotations from an environment.\<close>
 
 consts   formula :: i
 datatype
   "formula" = Member ("x \<in> nat", "y \<in> nat")
             | Equal  ("x \<in> nat", "y \<in> nat")
             | Nand ("p \<in> formula", "q \<in> formula")
             | Forall ("p \<in> formula")
 
 declare formula.intros [TC]
 
 definition
   Neg :: "i\<Rightarrow>i" where
   "Neg(p) \<equiv> Nand(p,p)"
 
 definition
   And :: "[i,i]\<Rightarrow>i" where
   "And(p,q) \<equiv> Neg(Nand(p,q))"
 
 definition
   Or :: "[i,i]\<Rightarrow>i" where
   "Or(p,q) \<equiv> Nand(Neg(p),Neg(q))"
 
 definition
   Implies :: "[i,i]\<Rightarrow>i" where
   "Implies(p,q) \<equiv> Nand(p,Neg(q))"
 
 definition
   Iff :: "[i,i]\<Rightarrow>i" where
   "Iff(p,q) \<equiv> And(Implies(p,q), Implies(q,p))"
 
 definition
   Exists :: "i\<Rightarrow>i" where
   "Exists(p) \<equiv> Neg(Forall(Neg(p)))"
 
 lemma Neg_type [TC]: "p \<in> formula \<Longrightarrow> Neg(p) \<in> formula"
 by (simp add: Neg_def)
 
 lemma And_type [TC]: "\<lbrakk>p \<in> formula; q \<in> formula\<rbrakk> \<Longrightarrow> And(p,q) \<in> formula"
 by (simp add: And_def)
 
 lemma Or_type [TC]: "\<lbrakk>p \<in> formula; q \<in> formula\<rbrakk> \<Longrightarrow> Or(p,q) \<in> formula"
 by (simp add: Or_def)
 
 lemma Implies_type [TC]:
      "\<lbrakk>p \<in> formula; q \<in> formula\<rbrakk> \<Longrightarrow> Implies(p,q) \<in> formula"
 by (simp add: Implies_def)
 
 lemma Iff_type [TC]:
      "\<lbrakk>p \<in> formula; q \<in> formula\<rbrakk> \<Longrightarrow> Iff(p,q) \<in> formula"
 by (simp add: Iff_def)
 
 lemma Exists_type [TC]: "p \<in> formula \<Longrightarrow> Exists(p) \<in> formula"
 by (simp add: Exists_def)
 
 
 consts   satisfies :: "[i,i]\<Rightarrow>i"
 primrec (*explicit lambda is required because the environment varies*)
   "satisfies(A,Member(x,y)) =
       (\<lambda>env \<in> list(A). bool_of_o (nth(x,env) \<in> nth(y,env)))"
 
   "satisfies(A,Equal(x,y)) =
       (\<lambda>env \<in> list(A). bool_of_o (nth(x,env) = nth(y,env)))"
 
   "satisfies(A,Nand(p,q)) =
       (\<lambda>env \<in> list(A). not ((satisfies(A,p)`env) and (satisfies(A,q)`env)))"
 
   "satisfies(A,Forall(p)) =
       (\<lambda>env \<in> list(A). bool_of_o (\<forall>x\<in>A. satisfies(A,p) ` (Cons(x,env)) = 1))"
 
 
 lemma satisfies_type: "p \<in> formula \<Longrightarrow> satisfies(A,p) \<in> list(A) -> bool"
 by (induct set: formula) simp_all
 
 abbreviation
   sats :: "[i,i,i] \<Rightarrow> o" where
   "sats(A,p,env) \<equiv> satisfies(A,p)`env = 1"
 
 lemma sats_Member_iff [simp]:
   "env \<in> list(A) \<Longrightarrow> sats(A, Member(x,y), env) \<longleftrightarrow> nth(x,env) \<in> nth(y,env)"
 by simp
 
 lemma sats_Equal_iff [simp]:
   "env \<in> list(A) \<Longrightarrow> sats(A, Equal(x,y), env) \<longleftrightarrow> nth(x,env) = nth(y,env)"
 by simp
 
 lemma sats_Nand_iff [simp]:
   "env \<in> list(A)
    \<Longrightarrow> (sats(A, Nand(p,q), env)) \<longleftrightarrow> \<not> (sats(A,p,env) \<and> sats(A,q,env))"
 by (simp add: Bool.and_def Bool.not_def cond_def)
 
 lemma sats_Forall_iff [simp]:
   "env \<in> list(A)
    \<Longrightarrow> sats(A, Forall(p), env) \<longleftrightarrow> (\<forall>x\<in>A. sats(A, p, Cons(x,env)))"
 by simp
 
 declare satisfies.simps [simp del]
 
 subsection\<open>Dividing line between primitive and derived connectives\<close>
 
 lemma sats_Neg_iff [simp]:
   "env \<in> list(A)
    \<Longrightarrow> sats(A, Neg(p), env) \<longleftrightarrow> \<not> sats(A,p,env)"
 by (simp add: Neg_def)
 
 lemma sats_And_iff [simp]:
   "env \<in> list(A)
    \<Longrightarrow> (sats(A, And(p,q), env)) \<longleftrightarrow> sats(A,p,env) \<and> sats(A,q,env)"
 by (simp add: And_def)
 
 lemma sats_Or_iff [simp]:
   "env \<in> list(A)
    \<Longrightarrow> (sats(A, Or(p,q), env)) \<longleftrightarrow> sats(A,p,env) | sats(A,q,env)"
 by (simp add: Or_def)
 
 lemma sats_Implies_iff [simp]:
   "env \<in> list(A)
    \<Longrightarrow> (sats(A, Implies(p,q), env)) \<longleftrightarrow> (sats(A,p,env) \<longrightarrow> sats(A,q,env))"
 by (simp add: Implies_def, blast)
 
 lemma sats_Iff_iff [simp]:
   "env \<in> list(A)
    \<Longrightarrow> (sats(A, Iff(p,q), env)) \<longleftrightarrow> (sats(A,p,env) \<longleftrightarrow> sats(A,q,env))"
 by (simp add: Iff_def, blast)
 
 lemma sats_Exists_iff [simp]:
   "env \<in> list(A)
    \<Longrightarrow> sats(A, Exists(p), env) \<longleftrightarrow> (\<exists>x\<in>A. sats(A, p, Cons(x,env)))"
 by (simp add: Exists_def)
 
 
 subsubsection\<open>Derived rules to help build up formulas\<close>
 
 lemma mem_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> (x\<in>y) \<longleftrightarrow> sats(A, Member(i,j), env)"
 by (simp add: satisfies.simps)
 
 lemma equal_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> (x=y) \<longleftrightarrow> sats(A, Equal(i,j), env)"
 by (simp add: satisfies.simps)
 
 lemma not_iff_sats:
       "\<lbrakk>P \<longleftrightarrow> sats(A,p,env); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> (\<not>P) \<longleftrightarrow> sats(A, Neg(p), env)"
 by simp
 
 lemma conj_iff_sats:
       "\<lbrakk>P \<longleftrightarrow> sats(A,p,env); Q \<longleftrightarrow> sats(A,q,env); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> (P \<and> Q) \<longleftrightarrow> sats(A, And(p,q), env)"
 by (simp)
 
 lemma disj_iff_sats:
       "\<lbrakk>P \<longleftrightarrow> sats(A,p,env); Q \<longleftrightarrow> sats(A,q,env); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> (P | Q) \<longleftrightarrow> sats(A, Or(p,q), env)"
 by (simp)
 
 lemma iff_iff_sats:
       "\<lbrakk>P \<longleftrightarrow> sats(A,p,env); Q \<longleftrightarrow> sats(A,q,env); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> (P \<longleftrightarrow> Q) \<longleftrightarrow> sats(A, Iff(p,q), env)"
 by (simp)
 
 lemma imp_iff_sats:
       "\<lbrakk>P \<longleftrightarrow> sats(A,p,env); Q \<longleftrightarrow> sats(A,q,env); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> (P \<longrightarrow> Q) \<longleftrightarrow> sats(A, Implies(p,q), env)"
 by (simp)
 
 lemma ball_iff_sats:
       "\<lbrakk>\<And>x. x\<in>A \<Longrightarrow> P(x) \<longleftrightarrow> sats(A, p, Cons(x, env)); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> (\<forall>x\<in>A. P(x)) \<longleftrightarrow> sats(A, Forall(p), env)"
 by (simp)
 
 lemma bex_iff_sats:
       "\<lbrakk>\<And>x. x\<in>A \<Longrightarrow> P(x) \<longleftrightarrow> sats(A, p, Cons(x, env)); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> (\<exists>x\<in>A. P(x)) \<longleftrightarrow> sats(A, Exists(p), env)"
 by (simp)
 
 lemmas FOL_iff_sats =
         mem_iff_sats equal_iff_sats not_iff_sats conj_iff_sats
         disj_iff_sats imp_iff_sats iff_iff_sats imp_iff_sats ball_iff_sats
         bex_iff_sats
 
 
 subsection\<open>Arity of a Formula: Maximum Free de Bruijn Index\<close>
 
 consts   arity :: "i\<Rightarrow>i"
 primrec
   "arity(Member(x,y)) = succ(x) \<union> succ(y)"
 
   "arity(Equal(x,y)) = succ(x) \<union> succ(y)"
 
   "arity(Nand(p,q)) = arity(p) \<union> arity(q)"
 
   "arity(Forall(p)) = Arith.pred(arity(p))"
 
 
 lemma arity_type [TC]: "p \<in> formula \<Longrightarrow> arity(p) \<in> nat"
 by (induct_tac p, simp_all)
 
 lemma arity_Neg [simp]: "arity(Neg(p)) = arity(p)"
 by (simp add: Neg_def)
 
 lemma arity_And [simp]: "arity(And(p,q)) = arity(p) \<union> arity(q)"
 by (simp add: And_def)
 
 lemma arity_Or [simp]: "arity(Or(p,q)) = arity(p) \<union> arity(q)"
 by (simp add: Or_def)
 
 lemma arity_Implies [simp]: "arity(Implies(p,q)) = arity(p) \<union> arity(q)"
 by (simp add: Implies_def)
 
 lemma arity_Iff [simp]: "arity(Iff(p,q)) = arity(p) \<union> arity(q)"
 by (simp add: Iff_def, blast)
 
 lemma arity_Exists [simp]: "arity(Exists(p)) = Arith.pred(arity(p))"
 by (simp add: Exists_def)
 
 
 lemma arity_sats_iff [rule_format]:
   "\<lbrakk>p \<in> formula; extra \<in> list(A)\<rbrakk>
    \<Longrightarrow> \<forall>env \<in> list(A).
            arity(p) \<le> length(env) \<longrightarrow>
            sats(A, p, env @ extra) \<longleftrightarrow> sats(A, p, env)"
 apply (induct_tac p)
 apply (simp_all add: Arith.pred_def nth_append Un_least_lt_iff nat_imp_quasinat
                 split: split_nat_case, auto)
 done
 
 lemma arity_sats1_iff:
   "\<lbrakk>arity(p) \<le> succ(length(env)); p \<in> formula; x \<in> A; env \<in> list(A);
       extra \<in> list(A)\<rbrakk>
    \<Longrightarrow> sats(A, p, Cons(x, env @ extra)) \<longleftrightarrow> sats(A, p, Cons(x, env))"
 apply (insert arity_sats_iff [of p extra A "Cons(x,env)"])
 apply simp
 done
 
 
 subsection\<open>Renaming Some de Bruijn Variables\<close>
 
 definition
   incr_var :: "[i,i]\<Rightarrow>i" where
   "incr_var(x,nq) \<equiv> if x<nq then x else succ(x)"
 
 lemma incr_var_lt: "x<nq \<Longrightarrow> incr_var(x,nq) = x"
 by (simp add: incr_var_def)
 
 lemma incr_var_le: "nq\<le>x \<Longrightarrow> incr_var(x,nq) = succ(x)"
 apply (simp add: incr_var_def)
 apply (blast dest: lt_trans1)
 done
 
 consts   incr_bv :: "i\<Rightarrow>i"
 primrec
   "incr_bv(Member(x,y)) =
       (\<lambda>nq \<in> nat. Member (incr_var(x,nq), incr_var(y,nq)))"
 
   "incr_bv(Equal(x,y)) =
       (\<lambda>nq \<in> nat. Equal (incr_var(x,nq), incr_var(y,nq)))"
 
   "incr_bv(Nand(p,q)) =
       (\<lambda>nq \<in> nat. Nand (incr_bv(p)`nq, incr_bv(q)`nq))"
 
   "incr_bv(Forall(p)) =
       (\<lambda>nq \<in> nat. Forall (incr_bv(p) ` succ(nq)))"
 
 
 lemma [TC]: "x \<in> nat \<Longrightarrow> incr_var(x,nq) \<in> nat"
 by (simp add: incr_var_def)
 
 lemma incr_bv_type [TC]: "p \<in> formula \<Longrightarrow> incr_bv(p) \<in> nat -> formula"
 by (induct_tac p, simp_all)
 
 text\<open>Obviously, \<^term>\<open>DPow\<close> is closed under complements and finite
 intersections and unions.  Needs an inductive lemma to allow two lists of
 parameters to be combined.\<close>
 
 lemma sats_incr_bv_iff [rule_format]:
   "\<lbrakk>p \<in> formula; env \<in> list(A); x \<in> A\<rbrakk>
    \<Longrightarrow> \<forall>bvs \<in> list(A).
            sats(A, incr_bv(p) ` length(bvs), bvs @ Cons(x,env)) \<longleftrightarrow>
            sats(A, p, bvs@env)"
 apply (induct_tac p)
 apply (simp_all add: incr_var_def nth_append succ_lt_iff length_type)
 apply (auto simp add: diff_succ not_lt_iff_le)
 done
 
 
 (*the following two lemmas prevent huge case splits in arity_incr_bv_lemma*)
 lemma incr_var_lemma:
      "\<lbrakk>x \<in> nat; y \<in> nat; nq \<le> x\<rbrakk>
       \<Longrightarrow> succ(x) \<union> incr_var(y,nq) = succ(x \<union> y)"
 apply (simp add: incr_var_def Ord_Un_if, auto)
   apply (blast intro: leI)
  apply (simp add: not_lt_iff_le)
  apply (blast intro: le_anti_sym)
 apply (blast dest: lt_trans2)
 done
 
 lemma incr_And_lemma:
      "y < x \<Longrightarrow> y \<union> succ(x) = succ(x \<union> y)"
 apply (simp add: Ord_Un_if lt_Ord lt_Ord2 succ_lt_iff)
 apply (blast dest: lt_asym)
 done
 
 lemma arity_incr_bv_lemma [rule_format]:
   "p \<in> formula
    \<Longrightarrow> \<forall>n \<in> nat. arity (incr_bv(p) ` n) =
                  (if n < arity(p) then succ(arity(p)) else arity(p))"
 apply (induct_tac p)
 apply (simp_all add: imp_disj not_lt_iff_le Un_least_lt_iff lt_Un_iff le_Un_iff
                      succ_Un_distrib [symmetric] incr_var_lt incr_var_le
                      Un_commute incr_var_lemma Arith.pred_def nat_imp_quasinat
             split: split_nat_case)
  txt\<open>the Forall case reduces to linear arithmetic\<close>
  prefer 2
  apply clarify
  apply (blast dest: lt_trans1)
 txt\<open>left with the And case\<close>
 apply safe
  apply (blast intro: incr_And_lemma lt_trans1)
 apply (subst incr_And_lemma)
  apply (blast intro: lt_trans1)
 apply (simp add: Un_commute)
 done
 
 
 subsection\<open>Renaming all but the First de Bruijn Variable\<close>
 
 definition
   incr_bv1 :: "i \<Rightarrow> i" where
   "incr_bv1(p) \<equiv> incr_bv(p)`1"
 
 
 lemma incr_bv1_type [TC]: "p \<in> formula \<Longrightarrow> incr_bv1(p) \<in> formula"
 by (simp add: incr_bv1_def)
 
 (*For renaming all but the bound variable at level 0*)
 lemma sats_incr_bv1_iff:
   "\<lbrakk>p \<in> formula; env \<in> list(A); x \<in> A; y \<in> A\<rbrakk>
    \<Longrightarrow> sats(A, incr_bv1(p), Cons(x, Cons(y, env))) \<longleftrightarrow>
        sats(A, p, Cons(x,env))"
 apply (insert sats_incr_bv_iff [of p env A y "Cons(x,Nil)"])
 apply (simp add: incr_bv1_def)
 done
 
 lemma formula_add_params1 [rule_format]:
   "\<lbrakk>p \<in> formula; n \<in> nat; x \<in> A\<rbrakk>
    \<Longrightarrow> \<forall>bvs \<in> list(A). \<forall>env \<in> list(A).
           length(bvs) = n \<longrightarrow>
           sats(A, iterates(incr_bv1, n, p), Cons(x, bvs@env)) \<longleftrightarrow>
           sats(A, p, Cons(x,env))"
 apply (induct_tac n, simp, clarify)
 apply (erule list.cases)
 apply (simp_all add: sats_incr_bv1_iff)
 done
 
 
 lemma arity_incr_bv1_eq:
   "p \<in> formula
    \<Longrightarrow> arity(incr_bv1(p)) =
         (if 1 < arity(p) then succ(arity(p)) else arity(p))"
 apply (insert arity_incr_bv_lemma [of p 1])
 apply (simp add: incr_bv1_def)
 done
 
 lemma arity_iterates_incr_bv1_eq:
   "\<lbrakk>p \<in> formula; n \<in> nat\<rbrakk>
    \<Longrightarrow> arity(incr_bv1^n(p)) =
          (if 1 < arity(p) then n #+ arity(p) else arity(p))"
 apply (induct_tac n)
 apply (simp_all add: arity_incr_bv1_eq)
 apply (simp add: not_lt_iff_le)
 apply (blast intro: le_trans add_le_self2 arity_type)
 done
 
 
 
 subsection\<open>Definable Powerset\<close>
 
 text\<open>The definable powerset operation: Kunen's definition VI 1.1, page 165.\<close>
 definition
   DPow :: "i \<Rightarrow> i" where
   "DPow(A) \<equiv> {X \<in> Pow(A).
                \<exists>env \<in> list(A). \<exists>p \<in> formula.
                  arity(p) \<le> succ(length(env)) \<and>
                  X = {x\<in>A. sats(A, p, Cons(x,env))}}"
 
 lemma DPowI:
   "\<lbrakk>env \<in> list(A);  p \<in> formula;  arity(p) \<le> succ(length(env))\<rbrakk>
    \<Longrightarrow> {x\<in>A. sats(A, p, Cons(x,env))} \<in> DPow(A)"
 by (simp add: DPow_def, blast)
 
 text\<open>With this rule we can specify \<^term>\<open>p\<close> later.\<close>
 lemma DPowI2 [rule_format]:
   "\<lbrakk>\<forall>x\<in>A. P(x) \<longleftrightarrow> sats(A, p, Cons(x,env));
      env \<in> list(A);  p \<in> formula;  arity(p) \<le> succ(length(env))\<rbrakk>
    \<Longrightarrow> {x\<in>A. P(x)} \<in> DPow(A)"
 by (simp add: DPow_def, blast)
 
 lemma DPowD:
   "X \<in> DPow(A)
    \<Longrightarrow> X \<subseteq> A \<and>
        (\<exists>env \<in> list(A).
         \<exists>p \<in> formula. arity(p) \<le> succ(length(env)) \<and>
                       X = {x\<in>A. sats(A, p, Cons(x,env))})"
 by (simp add: DPow_def)
 
 lemmas DPow_imp_subset = DPowD [THEN conjunct1]
 
 (*Kunen's Lemma VI 1.2*)
 lemma "\<lbrakk>p \<in> formula; env \<in> list(A); arity(p) \<le> succ(length(env))\<rbrakk>
        \<Longrightarrow> {x\<in>A. sats(A, p, Cons(x,env))} \<in> DPow(A)"
 by (blast intro: DPowI)
 
 lemma DPow_subset_Pow: "DPow(A) \<subseteq> Pow(A)"
 by (simp add: DPow_def, blast)
 
 lemma empty_in_DPow: "0 \<in> DPow(A)"
 apply (simp add: DPow_def)
 apply (rule_tac x=Nil in bexI)
  apply (rule_tac x="Neg(Equal(0,0))" in bexI)
   apply (auto simp add: Un_least_lt_iff)
 done
 
 lemma Compl_in_DPow: "X \<in> DPow(A) \<Longrightarrow> (A-X) \<in> DPow(A)"
 apply (simp add: DPow_def, clarify, auto)
 apply (rule bexI)
  apply (rule_tac x="Neg(p)" in bexI)
   apply auto
 done
 
 lemma Int_in_DPow: "\<lbrakk>X \<in> DPow(A); Y \<in> DPow(A)\<rbrakk> \<Longrightarrow> X \<inter> Y \<in> DPow(A)"
 apply (simp add: DPow_def, auto)
 apply (rename_tac envp p envq q)
 apply (rule_tac x="envp@envq" in bexI)
  apply (rule_tac x="And(p, iterates(incr_bv1,length(envp),q))" in bexI)
   apply typecheck
 apply (rule conjI)
 (*finally check the arity!*)
  apply (simp add: arity_iterates_incr_bv1_eq Un_least_lt_iff)
  apply (force intro: add_le_self le_trans)
 apply (simp add: arity_sats1_iff formula_add_params1, blast)
 done
 
 lemma Un_in_DPow: "\<lbrakk>X \<in> DPow(A); Y \<in> DPow(A)\<rbrakk> \<Longrightarrow> X \<union> Y \<in> DPow(A)"
 apply (subgoal_tac "X \<union> Y = A - ((A-X) \<inter> (A-Y))")
 apply (simp add: Int_in_DPow Compl_in_DPow)
 apply (simp add: DPow_def, blast)
 done
 
 lemma singleton_in_DPow: "a \<in> A \<Longrightarrow> {a} \<in> DPow(A)"
 apply (simp add: DPow_def)
 apply (rule_tac x="Cons(a,Nil)" in bexI)
  apply (rule_tac x="Equal(0,1)" in bexI)
   apply typecheck
 apply (force simp add: succ_Un_distrib [symmetric])
 done
 
 lemma cons_in_DPow: "\<lbrakk>a \<in> A; X \<in> DPow(A)\<rbrakk> \<Longrightarrow> cons(a,X) \<in> DPow(A)"
 apply (rule cons_eq [THEN subst])
 apply (blast intro: singleton_in_DPow Un_in_DPow)
 done
 
 (*Part of Lemma 1.3*)
 lemma Fin_into_DPow: "X \<in> Fin(A) \<Longrightarrow> X \<in> DPow(A)"
 apply (erule Fin.induct)
  apply (rule empty_in_DPow)
 apply (blast intro: cons_in_DPow)
 done
 
 text\<open>\<^term>\<open>DPow\<close> is not monotonic.  For example, let \<^term>\<open>A\<close> be some
 non-constructible set of natural numbers, and let \<^term>\<open>B\<close> be \<^term>\<open>nat\<close>.
 Then \<^term>\<open>A<=B\<close> and obviously \<^term>\<open>A \<in> DPow(A)\<close> but \<^term>\<open>A \<notin>
 DPow(B)\<close>.\<close>
 
 (*This may be true but the proof looks difficult, requiring relativization
 lemma DPow_insert: "DPow (cons(a,A)) = DPow(A) \<union> {cons(a,X) . X \<in> DPow(A)}"
 apply (rule equalityI, safe)
 oops
 *)
 
 lemma Finite_Pow_subset_Pow: "Finite(A) \<Longrightarrow> Pow(A) \<subseteq> DPow(A)"
 by (blast intro: Fin_into_DPow Finite_into_Fin Fin_subset)
 
 lemma Finite_DPow_eq_Pow: "Finite(A) \<Longrightarrow> DPow(A) = Pow(A)"
 apply (rule equalityI)
 apply (rule DPow_subset_Pow)
 apply (erule Finite_Pow_subset_Pow)
 done
 
 
 subsection\<open>Internalized Formulas for the Ordinals\<close>
 
 text\<open>The \<open>sats\<close> theorems below differ from the usual form in that they
 include an element of absoluteness.  That is, they relate internalized
 formulas to real concepts such as the subset relation, rather than to the
 relativized concepts defined in theory \<open>Relative\<close>.  This lets us prove
 the theorem as \<open>Ords_in_DPow\<close> without first having to instantiate the
 locale \<open>M_trivial\<close>.  Note that the present theory does not even take
 \<open>Relative\<close> as a parent.\<close>
 
 subsubsection\<open>The subset relation\<close>
 
 definition
   subset_fm :: "[i,i]\<Rightarrow>i" where
   "subset_fm(x,y) \<equiv> Forall(Implies(Member(0,succ(x)), Member(0,succ(y))))"
 
 lemma subset_type [TC]: "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> subset_fm(x,y) \<in> formula"
 by (simp add: subset_fm_def)
 
 lemma arity_subset_fm [simp]:
      "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> arity(subset_fm(x,y)) = succ(x) \<union> succ(y)"
 by (simp add: subset_fm_def succ_Un_distrib [symmetric])
 
 lemma sats_subset_fm [simp]:
    "\<lbrakk>x < length(env); y \<in> nat; env \<in> list(A); Transset(A)\<rbrakk>
     \<Longrightarrow> sats(A, subset_fm(x,y), env) \<longleftrightarrow> nth(x,env) \<subseteq> nth(y,env)"
 apply (frule lt_length_in_nat, assumption)
 apply (simp add: subset_fm_def Transset_def)
 apply (blast intro: nth_type)
 done
 
 subsubsection\<open>Transitive sets\<close>
 
 definition
   transset_fm :: "i\<Rightarrow>i" where
   "transset_fm(x) \<equiv> Forall(Implies(Member(0,succ(x)), subset_fm(0,succ(x))))"
 
 lemma transset_type [TC]: "x \<in> nat \<Longrightarrow> transset_fm(x) \<in> formula"
 by (simp add: transset_fm_def)
 
 lemma arity_transset_fm [simp]:
      "x \<in> nat \<Longrightarrow> arity(transset_fm(x)) = succ(x)"
 by (simp add: transset_fm_def succ_Un_distrib [symmetric])
 
 lemma sats_transset_fm [simp]:
    "\<lbrakk>x < length(env); env \<in> list(A); Transset(A)\<rbrakk>
     \<Longrightarrow> sats(A, transset_fm(x), env) \<longleftrightarrow> Transset(nth(x,env))"
 apply (frule lt_nat_in_nat, erule length_type)
 apply (simp add: transset_fm_def Transset_def)
 apply (blast intro: nth_type)
 done
 
 subsubsection\<open>Ordinals\<close>
 
 definition
   ordinal_fm :: "i\<Rightarrow>i" where
   "ordinal_fm(x) \<equiv>
     And(transset_fm(x), Forall(Implies(Member(0,succ(x)), transset_fm(0))))"
 
 lemma ordinal_type [TC]: "x \<in> nat \<Longrightarrow> ordinal_fm(x) \<in> formula"
 by (simp add: ordinal_fm_def)
 
 lemma arity_ordinal_fm [simp]:
      "x \<in> nat \<Longrightarrow> arity(ordinal_fm(x)) = succ(x)"
 by (simp add: ordinal_fm_def succ_Un_distrib [symmetric])
 
 lemma sats_ordinal_fm:
    "\<lbrakk>x < length(env); env \<in> list(A); Transset(A)\<rbrakk>
     \<Longrightarrow> sats(A, ordinal_fm(x), env) \<longleftrightarrow> Ord(nth(x,env))"
 apply (frule lt_nat_in_nat, erule length_type)
 apply (simp add: ordinal_fm_def Ord_def Transset_def)
 apply (blast intro: nth_type)
 done
 
 text\<open>The subset consisting of the ordinals is definable.  Essential lemma for
 \<open>Ord_in_Lset\<close>.  This result is the objective of the present subsection.\<close>
 theorem Ords_in_DPow: "Transset(A) \<Longrightarrow> {x \<in> A. Ord(x)} \<in> DPow(A)"
 apply (simp add: DPow_def Collect_subset)
 apply (rule_tac x=Nil in bexI)
  apply (rule_tac x="ordinal_fm(0)" in bexI)
 apply (simp_all add: sats_ordinal_fm)
 done
 
 
 subsection\<open>Constant Lset: Levels of the Constructible Universe\<close>
 
 definition
   Lset :: "i\<Rightarrow>i" where
   "Lset(i) \<equiv> transrec(i, \<lambda>x f. \<Union>y\<in>x. DPow(f`y))"
 
 definition
   L :: "i\<Rightarrow>o" where \<comment> \<open>Kunen's definition VI 1.5, page 167\<close>
   "L(x) \<equiv> \<exists>i. Ord(i) \<and> x \<in> Lset(i)"
 
 text\<open>NOT SUITABLE FOR REWRITING -- RECURSIVE!\<close>
 lemma Lset: "Lset(i) = (\<Union>j\<in>i. DPow(Lset(j)))"
 by (subst Lset_def [THEN def_transrec], simp)
 
 lemma LsetI: "\<lbrakk>y\<in>x; A \<in> DPow(Lset(y))\<rbrakk> \<Longrightarrow> A \<in> Lset(x)"
 by (subst Lset, blast)
 
 lemma LsetD: "A \<in> Lset(x) \<Longrightarrow> \<exists>y\<in>x. A \<in> DPow(Lset(y))"
 apply (insert Lset [of x])
 apply (blast intro: elim: equalityE)
 done
 
 subsubsection\<open>Transitivity\<close>
 
 lemma elem_subset_in_DPow: "\<lbrakk>X \<in> A; X \<subseteq> A\<rbrakk> \<Longrightarrow> X \<in> DPow(A)"
 apply (simp add: Transset_def DPow_def)
 apply (rule_tac x="[X]" in bexI)
  apply (rule_tac x="Member(0,1)" in bexI)
   apply (auto simp add: Un_least_lt_iff)
 done
 
 lemma Transset_subset_DPow: "Transset(A) \<Longrightarrow> A \<subseteq> DPow(A)"
 apply clarify
 apply (simp add: Transset_def)
 apply (blast intro: elem_subset_in_DPow)
 done
 
 lemma Transset_DPow: "Transset(A) \<Longrightarrow> Transset(DPow(A))"
 apply (simp add: Transset_def)
 apply (blast intro: elem_subset_in_DPow dest: DPowD)
 done
 
 text\<open>Kunen's VI 1.6 (a)\<close>
 lemma Transset_Lset: "Transset(Lset(i))"
 apply (rule_tac a=i in eps_induct)
 apply (subst Lset)
 apply (blast intro!: Transset_Union_family Transset_Un Transset_DPow)
 done
 
 lemma mem_Lset_imp_subset_Lset: "a \<in> Lset(i) \<Longrightarrow> a \<subseteq> Lset(i)"
 apply (insert Transset_Lset)
 apply (simp add: Transset_def)
 done
 
 subsubsection\<open>Monotonicity\<close>
 
 text\<open>Kunen's VI 1.6 (b)\<close>
 lemma Lset_mono [rule_format]:
      "\<forall>j. i<=j \<longrightarrow> Lset(i) \<subseteq> Lset(j)"
 proof (induct i rule: eps_induct, intro allI impI)
   fix x j
   assume "\<forall>y\<in>x. \<forall>j. y \<subseteq> j \<longrightarrow> Lset(y) \<subseteq> Lset(j)"
      and "x \<subseteq> j"
   thus "Lset(x) \<subseteq> Lset(j)"
     by (force simp add: Lset [of x] Lset [of j])
 qed
 
 text\<open>This version lets us remove the premise \<^term>\<open>Ord(i)\<close> sometimes.\<close>
 lemma Lset_mono_mem [rule_format]:
      "\<forall>j. i \<in> j \<longrightarrow> Lset(i) \<subseteq> Lset(j)"
 proof (induct i rule: eps_induct, intro allI impI)
   fix x j
   assume "\<forall>y\<in>x. \<forall>j. y \<in> j \<longrightarrow> Lset(y) \<subseteq> Lset(j)"
      and "x \<in> j"
   thus "Lset(x) \<subseteq> Lset(j)"
     by (force simp add: Lset [of j]
               intro!: bexI intro: elem_subset_in_DPow dest: LsetD DPowD)
 qed
 
 
 text\<open>Useful with Reflection to bump up the ordinal\<close>
 lemma subset_Lset_ltD: "\<lbrakk>A \<subseteq> Lset(i); i < j\<rbrakk> \<Longrightarrow> A \<subseteq> Lset(j)"
 by (blast dest: ltD [THEN Lset_mono_mem])
 
 subsubsection\<open>0, successor and limit equations for Lset\<close>
 
 lemma Lset_0 [simp]: "Lset(0) = 0"
 by (subst Lset, blast)
 
 lemma Lset_succ_subset1: "DPow(Lset(i)) \<subseteq> Lset(succ(i))"
 by (subst Lset, rule succI1 [THEN RepFunI, THEN Union_upper])
 
 lemma Lset_succ_subset2: "Lset(succ(i)) \<subseteq> DPow(Lset(i))"
 apply (subst Lset, rule UN_least)
 apply (erule succE)
  apply blast
 apply clarify
 apply (rule elem_subset_in_DPow)
  apply (subst Lset)
  apply blast
 apply (blast intro: dest: DPowD Lset_mono_mem)
 done
 
 lemma Lset_succ: "Lset(succ(i)) = DPow(Lset(i))"
 by (intro equalityI Lset_succ_subset1 Lset_succ_subset2)
 
 lemma Lset_Union [simp]: "Lset(\<Union>(X)) = (\<Union>y\<in>X. Lset(y))"
 apply (subst Lset)
 apply (rule equalityI)
  txt\<open>first inclusion\<close>
  apply (rule UN_least)
  apply (erule UnionE)
  apply (rule subset_trans)
   apply (erule_tac [2] UN_upper, subst Lset, erule UN_upper)
 txt\<open>opposite inclusion\<close>
 apply (rule UN_least)
 apply (subst Lset, blast)
 done
 
 subsubsection\<open>Lset applied to Limit ordinals\<close>
 
 lemma Limit_Lset_eq:
     "Limit(i) \<Longrightarrow> Lset(i) = (\<Union>y\<in>i. Lset(y))"
 by (simp add: Lset_Union [symmetric] Limit_Union_eq)
 
 lemma lt_LsetI: "\<lbrakk>a \<in> Lset(j);  j<i\<rbrakk> \<Longrightarrow> a \<in> Lset(i)"
 by (blast dest: Lset_mono [OF le_imp_subset [OF leI]])
 
 lemma Limit_LsetE:
     "\<lbrakk>a \<in> Lset(i);  \<not>R \<Longrightarrow> Limit(i);
         \<And>x. \<lbrakk>x<i;  a \<in> Lset(x)\<rbrakk> \<Longrightarrow> R
 \<rbrakk> \<Longrightarrow> R"
 apply (rule classical)
 apply (rule Limit_Lset_eq [THEN equalityD1, THEN subsetD, THEN UN_E])
   prefer 2 apply assumption
  apply blast
 apply (blast intro: ltI  Limit_is_Ord)
 done
 
 subsubsection\<open>Basic closure properties\<close>
 
 lemma zero_in_Lset: "y \<in> x \<Longrightarrow> 0 \<in> Lset(x)"
 by (subst Lset, blast intro: empty_in_DPow)
 
 lemma notin_Lset: "x \<notin> Lset(x)"
 apply (rule_tac a=x in eps_induct)
 apply (subst Lset)
 apply (blast dest: DPowD)
 done
 
 
 subsection\<open>Constructible Ordinals: Kunen's VI 1.9 (b)\<close>
 
 lemma Ords_of_Lset_eq: "Ord(i) \<Longrightarrow> {x\<in>Lset(i). Ord(x)} = i"
 apply (erule trans_induct3)
   apply (simp_all add: Lset_succ Limit_Lset_eq Limit_Union_eq)
 txt\<open>The successor case remains.\<close>
 apply (rule equalityI)
 txt\<open>First inclusion\<close>
  apply clarify
  apply (erule Ord_linear_lt, assumption)
    apply (blast dest: DPow_imp_subset ltD notE [OF notin_Lset])
   apply blast
  apply (blast dest: ltD)
 txt\<open>Opposite inclusion, \<^term>\<open>succ(x) \<subseteq> DPow(Lset(x)) \<inter> ON\<close>\<close>
 apply auto
 txt\<open>Key case:\<close>
   apply (erule subst, rule Ords_in_DPow [OF Transset_Lset])
  apply (blast intro: elem_subset_in_DPow dest: OrdmemD elim: equalityE)
 apply (blast intro: Ord_in_Ord)
 done
 
 
 lemma Ord_subset_Lset: "Ord(i) \<Longrightarrow> i \<subseteq> Lset(i)"
 by (subst Ords_of_Lset_eq [symmetric], assumption, fast)
 
 lemma Ord_in_Lset: "Ord(i) \<Longrightarrow> i \<in> Lset(succ(i))"
 apply (simp add: Lset_succ)
 apply (subst Ords_of_Lset_eq [symmetric], assumption,
        rule Ords_in_DPow [OF Transset_Lset])
 done
 
 lemma Ord_in_L: "Ord(i) \<Longrightarrow> L(i)"
 by (simp add: L_def, blast intro: Ord_in_Lset)
 
 subsubsection\<open>Unions\<close>
 
 lemma Union_in_Lset:
      "X \<in> Lset(i) \<Longrightarrow> \<Union>(X) \<in> Lset(succ(i))"
 apply (insert Transset_Lset)
 apply (rule LsetI [OF succI1])
 apply (simp add: Transset_def DPow_def)
 apply (intro conjI, blast)
 txt\<open>Now to create the formula \<^term>\<open>\<exists>y. y \<in> X \<and> x \<in> y\<close>\<close>
 apply (rule_tac x="Cons(X,Nil)" in bexI)
  apply (rule_tac x="Exists(And(Member(0,2), Member(1,0)))" in bexI)
   apply typecheck
 apply (simp add: succ_Un_distrib [symmetric], blast)
 done
 
 theorem Union_in_L: "L(X) \<Longrightarrow> L(\<Union>(X))"
 by (simp add: L_def, blast dest: Union_in_Lset)
 
 subsubsection\<open>Finite sets and ordered pairs\<close>
 
 lemma singleton_in_Lset: "a \<in> Lset(i) \<Longrightarrow> {a} \<in> Lset(succ(i))"
 by (simp add: Lset_succ singleton_in_DPow)
 
 lemma doubleton_in_Lset:
      "\<lbrakk>a \<in> Lset(i);  b \<in> Lset(i)\<rbrakk> \<Longrightarrow> {a,b} \<in> Lset(succ(i))"
 by (simp add: Lset_succ empty_in_DPow cons_in_DPow)
 
 lemma Pair_in_Lset:
     "\<lbrakk>a \<in> Lset(i);  b \<in> Lset(i); Ord(i)\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle> \<in> Lset(succ(succ(i)))"
-apply (unfold Pair_def)
+  unfolding Pair_def
 apply (blast intro: doubleton_in_Lset)
 done
 
 lemmas Lset_UnI1 = Un_upper1 [THEN Lset_mono [THEN subsetD]]
 lemmas Lset_UnI2 = Un_upper2 [THEN Lset_mono [THEN subsetD]]
 
 text\<open>Hard work is finding a single \<^term>\<open>j \<in> i\<close> such that \<^term>\<open>{a,b} \<subseteq> Lset(j)\<close>\<close>
 lemma doubleton_in_LLimit:
     "\<lbrakk>a \<in> Lset(i);  b \<in> Lset(i);  Limit(i)\<rbrakk> \<Longrightarrow> {a,b} \<in> Lset(i)"
 apply (erule Limit_LsetE, assumption)
 apply (erule Limit_LsetE, assumption)
 apply (blast intro: lt_LsetI [OF doubleton_in_Lset]
                     Lset_UnI1 Lset_UnI2 Limit_has_succ Un_least_lt)
 done
 
 theorem doubleton_in_L: "\<lbrakk>L(a); L(b)\<rbrakk> \<Longrightarrow> L({a, b})"
 apply (simp add: L_def, clarify)
 apply (drule Ord2_imp_greater_Limit, assumption)
 apply (blast intro: lt_LsetI doubleton_in_LLimit Limit_is_Ord)
 done
 
 lemma Pair_in_LLimit:
     "\<lbrakk>a \<in> Lset(i);  b \<in> Lset(i);  Limit(i)\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle> \<in> Lset(i)"
 txt\<open>Infer that a, b occur at ordinals x,xa < i.\<close>
 apply (erule Limit_LsetE, assumption)
 apply (erule Limit_LsetE, assumption)
 txt\<open>Infer that \<^term>\<open>succ(succ(x \<union> xa)) < i\<close>\<close>
 apply (blast intro: lt_Ord lt_LsetI [OF Pair_in_Lset]
                     Lset_UnI1 Lset_UnI2 Limit_has_succ Un_least_lt)
 done
 
 
 
 text\<open>The rank function for the constructible universe\<close>
 definition
   lrank :: "i\<Rightarrow>i" where \<comment> \<open>Kunen's definition VI 1.7\<close>
   "lrank(x) \<equiv> \<mu> i. x \<in> Lset(succ(i))"
 
 lemma L_I: "\<lbrakk>x \<in> Lset(i); Ord(i)\<rbrakk> \<Longrightarrow> L(x)"
 by (simp add: L_def, blast)
 
 lemma L_D: "L(x) \<Longrightarrow> \<exists>i. Ord(i) \<and> x \<in> Lset(i)"
 by (simp add: L_def)
 
 lemma Ord_lrank [simp]: "Ord(lrank(a))"
 by (simp add: lrank_def)
 
 lemma Lset_lrank_lt [rule_format]: "Ord(i) \<Longrightarrow> x \<in> Lset(i) \<longrightarrow> lrank(x) < i"
 apply (erule trans_induct3)
   apply simp
  apply (simp only: lrank_def)
  apply (blast intro: Least_le)
 apply (simp_all add: Limit_Lset_eq)
 apply (blast intro: ltI Limit_is_Ord lt_trans)
 done
 
 text\<open>Kunen's VI 1.8.  The proof is much harder than the text would
 suggest.  For a start, it needs the previous lemma, which is proved by
 induction.\<close>
 lemma Lset_iff_lrank_lt: "Ord(i) \<Longrightarrow> x \<in> Lset(i) \<longleftrightarrow> L(x) \<and> lrank(x) < i"
 apply (simp add: L_def, auto)
  apply (blast intro: Lset_lrank_lt)
- apply (unfold lrank_def)
+   unfolding lrank_def
 apply (drule succI1 [THEN Lset_mono_mem, THEN subsetD])
 apply (drule_tac P="\<lambda>i. x \<in> Lset(succ(i))" in LeastI, assumption)
 apply (blast intro!: le_imp_subset Lset_mono [THEN subsetD])
 done
 
 lemma Lset_succ_lrank_iff [simp]: "x \<in> Lset(succ(lrank(x))) \<longleftrightarrow> L(x)"
 by (simp add: Lset_iff_lrank_lt)
 
 text\<open>Kunen's VI 1.9 (a)\<close>
 lemma lrank_of_Ord: "Ord(i) \<Longrightarrow> lrank(i) = i"
-apply (unfold lrank_def)
+  unfolding lrank_def
 apply (rule Least_equality)
   apply (erule Ord_in_Lset)
  apply assumption
 apply (insert notin_Lset [of i])
 apply (blast intro!: le_imp_subset Lset_mono [THEN subsetD])
 done
 
 
 text\<open>This is lrank(lrank(a)) = lrank(a)\<close>
 declare Ord_lrank [THEN lrank_of_Ord, simp]
 
 text\<open>Kunen's VI 1.10\<close>
 lemma Lset_in_Lset_succ: "Lset(i) \<in> Lset(succ(i))"
 apply (simp add: Lset_succ DPow_def)
 apply (rule_tac x=Nil in bexI)
  apply (rule_tac x="Equal(0,0)" in bexI)
 apply auto
 done
 
 lemma lrank_Lset: "Ord(i) \<Longrightarrow> lrank(Lset(i)) = i"
-apply (unfold lrank_def)
+  unfolding lrank_def
 apply (rule Least_equality)
   apply (rule Lset_in_Lset_succ)
  apply assumption
 apply clarify
 apply (subgoal_tac "Lset(succ(ia)) \<subseteq> Lset(i)")
  apply (blast dest: mem_irrefl)
 apply (blast intro!: le_imp_subset Lset_mono)
 done
 
 text\<open>Kunen's VI 1.11\<close>
 lemma Lset_subset_Vset: "Ord(i) \<Longrightarrow> Lset(i) \<subseteq> Vset(i)"
 apply (erule trans_induct)
 apply (subst Lset)
 apply (subst Vset)
 apply (rule UN_mono [OF subset_refl])
 apply (rule subset_trans [OF DPow_subset_Pow])
 apply (rule Pow_mono, blast)
 done
 
 text\<open>Kunen's VI 1.12\<close>
 lemma Lset_subset_Vset': "i \<in> nat \<Longrightarrow> Lset(i) = Vset(i)"
 apply (erule nat_induct)
  apply (simp add: Vfrom_0)
 apply (simp add: Lset_succ Vset_succ Finite_Vset Finite_DPow_eq_Pow)
 done
 
 text\<open>Every set of constructible sets is included in some \<^term>\<open>Lset\<close>\<close>
 lemma subset_Lset:
      "(\<forall>x\<in>A. L(x)) \<Longrightarrow> \<exists>i. Ord(i) \<and> A \<subseteq> Lset(i)"
 by (rule_tac x = "\<Union>x\<in>A. succ(lrank(x))" in exI, force)
 
 lemma subset_LsetE:
      "\<lbrakk>\<forall>x\<in>A. L(x);
         \<And>i. \<lbrakk>Ord(i); A \<subseteq> Lset(i)\<rbrakk> \<Longrightarrow> P\<rbrakk>
       \<Longrightarrow> P"
 by (blast dest: subset_Lset)
 
 subsubsection\<open>For L to satisfy the Powerset axiom\<close>
 
 lemma LPow_env_typing:
     "\<lbrakk>y \<in> Lset(i); Ord(i); y \<subseteq> X\<rbrakk>
      \<Longrightarrow> \<exists>z \<in> Pow(X). y \<in> Lset(succ(lrank(z)))"
 by (auto intro: L_I iff: Lset_succ_lrank_iff)
 
 lemma LPow_in_Lset:
      "\<lbrakk>X \<in> Lset(i); Ord(i)\<rbrakk> \<Longrightarrow> \<exists>j. Ord(j) \<and> {y \<in> Pow(X). L(y)} \<in> Lset(j)"
 apply (rule_tac x="succ(\<Union>y \<in> Pow(X). succ(lrank(y)))" in exI)
 apply simp
 apply (rule LsetI [OF succI1])
 apply (simp add: DPow_def)
 apply (intro conjI, clarify)
  apply (rule_tac a=x in UN_I, simp+)
 txt\<open>Now to create the formula \<^term>\<open>y \<subseteq> X\<close>\<close>
 apply (rule_tac x="Cons(X,Nil)" in bexI)
  apply (rule_tac x="subset_fm(0,1)" in bexI)
   apply typecheck
  apply (rule conjI)
 apply (simp add: succ_Un_distrib [symmetric])
 apply (rule equality_iffI)
 apply (simp add: Transset_UN [OF Transset_Lset] LPow_env_typing)
 apply (auto intro: L_I iff: Lset_succ_lrank_iff)
 done
 
 theorem LPow_in_L: "L(X) \<Longrightarrow> L({y \<in> Pow(X). L(y)})"
 by (blast intro: L_I dest: L_D LPow_in_Lset)
 
 
 subsection\<open>Eliminating \<^term>\<open>arity\<close> from the Definition of \<^term>\<open>Lset\<close>\<close>
 
 lemma nth_zero_eq_0: "n \<in> nat \<Longrightarrow> nth(n,[0]) = 0"
 by (induct_tac n, auto)
 
 lemma sats_app_0_iff [rule_format]:
   "\<lbrakk>p \<in> formula; 0 \<in> A\<rbrakk>
    \<Longrightarrow> \<forall>env \<in> list(A). sats(A,p, env@[0]) \<longleftrightarrow> sats(A,p,env)"
 apply (induct_tac p)
 apply (simp_all del: app_Cons add: app_Cons [symmetric]
                 add: nth_zero_eq_0 nth_append not_lt_iff_le nth_eq_0)
 done
 
 lemma sats_app_zeroes_iff:
   "\<lbrakk>p \<in> formula; 0 \<in> A; env \<in> list(A); n \<in> nat\<rbrakk>
    \<Longrightarrow> sats(A,p,env @ repeat(0,n)) \<longleftrightarrow> sats(A,p,env)"
 apply (induct_tac n, simp)
 apply (simp del: repeat.simps
             add: repeat_succ_app sats_app_0_iff app_assoc [symmetric])
 done
 
 lemma exists_bigger_env:
   "\<lbrakk>p \<in> formula; 0 \<in> A; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> \<exists>env' \<in> list(A). arity(p) \<le> succ(length(env')) \<and>
               (\<forall>a\<in>A. sats(A,p,Cons(a,env')) \<longleftrightarrow> sats(A,p,Cons(a,env)))"
 apply (rule_tac x="env @ repeat(0,arity(p))" in bexI)
 apply (simp del: app_Cons add: app_Cons [symmetric]
             add: length_repeat sats_app_zeroes_iff, typecheck)
 done
 
 
 text\<open>A simpler version of \<^term>\<open>DPow\<close>: no arity check!\<close>
 definition
   DPow' :: "i \<Rightarrow> i" where
   "DPow'(A) \<equiv> {X \<in> Pow(A).
                 \<exists>env \<in> list(A). \<exists>p \<in> formula.
                     X = {x\<in>A. sats(A, p, Cons(x,env))}}"
 
 lemma DPow_subset_DPow': "DPow(A) \<subseteq> DPow'(A)"
 by (simp add: DPow_def DPow'_def, blast)
 
 lemma DPow'_0: "DPow'(0) = {0}"
 by (auto simp add: DPow'_def)
 
 lemma DPow'_subset_DPow: "0 \<in> A \<Longrightarrow> DPow'(A) \<subseteq> DPow(A)"
 apply (auto simp add: DPow'_def DPow_def)
 apply (frule exists_bigger_env, assumption+, force)
 done
 
 lemma DPow_eq_DPow': "Transset(A) \<Longrightarrow> DPow(A) = DPow'(A)"
 apply (drule Transset_0_disj)
 apply (erule disjE)
  apply (simp add: DPow'_0 Finite_DPow_eq_Pow)
 apply (rule equalityI)
  apply (rule DPow_subset_DPow')
 apply (erule DPow'_subset_DPow)
 done
 
 text\<open>And thus we can relativize \<^term>\<open>Lset\<close> without bothering with
       \<^term>\<open>arity\<close> and \<^term>\<open>length\<close>\<close>
 lemma Lset_eq_transrec_DPow': "Lset(i) = transrec(i, \<lambda>x f. \<Union>y\<in>x. DPow'(f`y))"
 apply (rule_tac a=i in eps_induct)
 apply (subst Lset)
 apply (subst transrec)
 apply (simp only: DPow_eq_DPow' [OF Transset_Lset], simp)
 done
 
 text\<open>With this rule we can specify \<^term>\<open>p\<close> later and don't worry about
       arities at all!\<close>
 lemma DPow_LsetI [rule_format]:
   "\<lbrakk>\<forall>x\<in>Lset(i). P(x) \<longleftrightarrow> sats(Lset(i), p, Cons(x,env));
      env \<in> list(Lset(i));  p \<in> formula\<rbrakk>
    \<Longrightarrow> {x\<in>Lset(i). P(x)} \<in> DPow(Lset(i))"
 by (simp add: DPow_eq_DPow' [OF Transset_Lset] DPow'_def, blast)
 
 end
diff --git a/src/ZF/Constructible/L_axioms.thy b/src/ZF/Constructible/L_axioms.thy
--- a/src/ZF/Constructible/L_axioms.thy
+++ b/src/ZF/Constructible/L_axioms.thy
@@ -1,1403 +1,1403 @@
 (*  Title:      ZF/Constructible/L_axioms.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
 *)
 
 section \<open>The ZF Axioms (Except Separation) in L\<close>
 
 theory L_axioms imports Formula Relative Reflection MetaExists begin
 
 text \<open>The class L satisfies the premises of locale \<open>M_trivial\<close>\<close>
 
 lemma transL: "\<lbrakk>y\<in>x; L(x)\<rbrakk> \<Longrightarrow> L(y)"
 apply (insert Transset_Lset)
 apply (simp add: Transset_def L_def, blast)
 done
 
 lemma nonempty: "L(0)"
 apply (simp add: L_def)
 apply (blast intro: zero_in_Lset)
 done
 
 theorem upair_ax: "upair_ax(L)"
 apply (simp add: upair_ax_def upair_def, clarify)
 apply (rule_tac x="{x,y}" in rexI)
 apply (simp_all add: doubleton_in_L)
 done
 
 theorem Union_ax: "Union_ax(L)"
 apply (simp add: Union_ax_def big_union_def, clarify)
 apply (rule_tac x="\<Union>(x)" in rexI)
 apply (simp_all add: Union_in_L, auto)
 apply (blast intro: transL)
 done
 
 theorem power_ax: "power_ax(L)"
 apply (simp add: power_ax_def powerset_def Relative.subset_def, clarify)
 apply (rule_tac x="{y \<in> Pow(x). L(y)}" in rexI)
 apply (simp_all add: LPow_in_L, auto)
 apply (blast intro: transL)
 done
 
 text\<open>We don't actually need \<^term>\<open>L\<close> to satisfy the foundation axiom.\<close>
 theorem foundation_ax: "foundation_ax(L)"
 apply (simp add: foundation_ax_def)
 apply (rule rallI) 
 apply (cut_tac A=x in foundation)
 apply (blast intro: transL)
 done
 
 subsection\<open>For L to satisfy Replacement\<close>
 
 (*Can't move these to Formula unless the definition of univalent is moved
 there too!*)
 
 lemma LReplace_in_Lset:
      "\<lbrakk>X \<in> Lset(i); univalent(L,X,Q); Ord(i)\<rbrakk>
       \<Longrightarrow> \<exists>j. Ord(j) \<and> Replace(X, \<lambda>x y. Q(x,y) \<and> L(y)) \<subseteq> Lset(j)"
 apply (rule_tac x="\<Union>y \<in> Replace(X, \<lambda>x y. Q(x,y) \<and> L(y)). succ(lrank(y))"
        in exI)
 apply simp
 apply clarify
 apply (rule_tac a=x in UN_I)
  apply (simp_all add: Replace_iff univalent_def)
 apply (blast dest: transL L_I)
 done
 
 lemma LReplace_in_L:
      "\<lbrakk>L(X); univalent(L,X,Q)\<rbrakk>
       \<Longrightarrow> \<exists>Y. L(Y) \<and> Replace(X, \<lambda>x y. Q(x,y) \<and> L(y)) \<subseteq> Y"
 apply (drule L_D, clarify)
 apply (drule LReplace_in_Lset, assumption+)
 apply (blast intro: L_I Lset_in_Lset_succ)
 done
 
 theorem replacement: "replacement(L,P)"
 apply (simp add: replacement_def, clarify)
 apply (frule LReplace_in_L, assumption+, clarify)
 apply (rule_tac x=Y in rexI)
 apply (simp_all add: Replace_iff univalent_def, blast)
 done
 
 lemma strong_replacementI [rule_format]:
     "\<lbrakk>\<forall>B[L]. separation(L, \<lambda>u. \<exists>x[L]. x\<in>B \<and> P(x,u))\<rbrakk>
      \<Longrightarrow> strong_replacement(L,P)"
 apply (simp add: strong_replacement_def, clarify)
 apply (frule replacementD [OF replacement], assumption, clarify)
 apply (drule_tac x=A in rspec, clarify)
 apply (drule_tac z=Y in separationD, assumption, clarify)
 apply (rule_tac x=y in rexI, force, assumption)
 done
 
 
 subsection\<open>Instantiating the locale \<open>M_trivial\<close>\<close>
 text\<open>No instances of Separation yet.\<close>
 
 lemma Lset_mono_le: "mono_le_subset(Lset)"
 by (simp add: mono_le_subset_def le_imp_subset Lset_mono)
 
 lemma Lset_cont: "cont_Ord(Lset)"
 by (simp add: cont_Ord_def Limit_Lset_eq OUnion_def Limit_is_Ord)
 
 lemmas L_nat = Ord_in_L [OF Ord_nat]
 
 theorem M_trivial_L: "M_trivial(L)"
   apply (rule M_trivial.intro)
   apply (rule M_trans.intro)
     apply (erule (1) transL)
    apply(rule exI,rule  nonempty)
   apply (rule M_trivial_axioms.intro)
       apply (rule upair_ax)
    apply (rule Union_ax)
   done
 
 interpretation L: M_trivial L by (rule M_trivial_L)
 
 (* Replaces the following declarations...
 lemmas rall_abs = M_trivial.rall_abs [OF M_trivial_L]
   and rex_abs = M_trivial.rex_abs [OF M_trivial_L]
 ...
 declare rall_abs [simp]
 declare rex_abs [simp]
 ...and dozens of similar ones.
 *)
 
 subsection\<open>Instantiation of the locale \<open>reflection\<close>\<close>
 
 text\<open>instances of locale constants\<close>
 
 definition
   L_F0 :: "[i\<Rightarrow>o,i] \<Rightarrow> i" where
     "L_F0(P,y) \<equiv> \<mu> b. (\<exists>z. L(z) \<and> P(\<langle>y,z\<rangle>)) \<longrightarrow> (\<exists>z\<in>Lset(b). P(\<langle>y,z\<rangle>))"
 
 definition
   L_FF :: "[i\<Rightarrow>o,i] \<Rightarrow> i" where
     "L_FF(P)   \<equiv> \<lambda>a. \<Union>y\<in>Lset(a). L_F0(P,y)"
 
 definition
   L_ClEx :: "[i\<Rightarrow>o,i] \<Rightarrow> o" where
     "L_ClEx(P) \<equiv> \<lambda>a. Limit(a) \<and> normalize(L_FF(P),a) = a"
 
 
 text\<open>We must use the meta-existential quantifier; otherwise the reflection
       terms become enormous!\<close>
 definition
   L_Reflects :: "[i\<Rightarrow>o,[i,i]\<Rightarrow>o] \<Rightarrow> prop"  (\<open>(3REFLECTS/ [_,/ _])\<close>) where
     "REFLECTS[P,Q] \<equiv> (\<Or>Cl. Closed_Unbounded(Cl) \<and>
                            (\<forall>a. Cl(a) \<longrightarrow> (\<forall>x \<in> Lset(a). P(x) \<longleftrightarrow> Q(a,x))))"
 
 
 theorem Triv_reflection:
      "REFLECTS[P, \<lambda>a x. P(x)]"
 apply (simp add: L_Reflects_def)
 apply (rule meta_exI)
 apply (rule Closed_Unbounded_Ord)
 done
 
 theorem Not_reflection:
      "REFLECTS[P,Q] \<Longrightarrow> REFLECTS[\<lambda>x. \<not>P(x), \<lambda>a x. \<not>Q(a,x)]"
-apply (unfold L_Reflects_def)
+  unfolding L_Reflects_def
 apply (erule meta_exE)
 apply (rule_tac x=Cl in meta_exI, simp)
 done
 
 theorem And_reflection:
      "\<lbrakk>REFLECTS[P,Q]; REFLECTS[P',Q']\<rbrakk>
       \<Longrightarrow> REFLECTS[\<lambda>x. P(x) \<and> P'(x), \<lambda>a x. Q(a,x) \<and> Q'(a,x)]"
-apply (unfold L_Reflects_def)
+  unfolding L_Reflects_def
 apply (elim meta_exE)
 apply (rule_tac x="\<lambda>a. Cl(a) \<and> Cla(a)" in meta_exI)
 apply (simp add: Closed_Unbounded_Int, blast)
 done
 
 theorem Or_reflection:
      "\<lbrakk>REFLECTS[P,Q]; REFLECTS[P',Q']\<rbrakk>
       \<Longrightarrow> REFLECTS[\<lambda>x. P(x) \<or> P'(x), \<lambda>a x. Q(a,x) \<or> Q'(a,x)]"
-apply (unfold L_Reflects_def)
+  unfolding L_Reflects_def
 apply (elim meta_exE)
 apply (rule_tac x="\<lambda>a. Cl(a) \<and> Cla(a)" in meta_exI)
 apply (simp add: Closed_Unbounded_Int, blast)
 done
 
 theorem Imp_reflection:
      "\<lbrakk>REFLECTS[P,Q]; REFLECTS[P',Q']\<rbrakk>
       \<Longrightarrow> REFLECTS[\<lambda>x. P(x) \<longrightarrow> P'(x), \<lambda>a x. Q(a,x) \<longrightarrow> Q'(a,x)]"
-apply (unfold L_Reflects_def)
+  unfolding L_Reflects_def
 apply (elim meta_exE)
 apply (rule_tac x="\<lambda>a. Cl(a) \<and> Cla(a)" in meta_exI)
 apply (simp add: Closed_Unbounded_Int, blast)
 done
 
 theorem Iff_reflection:
      "\<lbrakk>REFLECTS[P,Q]; REFLECTS[P',Q']\<rbrakk>
       \<Longrightarrow> REFLECTS[\<lambda>x. P(x) \<longleftrightarrow> P'(x), \<lambda>a x. Q(a,x) \<longleftrightarrow> Q'(a,x)]"
-apply (unfold L_Reflects_def)
+  unfolding L_Reflects_def
 apply (elim meta_exE)
 apply (rule_tac x="\<lambda>a. Cl(a) \<and> Cla(a)" in meta_exI)
 apply (simp add: Closed_Unbounded_Int, blast)
 done
 
 
 lemma reflection_Lset: "reflection(Lset)"
 by (blast intro: reflection.intro Lset_mono_le Lset_cont 
                  Formula.Pair_in_LLimit)+
 
 
 theorem Ex_reflection:
      "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
       \<Longrightarrow> REFLECTS[\<lambda>x. \<exists>z. L(z) \<and> P(x,z), \<lambda>a x. \<exists>z\<in>Lset(a). Q(a,x,z)]"
 apply (unfold L_Reflects_def L_ClEx_def L_FF_def L_F0_def L_def)
 apply (elim meta_exE)
 apply (rule meta_exI)
 apply (erule reflection.Ex_reflection [OF reflection_Lset])
 done
 
 theorem All_reflection:
      "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
       \<Longrightarrow> REFLECTS[\<lambda>x. \<forall>z. L(z) \<longrightarrow> P(x,z), \<lambda>a x. \<forall>z\<in>Lset(a). Q(a,x,z)]"
 apply (unfold L_Reflects_def L_ClEx_def L_FF_def L_F0_def L_def)
 apply (elim meta_exE)
 apply (rule meta_exI)
 apply (erule reflection.All_reflection [OF reflection_Lset])
 done
 
 theorem Rex_reflection:
      "REFLECTS[ \<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
       \<Longrightarrow> REFLECTS[\<lambda>x. \<exists>z[L]. P(x,z), \<lambda>a x. \<exists>z\<in>Lset(a). Q(a,x,z)]"
-apply (unfold rex_def)
+  unfolding rex_def
 apply (intro And_reflection Ex_reflection, assumption)
 done
 
 theorem Rall_reflection:
      "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
       \<Longrightarrow> REFLECTS[\<lambda>x. \<forall>z[L]. P(x,z), \<lambda>a x. \<forall>z\<in>Lset(a). Q(a,x,z)]"
-apply (unfold rall_def)
+  unfolding rall_def
 apply (intro Imp_reflection All_reflection, assumption)
 done
 
 text\<open>This version handles an alternative form of the bounded quantifier
       in the second argument of \<open>REFLECTS\<close>.\<close>
 theorem Rex_reflection':
      "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
       \<Longrightarrow> REFLECTS[\<lambda>x. \<exists>z[L]. P(x,z), \<lambda>a x. \<exists>z[##Lset(a)]. Q(a,x,z)]"
 apply (unfold setclass_def rex_def)
 apply (erule Rex_reflection [unfolded rex_def Bex_def]) 
 done
 
 text\<open>As above.\<close>
 theorem Rall_reflection':
      "REFLECTS[\<lambda>x. P(fst(x),snd(x)), \<lambda>a x. Q(a,fst(x),snd(x))]
       \<Longrightarrow> REFLECTS[\<lambda>x. \<forall>z[L]. P(x,z), \<lambda>a x. \<forall>z[##Lset(a)]. Q(a,x,z)]"
 apply (unfold setclass_def rall_def)
 apply (erule Rall_reflection [unfolded rall_def Ball_def]) 
 done
 
 lemmas FOL_reflections =
         Triv_reflection Not_reflection And_reflection Or_reflection
         Imp_reflection Iff_reflection Ex_reflection All_reflection
         Rex_reflection Rall_reflection Rex_reflection' Rall_reflection'
 
 lemma ReflectsD:
      "\<lbrakk>REFLECTS[P,Q]; Ord(i)\<rbrakk>
       \<Longrightarrow> \<exists>j. i<j \<and> (\<forall>x \<in> Lset(j). P(x) \<longleftrightarrow> Q(j,x))"
 apply (unfold L_Reflects_def Closed_Unbounded_def)
 apply (elim meta_exE, clarify)
 apply (blast dest!: UnboundedD)
 done
 
 lemma ReflectsE:
      "\<lbrakk>REFLECTS[P,Q]; Ord(i);
          \<And>j. \<lbrakk>i<j;  \<forall>x \<in> Lset(j). P(x) \<longleftrightarrow> Q(j,x)\<rbrakk> \<Longrightarrow> R\<rbrakk>
       \<Longrightarrow> R"
 by (drule ReflectsD, assumption, blast)
 
 lemma Collect_mem_eq: "{x\<in>A. x\<in>B} = A \<inter> B"
 by blast
 
 
 subsection\<open>Internalized Formulas for some Set-Theoretic Concepts\<close>
 
 subsubsection\<open>Some numbers to help write de Bruijn indices\<close>
 
 abbreviation
   digit3 :: i   (\<open>3\<close>) where "3 \<equiv> succ(2)"
 
 abbreviation
   digit4 :: i   (\<open>4\<close>) where "4 \<equiv> succ(3)"
 
 abbreviation
   digit5 :: i   (\<open>5\<close>) where "5 \<equiv> succ(4)"
 
 abbreviation
   digit6 :: i   (\<open>6\<close>) where "6 \<equiv> succ(5)"
 
 abbreviation
   digit7 :: i   (\<open>7\<close>) where "7 \<equiv> succ(6)"
 
 abbreviation
   digit8 :: i   (\<open>8\<close>) where "8 \<equiv> succ(7)"
 
 abbreviation
   digit9 :: i   (\<open>9\<close>) where "9 \<equiv> succ(8)"
 
 
 subsubsection\<open>The Empty Set, Internalized\<close>
 
 definition
   empty_fm :: "i\<Rightarrow>i" where
     "empty_fm(x) \<equiv> Forall(Neg(Member(0,succ(x))))"
 
 lemma empty_type [TC]:
      "x \<in> nat \<Longrightarrow> empty_fm(x) \<in> formula"
 by (simp add: empty_fm_def)
 
 lemma sats_empty_fm [simp]:
    "\<lbrakk>x \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, empty_fm(x), env) \<longleftrightarrow> empty(##A, nth(x,env))"
 by (simp add: empty_fm_def empty_def)
 
 lemma empty_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> empty(##A, x) \<longleftrightarrow> sats(A, empty_fm(i), env)"
 by simp
 
 theorem empty_reflection:
      "REFLECTS[\<lambda>x. empty(L,f(x)),
                \<lambda>i x. empty(##Lset(i),f(x))]"
 apply (simp only: empty_def)
 apply (intro FOL_reflections)
 done
 
 text\<open>Not used.  But maybe useful?\<close>
 lemma Transset_sats_empty_fm_eq_0:
    "\<lbrakk>n \<in> nat; env \<in> list(A); Transset(A)\<rbrakk>
     \<Longrightarrow> sats(A, empty_fm(n), env) \<longleftrightarrow> nth(n,env) = 0"
 apply (simp add: empty_fm_def empty_def Transset_def, auto)
 apply (case_tac "n < length(env)")
 apply (frule nth_type, assumption+, blast)
 apply (simp_all add: not_lt_iff_le nth_eq_0)
 done
 
 
 subsubsection\<open>Unordered Pairs, Internalized\<close>
 
 definition
   upair_fm :: "[i,i,i]\<Rightarrow>i" where
     "upair_fm(x,y,z) \<equiv>
        And(Member(x,z),
            And(Member(y,z),
                Forall(Implies(Member(0,succ(z)),
                               Or(Equal(0,succ(x)), Equal(0,succ(y)))))))"
 
 lemma upair_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> upair_fm(x,y,z) \<in> formula"
 by (simp add: upair_fm_def)
 
 lemma sats_upair_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, upair_fm(x,y,z), env) \<longleftrightarrow>
             upair(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: upair_fm_def upair_def)
 
 lemma upair_iff_sats:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> upair(##A, x, y, z) \<longleftrightarrow> sats(A, upair_fm(i,j,k), env)"
 by (simp)
 
 text\<open>Useful? At least it refers to "real" unordered pairs\<close>
 lemma sats_upair_fm2 [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z < length(env); env \<in> list(A); Transset(A)\<rbrakk>
     \<Longrightarrow> sats(A, upair_fm(x,y,z), env) \<longleftrightarrow>
         nth(z,env) = {nth(x,env), nth(y,env)}"
 apply (frule lt_length_in_nat, assumption)
 apply (simp add: upair_fm_def Transset_def, auto)
 apply (blast intro: nth_type)
 done
 
 theorem upair_reflection:
      "REFLECTS[\<lambda>x. upair(L,f(x),g(x),h(x)),
                \<lambda>i x. upair(##Lset(i),f(x),g(x),h(x))]"
 apply (simp add: upair_def)
 apply (intro FOL_reflections)
 done
 
 subsubsection\<open>Ordered pairs, Internalized\<close>
 
 definition
   pair_fm :: "[i,i,i]\<Rightarrow>i" where
     "pair_fm(x,y,z) \<equiv>
        Exists(And(upair_fm(succ(x),succ(x),0),
               Exists(And(upair_fm(succ(succ(x)),succ(succ(y)),0),
                          upair_fm(1,0,succ(succ(z)))))))"
 
 lemma pair_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> pair_fm(x,y,z) \<in> formula"
 by (simp add: pair_fm_def)
 
 lemma sats_pair_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, pair_fm(x,y,z), env) \<longleftrightarrow>
         pair(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: pair_fm_def pair_def)
 
 lemma pair_iff_sats:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> pair(##A, x, y, z) \<longleftrightarrow> sats(A, pair_fm(i,j,k), env)"
 by (simp)
 
 theorem pair_reflection:
      "REFLECTS[\<lambda>x. pair(L,f(x),g(x),h(x)),
                \<lambda>i x. pair(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: pair_def)
 apply (intro FOL_reflections upair_reflection)
 done
 
 
 subsubsection\<open>Binary Unions, Internalized\<close>
 
 definition
   union_fm :: "[i,i,i]\<Rightarrow>i" where
     "union_fm(x,y,z) \<equiv>
        Forall(Iff(Member(0,succ(z)),
                   Or(Member(0,succ(x)),Member(0,succ(y)))))"
 
 lemma union_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> union_fm(x,y,z) \<in> formula"
 by (simp add: union_fm_def)
 
 lemma sats_union_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, union_fm(x,y,z), env) \<longleftrightarrow>
         union(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: union_fm_def union_def)
 
 lemma union_iff_sats:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> union(##A, x, y, z) \<longleftrightarrow> sats(A, union_fm(i,j,k), env)"
 by (simp)
 
 theorem union_reflection:
      "REFLECTS[\<lambda>x. union(L,f(x),g(x),h(x)),
                \<lambda>i x. union(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: union_def)
 apply (intro FOL_reflections)
 done
 
 
 subsubsection\<open>Set ``Cons,'' Internalized\<close>
 
 definition
   cons_fm :: "[i,i,i]\<Rightarrow>i" where
     "cons_fm(x,y,z) \<equiv>
        Exists(And(upair_fm(succ(x),succ(x),0),
                   union_fm(0,succ(y),succ(z))))"
 
 
 lemma cons_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> cons_fm(x,y,z) \<in> formula"
 by (simp add: cons_fm_def)
 
 lemma sats_cons_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> 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:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> 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 upair_reflection union_reflection)
 done
 
 
 subsubsection\<open>Successor Function, Internalized\<close>
 
 definition
   succ_fm :: "[i,i]\<Rightarrow>i" where
     "succ_fm(x,y) \<equiv> cons_fm(x,x,y)"
 
 lemma succ_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> succ_fm(x,y) \<in> formula"
 by (simp add: succ_fm_def)
 
 lemma sats_succ_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, succ_fm(x,y), env) \<longleftrightarrow>
         successor(##A, nth(x,env), nth(y,env))"
 by (simp add: succ_fm_def successor_def)
 
 lemma successor_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; j \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> successor(##A, x, y) \<longleftrightarrow> sats(A, succ_fm(i,j), env)"
 by simp
 
 theorem successor_reflection:
      "REFLECTS[\<lambda>x. successor(L,f(x),g(x)),
                \<lambda>i x. successor(##Lset(i),f(x),g(x))]"
 apply (simp only: successor_def)
 apply (intro cons_reflection)
 done
 
 
 subsubsection\<open>The Number 1, Internalized\<close>
 
 (* "number1(M,a) \<equiv> (\<exists>x[M]. empty(M,x) \<and> successor(M,x,a))" *)
 definition
   number1_fm :: "i\<Rightarrow>i" where
     "number1_fm(a) \<equiv> Exists(And(empty_fm(0), succ_fm(0,succ(a))))"
 
 lemma number1_type [TC]:
      "x \<in> nat \<Longrightarrow> number1_fm(x) \<in> formula"
 by (simp add: number1_fm_def)
 
 lemma sats_number1_fm [simp]:
    "\<lbrakk>x \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, number1_fm(x), env) \<longleftrightarrow> number1(##A, nth(x,env))"
 by (simp add: number1_fm_def number1_def)
 
 lemma number1_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> number1(##A, x) \<longleftrightarrow> sats(A, number1_fm(i), env)"
 by simp
 
 theorem number1_reflection:
      "REFLECTS[\<lambda>x. number1(L,f(x)),
                \<lambda>i x. number1(##Lset(i),f(x))]"
 apply (simp only: number1_def)
 apply (intro FOL_reflections empty_reflection successor_reflection)
 done
 
 
 subsubsection\<open>Big Union, Internalized\<close>
 
 (*  "big_union(M,A,z) \<equiv> \<forall>x[M]. x \<in> z \<longleftrightarrow> (\<exists>y[M]. y\<in>A \<and> x \<in> y)" *)
 definition
   big_union_fm :: "[i,i]\<Rightarrow>i" where
     "big_union_fm(A,z) \<equiv>
        Forall(Iff(Member(0,succ(z)),
                   Exists(And(Member(0,succ(succ(A))), Member(1,0)))))"
 
 lemma big_union_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> big_union_fm(x,y) \<in> formula"
 by (simp add: big_union_fm_def)
 
 lemma sats_big_union_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, big_union_fm(x,y), env) \<longleftrightarrow>
         big_union(##A, nth(x,env), nth(y,env))"
 by (simp add: big_union_fm_def big_union_def)
 
 lemma big_union_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; j \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> big_union(##A, x, y) \<longleftrightarrow> sats(A, big_union_fm(i,j), env)"
 by simp
 
 theorem big_union_reflection:
      "REFLECTS[\<lambda>x. big_union(L,f(x),g(x)),
                \<lambda>i x. big_union(##Lset(i),f(x),g(x))]"
 apply (simp only: big_union_def)
 apply (intro FOL_reflections)
 done
 
 
 subsubsection\<open>Variants of Satisfaction Definitions for Ordinals, etc.\<close>
 
 text\<open>The \<open>sats\<close> theorems below are standard versions of the ones proved
 in theory \<open>Formula\<close>.  They relate elements of type \<^term>\<open>formula\<close> to
 relativized concepts such as \<^term>\<open>subset\<close> or \<^term>\<open>ordinal\<close> rather than to
 real concepts such as \<^term>\<open>Ord\<close>.  Now that we have instantiated the locale
 \<open>M_trivial\<close>, we no longer require the earlier versions.\<close>
 
 lemma sats_subset_fm':
    "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, subset_fm(x,y), env) \<longleftrightarrow> subset(##A, nth(x,env), nth(y,env))"
 by (simp add: subset_fm_def Relative.subset_def)
 
 theorem subset_reflection:
      "REFLECTS[\<lambda>x. subset(L,f(x),g(x)),
                \<lambda>i x. subset(##Lset(i),f(x),g(x))]"
 apply (simp only: Relative.subset_def)
 apply (intro FOL_reflections)
 done
 
 lemma sats_transset_fm':
    "\<lbrakk>x \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, transset_fm(x), env) \<longleftrightarrow> transitive_set(##A, nth(x,env))"
 by (simp add: sats_subset_fm' transset_fm_def transitive_set_def)
 
 theorem transitive_set_reflection:
      "REFLECTS[\<lambda>x. transitive_set(L,f(x)),
                \<lambda>i x. transitive_set(##Lset(i),f(x))]"
 apply (simp only: transitive_set_def)
 apply (intro FOL_reflections subset_reflection)
 done
 
 lemma sats_ordinal_fm':
    "\<lbrakk>x \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, ordinal_fm(x), env) \<longleftrightarrow> ordinal(##A,nth(x,env))"
 by (simp add: sats_transset_fm' ordinal_fm_def ordinal_def)
 
 lemma ordinal_iff_sats:
       "\<lbrakk>nth(i,env) = x;  i \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> ordinal(##A, x) \<longleftrightarrow> sats(A, ordinal_fm(i), env)"
 by (simp add: sats_ordinal_fm')
 
 theorem ordinal_reflection:
      "REFLECTS[\<lambda>x. ordinal(L,f(x)), \<lambda>i x. ordinal(##Lset(i),f(x))]"
 apply (simp only: ordinal_def)
 apply (intro FOL_reflections transitive_set_reflection)
 done
 
 
 subsubsection\<open>Membership Relation, Internalized\<close>
 
 definition
   Memrel_fm :: "[i,i]\<Rightarrow>i" where
     "Memrel_fm(A,r) \<equiv>
        Forall(Iff(Member(0,succ(r)),
                   Exists(And(Member(0,succ(succ(A))),
                              Exists(And(Member(0,succ(succ(succ(A)))),
                                         And(Member(1,0),
                                             pair_fm(1,0,2))))))))"
 
 lemma Memrel_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> Memrel_fm(x,y) \<in> formula"
 by (simp add: Memrel_fm_def)
 
 lemma sats_Memrel_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, Memrel_fm(x,y), env) \<longleftrightarrow>
         membership(##A, nth(x,env), nth(y,env))"
 by (simp add: Memrel_fm_def membership_def)
 
 lemma Memrel_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; j \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> membership(##A, x, y) \<longleftrightarrow> sats(A, Memrel_fm(i,j), env)"
 by simp
 
 theorem membership_reflection:
      "REFLECTS[\<lambda>x. membership(L,f(x),g(x)),
                \<lambda>i x. membership(##Lset(i),f(x),g(x))]"
 apply (simp only: membership_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 subsubsection\<open>Predecessor Set, Internalized\<close>
 
 definition
   pred_set_fm :: "[i,i,i,i]\<Rightarrow>i" where
     "pred_set_fm(A,x,r,B) \<equiv>
        Forall(Iff(Member(0,succ(B)),
                   Exists(And(Member(0,succ(succ(r))),
                              And(Member(1,succ(succ(A))),
                                  pair_fm(1,succ(succ(x)),0))))))"
 
 
 lemma pred_set_type [TC]:
      "\<lbrakk>A \<in> nat; x \<in> nat; r \<in> nat; B \<in> nat\<rbrakk>
       \<Longrightarrow> pred_set_fm(A,x,r,B) \<in> formula"
 by (simp add: pred_set_fm_def)
 
 lemma sats_pred_set_fm [simp]:
    "\<lbrakk>U \<in> nat; x \<in> nat; r \<in> nat; B \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, pred_set_fm(U,x,r,B), env) \<longleftrightarrow>
         pred_set(##A, nth(U,env), nth(x,env), nth(r,env), nth(B,env))"
 by (simp add: pred_set_fm_def pred_set_def)
 
 lemma pred_set_iff_sats:
       "\<lbrakk>nth(i,env) = U; nth(j,env) = x; nth(k,env) = r; nth(l,env) = B;
           i \<in> nat; j \<in> nat; k \<in> nat; l \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> pred_set(##A,U,x,r,B) \<longleftrightarrow> sats(A, pred_set_fm(i,j,k,l), env)"
 by (simp)
 
 theorem pred_set_reflection:
      "REFLECTS[\<lambda>x. pred_set(L,f(x),g(x),h(x),b(x)),
                \<lambda>i x. pred_set(##Lset(i),f(x),g(x),h(x),b(x))]"
 apply (simp only: pred_set_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 
 
 subsubsection\<open>Domain of a Relation, Internalized\<close>
 
 (* "is_domain(M,r,z) \<equiv>
         \<forall>x[M]. (x \<in> z \<longleftrightarrow> (\<exists>w[M]. w\<in>r \<and> (\<exists>y[M]. pair(M,x,y,w))))" *)
 definition
   domain_fm :: "[i,i]\<Rightarrow>i" where
     "domain_fm(r,z) \<equiv>
        Forall(Iff(Member(0,succ(z)),
                   Exists(And(Member(0,succ(succ(r))),
                              Exists(pair_fm(2,0,1))))))"
 
 lemma domain_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> domain_fm(x,y) \<in> formula"
 by (simp add: domain_fm_def)
 
 lemma sats_domain_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, domain_fm(x,y), env) \<longleftrightarrow>
         is_domain(##A, nth(x,env), nth(y,env))"
 by (simp add: domain_fm_def is_domain_def)
 
 lemma domain_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; j \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> is_domain(##A, x, y) \<longleftrightarrow> sats(A, domain_fm(i,j), env)"
 by simp
 
 theorem domain_reflection:
      "REFLECTS[\<lambda>x. is_domain(L,f(x),g(x)),
                \<lambda>i x. is_domain(##Lset(i),f(x),g(x))]"
 apply (simp only: is_domain_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 
 subsubsection\<open>Range of a Relation, Internalized\<close>
 
 (* "is_range(M,r,z) \<equiv>
         \<forall>y[M]. (y \<in> z \<longleftrightarrow> (\<exists>w[M]. w\<in>r \<and> (\<exists>x[M]. pair(M,x,y,w))))" *)
 definition
   range_fm :: "[i,i]\<Rightarrow>i" where
     "range_fm(r,z) \<equiv>
        Forall(Iff(Member(0,succ(z)),
                   Exists(And(Member(0,succ(succ(r))),
                              Exists(pair_fm(0,2,1))))))"
 
 lemma range_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> range_fm(x,y) \<in> formula"
 by (simp add: range_fm_def)
 
 lemma sats_range_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, range_fm(x,y), env) \<longleftrightarrow>
         is_range(##A, nth(x,env), nth(y,env))"
 by (simp add: range_fm_def is_range_def)
 
 lemma range_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; j \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> is_range(##A, x, y) \<longleftrightarrow> sats(A, range_fm(i,j), env)"
 by simp
 
 theorem range_reflection:
      "REFLECTS[\<lambda>x. is_range(L,f(x),g(x)),
                \<lambda>i x. is_range(##Lset(i),f(x),g(x))]"
 apply (simp only: is_range_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 
 subsubsection\<open>Field of a Relation, Internalized\<close>
 
 (* "is_field(M,r,z) \<equiv>
         \<exists>dr[M]. is_domain(M,r,dr) \<and>
             (\<exists>rr[M]. is_range(M,r,rr) \<and> union(M,dr,rr,z))" *)
 definition
   field_fm :: "[i,i]\<Rightarrow>i" where
     "field_fm(r,z) \<equiv>
        Exists(And(domain_fm(succ(r),0),
               Exists(And(range_fm(succ(succ(r)),0),
                          union_fm(1,0,succ(succ(z)))))))"
 
 lemma field_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> field_fm(x,y) \<in> formula"
 by (simp add: field_fm_def)
 
 lemma sats_field_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, field_fm(x,y), env) \<longleftrightarrow>
         is_field(##A, nth(x,env), nth(y,env))"
 by (simp add: field_fm_def is_field_def)
 
 lemma field_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; j \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> is_field(##A, x, y) \<longleftrightarrow> sats(A, field_fm(i,j), env)"
 by simp
 
 theorem field_reflection:
      "REFLECTS[\<lambda>x. is_field(L,f(x),g(x)),
                \<lambda>i x. is_field(##Lset(i),f(x),g(x))]"
 apply (simp only: is_field_def)
 apply (intro FOL_reflections domain_reflection range_reflection
              union_reflection)
 done
 
 
 subsubsection\<open>Image under a Relation, Internalized\<close>
 
 (* "image(M,r,A,z) \<equiv>
         \<forall>y[M]. (y \<in> z \<longleftrightarrow> (\<exists>w[M]. w\<in>r \<and> (\<exists>x[M]. x\<in>A \<and> pair(M,x,y,w))))" *)
 definition
   image_fm :: "[i,i,i]\<Rightarrow>i" where
     "image_fm(r,A,z) \<equiv>
        Forall(Iff(Member(0,succ(z)),
                   Exists(And(Member(0,succ(succ(r))),
                              Exists(And(Member(0,succ(succ(succ(A)))),
                                         pair_fm(0,2,1)))))))"
 
 lemma image_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> image_fm(x,y,z) \<in> formula"
 by (simp add: image_fm_def)
 
 lemma sats_image_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, image_fm(x,y,z), env) \<longleftrightarrow>
         image(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: image_fm_def Relative.image_def)
 
 lemma image_iff_sats:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> image(##A, x, y, z) \<longleftrightarrow> sats(A, image_fm(i,j,k), env)"
 by (simp)
 
 theorem image_reflection:
      "REFLECTS[\<lambda>x. image(L,f(x),g(x),h(x)),
                \<lambda>i x. image(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: Relative.image_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 
 subsubsection\<open>Pre-Image under a Relation, Internalized\<close>
 
 (* "pre_image(M,r,A,z) \<equiv>
         \<forall>x[M]. x \<in> z \<longleftrightarrow> (\<exists>w[M]. w\<in>r \<and> (\<exists>y[M]. y\<in>A \<and> pair(M,x,y,w)))" *)
 definition
   pre_image_fm :: "[i,i,i]\<Rightarrow>i" where
     "pre_image_fm(r,A,z) \<equiv>
        Forall(Iff(Member(0,succ(z)),
                   Exists(And(Member(0,succ(succ(r))),
                              Exists(And(Member(0,succ(succ(succ(A)))),
                                         pair_fm(2,0,1)))))))"
 
 lemma pre_image_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> pre_image_fm(x,y,z) \<in> formula"
 by (simp add: pre_image_fm_def)
 
 lemma sats_pre_image_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, pre_image_fm(x,y,z), env) \<longleftrightarrow>
         pre_image(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: pre_image_fm_def Relative.pre_image_def)
 
 lemma pre_image_iff_sats:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> pre_image(##A, x, y, z) \<longleftrightarrow> sats(A, pre_image_fm(i,j,k), env)"
 by (simp)
 
 theorem pre_image_reflection:
      "REFLECTS[\<lambda>x. pre_image(L,f(x),g(x),h(x)),
                \<lambda>i x. pre_image(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: Relative.pre_image_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 
 subsubsection\<open>Function Application, Internalized\<close>
 
 (* "fun_apply(M,f,x,y) \<equiv>
         (\<exists>xs[M]. \<exists>fxs[M].
          upair(M,x,x,xs) \<and> image(M,f,xs,fxs) \<and> big_union(M,fxs,y))" *)
 definition
   fun_apply_fm :: "[i,i,i]\<Rightarrow>i" where
     "fun_apply_fm(f,x,y) \<equiv>
        Exists(Exists(And(upair_fm(succ(succ(x)), succ(succ(x)), 1),
                          And(image_fm(succ(succ(f)), 1, 0),
                              big_union_fm(0,succ(succ(y)))))))"
 
 lemma fun_apply_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> fun_apply_fm(x,y,z) \<in> formula"
 by (simp add: fun_apply_fm_def)
 
 lemma sats_fun_apply_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, fun_apply_fm(x,y,z), env) \<longleftrightarrow>
         fun_apply(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: fun_apply_fm_def fun_apply_def)
 
 lemma fun_apply_iff_sats:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> fun_apply(##A, x, y, z) \<longleftrightarrow> sats(A, fun_apply_fm(i,j,k), env)"
 by simp
 
 theorem fun_apply_reflection:
      "REFLECTS[\<lambda>x. fun_apply(L,f(x),g(x),h(x)),
                \<lambda>i x. fun_apply(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: fun_apply_def)
 apply (intro FOL_reflections upair_reflection image_reflection
              big_union_reflection)
 done
 
 
 subsubsection\<open>The Concept of Relation, Internalized\<close>
 
 (* "is_relation(M,r) \<equiv>
         (\<forall>z[M]. z\<in>r \<longrightarrow> (\<exists>x[M]. \<exists>y[M]. pair(M,x,y,z)))" *)
 definition
   relation_fm :: "i\<Rightarrow>i" where
     "relation_fm(r) \<equiv>
        Forall(Implies(Member(0,succ(r)), Exists(Exists(pair_fm(1,0,2)))))"
 
 lemma relation_type [TC]:
      "\<lbrakk>x \<in> nat\<rbrakk> \<Longrightarrow> relation_fm(x) \<in> formula"
 by (simp add: relation_fm_def)
 
 lemma sats_relation_fm [simp]:
    "\<lbrakk>x \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, relation_fm(x), env) \<longleftrightarrow> is_relation(##A, nth(x,env))"
 by (simp add: relation_fm_def is_relation_def)
 
 lemma relation_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> is_relation(##A, x) \<longleftrightarrow> sats(A, relation_fm(i), env)"
 by simp
 
 theorem is_relation_reflection:
      "REFLECTS[\<lambda>x. is_relation(L,f(x)),
                \<lambda>i x. is_relation(##Lset(i),f(x))]"
 apply (simp only: is_relation_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 
 subsubsection\<open>The Concept of Function, Internalized\<close>
 
 (* "is_function(M,r) \<equiv>
         \<forall>x[M]. \<forall>y[M]. \<forall>y'[M]. \<forall>p[M]. \<forall>p'[M].
            pair(M,x,y,p) \<longrightarrow> pair(M,x,y',p') \<longrightarrow> p\<in>r \<longrightarrow> p'\<in>r \<longrightarrow> y=y'" *)
 definition
   function_fm :: "i\<Rightarrow>i" where
     "function_fm(r) \<equiv>
        Forall(Forall(Forall(Forall(Forall(
          Implies(pair_fm(4,3,1),
                  Implies(pair_fm(4,2,0),
                          Implies(Member(1,r#+5),
                                  Implies(Member(0,r#+5), Equal(3,2))))))))))"
 
 lemma function_type [TC]:
      "\<lbrakk>x \<in> nat\<rbrakk> \<Longrightarrow> function_fm(x) \<in> formula"
 by (simp add: function_fm_def)
 
 lemma sats_function_fm [simp]:
    "\<lbrakk>x \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, function_fm(x), env) \<longleftrightarrow> is_function(##A, nth(x,env))"
 by (simp add: function_fm_def is_function_def)
 
 lemma is_function_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> is_function(##A, x) \<longleftrightarrow> sats(A, function_fm(i), env)"
 by simp
 
 theorem is_function_reflection:
      "REFLECTS[\<lambda>x. is_function(L,f(x)),
                \<lambda>i x. is_function(##Lset(i),f(x))]"
 apply (simp only: is_function_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 
 subsubsection\<open>Typed Functions, Internalized\<close>
 
 (* "typed_function(M,A,B,r) \<equiv>
         is_function(M,r) \<and> is_relation(M,r) \<and> is_domain(M,r,A) \<and>
         (\<forall>u[M]. u\<in>r \<longrightarrow> (\<forall>x[M]. \<forall>y[M]. pair(M,x,y,u) \<longrightarrow> y\<in>B))" *)
 
 definition
   typed_function_fm :: "[i,i,i]\<Rightarrow>i" where
     "typed_function_fm(A,B,r) \<equiv>
        And(function_fm(r),
          And(relation_fm(r),
            And(domain_fm(r,A),
              Forall(Implies(Member(0,succ(r)),
                   Forall(Forall(Implies(pair_fm(1,0,2),Member(0,B#+3)))))))))"
 
 lemma typed_function_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> typed_function_fm(x,y,z) \<in> formula"
 by (simp add: typed_function_fm_def)
 
 lemma sats_typed_function_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, typed_function_fm(x,y,z), env) \<longleftrightarrow>
         typed_function(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: typed_function_fm_def typed_function_def)
 
 lemma typed_function_iff_sats:
   "\<lbrakk>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)\<rbrakk>
    \<Longrightarrow> typed_function(##A, x, y, z) \<longleftrightarrow> sats(A, typed_function_fm(i,j,k), env)"
 by simp
 
 lemmas function_reflections =
         empty_reflection number1_reflection
         upair_reflection pair_reflection union_reflection
         big_union_reflection cons_reflection successor_reflection
         fun_apply_reflection subset_reflection
         transitive_set_reflection membership_reflection
         pred_set_reflection domain_reflection range_reflection field_reflection
         image_reflection pre_image_reflection
         is_relation_reflection is_function_reflection
 
 lemmas function_iff_sats =
         empty_iff_sats number1_iff_sats
         upair_iff_sats pair_iff_sats union_iff_sats
         big_union_iff_sats cons_iff_sats successor_iff_sats
         fun_apply_iff_sats  Memrel_iff_sats
         pred_set_iff_sats domain_iff_sats range_iff_sats field_iff_sats
         image_iff_sats pre_image_iff_sats
         relation_iff_sats is_function_iff_sats
 
 
 theorem typed_function_reflection:
      "REFLECTS[\<lambda>x. typed_function(L,f(x),g(x),h(x)),
                \<lambda>i x. typed_function(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: typed_function_def)
 apply (intro FOL_reflections function_reflections)
 done
 
 
 subsubsection\<open>Composition of Relations, Internalized\<close>
 
 (* "composition(M,r,s,t) \<equiv>
         \<forall>p[M]. p \<in> t \<longleftrightarrow>
                (\<exists>x[M]. \<exists>y[M]. \<exists>z[M]. \<exists>xy[M]. \<exists>yz[M].
                 pair(M,x,z,p) \<and> pair(M,x,y,xy) \<and> pair(M,y,z,yz) \<and>
                 xy \<in> s \<and> yz \<in> r)" *)
 definition
   composition_fm :: "[i,i,i]\<Rightarrow>i" where
   "composition_fm(r,s,t) \<equiv>
      Forall(Iff(Member(0,succ(t)),
              Exists(Exists(Exists(Exists(Exists(
               And(pair_fm(4,2,5),
                And(pair_fm(4,3,1),
                 And(pair_fm(3,2,0),
                  And(Member(1,s#+6), Member(0,r#+6))))))))))))"
 
 lemma composition_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> composition_fm(x,y,z) \<in> formula"
 by (simp add: composition_fm_def)
 
 lemma sats_composition_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, composition_fm(x,y,z), env) \<longleftrightarrow>
         composition(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: composition_fm_def composition_def)
 
 lemma composition_iff_sats:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> composition(##A, x, y, z) \<longleftrightarrow> sats(A, composition_fm(i,j,k), env)"
 by simp
 
 theorem composition_reflection:
      "REFLECTS[\<lambda>x. composition(L,f(x),g(x),h(x)),
                \<lambda>i x. composition(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: composition_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 
 subsubsection\<open>Injections, Internalized\<close>
 
 (* "injection(M,A,B,f) \<equiv>
         typed_function(M,A,B,f) \<and>
         (\<forall>x[M]. \<forall>x'[M]. \<forall>y[M]. \<forall>p[M]. \<forall>p'[M].
           pair(M,x,y,p) \<longrightarrow> pair(M,x',y,p') \<longrightarrow> p\<in>f \<longrightarrow> p'\<in>f \<longrightarrow> x=x')" *)
 definition
   injection_fm :: "[i,i,i]\<Rightarrow>i" where
   "injection_fm(A,B,f) \<equiv>
     And(typed_function_fm(A,B,f),
        Forall(Forall(Forall(Forall(Forall(
          Implies(pair_fm(4,2,1),
                  Implies(pair_fm(3,2,0),
                          Implies(Member(1,f#+5),
                                  Implies(Member(0,f#+5), Equal(4,3)))))))))))"
 
 
 lemma injection_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> injection_fm(x,y,z) \<in> formula"
 by (simp add: injection_fm_def)
 
 lemma sats_injection_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, injection_fm(x,y,z), env) \<longleftrightarrow>
         injection(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: injection_fm_def injection_def)
 
 lemma injection_iff_sats:
   "\<lbrakk>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)\<rbrakk>
    \<Longrightarrow> injection(##A, x, y, z) \<longleftrightarrow> sats(A, injection_fm(i,j,k), env)"
 by simp
 
 theorem injection_reflection:
      "REFLECTS[\<lambda>x. injection(L,f(x),g(x),h(x)),
                \<lambda>i x. injection(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: injection_def)
 apply (intro FOL_reflections function_reflections typed_function_reflection)
 done
 
 
 subsubsection\<open>Surjections, Internalized\<close>
 
 (*  surjection :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o"
     "surjection(M,A,B,f) \<equiv>
         typed_function(M,A,B,f) \<and>
         (\<forall>y[M]. y\<in>B \<longrightarrow> (\<exists>x[M]. x\<in>A \<and> fun_apply(M,f,x,y)))" *)
 definition
   surjection_fm :: "[i,i,i]\<Rightarrow>i" where
   "surjection_fm(A,B,f) \<equiv>
     And(typed_function_fm(A,B,f),
        Forall(Implies(Member(0,succ(B)),
                       Exists(And(Member(0,succ(succ(A))),
                                  fun_apply_fm(succ(succ(f)),0,1))))))"
 
 lemma surjection_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> surjection_fm(x,y,z) \<in> formula"
 by (simp add: surjection_fm_def)
 
 lemma sats_surjection_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, surjection_fm(x,y,z), env) \<longleftrightarrow>
         surjection(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: surjection_fm_def surjection_def)
 
 lemma surjection_iff_sats:
   "\<lbrakk>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)\<rbrakk>
    \<Longrightarrow> surjection(##A, x, y, z) \<longleftrightarrow> sats(A, surjection_fm(i,j,k), env)"
 by simp
 
 theorem surjection_reflection:
      "REFLECTS[\<lambda>x. surjection(L,f(x),g(x),h(x)),
                \<lambda>i x. surjection(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: surjection_def)
 apply (intro FOL_reflections function_reflections typed_function_reflection)
 done
 
 
 
 subsubsection\<open>Bijections, Internalized\<close>
 
 (*   bijection :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o"
     "bijection(M,A,B,f) \<equiv> injection(M,A,B,f) \<and> surjection(M,A,B,f)" *)
 definition
   bijection_fm :: "[i,i,i]\<Rightarrow>i" where
   "bijection_fm(A,B,f) \<equiv> And(injection_fm(A,B,f), surjection_fm(A,B,f))"
 
 lemma bijection_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> bijection_fm(x,y,z) \<in> formula"
 by (simp add: bijection_fm_def)
 
 lemma sats_bijection_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, bijection_fm(x,y,z), env) \<longleftrightarrow>
         bijection(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: bijection_fm_def bijection_def)
 
 lemma bijection_iff_sats:
   "\<lbrakk>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)\<rbrakk>
    \<Longrightarrow> bijection(##A, x, y, z) \<longleftrightarrow> sats(A, bijection_fm(i,j,k), env)"
 by simp
 
 theorem bijection_reflection:
      "REFLECTS[\<lambda>x. bijection(L,f(x),g(x),h(x)),
                \<lambda>i x. bijection(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: bijection_def)
 apply (intro And_reflection injection_reflection surjection_reflection)
 done
 
 
 subsubsection\<open>Restriction of a Relation, Internalized\<close>
 
 
 (* "restriction(M,r,A,z) \<equiv>
         \<forall>x[M]. x \<in> z \<longleftrightarrow> (x \<in> r \<and> (\<exists>u[M]. u\<in>A \<and> (\<exists>v[M]. pair(M,u,v,x))))" *)
 definition
   restriction_fm :: "[i,i,i]\<Rightarrow>i" where
     "restriction_fm(r,A,z) \<equiv>
        Forall(Iff(Member(0,succ(z)),
                   And(Member(0,succ(r)),
                       Exists(And(Member(0,succ(succ(A))),
                                  Exists(pair_fm(1,0,2)))))))"
 
 lemma restriction_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> restriction_fm(x,y,z) \<in> formula"
 by (simp add: restriction_fm_def)
 
 lemma sats_restriction_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, restriction_fm(x,y,z), env) \<longleftrightarrow>
         restriction(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: restriction_fm_def restriction_def)
 
 lemma restriction_iff_sats:
       "\<lbrakk>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)\<rbrakk>
        \<Longrightarrow> restriction(##A, x, y, z) \<longleftrightarrow> sats(A, restriction_fm(i,j,k), env)"
 by simp
 
 theorem restriction_reflection:
      "REFLECTS[\<lambda>x. restriction(L,f(x),g(x),h(x)),
                \<lambda>i x. restriction(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: restriction_def)
 apply (intro FOL_reflections pair_reflection)
 done
 
 subsubsection\<open>Order-Isomorphisms, Internalized\<close>
 
 (*  order_isomorphism :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o"
    "order_isomorphism(M,A,r,B,s,f) \<equiv>
         bijection(M,A,B,f) \<and>
         (\<forall>x[M]. x\<in>A \<longrightarrow> (\<forall>y[M]. y\<in>A \<longrightarrow>
           (\<forall>p[M]. \<forall>fx[M]. \<forall>fy[M]. \<forall>q[M].
             pair(M,x,y,p) \<longrightarrow> fun_apply(M,f,x,fx) \<longrightarrow> fun_apply(M,f,y,fy) \<longrightarrow>
             pair(M,fx,fy,q) \<longrightarrow> (p\<in>r \<longleftrightarrow> q\<in>s))))"
   *)
 
 definition
   order_isomorphism_fm :: "[i,i,i,i,i]\<Rightarrow>i" where
  "order_isomorphism_fm(A,r,B,s,f) \<equiv>
    And(bijection_fm(A,B,f),
      Forall(Implies(Member(0,succ(A)),
        Forall(Implies(Member(0,succ(succ(A))),
          Forall(Forall(Forall(Forall(
            Implies(pair_fm(5,4,3),
              Implies(fun_apply_fm(f#+6,5,2),
                Implies(fun_apply_fm(f#+6,4,1),
                  Implies(pair_fm(2,1,0),
                    Iff(Member(3,r#+6), Member(0,s#+6)))))))))))))))"
 
 lemma order_isomorphism_type [TC]:
      "\<lbrakk>A \<in> nat; r \<in> nat; B \<in> nat; s \<in> nat; f \<in> nat\<rbrakk>
       \<Longrightarrow> order_isomorphism_fm(A,r,B,s,f) \<in> formula"
 by (simp add: order_isomorphism_fm_def)
 
 lemma sats_order_isomorphism_fm [simp]:
    "\<lbrakk>U \<in> nat; r \<in> nat; B \<in> nat; s \<in> nat; f \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, order_isomorphism_fm(U,r,B,s,f), env) \<longleftrightarrow>
         order_isomorphism(##A, nth(U,env), nth(r,env), nth(B,env),
                                nth(s,env), nth(f,env))"
 by (simp add: order_isomorphism_fm_def order_isomorphism_def)
 
 lemma order_isomorphism_iff_sats:
   "\<lbrakk>nth(i,env) = U; nth(j,env) = r; nth(k,env) = B; nth(j',env) = s;
       nth(k',env) = f;
       i \<in> nat; j \<in> nat; k \<in> nat; j' \<in> nat; k' \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> order_isomorphism(##A,U,r,B,s,f) \<longleftrightarrow>
        sats(A, order_isomorphism_fm(i,j,k,j',k'), env)"
 by simp
 
 theorem order_isomorphism_reflection:
      "REFLECTS[\<lambda>x. order_isomorphism(L,f(x),g(x),h(x),g'(x),h'(x)),
                \<lambda>i x. order_isomorphism(##Lset(i),f(x),g(x),h(x),g'(x),h'(x))]"
 apply (simp only: order_isomorphism_def)
 apply (intro FOL_reflections function_reflections bijection_reflection)
 done
 
 subsubsection\<open>Limit Ordinals, Internalized\<close>
 
 text\<open>A limit ordinal is a non-empty, successor-closed ordinal\<close>
 
 (* "limit_ordinal(M,a) \<equiv>
         ordinal(M,a) \<and> \<not> empty(M,a) \<and>
         (\<forall>x[M]. x\<in>a \<longrightarrow> (\<exists>y[M]. y\<in>a \<and> successor(M,x,y)))" *)
 
 definition
   limit_ordinal_fm :: "i\<Rightarrow>i" where
     "limit_ordinal_fm(x) \<equiv>
         And(ordinal_fm(x),
             And(Neg(empty_fm(x)),
                 Forall(Implies(Member(0,succ(x)),
                                Exists(And(Member(0,succ(succ(x))),
                                           succ_fm(1,0)))))))"
 
 lemma limit_ordinal_type [TC]:
      "x \<in> nat \<Longrightarrow> limit_ordinal_fm(x) \<in> formula"
 by (simp add: limit_ordinal_fm_def)
 
 lemma sats_limit_ordinal_fm [simp]:
    "\<lbrakk>x \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, limit_ordinal_fm(x), env) \<longleftrightarrow> limit_ordinal(##A, nth(x,env))"
 by (simp add: limit_ordinal_fm_def limit_ordinal_def sats_ordinal_fm')
 
 lemma limit_ordinal_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> limit_ordinal(##A, x) \<longleftrightarrow> sats(A, limit_ordinal_fm(i), env)"
 by simp
 
 theorem limit_ordinal_reflection:
      "REFLECTS[\<lambda>x. limit_ordinal(L,f(x)),
                \<lambda>i x. limit_ordinal(##Lset(i),f(x))]"
 apply (simp only: limit_ordinal_def)
 apply (intro FOL_reflections ordinal_reflection
              empty_reflection successor_reflection)
 done
 
 subsubsection\<open>Finite Ordinals: The Predicate ``Is A Natural Number''\<close>
 
 (*     "finite_ordinal(M,a) \<equiv> 
         ordinal(M,a) \<and> \<not> limit_ordinal(M,a) \<and> 
         (\<forall>x[M]. x\<in>a \<longrightarrow> \<not> limit_ordinal(M,x))" *)
 definition
   finite_ordinal_fm :: "i\<Rightarrow>i" where
     "finite_ordinal_fm(x) \<equiv>
        And(ordinal_fm(x),
           And(Neg(limit_ordinal_fm(x)),
            Forall(Implies(Member(0,succ(x)),
                           Neg(limit_ordinal_fm(0))))))"
 
 lemma finite_ordinal_type [TC]:
      "x \<in> nat \<Longrightarrow> finite_ordinal_fm(x) \<in> formula"
 by (simp add: finite_ordinal_fm_def)
 
 lemma sats_finite_ordinal_fm [simp]:
    "\<lbrakk>x \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, finite_ordinal_fm(x), env) \<longleftrightarrow> finite_ordinal(##A, nth(x,env))"
 by (simp add: finite_ordinal_fm_def sats_ordinal_fm' finite_ordinal_def)
 
 lemma finite_ordinal_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> finite_ordinal(##A, x) \<longleftrightarrow> sats(A, finite_ordinal_fm(i), env)"
 by simp
 
 theorem finite_ordinal_reflection:
      "REFLECTS[\<lambda>x. finite_ordinal(L,f(x)),
                \<lambda>i x. finite_ordinal(##Lset(i),f(x))]"
 apply (simp only: finite_ordinal_def)
 apply (intro FOL_reflections ordinal_reflection limit_ordinal_reflection)
 done
 
 
 subsubsection\<open>Omega: The Set of Natural Numbers\<close>
 
 (* omega(M,a) \<equiv> limit_ordinal(M,a) \<and> (\<forall>x[M]. x\<in>a \<longrightarrow> \<not> limit_ordinal(M,x)) *)
 definition
   omega_fm :: "i\<Rightarrow>i" where
     "omega_fm(x) \<equiv>
        And(limit_ordinal_fm(x),
            Forall(Implies(Member(0,succ(x)),
                           Neg(limit_ordinal_fm(0)))))"
 
 lemma omega_type [TC]:
      "x \<in> nat \<Longrightarrow> omega_fm(x) \<in> formula"
 by (simp add: omega_fm_def)
 
 lemma sats_omega_fm [simp]:
    "\<lbrakk>x \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, omega_fm(x), env) \<longleftrightarrow> omega(##A, nth(x,env))"
 by (simp add: omega_fm_def omega_def)
 
 lemma omega_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y;
           i \<in> nat; env \<in> list(A)\<rbrakk>
        \<Longrightarrow> omega(##A, x) \<longleftrightarrow> sats(A, omega_fm(i), env)"
 by simp
 
 theorem omega_reflection:
      "REFLECTS[\<lambda>x. omega(L,f(x)),
                \<lambda>i x. omega(##Lset(i),f(x))]"
 apply (simp only: omega_def)
 apply (intro FOL_reflections limit_ordinal_reflection)
 done
 
 
 lemmas fun_plus_reflections =
         typed_function_reflection composition_reflection
         injection_reflection surjection_reflection
         bijection_reflection restriction_reflection
         order_isomorphism_reflection finite_ordinal_reflection 
         ordinal_reflection limit_ordinal_reflection omega_reflection
 
 lemmas fun_plus_iff_sats =
         typed_function_iff_sats composition_iff_sats
         injection_iff_sats surjection_iff_sats
         bijection_iff_sats restriction_iff_sats
         order_isomorphism_iff_sats finite_ordinal_iff_sats
         ordinal_iff_sats limit_ordinal_iff_sats omega_iff_sats
 
 end
diff --git a/src/ZF/Constructible/Normal.thy b/src/ZF/Constructible/Normal.thy
--- a/src/ZF/Constructible/Normal.thy
+++ b/src/ZF/Constructible/Normal.thy
@@ -1,503 +1,503 @@
 (*  Title:      ZF/Constructible/Normal.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
 *)
 
 section \<open>Closed Unbounded Classes and Normal Functions\<close>
 
 theory Normal imports ZF begin
 
 text\<open>
 One source is the book
 
 Frank R. Drake.
 \emph{Set Theory: An Introduction to Large Cardinals}.
 North-Holland, 1974.
 \<close>
 
 
 subsection \<open>Closed and Unbounded (c.u.) Classes of Ordinals\<close>
 
 definition
   Closed :: "(i\<Rightarrow>o) \<Rightarrow> o" where
     "Closed(P) \<equiv> \<forall>I. I \<noteq> 0 \<longrightarrow> (\<forall>i\<in>I. Ord(i) \<and> P(i)) \<longrightarrow> P(\<Union>(I))"
 
 definition
   Unbounded :: "(i\<Rightarrow>o) \<Rightarrow> o" where
     "Unbounded(P) \<equiv> \<forall>i. Ord(i) \<longrightarrow> (\<exists>j. i<j \<and> P(j))"
 
 definition
   Closed_Unbounded :: "(i\<Rightarrow>o) \<Rightarrow> o" where
     "Closed_Unbounded(P) \<equiv> Closed(P) \<and> Unbounded(P)"
 
 
 subsubsection\<open>Simple facts about c.u. classes\<close>
 
 lemma ClosedI:
   "\<lbrakk>\<And>I. \<lbrakk>I \<noteq> 0; \<forall>i\<in>I. Ord(i) \<and> P(i)\<rbrakk> \<Longrightarrow> P(\<Union>(I))\<rbrakk> 
       \<Longrightarrow> Closed(P)"
   by (simp add: Closed_def)
 
 lemma ClosedD:
   "\<lbrakk>Closed(P); I \<noteq> 0; \<And>i. i\<in>I \<Longrightarrow> Ord(i); \<And>i. i\<in>I \<Longrightarrow> P(i)\<rbrakk> 
       \<Longrightarrow> P(\<Union>(I))"
   by (simp add: Closed_def)
 
 lemma UnboundedD:
   "\<lbrakk>Unbounded(P);  Ord(i)\<rbrakk> \<Longrightarrow> \<exists>j. i<j \<and> P(j)"
   by (simp add: Unbounded_def)
 
 lemma Closed_Unbounded_imp_Unbounded: "Closed_Unbounded(C) \<Longrightarrow> Unbounded(C)"
   by (simp add: Closed_Unbounded_def) 
 
 
 text\<open>The universal class, V, is closed and unbounded.
       A bit odd, since C. U. concerns only ordinals, but it's used below!\<close>
 theorem Closed_Unbounded_V [simp]: "Closed_Unbounded(\<lambda>x. True)"
   by (unfold Closed_Unbounded_def Closed_def Unbounded_def, blast)
 
 text\<open>The class of ordinals, \<^term>\<open>Ord\<close>, is closed and unbounded.\<close>
 theorem Closed_Unbounded_Ord   [simp]: "Closed_Unbounded(Ord)"
   by (unfold Closed_Unbounded_def Closed_def Unbounded_def, blast)
 
 text\<open>The class of limit ordinals, \<^term>\<open>Limit\<close>, is closed and unbounded.\<close>
 theorem Closed_Unbounded_Limit [simp]: "Closed_Unbounded(Limit)"
   apply (simp add: Closed_Unbounded_def Closed_def Unbounded_def Limit_Union, 
       clarify)
   apply (rule_tac x="i++nat" in exI)  
   apply (blast intro: oadd_lt_self oadd_LimitI Limit_has_0) 
   done
 
 text\<open>The class of cardinals, \<^term>\<open>Card\<close>, is closed and unbounded.\<close>
 theorem Closed_Unbounded_Card  [simp]: "Closed_Unbounded(Card)"
   apply (simp add: Closed_Unbounded_def Closed_def Unbounded_def)
   apply (blast intro: lt_csucc Card_csucc)
   done
 
 
 subsubsection\<open>The intersection of any set-indexed family of c.u. classes is
       c.u.\<close>
 
 text\<open>The constructions below come from Kunen, \emph{Set Theory}, page 78.\<close>
 locale cub_family =
   fixes P and A
   fixes next_greater \<comment> \<open>the next ordinal satisfying class \<^term>\<open>A\<close>\<close>
   fixes sup_greater  \<comment> \<open>sup of those ordinals over all \<^term>\<open>A\<close>\<close>
   assumes closed:    "a\<in>A \<Longrightarrow> Closed(P(a))"
       and unbounded: "a\<in>A \<Longrightarrow> Unbounded(P(a))"
       and A_non0: "A\<noteq>0"
   defines "next_greater(a,x) \<equiv> \<mu> y. x<y \<and> P(a,y)"
       and "sup_greater(x) \<equiv> \<Union>a\<in>A. next_greater(a,x)"
 
 begin
 
 text\<open>Trivial that the intersection is closed.\<close>
 lemma Closed_INT: "Closed(\<lambda>x. \<forall>i\<in>A. P(i,x))"
   by (blast intro: ClosedI ClosedD [OF closed])
 
 text\<open>All remaining effort goes to show that the intersection is unbounded.\<close>
 
 lemma Ord_sup_greater:
   "Ord(sup_greater(x))"
   by (simp add: sup_greater_def next_greater_def)
 
 lemma Ord_next_greater:
   "Ord(next_greater(a,x))"
   by (simp add: next_greater_def)
 
 text\<open>\<^term>\<open>next_greater\<close> works as expected: it returns a larger value
 and one that belongs to class \<^term>\<open>P(a)\<close>.\<close>
 lemma next_greater_lemma:
   "\<lbrakk>Ord(x); a\<in>A\<rbrakk> \<Longrightarrow> P(a, next_greater(a,x)) \<and> x < next_greater(a,x)"
   apply (simp add: next_greater_def)
   apply (rule exE [OF UnboundedD [OF unbounded]])
     apply assumption+
   apply (blast intro: LeastI2 lt_Ord2) 
   done
 
 lemma next_greater_in_P:
   "\<lbrakk>Ord(x); a\<in>A\<rbrakk> \<Longrightarrow> P(a, next_greater(a,x))"
   by (blast dest: next_greater_lemma)
 
 lemma next_greater_gt:
   "\<lbrakk>Ord(x); a\<in>A\<rbrakk> \<Longrightarrow> x < next_greater(a,x)"
   by (blast dest: next_greater_lemma)
 
 lemma sup_greater_gt:
   "Ord(x) \<Longrightarrow> x < sup_greater(x)"
   apply (simp add: sup_greater_def)
   apply (insert A_non0)
   apply (blast intro: UN_upper_lt next_greater_gt Ord_next_greater)
   done
 
 lemma next_greater_le_sup_greater:
   "a\<in>A \<Longrightarrow> next_greater(a,x) \<le> sup_greater(x)"
   apply (simp add: sup_greater_def) 
   apply (blast intro: UN_upper_le Ord_next_greater)
   done
 
 lemma omega_sup_greater_eq_UN:
   "\<lbrakk>Ord(x); a\<in>A\<rbrakk> 
       \<Longrightarrow> sup_greater^\<omega> (x) = 
           (\<Union>n\<in>nat. next_greater(a, sup_greater^n (x)))"
   apply (simp add: iterates_omega_def)
   apply (rule le_anti_sym)
    apply (rule le_implies_UN_le_UN) 
    apply (blast intro: leI next_greater_gt Ord_iterates Ord_sup_greater)  
   txt\<open>Opposite bound:
 @{subgoals[display,indent=0,margin=65]}
 \<close>
   apply (rule UN_least_le) 
    apply (blast intro: Ord_iterates Ord_sup_greater)  
   apply (rule_tac a="succ(n)" in UN_upper_le)
     apply (simp_all add: next_greater_le_sup_greater) 
   apply (blast intro: Ord_iterates Ord_sup_greater)  
   done
 
 lemma P_omega_sup_greater:
   "\<lbrakk>Ord(x); a\<in>A\<rbrakk> \<Longrightarrow> P(a, sup_greater^\<omega> (x))"
   apply (simp add: omega_sup_greater_eq_UN)
   apply (rule ClosedD [OF closed]) 
      apply (blast intro: ltD, auto)
    apply (blast intro: Ord_iterates Ord_next_greater Ord_sup_greater)
   apply (blast intro: next_greater_in_P Ord_iterates Ord_sup_greater)
   done
 
 lemma omega_sup_greater_gt:
   "Ord(x) \<Longrightarrow> x < sup_greater^\<omega> (x)"
   apply (simp add: iterates_omega_def)
   apply (rule UN_upper_lt [of 1], simp_all) 
    apply (blast intro: sup_greater_gt) 
   apply (blast intro: Ord_iterates Ord_sup_greater)
   done
 
 lemma Unbounded_INT: "Unbounded(\<lambda>x. \<forall>a\<in>A. P(a,x))"
-  apply (unfold Unbounded_def)  
+    unfolding Unbounded_def  
   apply (blast intro!: omega_sup_greater_gt P_omega_sup_greater) 
   done
 
 lemma Closed_Unbounded_INT: 
   "Closed_Unbounded(\<lambda>x. \<forall>a\<in>A. P(a,x))"
   by (simp add: Closed_Unbounded_def Closed_INT Unbounded_INT)
 
 end
 
 
 theorem Closed_Unbounded_INT:
   "(\<And>a. a\<in>A \<Longrightarrow> Closed_Unbounded(P(a)))
      \<Longrightarrow> Closed_Unbounded(\<lambda>x. \<forall>a\<in>A. P(a, x))"
   apply (case_tac "A=0", simp)
   apply (rule cub_family.Closed_Unbounded_INT [OF cub_family.intro])
     apply (simp_all add: Closed_Unbounded_def)
   done
 
 lemma Int_iff_INT2:
   "P(x) \<and> Q(x)  \<longleftrightarrow>  (\<forall>i\<in>2. (i=0 \<longrightarrow> P(x)) \<and> (i=1 \<longrightarrow> Q(x)))"
   by auto
 
 theorem Closed_Unbounded_Int:
   "\<lbrakk>Closed_Unbounded(P); Closed_Unbounded(Q)\<rbrakk> 
       \<Longrightarrow> Closed_Unbounded(\<lambda>x. P(x) \<and> Q(x))"
   apply (simp only: Int_iff_INT2)
   apply (rule Closed_Unbounded_INT, auto) 
   done
 
 
 subsection \<open>Normal Functions\<close> 
 
 definition
   mono_le_subset :: "(i\<Rightarrow>i) \<Rightarrow> o" where
     "mono_le_subset(M) \<equiv> \<forall>i j. i\<le>j \<longrightarrow> M(i) \<subseteq> M(j)"
 
 definition
   mono_Ord :: "(i\<Rightarrow>i) \<Rightarrow> o" where
     "mono_Ord(F) \<equiv> \<forall>i j. i<j \<longrightarrow> F(i) < F(j)"
 
 definition
   cont_Ord :: "(i\<Rightarrow>i) \<Rightarrow> o" where
     "cont_Ord(F) \<equiv> \<forall>l. Limit(l) \<longrightarrow> F(l) = (\<Union>i<l. F(i))"
 
 definition
   Normal :: "(i\<Rightarrow>i) \<Rightarrow> o" where
     "Normal(F) \<equiv> mono_Ord(F) \<and> cont_Ord(F)"
 
 
 subsubsection\<open>Immediate properties of the definitions\<close>
 
 lemma NormalI:
   "\<lbrakk>\<And>i j. i<j \<Longrightarrow> F(i) < F(j);  \<And>l. Limit(l) \<Longrightarrow> F(l) = (\<Union>i<l. F(i))\<rbrakk>
       \<Longrightarrow> Normal(F)"
   by (simp add: Normal_def mono_Ord_def cont_Ord_def)
 
 lemma mono_Ord_imp_Ord: "\<lbrakk>Ord(i); mono_Ord(F)\<rbrakk> \<Longrightarrow> Ord(F(i))"
   apply (auto simp add: mono_Ord_def)
   apply (blast intro: lt_Ord) 
   done
 
 lemma mono_Ord_imp_mono: "\<lbrakk>i<j; mono_Ord(F)\<rbrakk> \<Longrightarrow> F(i) < F(j)"
   by (simp add: mono_Ord_def)
 
 lemma Normal_imp_Ord [simp]: "\<lbrakk>Normal(F); Ord(i)\<rbrakk> \<Longrightarrow> Ord(F(i))"
   by (simp add: Normal_def mono_Ord_imp_Ord) 
 
 lemma Normal_imp_cont: "\<lbrakk>Normal(F); Limit(l)\<rbrakk> \<Longrightarrow> F(l) = (\<Union>i<l. F(i))"
   by (simp add: Normal_def cont_Ord_def)
 
 lemma Normal_imp_mono: "\<lbrakk>i<j; Normal(F)\<rbrakk> \<Longrightarrow> F(i) < F(j)"
   by (simp add: Normal_def mono_Ord_def)
 
 lemma Normal_increasing:
   assumes i: "Ord(i)" and F: "Normal(F)" shows"i \<le> F(i)"
 using i
 proof (induct i rule: trans_induct3)
   case 0 thus ?case by (simp add: subset_imp_le F)
 next
   case (succ i) 
   hence "F(i) < F(succ(i))" using F
     by (simp add: Normal_def mono_Ord_def)
   thus ?case using succ.hyps
     by (blast intro: lt_trans1)
 next
   case (limit l) 
   hence "l = (\<Union>y<l. y)" 
     by (simp add: Limit_OUN_eq)
   also have "... \<le> (\<Union>y<l. F(y))" using limit
     by (blast intro: ltD le_implies_OUN_le_OUN)
   finally have "l \<le> (\<Union>y<l. F(y))" .
   moreover have "(\<Union>y<l. F(y)) \<le> F(l)" using limit F
     by (simp add: Normal_imp_cont lt_Ord)
   ultimately show ?case
     by (blast intro: le_trans) 
 qed
 
 
 subsubsection\<open>The class of fixedpoints is closed and unbounded\<close>
 
 text\<open>The proof is from Drake, pages 113--114.\<close>
 
 lemma mono_Ord_imp_le_subset: "mono_Ord(F) \<Longrightarrow> mono_le_subset(F)"
   apply (simp add: mono_le_subset_def, clarify)
   apply (subgoal_tac "F(i)\<le>F(j)", blast dest: le_imp_subset) 
   apply (simp add: le_iff) 
   apply (blast intro: lt_Ord2 mono_Ord_imp_Ord mono_Ord_imp_mono) 
   done
 
 text\<open>The following equation is taken for granted in any set theory text.\<close>
 lemma cont_Ord_Union:
   "\<lbrakk>cont_Ord(F); mono_le_subset(F); X=0 \<longrightarrow> F(0)=0; \<forall>x\<in>X. Ord(x)\<rbrakk> 
       \<Longrightarrow> F(\<Union>(X)) = (\<Union>y\<in>X. F(y))"
   apply (frule Ord_set_cases)
   apply (erule disjE, force) 
   apply (thin_tac "X=0 \<longrightarrow> Q" for Q, auto)
   txt\<open>The trival case of \<^term>\<open>\<Union>X \<in> X\<close>\<close>
    apply (rule equalityI, blast intro: Ord_Union_eq_succD) 
    apply (simp add: mono_le_subset_def UN_subset_iff le_subset_iff) 
    apply (blast elim: equalityE)
   txt\<open>The limit case, \<^term>\<open>Limit(\<Union>X)\<close>:
 @{subgoals[display,indent=0,margin=65]}
 \<close>
   apply (simp add: OUN_Union_eq cont_Ord_def)
   apply (rule equalityI) 
   txt\<open>First inclusion:\<close>
    apply (rule UN_least [OF OUN_least])
    apply (simp add: mono_le_subset_def, blast intro: leI) 
   txt\<open>Second inclusion:\<close>
   apply (rule UN_least) 
   apply (frule Union_upper_le, blast, blast)
   apply (erule leE, drule ltD, elim UnionE)
    apply (simp add: OUnion_def)
    apply blast+
   done
 
 lemma Normal_Union:
   "\<lbrakk>X\<noteq>0; \<forall>x\<in>X. Ord(x); Normal(F)\<rbrakk> \<Longrightarrow> F(\<Union>(X)) = (\<Union>y\<in>X. F(y))"
   apply (simp add: Normal_def) 
   apply (blast intro: mono_Ord_imp_le_subset cont_Ord_Union) 
   done
 
 lemma Normal_imp_fp_Closed: "Normal(F) \<Longrightarrow> Closed(\<lambda>i. F(i) = i)"
   apply (simp add: Closed_def ball_conj_distrib, clarify)
   apply (frule Ord_set_cases)
   apply (auto simp add: Normal_Union)
   done
 
 
 lemma iterates_Normal_increasing:
   "\<lbrakk>n\<in>nat;  x < F(x);  Normal(F)\<rbrakk> 
       \<Longrightarrow> F^n (x) < F^(succ(n)) (x)"  
   apply (induct n rule: nat_induct)
    apply (simp_all add: Normal_imp_mono)
   done
 
 lemma Ord_iterates_Normal:
      "\<lbrakk>n\<in>nat;  Normal(F);  Ord(x)\<rbrakk> \<Longrightarrow> Ord(F^n (x))"  
 by (simp) 
 
 text\<open>THIS RESULT IS UNUSED\<close>
 lemma iterates_omega_Limit:
   "\<lbrakk>Normal(F);  x < F(x)\<rbrakk> \<Longrightarrow> Limit(F^\<omega> (x))"  
   apply (frule lt_Ord) 
   apply (simp add: iterates_omega_def)
   apply (rule increasing_LimitI) 
     \<comment> \<open>this lemma is @{thm increasing_LimitI [no_vars]}\<close>
    apply (blast intro: UN_upper_lt [of "1"]   Normal_imp_Ord
       Ord_iterates lt_imp_0_lt
       iterates_Normal_increasing, clarify)
   apply (rule bexI) 
    apply (blast intro: Ord_in_Ord [OF Ord_iterates_Normal]) 
   apply (rule UN_I, erule nat_succI) 
   apply (blast intro:  iterates_Normal_increasing Ord_iterates_Normal
       ltD [OF lt_trans1, OF succ_leI, OF ltI]) 
   done
 
 lemma iterates_omega_fixedpoint:
      "\<lbrakk>Normal(F); Ord(a)\<rbrakk> \<Longrightarrow> F(F^\<omega> (a)) = F^\<omega> (a)" 
 apply (frule Normal_increasing, assumption)
 apply (erule leE) 
  apply (simp_all add: iterates_omega_triv [OF sym])  (*for subgoal 2*)
 apply (simp add:  iterates_omega_def Normal_Union) 
 apply (rule equalityI, force simp add: nat_succI) 
 txt\<open>Opposite inclusion:
 @{subgoals[display,indent=0,margin=65]}
 \<close>
 apply clarify
 apply (rule UN_I, assumption) 
 apply (frule iterates_Normal_increasing, assumption, assumption, simp)
 apply (blast intro: Ord_trans ltD Ord_iterates_Normal Normal_imp_Ord [of F]) 
 done
 
 lemma iterates_omega_increasing:
      "\<lbrakk>Normal(F); Ord(a)\<rbrakk> \<Longrightarrow> a \<le> F^\<omega> (a)"   
-apply (unfold iterates_omega_def)
+  unfolding iterates_omega_def
 apply (rule UN_upper_le [of 0], simp_all)
 done
 
 lemma Normal_imp_fp_Unbounded: "Normal(F) \<Longrightarrow> Unbounded(\<lambda>i. F(i) = i)"
 apply (unfold Unbounded_def, clarify)
 apply (rule_tac x="F^\<omega> (succ(i))" in exI)
 apply (simp add: iterates_omega_fixedpoint) 
 apply (blast intro: lt_trans2 [OF _ iterates_omega_increasing])
 done
 
 
 theorem Normal_imp_fp_Closed_Unbounded: 
      "Normal(F) \<Longrightarrow> Closed_Unbounded(\<lambda>i. F(i) = i)"
 by (simp add: Closed_Unbounded_def Normal_imp_fp_Closed
               Normal_imp_fp_Unbounded)
 
 
 subsubsection\<open>Function \<open>normalize\<close>\<close>
 
 text\<open>Function \<open>normalize\<close> maps a function \<open>F\<close> to a 
       normal function that bounds it above.  The result is normal if and
       only if \<open>F\<close> is continuous: succ is not bounded above by any 
       normal function, by @{thm [source] Normal_imp_fp_Unbounded}.
 \<close>
 definition
   normalize :: "[i\<Rightarrow>i, i] \<Rightarrow> i" where
     "normalize(F,a) \<equiv> transrec2(a, F(0), \<lambda>x r. F(succ(x)) \<union> succ(r))"
 
 
 lemma Ord_normalize [simp, intro]:
      "\<lbrakk>Ord(a); \<And>x. Ord(x) \<Longrightarrow> Ord(F(x))\<rbrakk> \<Longrightarrow> Ord(normalize(F, a))"
 apply (induct a rule: trans_induct3)
 apply (simp_all add: ltD def_transrec2 [OF normalize_def])
 done
 
 lemma normalize_increasing:
   assumes ab: "a < b" and F: "\<And>x. Ord(x) \<Longrightarrow> Ord(F(x))"
   shows "normalize(F,a) < normalize(F,b)"
 proof -
   { fix x
     have "Ord(b)" using ab by (blast intro: lt_Ord2) 
     hence "x < b \<Longrightarrow> normalize(F,x) < normalize(F,b)"
     proof (induct b arbitrary: x rule: trans_induct3)
       case 0 thus ?case by simp
     next
       case (succ b)
       thus ?case
         by (auto simp add: le_iff def_transrec2 [OF normalize_def] intro: Un_upper2_lt F)
     next
       case (limit l)
       hence sc: "succ(x) < l" 
         by (blast intro: Limit_has_succ) 
       hence "normalize(F,x) < normalize(F,succ(x))" 
         by (blast intro: limit elim: ltE) 
       hence "normalize(F,x) < (\<Union>j<l. normalize(F,j))"
         by (blast intro: OUN_upper_lt lt_Ord F sc) 
       thus ?case using limit
         by (simp add: def_transrec2 [OF normalize_def])
     qed
   } thus ?thesis using ab .
 qed
 
 theorem Normal_normalize:
   "(\<And>x. Ord(x) \<Longrightarrow> Ord(F(x))) \<Longrightarrow> Normal(normalize(F))"
   apply (rule NormalI) 
    apply (blast intro!: normalize_increasing)
   apply (simp add: def_transrec2 [OF normalize_def])
   done
 
 theorem le_normalize:
   assumes a: "Ord(a)" and coF: "cont_Ord(F)" and F: "\<And>x. Ord(x) \<Longrightarrow> Ord(F(x))"
   shows "F(a) \<le> normalize(F,a)"
 using a
 proof (induct a rule: trans_induct3)
   case 0 thus ?case by (simp add: F def_transrec2 [OF normalize_def])
 next
   case (succ a)
   thus ?case
     by (simp add: def_transrec2 [OF normalize_def] Un_upper1_le F )
 next
   case (limit l) 
   thus ?case using F coF [unfolded cont_Ord_def]
     by (simp add: def_transrec2 [OF normalize_def] le_implies_OUN_le_OUN ltD) 
 qed
 
 
 subsection \<open>The Alephs\<close>
 text \<open>This is the well-known transfinite enumeration of the cardinal 
 numbers.\<close>
 
 definition
   Aleph :: "i \<Rightarrow> i"  (\<open>\<aleph>_\<close> [90] 90) where
     "Aleph(a) \<equiv> transrec2(a, nat, \<lambda>x r. csucc(r))"
 
 lemma Card_Aleph [simp, intro]:
   "Ord(a) \<Longrightarrow> Card(Aleph(a))"
   apply (erule trans_induct3) 
     apply (simp_all add: Card_csucc Card_nat Card_is_Ord
       def_transrec2 [OF Aleph_def])
   done
 
 lemma Aleph_increasing:
   assumes ab: "a < b" shows "Aleph(a) < Aleph(b)"
 proof -
   { fix x
     have "Ord(b)" using ab by (blast intro: lt_Ord2) 
     hence "x < b \<Longrightarrow> Aleph(x) < Aleph(b)"
     proof (induct b arbitrary: x rule: trans_induct3)
       case 0 thus ?case by simp
     next
       case (succ b)
       thus ?case
         by (force simp add: le_iff def_transrec2 [OF Aleph_def] 
                   intro: lt_trans lt_csucc Card_is_Ord)
     next
       case (limit l)
       hence sc: "succ(x) < l" 
         by (blast intro: Limit_has_succ) 
       hence "\<aleph> x < (\<Union>j<l. \<aleph>j)" using limit
         by (blast intro: OUN_upper_lt Card_is_Ord ltD lt_Ord)
       thus ?case using limit
         by (simp add: def_transrec2 [OF Aleph_def])
     qed
   } thus ?thesis using ab .
 qed
 
 theorem Normal_Aleph: "Normal(Aleph)"
   apply (rule NormalI) 
    apply (blast intro!: Aleph_increasing)
   apply (simp add: def_transrec2 [OF Aleph_def])
   done
 
 end
diff --git a/src/ZF/Constructible/Satisfies_absolute.thy b/src/ZF/Constructible/Satisfies_absolute.thy
--- a/src/ZF/Constructible/Satisfies_absolute.thy
+++ b/src/ZF/Constructible/Satisfies_absolute.thy
@@ -1,1039 +1,1039 @@
 (*  Title:      ZF/Constructible/Satisfies_absolute.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
 *)
 
 section \<open>Absoluteness for the Satisfies Relation on Formulas\<close>
 
 theory Satisfies_absolute imports Datatype_absolute Rec_Separation begin 
 
 
 subsection \<open>More Internalization\<close>
 
 subsubsection\<open>The Formula \<^term>\<open>is_depth\<close>, Internalized\<close>
 
 (*    "is_depth(M,p,n) \<equiv> 
        \<exists>sn[M]. \<exists>formula_n[M]. \<exists>formula_sn[M]. 
          2          1                0
         is_formula_N(M,n,formula_n) \<and> p \<notin> formula_n \<and>
         successor(M,n,sn) \<and> is_formula_N(M,sn,formula_sn) \<and> p \<in> formula_sn" *)
 definition
   depth_fm :: "[i,i]\<Rightarrow>i" where
   "depth_fm(p,n) \<equiv> 
      Exists(Exists(Exists(
        And(formula_N_fm(n#+3,1),
          And(Neg(Member(p#+3,1)),
           And(succ_fm(n#+3,2),
            And(formula_N_fm(2,0), Member(p#+3,0))))))))"
 
 lemma depth_fm_type [TC]:
  "\<lbrakk>x \<in> nat; y \<in> nat\<rbrakk> \<Longrightarrow> depth_fm(x,y) \<in> formula"
 by (simp add: depth_fm_def)
 
 lemma sats_depth_fm [simp]:
    "\<lbrakk>x \<in> nat; y < length(env); env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, depth_fm(x,y), env) \<longleftrightarrow>
         is_depth(##A, nth(x,env), nth(y,env))"
 apply (frule_tac x=y in lt_length_in_nat, assumption)  
 apply (simp add: depth_fm_def is_depth_def) 
 done
 
 lemma depth_iff_sats:
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y; 
           i \<in> nat; j < length(env); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> is_depth(##A, x, y) \<longleftrightarrow> sats(A, depth_fm(i,j), env)"
 by (simp)
 
 theorem depth_reflection:
      "REFLECTS[\<lambda>x. is_depth(L, f(x), g(x)),  
                \<lambda>i x. is_depth(##Lset(i), f(x), g(x))]"
 apply (simp only: is_depth_def)
 apply (intro FOL_reflections function_reflections formula_N_reflection) 
 done
 
 
 
 subsubsection\<open>The Operator \<^term>\<open>is_formula_case\<close>\<close>
 
 text\<open>The arguments of \<^term>\<open>is_a\<close> are always 2, 1, 0, and the formula
       will be enclosed by three quantifiers.\<close>
 
 (* is_formula_case :: 
     "[i\<Rightarrow>o, [i,i,i]\<Rightarrow>o, [i,i,i]\<Rightarrow>o, [i,i,i]\<Rightarrow>o, [i,i]\<Rightarrow>o, i, i] \<Rightarrow> o"
   "is_formula_case(M, is_a, is_b, is_c, is_d, v, z) \<equiv> 
       (\<forall>x[M]. \<forall>y[M]. x\<in>nat \<longrightarrow> y\<in>nat \<longrightarrow> is_Member(M,x,y,v) \<longrightarrow> is_a(x,y,z)) \<and>
       (\<forall>x[M]. \<forall>y[M]. x\<in>nat \<longrightarrow> y\<in>nat \<longrightarrow> is_Equal(M,x,y,v) \<longrightarrow> is_b(x,y,z)) \<and>
       (\<forall>x[M]. \<forall>y[M]. x\<in>formula \<longrightarrow> y\<in>formula \<longrightarrow> 
                      is_Nand(M,x,y,v) \<longrightarrow> is_c(x,y,z)) \<and>
       (\<forall>x[M]. x\<in>formula \<longrightarrow> is_Forall(M,x,v) \<longrightarrow> is_d(x,z))" *)
 
 definition
   formula_case_fm :: "[i, i, i, i, i, i]\<Rightarrow>i" where
   "formula_case_fm(is_a, is_b, is_c, is_d, v, z) \<equiv> 
         And(Forall(Forall(Implies(finite_ordinal_fm(1), 
                            Implies(finite_ordinal_fm(0), 
                             Implies(Member_fm(1,0,v#+2), 
                              Forall(Implies(Equal(0,z#+3), is_a))))))),
         And(Forall(Forall(Implies(finite_ordinal_fm(1), 
                            Implies(finite_ordinal_fm(0), 
                             Implies(Equal_fm(1,0,v#+2), 
                              Forall(Implies(Equal(0,z#+3), is_b))))))),
         And(Forall(Forall(Implies(mem_formula_fm(1), 
                            Implies(mem_formula_fm(0), 
                             Implies(Nand_fm(1,0,v#+2), 
                              Forall(Implies(Equal(0,z#+3), is_c))))))),
         Forall(Implies(mem_formula_fm(0), 
                        Implies(Forall_fm(0,succ(v)), 
                              Forall(Implies(Equal(0,z#+2), is_d))))))))"
 
 
 lemma is_formula_case_type [TC]:
      "\<lbrakk>is_a \<in> formula;  is_b \<in> formula;  is_c \<in> formula;  is_d \<in> formula;  
          x \<in> nat; y \<in> nat\<rbrakk> 
       \<Longrightarrow> formula_case_fm(is_a, is_b, is_c, is_d, x, y) \<in> formula"
 by (simp add: formula_case_fm_def)
 
 lemma sats_formula_case_fm:
   assumes is_a_iff_sats: 
       "\<And>a0 a1 a2. 
         \<lbrakk>a0\<in>A; a1\<in>A; a2\<in>A\<rbrakk>  
         \<Longrightarrow> ISA(a2, a1, a0) \<longleftrightarrow> sats(A, is_a, Cons(a0,Cons(a1,Cons(a2,env))))"
   and is_b_iff_sats: 
       "\<And>a0 a1 a2. 
         \<lbrakk>a0\<in>A; a1\<in>A; a2\<in>A\<rbrakk>  
         \<Longrightarrow> ISB(a2, a1, a0) \<longleftrightarrow> sats(A, is_b, Cons(a0,Cons(a1,Cons(a2,env))))"
   and is_c_iff_sats: 
       "\<And>a0 a1 a2. 
         \<lbrakk>a0\<in>A; a1\<in>A; a2\<in>A\<rbrakk>  
         \<Longrightarrow> ISC(a2, a1, a0) \<longleftrightarrow> sats(A, is_c, Cons(a0,Cons(a1,Cons(a2,env))))"
   and is_d_iff_sats: 
       "\<And>a0 a1. 
         \<lbrakk>a0\<in>A; a1\<in>A\<rbrakk>  
         \<Longrightarrow> ISD(a1, a0) \<longleftrightarrow> sats(A, is_d, Cons(a0,Cons(a1,env)))"
   shows 
       "\<lbrakk>x \<in> nat; y < length(env); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> sats(A, formula_case_fm(is_a,is_b,is_c,is_d,x,y), env) \<longleftrightarrow>
            is_formula_case(##A, ISA, ISB, ISC, ISD, nth(x,env), nth(y,env))"
 apply (frule_tac x=y in lt_length_in_nat, assumption)  
 apply (simp add: formula_case_fm_def is_formula_case_def 
                  is_a_iff_sats [THEN iff_sym] is_b_iff_sats [THEN iff_sym]
                  is_c_iff_sats [THEN iff_sym] is_d_iff_sats [THEN iff_sym])
 done
 
 lemma formula_case_iff_sats:
   assumes is_a_iff_sats: 
       "\<And>a0 a1 a2. 
         \<lbrakk>a0\<in>A; a1\<in>A; a2\<in>A\<rbrakk>  
         \<Longrightarrow> ISA(a2, a1, a0) \<longleftrightarrow> sats(A, is_a, Cons(a0,Cons(a1,Cons(a2,env))))"
   and is_b_iff_sats: 
       "\<And>a0 a1 a2. 
         \<lbrakk>a0\<in>A; a1\<in>A; a2\<in>A\<rbrakk>  
         \<Longrightarrow> ISB(a2, a1, a0) \<longleftrightarrow> sats(A, is_b, Cons(a0,Cons(a1,Cons(a2,env))))"
   and is_c_iff_sats: 
       "\<And>a0 a1 a2. 
         \<lbrakk>a0\<in>A; a1\<in>A; a2\<in>A\<rbrakk>  
         \<Longrightarrow> ISC(a2, a1, a0) \<longleftrightarrow> sats(A, is_c, Cons(a0,Cons(a1,Cons(a2,env))))"
   and is_d_iff_sats: 
       "\<And>a0 a1. 
         \<lbrakk>a0\<in>A; a1\<in>A\<rbrakk>  
         \<Longrightarrow> ISD(a1, a0) \<longleftrightarrow> sats(A, is_d, Cons(a0,Cons(a1,env)))"
   shows 
       "\<lbrakk>nth(i,env) = x; nth(j,env) = y; 
       i \<in> nat; j < length(env); env \<in> list(A)\<rbrakk>
        \<Longrightarrow> is_formula_case(##A, ISA, ISB, ISC, ISD, x, y) \<longleftrightarrow>
            sats(A, formula_case_fm(is_a,is_b,is_c,is_d,i,j), env)"
 by (simp add: sats_formula_case_fm [OF is_a_iff_sats is_b_iff_sats 
                                        is_c_iff_sats is_d_iff_sats])
 
 
 text\<open>The second argument of \<^term>\<open>is_a\<close> gives it direct access to \<^term>\<open>x\<close>,
   which is essential for handling free variable references.  Treatment is
   based on that of \<open>is_nat_case_reflection\<close>.\<close>
 theorem is_formula_case_reflection:
   assumes is_a_reflection:
     "\<And>h f g g'. REFLECTS[\<lambda>x. is_a(L, h(x), f(x), g(x), g'(x)),
                      \<lambda>i x. is_a(##Lset(i), h(x), f(x), g(x), g'(x))]"
   and is_b_reflection:
     "\<And>h f g g'. REFLECTS[\<lambda>x. is_b(L, h(x), f(x), g(x), g'(x)),
                      \<lambda>i x. is_b(##Lset(i), h(x), f(x), g(x), g'(x))]"
   and is_c_reflection:
     "\<And>h f g g'. REFLECTS[\<lambda>x. is_c(L, h(x), f(x), g(x), g'(x)),
                      \<lambda>i x. is_c(##Lset(i), h(x), f(x), g(x), g'(x))]"
   and is_d_reflection:
     "\<And>h f g g'. REFLECTS[\<lambda>x. is_d(L, h(x), f(x), g(x)),
                      \<lambda>i x. is_d(##Lset(i), h(x), f(x), g(x))]"
   shows "REFLECTS[\<lambda>x. is_formula_case(L, is_a(L,x), is_b(L,x), is_c(L,x), is_d(L,x), g(x), h(x)),
                \<lambda>i x. is_formula_case(##Lset(i), is_a(##Lset(i), x), is_b(##Lset(i), x), is_c(##Lset(i), x), is_d(##Lset(i), x), g(x), h(x))]"
 apply (simp (no_asm_use) only: is_formula_case_def)
 apply (intro FOL_reflections function_reflections finite_ordinal_reflection
          mem_formula_reflection
          Member_reflection Equal_reflection Nand_reflection Forall_reflection
          is_a_reflection is_b_reflection is_c_reflection is_d_reflection)
 done
 
 
 
 subsection \<open>Absoluteness for the Function \<^term>\<open>satisfies\<close>\<close>
 
 definition
   is_depth_apply :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
    \<comment> \<open>Merely a useful abbreviation for the sequel.\<close>
   "is_depth_apply(M,h,p,z) \<equiv>
     \<exists>dp[M]. \<exists>sdp[M]. \<exists>hsdp[M]. 
         finite_ordinal(M,dp) \<and> is_depth(M,p,dp) \<and> successor(M,dp,sdp) \<and>
         fun_apply(M,h,sdp,hsdp) \<and> fun_apply(M,hsdp,p,z)"
 
 lemma (in M_datatypes) is_depth_apply_abs [simp]:
      "\<lbrakk>M(h); p \<in> formula; M(z)\<rbrakk> 
       \<Longrightarrow> is_depth_apply(M,h,p,z) \<longleftrightarrow> z = h ` succ(depth(p)) ` p"
 by (simp add: is_depth_apply_def formula_into_M depth_type eq_commute)
 
 
 
 text\<open>There is at present some redundancy between the relativizations in
  e.g. \<open>satisfies_is_a\<close> and those in e.g. \<open>Member_replacement\<close>.\<close>
 
 text\<open>These constants let us instantiate the parameters \<^term>\<open>a\<close>, \<^term>\<open>b\<close>,
       \<^term>\<open>c\<close>, \<^term>\<open>d\<close>, etc., of the locale \<open>Formula_Rec\<close>.\<close>
 definition
   satisfies_a :: "[i,i,i]\<Rightarrow>i" where
    "satisfies_a(A) \<equiv> 
     \<lambda>x y. \<lambda>env \<in> list(A). bool_of_o (nth(x,env) \<in> nth(y,env))"
 
 definition
   satisfies_is_a :: "[i\<Rightarrow>o,i,i,i,i]\<Rightarrow>o" where
    "satisfies_is_a(M,A) \<equiv> 
     \<lambda>x y zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
              is_lambda(M, lA, 
                 \<lambda>env z. is_bool_of_o(M, 
                       \<exists>nx[M]. \<exists>ny[M]. 
                        is_nth(M,x,env,nx) \<and> is_nth(M,y,env,ny) \<and> nx \<in> ny, z),
                 zz)"
 
 definition
   satisfies_b :: "[i,i,i]\<Rightarrow>i" where
    "satisfies_b(A) \<equiv>
     \<lambda>x y. \<lambda>env \<in> list(A). bool_of_o (nth(x,env) = nth(y,env))"
 
 definition
   satisfies_is_b :: "[i\<Rightarrow>o,i,i,i,i]\<Rightarrow>o" where
    \<comment> \<open>We simplify the formula to have just \<^term>\<open>nx\<close> rather than 
        introducing \<^term>\<open>ny\<close> with  \<^term>\<open>nx=ny\<close>\<close>
   "satisfies_is_b(M,A) \<equiv> 
     \<lambda>x y zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
              is_lambda(M, lA, 
                 \<lambda>env z. is_bool_of_o(M, 
                       \<exists>nx[M]. is_nth(M,x,env,nx) \<and> is_nth(M,y,env,nx), z),
                 zz)"
 
 definition 
   satisfies_c :: "[i,i,i,i,i]\<Rightarrow>i" where
    "satisfies_c(A) \<equiv> \<lambda>p q rp rq. \<lambda>env \<in> list(A). not(rp ` env and rq ` env)"
 
 definition
   satisfies_is_c :: "[i\<Rightarrow>o,i,i,i,i,i]\<Rightarrow>o" where
    "satisfies_is_c(M,A,h) \<equiv> 
     \<lambda>p q zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
              is_lambda(M, lA, \<lambda>env z. \<exists>hp[M]. \<exists>hq[M]. 
                  (\<exists>rp[M]. is_depth_apply(M,h,p,rp) \<and> fun_apply(M,rp,env,hp)) \<and> 
                  (\<exists>rq[M]. is_depth_apply(M,h,q,rq) \<and> fun_apply(M,rq,env,hq)) \<and> 
                  (\<exists>pq[M]. is_and(M,hp,hq,pq) \<and> is_not(M,pq,z)),
                 zz)"
 
 definition
   satisfies_d :: "[i,i,i]\<Rightarrow>i" where
    "satisfies_d(A) 
     \<equiv> \<lambda>p rp. \<lambda>env \<in> list(A). bool_of_o (\<forall>x\<in>A. rp ` (Cons(x,env)) = 1)"
 
 definition
   satisfies_is_d :: "[i\<Rightarrow>o,i,i,i,i]\<Rightarrow>o" where
    "satisfies_is_d(M,A,h) \<equiv> 
     \<lambda>p zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
              is_lambda(M, lA, 
                 \<lambda>env z. \<exists>rp[M]. is_depth_apply(M,h,p,rp) \<and> 
                     is_bool_of_o(M, 
                            \<forall>x[M]. \<forall>xenv[M]. \<forall>hp[M]. 
                               x\<in>A \<longrightarrow> is_Cons(M,x,env,xenv) \<longrightarrow> 
                               fun_apply(M,rp,xenv,hp) \<longrightarrow> number1(M,hp),
                   z),
                zz)"
 
 definition
   satisfies_MH :: "[i\<Rightarrow>o,i,i,i,i]\<Rightarrow>o" where
     \<comment> \<open>The variable \<^term>\<open>u\<close> is unused, but gives \<^term>\<open>satisfies_MH\<close> 
         the correct arity.\<close>
   "satisfies_MH \<equiv> 
     \<lambda>M A u f z. 
          \<forall>fml[M]. is_formula(M,fml) \<longrightarrow>
              is_lambda (M, fml, 
                is_formula_case (M, satisfies_is_a(M,A), 
                                 satisfies_is_b(M,A), 
                                 satisfies_is_c(M,A,f), satisfies_is_d(M,A,f)),
                z)"
 
 definition
   is_satisfies :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
   "is_satisfies(M,A) \<equiv> is_formula_rec (M, satisfies_MH(M,A))"
 
 
 text\<open>This lemma relates the fragments defined above to the original primitive
       recursion in \<^term>\<open>satisfies\<close>.
       Induction is not required: the definitions are directly equal!\<close>
 lemma satisfies_eq:
   "satisfies(A,p) = 
    formula_rec (satisfies_a(A), satisfies_b(A), 
                 satisfies_c(A), satisfies_d(A), p)"
 by (simp add: satisfies_formula_def satisfies_a_def satisfies_b_def 
               satisfies_c_def satisfies_d_def) 
 
 text\<open>Further constraints on the class \<^term>\<open>M\<close> in order to prove
       absoluteness for the constants defined above.  The ultimate goal
       is the absoluteness of the function \<^term>\<open>satisfies\<close>.\<close>
 locale M_satisfies = M_eclose +
  assumes 
    Member_replacement:
     "\<lbrakk>M(A); x \<in> nat; y \<in> nat\<rbrakk>
      \<Longrightarrow> strong_replacement
          (M, \<lambda>env z. \<exists>bo[M]. \<exists>nx[M]. \<exists>ny[M]. 
               env \<in> list(A) \<and> is_nth(M,x,env,nx) \<and> is_nth(M,y,env,ny) \<and> 
               is_bool_of_o(M, nx \<in> ny, bo) \<and>
               pair(M, env, bo, z))"
  and
    Equal_replacement:
     "\<lbrakk>M(A); x \<in> nat; y \<in> nat\<rbrakk>
      \<Longrightarrow> strong_replacement
          (M, \<lambda>env z. \<exists>bo[M]. \<exists>nx[M]. \<exists>ny[M]. 
               env \<in> list(A) \<and> is_nth(M,x,env,nx) \<and> is_nth(M,y,env,ny) \<and> 
               is_bool_of_o(M, nx = ny, bo) \<and>
               pair(M, env, bo, z))"
  and
    Nand_replacement:
     "\<lbrakk>M(A); M(rp); M(rq)\<rbrakk>
      \<Longrightarrow> strong_replacement
          (M, \<lambda>env z. \<exists>rpe[M]. \<exists>rqe[M]. \<exists>andpq[M]. \<exists>notpq[M]. 
                fun_apply(M,rp,env,rpe) \<and> fun_apply(M,rq,env,rqe) \<and> 
                is_and(M,rpe,rqe,andpq) \<and> is_not(M,andpq,notpq) \<and> 
                env \<in> list(A) \<and> pair(M, env, notpq, z))"
  and
   Forall_replacement:
    "\<lbrakk>M(A); M(rp)\<rbrakk>
     \<Longrightarrow> strong_replacement
         (M, \<lambda>env z. \<exists>bo[M]. 
               env \<in> list(A) \<and> 
               is_bool_of_o (M, 
                             \<forall>a[M]. \<forall>co[M]. \<forall>rpco[M]. 
                                a\<in>A \<longrightarrow> is_Cons(M,a,env,co) \<longrightarrow>
                                fun_apply(M,rp,co,rpco) \<longrightarrow> number1(M, rpco), 
                             bo) \<and>
               pair(M,env,bo,z))"
  and
   formula_rec_replacement: 
       \<comment> \<open>For the \<^term>\<open>transrec\<close>\<close>
    "\<lbrakk>n \<in> nat; M(A)\<rbrakk> \<Longrightarrow> transrec_replacement(M, satisfies_MH(M,A), n)"
  and
   formula_rec_lambda_replacement:  
       \<comment> \<open>For the \<open>\<lambda>-abstraction\<close> in the \<^term>\<open>transrec\<close> body\<close>
    "\<lbrakk>M(g); M(A)\<rbrakk> \<Longrightarrow>
     strong_replacement (M, 
        \<lambda>x y. mem_formula(M,x) \<and>
              (\<exists>c[M]. is_formula_case(M, satisfies_is_a(M,A),
                                   satisfies_is_b(M,A),
                                   satisfies_is_c(M,A,g),
                                   satisfies_is_d(M,A,g), x, c) \<and>
              pair(M, x, c, y)))"
 
 
 lemma (in M_satisfies) Member_replacement':
     "\<lbrakk>M(A); x \<in> nat; y \<in> nat\<rbrakk>
      \<Longrightarrow> strong_replacement
          (M, \<lambda>env z. env \<in> list(A) \<and>
                      z = \<langle>env, bool_of_o(nth(x, env) \<in> nth(y, env))\<rangle>)"
 by (insert Member_replacement, simp) 
 
 lemma (in M_satisfies) Equal_replacement':
     "\<lbrakk>M(A); x \<in> nat; y \<in> nat\<rbrakk>
      \<Longrightarrow> strong_replacement
          (M, \<lambda>env z. env \<in> list(A) \<and>
                      z = \<langle>env, bool_of_o(nth(x, env) = nth(y, env))\<rangle>)"
 by (insert Equal_replacement, simp) 
 
 lemma (in M_satisfies) Nand_replacement':
     "\<lbrakk>M(A); M(rp); M(rq)\<rbrakk>
      \<Longrightarrow> strong_replacement
          (M, \<lambda>env z. env \<in> list(A) \<and> z = \<langle>env, not(rp`env and rq`env)\<rangle>)"
 by (insert Nand_replacement, simp) 
 
 lemma (in M_satisfies) Forall_replacement':
    "\<lbrakk>M(A); M(rp)\<rbrakk>
     \<Longrightarrow> strong_replacement
         (M, \<lambda>env z.
                env \<in> list(A) \<and>
                z = \<langle>env, bool_of_o (\<forall>a\<in>A. rp ` Cons(a,env) = 1)\<rangle>)"
 by (insert Forall_replacement, simp) 
 
 lemma (in M_satisfies) a_closed:
      "\<lbrakk>M(A); x\<in>nat; y\<in>nat\<rbrakk> \<Longrightarrow> M(satisfies_a(A,x,y))"
 apply (simp add: satisfies_a_def) 
 apply (blast intro: lam_closed2 Member_replacement') 
 done
 
 lemma (in M_satisfies) a_rel:
      "M(A) \<Longrightarrow> Relation2(M, nat, nat, satisfies_is_a(M,A), satisfies_a(A))"
 apply (simp add: Relation2_def satisfies_is_a_def satisfies_a_def)
 apply (auto del: iffI intro!: lambda_abs2 simp add: Relation1_def) 
 done
 
 lemma (in M_satisfies) b_closed:
      "\<lbrakk>M(A); x\<in>nat; y\<in>nat\<rbrakk> \<Longrightarrow> M(satisfies_b(A,x,y))"
 apply (simp add: satisfies_b_def) 
 apply (blast intro: lam_closed2 Equal_replacement') 
 done
 
 lemma (in M_satisfies) b_rel:
      "M(A) \<Longrightarrow> Relation2(M, nat, nat, satisfies_is_b(M,A), satisfies_b(A))"
 apply (simp add: Relation2_def satisfies_is_b_def satisfies_b_def)
 apply (auto del: iffI intro!: lambda_abs2 simp add: Relation1_def) 
 done
 
 lemma (in M_satisfies) c_closed:
      "\<lbrakk>M(A); x \<in> formula; y \<in> formula; M(rx); M(ry)\<rbrakk> 
       \<Longrightarrow> M(satisfies_c(A,x,y,rx,ry))"
 apply (simp add: satisfies_c_def) 
 apply (rule lam_closed2) 
 apply (rule Nand_replacement') 
 apply (simp_all add: formula_into_M list_into_M [of _ A])
 done
 
 lemma (in M_satisfies) c_rel:
  "\<lbrakk>M(A); M(f)\<rbrakk> \<Longrightarrow> 
   Relation2 (M, formula, formula, 
                satisfies_is_c(M,A,f),
                \<lambda>u v. satisfies_c(A, u, v, f ` succ(depth(u)) ` u, 
                                           f ` succ(depth(v)) ` v))"
 apply (simp add: Relation2_def satisfies_is_c_def satisfies_c_def)
 apply (auto del: iffI intro!: lambda_abs2 
             simp add: Relation1_def formula_into_M) 
 done
 
 lemma (in M_satisfies) d_closed:
      "\<lbrakk>M(A); x \<in> formula; M(rx)\<rbrakk> \<Longrightarrow> M(satisfies_d(A,x,rx))"
 apply (simp add: satisfies_d_def) 
 apply (rule lam_closed2) 
 apply (rule Forall_replacement') 
 apply (simp_all add: formula_into_M list_into_M [of _ A])
 done
 
 lemma (in M_satisfies) d_rel:
  "\<lbrakk>M(A); M(f)\<rbrakk> \<Longrightarrow> 
   Relation1(M, formula, satisfies_is_d(M,A,f), 
      \<lambda>u. satisfies_d(A, u, f ` succ(depth(u)) ` u))"
 apply (simp del: rall_abs 
             add: Relation1_def satisfies_is_d_def satisfies_d_def)
 apply (auto del: iffI intro!: lambda_abs2 simp add: Relation1_def) 
 done
 
 
 lemma (in M_satisfies) fr_replace:
       "\<lbrakk>n \<in> nat; M(A)\<rbrakk> \<Longrightarrow> transrec_replacement(M,satisfies_MH(M,A),n)" 
 by (blast intro: formula_rec_replacement) 
 
 lemma (in M_satisfies) formula_case_satisfies_closed:
  "\<lbrakk>M(g); M(A); x \<in> formula\<rbrakk> \<Longrightarrow>
   M(formula_case (satisfies_a(A), satisfies_b(A),
        \<lambda>u v. satisfies_c(A, u, v, 
                          g ` succ(depth(u)) ` u, g ` succ(depth(v)) ` v),
        \<lambda>u. satisfies_d (A, u, g ` succ(depth(u)) ` u),
        x))"
 by (blast intro: a_closed b_closed c_closed d_closed) 
 
 lemma (in M_satisfies) fr_lam_replace:
    "\<lbrakk>M(g); M(A)\<rbrakk> \<Longrightarrow>
     strong_replacement (M, \<lambda>x y. x \<in> formula \<and>
             y = \<langle>x, 
                  formula_rec_case(satisfies_a(A),
                                   satisfies_b(A),
                                   satisfies_c(A),
                                   satisfies_d(A), g, x)\<rangle>)"
 apply (insert formula_rec_lambda_replacement) 
 apply (simp add: formula_rec_case_def formula_case_satisfies_closed
                  formula_case_abs [OF a_rel b_rel c_rel d_rel]) 
 done
 
 
 
 text\<open>Instantiate locale \<open>Formula_Rec\<close> for the 
       Function \<^term>\<open>satisfies\<close>\<close>
 
 lemma (in M_satisfies) Formula_Rec_axioms_M:
    "M(A) \<Longrightarrow>
     Formula_Rec_axioms(M, satisfies_a(A), satisfies_is_a(M,A), 
                           satisfies_b(A), satisfies_is_b(M,A), 
                           satisfies_c(A), satisfies_is_c(M,A), 
                           satisfies_d(A), satisfies_is_d(M,A))"
 apply (rule Formula_Rec_axioms.intro)
 apply (assumption | 
        rule a_closed a_rel b_closed b_rel c_closed c_rel d_closed d_rel
        fr_replace [unfolded satisfies_MH_def]
        fr_lam_replace) +
 done
 
 
 theorem (in M_satisfies) Formula_Rec_M: 
     "M(A) \<Longrightarrow>
      Formula_Rec(M, satisfies_a(A), satisfies_is_a(M,A), 
                          satisfies_b(A), satisfies_is_b(M,A), 
                          satisfies_c(A), satisfies_is_c(M,A), 
                          satisfies_d(A), satisfies_is_d(M,A))"
   apply (rule Formula_Rec.intro)
    apply (rule M_satisfies.axioms, rule M_satisfies_axioms)
   apply (erule Formula_Rec_axioms_M) 
   done
 
 lemmas (in M_satisfies) 
     satisfies_closed' = Formula_Rec.formula_rec_closed [OF Formula_Rec_M]
 and satisfies_abs'    = Formula_Rec.formula_rec_abs [OF Formula_Rec_M]
 
 
 lemma (in M_satisfies) satisfies_closed:
   "\<lbrakk>M(A); p \<in> formula\<rbrakk> \<Longrightarrow> M(satisfies(A,p))"
 by (simp add: Formula_Rec.formula_rec_closed [OF Formula_Rec_M]  
               satisfies_eq) 
 
 lemma (in M_satisfies) satisfies_abs:
   "\<lbrakk>M(A); M(z); p \<in> formula\<rbrakk> 
    \<Longrightarrow> is_satisfies(M,A,p,z) \<longleftrightarrow> z = satisfies(A,p)"
 by (simp only: Formula_Rec.formula_rec_abs [OF Formula_Rec_M]  
                satisfies_eq is_satisfies_def satisfies_MH_def)
 
 
 subsection\<open>Internalizations Needed to Instantiate \<open>M_satisfies\<close>\<close>
 
 subsubsection\<open>The Operator \<^term>\<open>is_depth_apply\<close>, Internalized\<close>
 
 (* is_depth_apply(M,h,p,z) \<equiv>
     \<exists>dp[M]. \<exists>sdp[M]. \<exists>hsdp[M]. 
       2        1         0
         finite_ordinal(M,dp) \<and> is_depth(M,p,dp) \<and> successor(M,dp,sdp) \<and>
         fun_apply(M,h,sdp,hsdp) \<and> fun_apply(M,hsdp,p,z) *)
 definition
   depth_apply_fm :: "[i,i,i]\<Rightarrow>i" where
     "depth_apply_fm(h,p,z) \<equiv>
        Exists(Exists(Exists(
         And(finite_ordinal_fm(2),
          And(depth_fm(p#+3,2),
           And(succ_fm(2,1),
            And(fun_apply_fm(h#+3,1,0), fun_apply_fm(0,p#+3,z#+3))))))))"
 
 lemma depth_apply_type [TC]:
      "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk> \<Longrightarrow> depth_apply_fm(x,y,z) \<in> formula"
 by (simp add: depth_apply_fm_def)
 
 lemma sats_depth_apply_fm [simp]:
    "\<lbrakk>x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, depth_apply_fm(x,y,z), env) \<longleftrightarrow>
         is_depth_apply(##A, nth(x,env), nth(y,env), nth(z,env))"
 by (simp add: depth_apply_fm_def is_depth_apply_def)
 
 lemma depth_apply_iff_sats:
     "\<lbrakk>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)\<rbrakk>
      \<Longrightarrow> is_depth_apply(##A, x, y, z) \<longleftrightarrow> sats(A, depth_apply_fm(i,j,k), env)"
 by simp
 
 lemma depth_apply_reflection:
      "REFLECTS[\<lambda>x. is_depth_apply(L,f(x),g(x),h(x)),
                \<lambda>i x. is_depth_apply(##Lset(i),f(x),g(x),h(x))]"
 apply (simp only: is_depth_apply_def)
 apply (intro FOL_reflections function_reflections depth_reflection 
              finite_ordinal_reflection)
 done
 
 
 subsubsection\<open>The Operator \<^term>\<open>satisfies_is_a\<close>, Internalized\<close>
 
 (* satisfies_is_a(M,A) \<equiv> 
     \<lambda>x y zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
              is_lambda(M, lA, 
                 \<lambda>env z. is_bool_of_o(M, 
                       \<exists>nx[M]. \<exists>ny[M]. 
                        is_nth(M,x,env,nx) \<and> is_nth(M,y,env,ny) \<and> nx \<in> ny, z),
                 zz)  *)
 
 definition
   satisfies_is_a_fm :: "[i,i,i,i]\<Rightarrow>i" where
   "satisfies_is_a_fm(A,x,y,z) \<equiv>
    Forall(
      Implies(is_list_fm(succ(A),0),
        lambda_fm(
          bool_of_o_fm(Exists(
                        Exists(And(nth_fm(x#+6,3,1), 
                                And(nth_fm(y#+6,3,0), 
                                    Member(1,0))))), 0), 
          0, succ(z))))"
 
 lemma satisfies_is_a_type [TC]:
      "\<lbrakk>A \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk>
       \<Longrightarrow> satisfies_is_a_fm(A,x,y,z) \<in> formula"
 by (simp add: satisfies_is_a_fm_def)
 
 lemma sats_satisfies_is_a_fm [simp]:
    "\<lbrakk>u \<in> nat; x < length(env); y < length(env); z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, satisfies_is_a_fm(u,x,y,z), env) \<longleftrightarrow>
         satisfies_is_a(##A, nth(u,env), nth(x,env), nth(y,env), nth(z,env))"
 apply (frule_tac x=x in lt_length_in_nat, assumption)  
 apply (frule_tac x=y in lt_length_in_nat, assumption)  
 apply (simp add: satisfies_is_a_fm_def satisfies_is_a_def sats_lambda_fm 
                  sats_bool_of_o_fm)
 done
 
 lemma satisfies_is_a_iff_sats:
   "\<lbrakk>nth(u,env) = nu; nth(x,env) = nx; nth(y,env) = ny; nth(z,env) = nz;
       u \<in> nat; x < length(env); y < length(env); z \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> satisfies_is_a(##A,nu,nx,ny,nz) \<longleftrightarrow>
        sats(A, satisfies_is_a_fm(u,x,y,z), env)"
 by simp
 
 theorem satisfies_is_a_reflection:
      "REFLECTS[\<lambda>x. satisfies_is_a(L,f(x),g(x),h(x),g'(x)),
                \<lambda>i x. satisfies_is_a(##Lset(i),f(x),g(x),h(x),g'(x))]"
-apply (unfold satisfies_is_a_def) 
+  unfolding satisfies_is_a_def 
 apply (intro FOL_reflections is_lambda_reflection bool_of_o_reflection 
              nth_reflection is_list_reflection)
 done
 
 
 subsubsection\<open>The Operator \<^term>\<open>satisfies_is_b\<close>, Internalized\<close>
 
 (* satisfies_is_b(M,A) \<equiv> 
     \<lambda>x y zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
              is_lambda(M, lA, 
                 \<lambda>env z. is_bool_of_o(M, 
                       \<exists>nx[M]. is_nth(M,x,env,nx) \<and> is_nth(M,y,env,nx), z),
                 zz) *)
 
 definition
   satisfies_is_b_fm :: "[i,i,i,i]\<Rightarrow>i" where
  "satisfies_is_b_fm(A,x,y,z) \<equiv>
    Forall(
      Implies(is_list_fm(succ(A),0),
        lambda_fm(
          bool_of_o_fm(Exists(And(nth_fm(x#+5,2,0), nth_fm(y#+5,2,0))), 0), 
          0, succ(z))))"
 
 lemma satisfies_is_b_type [TC]:
      "\<lbrakk>A \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk>
       \<Longrightarrow> satisfies_is_b_fm(A,x,y,z) \<in> formula"
 by (simp add: satisfies_is_b_fm_def)
 
 lemma sats_satisfies_is_b_fm [simp]:
    "\<lbrakk>u \<in> nat; x < length(env); y < length(env); z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, satisfies_is_b_fm(u,x,y,z), env) \<longleftrightarrow>
         satisfies_is_b(##A, nth(u,env), nth(x,env), nth(y,env), nth(z,env))"
 apply (frule_tac x=x in lt_length_in_nat, assumption)  
 apply (frule_tac x=y in lt_length_in_nat, assumption)  
 apply (simp add: satisfies_is_b_fm_def satisfies_is_b_def sats_lambda_fm 
                  sats_bool_of_o_fm)
 done
 
 lemma satisfies_is_b_iff_sats:
   "\<lbrakk>nth(u,env) = nu; nth(x,env) = nx; nth(y,env) = ny; nth(z,env) = nz;
       u \<in> nat; x < length(env); y < length(env); z \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> satisfies_is_b(##A,nu,nx,ny,nz) \<longleftrightarrow>
        sats(A, satisfies_is_b_fm(u,x,y,z), env)"
 by simp
 
 theorem satisfies_is_b_reflection:
      "REFLECTS[\<lambda>x. satisfies_is_b(L,f(x),g(x),h(x),g'(x)),
                \<lambda>i x. satisfies_is_b(##Lset(i),f(x),g(x),h(x),g'(x))]"
-apply (unfold satisfies_is_b_def) 
+  unfolding satisfies_is_b_def 
 apply (intro FOL_reflections is_lambda_reflection bool_of_o_reflection 
              nth_reflection is_list_reflection)
 done
 
 
 subsubsection\<open>The Operator \<^term>\<open>satisfies_is_c\<close>, Internalized\<close>
 
 (* satisfies_is_c(M,A,h) \<equiv> 
     \<lambda>p q zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
              is_lambda(M, lA, \<lambda>env z. \<exists>hp[M]. \<exists>hq[M]. 
                  (\<exists>rp[M]. is_depth_apply(M,h,p,rp) \<and> fun_apply(M,rp,env,hp)) \<and> 
                  (\<exists>rq[M]. is_depth_apply(M,h,q,rq) \<and> fun_apply(M,rq,env,hq)) \<and> 
                  (\<exists>pq[M]. is_and(M,hp,hq,pq) \<and> is_not(M,pq,z)),
                 zz) *)
 
 definition
   satisfies_is_c_fm :: "[i,i,i,i,i]\<Rightarrow>i" where
  "satisfies_is_c_fm(A,h,p,q,zz) \<equiv>
    Forall(
      Implies(is_list_fm(succ(A),0),
        lambda_fm(
          Exists(Exists(
           And(Exists(And(depth_apply_fm(h#+7,p#+7,0), fun_apply_fm(0,4,2))),
           And(Exists(And(depth_apply_fm(h#+7,q#+7,0), fun_apply_fm(0,4,1))),
               Exists(And(and_fm(2,1,0), not_fm(0,3))))))),
          0, succ(zz))))"
 
 lemma satisfies_is_c_type [TC]:
      "\<lbrakk>A \<in> nat; h \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat\<rbrakk>
       \<Longrightarrow> satisfies_is_c_fm(A,h,x,y,z) \<in> formula"
 by (simp add: satisfies_is_c_fm_def)
 
 lemma sats_satisfies_is_c_fm [simp]:
    "\<lbrakk>u \<in> nat; v \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, satisfies_is_c_fm(u,v,x,y,z), env) \<longleftrightarrow>
         satisfies_is_c(##A, nth(u,env), nth(v,env), nth(x,env), 
                             nth(y,env), nth(z,env))"  
 by (simp add: satisfies_is_c_fm_def satisfies_is_c_def sats_lambda_fm)
 
 lemma satisfies_is_c_iff_sats:
   "\<lbrakk>nth(u,env) = nu; nth(v,env) = nv; nth(x,env) = nx; nth(y,env) = ny; 
       nth(z,env) = nz;
       u \<in> nat; v \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> satisfies_is_c(##A,nu,nv,nx,ny,nz) \<longleftrightarrow>
        sats(A, satisfies_is_c_fm(u,v,x,y,z), env)"
 by simp
 
 theorem satisfies_is_c_reflection:
      "REFLECTS[\<lambda>x. satisfies_is_c(L,f(x),g(x),h(x),g'(x),h'(x)),
                \<lambda>i x. satisfies_is_c(##Lset(i),f(x),g(x),h(x),g'(x),h'(x))]"
-apply (unfold satisfies_is_c_def) 
+  unfolding satisfies_is_c_def 
 apply (intro FOL_reflections function_reflections is_lambda_reflection
              extra_reflections nth_reflection depth_apply_reflection 
              is_list_reflection)
 done
 
 subsubsection\<open>The Operator \<^term>\<open>satisfies_is_d\<close>, Internalized\<close>
 
 (* satisfies_is_d(M,A,h) \<equiv> 
     \<lambda>p zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
              is_lambda(M, lA, 
                 \<lambda>env z. \<exists>rp[M]. is_depth_apply(M,h,p,rp) \<and> 
                     is_bool_of_o(M, 
                            \<forall>x[M]. \<forall>xenv[M]. \<forall>hp[M]. 
                               x\<in>A \<longrightarrow> is_Cons(M,x,env,xenv) \<longrightarrow> 
                               fun_apply(M,rp,xenv,hp) \<longrightarrow> number1(M,hp),
                   z),
                zz) *)
 
 definition
   satisfies_is_d_fm :: "[i,i,i,i]\<Rightarrow>i" where
  "satisfies_is_d_fm(A,h,p,zz) \<equiv>
    Forall(
      Implies(is_list_fm(succ(A),0),
        lambda_fm(
          Exists(
            And(depth_apply_fm(h#+5,p#+5,0),
                bool_of_o_fm(
                 Forall(Forall(Forall(
                  Implies(Member(2,A#+8),
                   Implies(Cons_fm(2,5,1),
                    Implies(fun_apply_fm(3,1,0), number1_fm(0))))))), 1))),
          0, succ(zz))))"
 
 lemma satisfies_is_d_type [TC]:
      "\<lbrakk>A \<in> nat; h \<in> nat; x \<in> nat; z \<in> nat\<rbrakk>
       \<Longrightarrow> satisfies_is_d_fm(A,h,x,z) \<in> formula"
 by (simp add: satisfies_is_d_fm_def)
 
 lemma sats_satisfies_is_d_fm [simp]:
    "\<lbrakk>u \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, satisfies_is_d_fm(u,x,y,z), env) \<longleftrightarrow>
         satisfies_is_d(##A, nth(u,env), nth(x,env), nth(y,env), nth(z,env))"  
 by (simp add: satisfies_is_d_fm_def satisfies_is_d_def sats_lambda_fm
               sats_bool_of_o_fm)
 
 lemma satisfies_is_d_iff_sats:
   "\<lbrakk>nth(u,env) = nu; nth(x,env) = nx; nth(y,env) = ny; nth(z,env) = nz;
       u \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> satisfies_is_d(##A,nu,nx,ny,nz) \<longleftrightarrow>
        sats(A, satisfies_is_d_fm(u,x,y,z), env)"
 by simp
 
 theorem satisfies_is_d_reflection:
      "REFLECTS[\<lambda>x. satisfies_is_d(L,f(x),g(x),h(x),g'(x)),
                \<lambda>i x. satisfies_is_d(##Lset(i),f(x),g(x),h(x),g'(x))]"
-apply (unfold satisfies_is_d_def) 
+  unfolding satisfies_is_d_def 
 apply (intro FOL_reflections function_reflections is_lambda_reflection
              extra_reflections nth_reflection depth_apply_reflection 
              is_list_reflection)
 done
 
 
 subsubsection\<open>The Operator \<^term>\<open>satisfies_MH\<close>, Internalized\<close>
 
 (* satisfies_MH \<equiv> 
     \<lambda>M A u f zz. 
          \<forall>fml[M]. is_formula(M,fml) \<longrightarrow>
              is_lambda (M, fml, 
                is_formula_case (M, satisfies_is_a(M,A), 
                                 satisfies_is_b(M,A), 
                                 satisfies_is_c(M,A,f), satisfies_is_d(M,A,f)),
                zz) *)
 
 definition
   satisfies_MH_fm :: "[i,i,i,i]\<Rightarrow>i" where
  "satisfies_MH_fm(A,u,f,zz) \<equiv>
    Forall(
      Implies(is_formula_fm(0),
        lambda_fm(
          formula_case_fm(satisfies_is_a_fm(A#+7,2,1,0), 
                          satisfies_is_b_fm(A#+7,2,1,0), 
                          satisfies_is_c_fm(A#+7,f#+7,2,1,0), 
                          satisfies_is_d_fm(A#+6,f#+6,1,0), 
                          1, 0),
          0, succ(zz))))"
 
 lemma satisfies_MH_type [TC]:
      "\<lbrakk>A \<in> nat; u \<in> nat; x \<in> nat; z \<in> nat\<rbrakk>
       \<Longrightarrow> satisfies_MH_fm(A,u,x,z) \<in> formula"
 by (simp add: satisfies_MH_fm_def)
 
 lemma sats_satisfies_MH_fm [simp]:
    "\<lbrakk>u \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
     \<Longrightarrow> sats(A, satisfies_MH_fm(u,x,y,z), env) \<longleftrightarrow>
         satisfies_MH(##A, nth(u,env), nth(x,env), nth(y,env), nth(z,env))"  
 by (simp add: satisfies_MH_fm_def satisfies_MH_def sats_lambda_fm
               sats_formula_case_fm)
 
 lemma satisfies_MH_iff_sats:
   "\<lbrakk>nth(u,env) = nu; nth(x,env) = nx; nth(y,env) = ny; nth(z,env) = nz;
       u \<in> nat; x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A)\<rbrakk>
    \<Longrightarrow> satisfies_MH(##A,nu,nx,ny,nz) \<longleftrightarrow>
        sats(A, satisfies_MH_fm(u,x,y,z), env)"
 by simp 
 
 lemmas satisfies_reflections =
        is_lambda_reflection is_formula_reflection 
        is_formula_case_reflection
        satisfies_is_a_reflection satisfies_is_b_reflection 
        satisfies_is_c_reflection satisfies_is_d_reflection
 
 theorem satisfies_MH_reflection:
      "REFLECTS[\<lambda>x. satisfies_MH(L,f(x),g(x),h(x),g'(x)),
                \<lambda>i x. satisfies_MH(##Lset(i),f(x),g(x),h(x),g'(x))]"
-apply (unfold satisfies_MH_def) 
+  unfolding satisfies_MH_def 
 apply (intro FOL_reflections satisfies_reflections)
 done
 
 
 subsection\<open>Lemmas for Instantiating the Locale \<open>M_satisfies\<close>\<close>
 
 
 subsubsection\<open>The \<^term>\<open>Member\<close> Case\<close>
 
 lemma Member_Reflects:
  "REFLECTS[\<lambda>u. \<exists>v[L]. v \<in> B \<and> (\<exists>bo[L]. \<exists>nx[L]. \<exists>ny[L].
           v \<in> lstA \<and> is_nth(L,x,v,nx) \<and> is_nth(L,y,v,ny) \<and>
           is_bool_of_o(L, nx \<in> ny, bo) \<and> pair(L,v,bo,u)),
    \<lambda>i u. \<exists>v \<in> Lset(i). v \<in> B \<and> (\<exists>bo \<in> Lset(i). \<exists>nx \<in> Lset(i). \<exists>ny \<in> Lset(i).
              v \<in> lstA \<and> is_nth(##Lset(i), x, v, nx) \<and> 
              is_nth(##Lset(i), y, v, ny) \<and>
           is_bool_of_o(##Lset(i), nx \<in> ny, bo) \<and> pair(##Lset(i), v, bo, u))]"
 by (intro FOL_reflections function_reflections nth_reflection 
           bool_of_o_reflection)
 
 
 lemma Member_replacement:
     "\<lbrakk>L(A); x \<in> nat; y \<in> nat\<rbrakk>
      \<Longrightarrow> strong_replacement
          (L, \<lambda>env z. \<exists>bo[L]. \<exists>nx[L]. \<exists>ny[L]. 
               env \<in> list(A) \<and> is_nth(L,x,env,nx) \<and> is_nth(L,y,env,ny) \<and> 
               is_bool_of_o(L, nx \<in> ny, bo) \<and>
               pair(L, env, bo, z))"
 apply (rule strong_replacementI)
 apply (rule_tac u="{list(A),B,x,y}" 
          in gen_separation_multi [OF Member_Reflects], 
        auto)
 apply (rule_tac env="[list(A),B,x,y]" in DPow_LsetI)
 apply (rule sep_rules nth_iff_sats is_bool_of_o_iff_sats | simp)+
 done
 
 
 subsubsection\<open>The \<^term>\<open>Equal\<close> Case\<close>
 
 lemma Equal_Reflects:
  "REFLECTS[\<lambda>u. \<exists>v[L]. v \<in> B \<and> (\<exists>bo[L]. \<exists>nx[L]. \<exists>ny[L].
           v \<in> lstA \<and> is_nth(L, x, v, nx) \<and> is_nth(L, y, v, ny) \<and>
           is_bool_of_o(L, nx = ny, bo) \<and> pair(L, v, bo, u)),
    \<lambda>i u. \<exists>v \<in> Lset(i). v \<in> B \<and> (\<exists>bo \<in> Lset(i). \<exists>nx \<in> Lset(i). \<exists>ny \<in> Lset(i).
              v \<in> lstA \<and> is_nth(##Lset(i), x, v, nx) \<and> 
              is_nth(##Lset(i), y, v, ny) \<and>
           is_bool_of_o(##Lset(i), nx = ny, bo) \<and> pair(##Lset(i), v, bo, u))]"
 by (intro FOL_reflections function_reflections nth_reflection 
           bool_of_o_reflection)
 
 
 lemma Equal_replacement:
     "\<lbrakk>L(A); x \<in> nat; y \<in> nat\<rbrakk>
      \<Longrightarrow> strong_replacement
          (L, \<lambda>env z. \<exists>bo[L]. \<exists>nx[L]. \<exists>ny[L]. 
               env \<in> list(A) \<and> is_nth(L,x,env,nx) \<and> is_nth(L,y,env,ny) \<and> 
               is_bool_of_o(L, nx = ny, bo) \<and>
               pair(L, env, bo, z))"
 apply (rule strong_replacementI)
 apply (rule_tac u="{list(A),B,x,y}" 
          in gen_separation_multi [OF Equal_Reflects], 
        auto)
 apply (rule_tac env="[list(A),B,x,y]" in DPow_LsetI)
 apply (rule sep_rules nth_iff_sats is_bool_of_o_iff_sats | simp)+
 done
 
 subsubsection\<open>The \<^term>\<open>Nand\<close> Case\<close>
 
 lemma Nand_Reflects:
     "REFLECTS [\<lambda>x. \<exists>u[L]. u \<in> B \<and>
                (\<exists>rpe[L]. \<exists>rqe[L]. \<exists>andpq[L]. \<exists>notpq[L].
                  fun_apply(L, rp, u, rpe) \<and> fun_apply(L, rq, u, rqe) \<and>
                  is_and(L, rpe, rqe, andpq) \<and> is_not(L, andpq, notpq) \<and>
                  u \<in> list(A) \<and> pair(L, u, notpq, x)),
     \<lambda>i x. \<exists>u \<in> Lset(i). u \<in> B \<and>
      (\<exists>rpe \<in> Lset(i). \<exists>rqe \<in> Lset(i). \<exists>andpq \<in> Lset(i). \<exists>notpq \<in> Lset(i).
        fun_apply(##Lset(i), rp, u, rpe) \<and> fun_apply(##Lset(i), rq, u, rqe) \<and>
        is_and(##Lset(i), rpe, rqe, andpq) \<and> is_not(##Lset(i), andpq, notpq) \<and>
        u \<in> list(A) \<and> pair(##Lset(i), u, notpq, x))]"
 apply (unfold is_and_def is_not_def) 
 apply (intro FOL_reflections function_reflections)
 done
 
 lemma Nand_replacement:
     "\<lbrakk>L(A); L(rp); L(rq)\<rbrakk>
      \<Longrightarrow> strong_replacement
          (L, \<lambda>env z. \<exists>rpe[L]. \<exists>rqe[L]. \<exists>andpq[L]. \<exists>notpq[L]. 
                fun_apply(L,rp,env,rpe) \<and> fun_apply(L,rq,env,rqe) \<and> 
                is_and(L,rpe,rqe,andpq) \<and> is_not(L,andpq,notpq) \<and> 
                env \<in> list(A) \<and> pair(L, env, notpq, z))"
 apply (rule strong_replacementI)
 apply (rule_tac u="{list(A),B,rp,rq}" 
          in gen_separation_multi [OF Nand_Reflects],
        auto)
 apply (rule_tac env="[list(A),B,rp,rq]" in DPow_LsetI)
 apply (rule sep_rules is_and_iff_sats is_not_iff_sats | simp)+
 done
 
 
 subsubsection\<open>The \<^term>\<open>Forall\<close> Case\<close>
 
 lemma Forall_Reflects:
  "REFLECTS [\<lambda>x. \<exists>u[L]. u \<in> B \<and> (\<exists>bo[L]. u \<in> list(A) \<and>
                  is_bool_of_o (L,
      \<forall>a[L]. \<forall>co[L]. \<forall>rpco[L]. a \<in> A \<longrightarrow>
                 is_Cons(L,a,u,co) \<longrightarrow> fun_apply(L,rp,co,rpco) \<longrightarrow> 
                 number1(L,rpco),
                            bo) \<and> pair(L,u,bo,x)),
  \<lambda>i x. \<exists>u \<in> Lset(i). u \<in> B \<and> (\<exists>bo \<in> Lset(i). u \<in> list(A) \<and>
         is_bool_of_o (##Lset(i),
  \<forall>a \<in> Lset(i). \<forall>co \<in> Lset(i). \<forall>rpco \<in> Lset(i). a \<in> A \<longrightarrow>
             is_Cons(##Lset(i),a,u,co) \<longrightarrow> fun_apply(##Lset(i),rp,co,rpco) \<longrightarrow> 
             number1(##Lset(i),rpco),
                        bo) \<and> pair(##Lset(i),u,bo,x))]"
-apply (unfold is_bool_of_o_def) 
+  unfolding is_bool_of_o_def 
 apply (intro FOL_reflections function_reflections Cons_reflection)
 done
 
 lemma Forall_replacement:
    "\<lbrakk>L(A); L(rp)\<rbrakk>
     \<Longrightarrow> strong_replacement
         (L, \<lambda>env z. \<exists>bo[L]. 
               env \<in> list(A) \<and> 
               is_bool_of_o (L, 
                             \<forall>a[L]. \<forall>co[L]. \<forall>rpco[L]. 
                                a\<in>A \<longrightarrow> is_Cons(L,a,env,co) \<longrightarrow>
                                fun_apply(L,rp,co,rpco) \<longrightarrow> number1(L, rpco), 
                             bo) \<and>
               pair(L,env,bo,z))"
 apply (rule strong_replacementI)
 apply (rule_tac u="{A,list(A),B,rp}" 
          in gen_separation_multi [OF Forall_Reflects],
        auto)
 apply (rule_tac env="[A,list(A),B,rp]" in DPow_LsetI)
 apply (rule sep_rules is_bool_of_o_iff_sats Cons_iff_sats | simp)+
 done
 
 subsubsection\<open>The \<^term>\<open>transrec_replacement\<close> Case\<close>
 
 lemma formula_rec_replacement_Reflects:
  "REFLECTS [\<lambda>x. \<exists>u[L]. u \<in> B \<and> (\<exists>y[L]. pair(L, u, y, x) \<and>
              is_wfrec (L, satisfies_MH(L,A), mesa, u, y)),
     \<lambda>i x. \<exists>u \<in> Lset(i). u \<in> B \<and> (\<exists>y \<in> Lset(i). pair(##Lset(i), u, y, x) \<and>
              is_wfrec (##Lset(i), satisfies_MH(##Lset(i),A), mesa, u, y))]"
 by (intro FOL_reflections function_reflections satisfies_MH_reflection 
           is_wfrec_reflection) 
 
 lemma formula_rec_replacement: 
       \<comment> \<open>For the \<^term>\<open>transrec\<close>\<close>
    "\<lbrakk>n \<in> nat; L(A)\<rbrakk> \<Longrightarrow> transrec_replacement(L, satisfies_MH(L,A), n)"
 apply (rule L.transrec_replacementI, simp add: L.nat_into_M)
 apply (rule strong_replacementI)
 apply (rule_tac u="{B,A,n,Memrel(eclose({n}))}"
          in gen_separation_multi [OF formula_rec_replacement_Reflects],
        auto simp add: L.nat_into_M)
 apply (rule_tac env="[B,A,n,Memrel(eclose({n}))]" in DPow_LsetI)
 apply (rule sep_rules satisfies_MH_iff_sats is_wfrec_iff_sats | simp)+
 done
 
 
 subsubsection\<open>The Lambda Replacement Case\<close>
 
 lemma formula_rec_lambda_replacement_Reflects:
  "REFLECTS [\<lambda>x. \<exists>u[L]. u \<in> B \<and>
      mem_formula(L,u) \<and>
      (\<exists>c[L].
          is_formula_case
           (L, satisfies_is_a(L,A), satisfies_is_b(L,A),
            satisfies_is_c(L,A,g), satisfies_is_d(L,A,g),
            u, c) \<and>
          pair(L,u,c,x)),
   \<lambda>i x. \<exists>u \<in> Lset(i). u \<in> B \<and> mem_formula(##Lset(i),u) \<and>
      (\<exists>c \<in> Lset(i).
          is_formula_case
           (##Lset(i), satisfies_is_a(##Lset(i),A), satisfies_is_b(##Lset(i),A),
            satisfies_is_c(##Lset(i),A,g), satisfies_is_d(##Lset(i),A,g),
            u, c) \<and>
          pair(##Lset(i),u,c,x))]"
 by (intro FOL_reflections function_reflections mem_formula_reflection
           is_formula_case_reflection satisfies_is_a_reflection
           satisfies_is_b_reflection satisfies_is_c_reflection
           satisfies_is_d_reflection)  
 
 lemma formula_rec_lambda_replacement: 
       \<comment> \<open>For the \<^term>\<open>transrec\<close>\<close>
    "\<lbrakk>L(g); L(A)\<rbrakk> \<Longrightarrow>
     strong_replacement (L, 
        \<lambda>x y. mem_formula(L,x) \<and>
              (\<exists>c[L]. is_formula_case(L, satisfies_is_a(L,A),
                                   satisfies_is_b(L,A),
                                   satisfies_is_c(L,A,g),
                                   satisfies_is_d(L,A,g), x, c) \<and>
              pair(L, x, c, y)))" 
 apply (rule strong_replacementI)
 apply (rule_tac u="{B,A,g}"
          in gen_separation_multi [OF formula_rec_lambda_replacement_Reflects], 
        auto)
 apply (rule_tac env="[A,g,B]" in DPow_LsetI)
 apply (rule sep_rules mem_formula_iff_sats
           formula_case_iff_sats satisfies_is_a_iff_sats
           satisfies_is_b_iff_sats satisfies_is_c_iff_sats
           satisfies_is_d_iff_sats | simp)+
 done
 
 
 subsection\<open>Instantiating \<open>M_satisfies\<close>\<close>
 
 lemma M_satisfies_axioms_L: "M_satisfies_axioms(L)"
   apply (rule M_satisfies_axioms.intro)
        apply (assumption | rule
          Member_replacement Equal_replacement 
          Nand_replacement Forall_replacement
          formula_rec_replacement formula_rec_lambda_replacement)+
   done
 
 theorem M_satisfies_L: "M_satisfies(L)"
   apply (rule M_satisfies.intro)
    apply (rule M_eclose_L)
   apply (rule M_satisfies_axioms_L)
   done
 
 text\<open>Finally: the point of the whole theory!\<close>
 lemmas satisfies_closed = M_satisfies.satisfies_closed [OF M_satisfies_L]
    and satisfies_abs = M_satisfies.satisfies_abs [OF M_satisfies_L]
 
 end
diff --git a/src/ZF/Constructible/Wellorderings.thy b/src/ZF/Constructible/Wellorderings.thy
--- a/src/ZF/Constructible/Wellorderings.thy
+++ b/src/ZF/Constructible/Wellorderings.thy
@@ -1,233 +1,233 @@
 (*  Title:      ZF/Constructible/Wellorderings.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
 *)
 
 section \<open>Relativized Wellorderings\<close>
 
 theory Wellorderings imports Relative begin
 
 text\<open>We define functions analogous to \<^term>\<open>ordermap\<close> \<^term>\<open>ordertype\<close> 
       but without using recursion.  Instead, there is a direct appeal
       to Replacement.  This will be the basis for a version relativized
       to some class \<open>M\<close>.  The main result is Theorem I 7.6 in Kunen,
       page 17.\<close>
 
 
 subsection\<open>Wellorderings\<close>
 
 definition
   irreflexive :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
     "irreflexive(M,A,r) \<equiv> \<forall>x[M]. x\<in>A \<longrightarrow> \<langle>x,x\<rangle> \<notin> r"
   
 definition
   transitive_rel :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
     "transitive_rel(M,A,r) \<equiv> 
         \<forall>x[M]. x\<in>A \<longrightarrow> (\<forall>y[M]. y\<in>A \<longrightarrow> (\<forall>z[M]. z\<in>A \<longrightarrow> 
                           \<langle>x,y\<rangle>\<in>r \<longrightarrow> \<langle>y,z\<rangle>\<in>r \<longrightarrow> \<langle>x,z\<rangle>\<in>r))"
 
 definition
   linear_rel :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
     "linear_rel(M,A,r) \<equiv> 
         \<forall>x[M]. x\<in>A \<longrightarrow> (\<forall>y[M]. y\<in>A \<longrightarrow> \<langle>x,y\<rangle>\<in>r | x=y | \<langle>y,x\<rangle>\<in>r)"
 
 definition
   wellfounded :: "[i\<Rightarrow>o,i]\<Rightarrow>o" where
     \<comment> \<open>EVERY non-empty set has an \<open>r\<close>-minimal element\<close>
     "wellfounded(M,r) \<equiv> 
         \<forall>x[M]. x\<noteq>0 \<longrightarrow> (\<exists>y[M]. y\<in>x \<and> \<not>(\<exists>z[M]. z\<in>x \<and> \<langle>z,y\<rangle> \<in> r))"
 definition
   wellfounded_on :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
     \<comment> \<open>every non-empty SUBSET OF \<open>A\<close> has an \<open>r\<close>-minimal element\<close>
     "wellfounded_on(M,A,r) \<equiv> 
         \<forall>x[M]. x\<noteq>0 \<longrightarrow> x\<subseteq>A \<longrightarrow> (\<exists>y[M]. y\<in>x \<and> \<not>(\<exists>z[M]. z\<in>x \<and> \<langle>z,y\<rangle> \<in> r))"
 
 definition
   wellordered :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
     \<comment> \<open>linear and wellfounded on \<open>A\<close>\<close>
     "wellordered(M,A,r) \<equiv> 
         transitive_rel(M,A,r) \<and> linear_rel(M,A,r) \<and> wellfounded_on(M,A,r)"
 
 
 subsubsection \<open>Trivial absoluteness proofs\<close>
 
 lemma (in M_basic) irreflexive_abs [simp]: 
      "M(A) \<Longrightarrow> irreflexive(M,A,r) \<longleftrightarrow> irrefl(A,r)"
 by (simp add: irreflexive_def irrefl_def)
 
 lemma (in M_basic) transitive_rel_abs [simp]: 
      "M(A) \<Longrightarrow> transitive_rel(M,A,r) \<longleftrightarrow> trans[A](r)"
 by (simp add: transitive_rel_def trans_on_def)
 
 lemma (in M_basic) linear_rel_abs [simp]: 
      "M(A) \<Longrightarrow> linear_rel(M,A,r) \<longleftrightarrow> linear(A,r)"
 by (simp add: linear_rel_def linear_def)
 
 lemma (in M_basic) wellordered_is_trans_on: 
     "\<lbrakk>wellordered(M,A,r); M(A)\<rbrakk> \<Longrightarrow> trans[A](r)"
 by (auto simp add: wellordered_def)
 
 lemma (in M_basic) wellordered_is_linear: 
     "\<lbrakk>wellordered(M,A,r); M(A)\<rbrakk> \<Longrightarrow> linear(A,r)"
 by (auto simp add: wellordered_def)
 
 lemma (in M_basic) wellordered_is_wellfounded_on: 
     "\<lbrakk>wellordered(M,A,r); M(A)\<rbrakk> \<Longrightarrow> wellfounded_on(M,A,r)"
 by (auto simp add: wellordered_def)
 
 lemma (in M_basic) wellfounded_imp_wellfounded_on: 
     "\<lbrakk>wellfounded(M,r); M(A)\<rbrakk> \<Longrightarrow> wellfounded_on(M,A,r)"
 by (auto simp add: wellfounded_def wellfounded_on_def)
 
 lemma (in M_basic) wellfounded_on_subset_A:
      "\<lbrakk>wellfounded_on(M,A,r);  B<=A\<rbrakk> \<Longrightarrow> wellfounded_on(M,B,r)"
 by (simp add: wellfounded_on_def, blast)
 
 
 subsubsection \<open>Well-founded relations\<close>
 
 lemma  (in M_basic) wellfounded_on_iff_wellfounded:
      "wellfounded_on(M,A,r) \<longleftrightarrow> wellfounded(M, r \<inter> A*A)"
 apply (simp add: wellfounded_on_def wellfounded_def, safe)
  apply force
 apply (drule_tac x=x in rspec, assumption, blast) 
 done
 
 lemma (in M_basic) wellfounded_on_imp_wellfounded:
      "\<lbrakk>wellfounded_on(M,A,r); r \<subseteq> A*A\<rbrakk> \<Longrightarrow> wellfounded(M,r)"
 by (simp add: wellfounded_on_iff_wellfounded subset_Int_iff)
 
 lemma (in M_basic) wellfounded_on_field_imp_wellfounded:
      "wellfounded_on(M, field(r), r) \<Longrightarrow> wellfounded(M,r)"
 by (simp add: wellfounded_def wellfounded_on_iff_wellfounded, fast)
 
 lemma (in M_basic) wellfounded_iff_wellfounded_on_field:
      "M(r) \<Longrightarrow> wellfounded(M,r) \<longleftrightarrow> wellfounded_on(M, field(r), r)"
 by (blast intro: wellfounded_imp_wellfounded_on
                  wellfounded_on_field_imp_wellfounded)
 
 (*Consider the least z in domain(r) such that P(z) does not hold...*)
 lemma (in M_basic) wellfounded_induct: 
      "\<lbrakk>wellfounded(M,r); M(a); M(r); separation(M, \<lambda>x. \<not>P(x));  
          \<forall>x. M(x) \<and> (\<forall>y. \<langle>y,x\<rangle> \<in> r \<longrightarrow> P(y)) \<longrightarrow> P(x)\<rbrakk>
       \<Longrightarrow> P(a)"
 apply (simp (no_asm_use) add: wellfounded_def)
 apply (drule_tac x="{z \<in> domain(r). \<not>P(z)}" in rspec)
 apply (blast dest: transM)+
 done
 
 lemma (in M_basic) wellfounded_on_induct: 
      "\<lbrakk>a\<in>A;  wellfounded_on(M,A,r);  M(A);  
        separation(M, \<lambda>x. x\<in>A \<longrightarrow> \<not>P(x));  
        \<forall>x\<in>A. M(x) \<and> (\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> r \<longrightarrow> P(y)) \<longrightarrow> P(x)\<rbrakk>
       \<Longrightarrow> P(a)"
 apply (simp (no_asm_use) add: wellfounded_on_def)
 apply (drule_tac x="{z\<in>A. z\<in>A \<longrightarrow> \<not>P(z)}" in rspec)
 apply (blast intro: transM)+
 done
 
 
 subsubsection \<open>Kunen's lemma IV 3.14, page 123\<close>
 
 lemma (in M_basic) linear_imp_relativized: 
      "linear(A,r) \<Longrightarrow> linear_rel(M,A,r)" 
 by (simp add: linear_def linear_rel_def) 
 
 lemma (in M_basic) trans_on_imp_relativized: 
      "trans[A](r) \<Longrightarrow> transitive_rel(M,A,r)" 
 by (unfold transitive_rel_def trans_on_def, blast) 
 
 lemma (in M_basic) wf_on_imp_relativized: 
      "wf[A](r) \<Longrightarrow> wellfounded_on(M,A,r)" 
 apply (clarsimp simp: wellfounded_on_def wf_def wf_on_def) 
 apply (drule_tac x=x in spec, blast) 
 done
 
 lemma (in M_basic) wf_imp_relativized: 
      "wf(r) \<Longrightarrow> wellfounded(M,r)" 
 apply (simp add: wellfounded_def wf_def, clarify) 
 apply (drule_tac x=x in spec, blast) 
 done
 
 lemma (in M_basic) well_ord_imp_relativized: 
      "well_ord(A,r) \<Longrightarrow> wellordered(M,A,r)" 
 by (simp add: wellordered_def well_ord_def tot_ord_def part_ord_def
        linear_imp_relativized trans_on_imp_relativized wf_on_imp_relativized)
 
 text\<open>The property being well founded (and hence of being well ordered) is not absolute: 
 the set that doesn't contain a minimal element may not exist in the class M. 
 However, every set that is well founded in a transitive model M is well founded (page 124).\<close>
 
 subsection\<open>Relativized versions of order-isomorphisms and order types\<close>
 
 lemma (in M_basic) order_isomorphism_abs [simp]: 
      "\<lbrakk>M(A); M(B); M(f)\<rbrakk> 
       \<Longrightarrow> order_isomorphism(M,A,r,B,s,f) \<longleftrightarrow> f \<in> ord_iso(A,r,B,s)"
 by (simp add: order_isomorphism_def ord_iso_def)
 
 lemma (in M_trans) pred_set_abs [simp]: 
      "\<lbrakk>M(r); M(B)\<rbrakk> \<Longrightarrow> pred_set(M,A,x,r,B) \<longleftrightarrow> B = Order.pred(A,x,r)"
 apply (simp add: pred_set_def Order.pred_def)
 apply (blast dest: transM) 
 done
 
 lemma (in M_basic) pred_closed [intro,simp]: 
   "\<lbrakk>M(A); M(r); M(x)\<rbrakk> \<Longrightarrow> M(Order.pred(A, x, r))"
   using pred_separation [of r x] by (simp add: Order.pred_def) 
 
 lemma (in M_basic) membership_abs [simp]: 
      "\<lbrakk>M(r); M(A)\<rbrakk> \<Longrightarrow> membership(M,A,r) \<longleftrightarrow> r = Memrel(A)"
 apply (simp add: membership_def Memrel_def, safe)
   apply (rule equalityI) 
    apply clarify 
    apply (frule transM, assumption)
    apply blast
   apply clarify 
   apply (subgoal_tac "M(\<langle>xb,ya\<rangle>)", blast) 
   apply (blast dest: transM) 
  apply auto 
 done
 
 lemma (in M_basic) M_Memrel_iff:
      "M(A) \<Longrightarrow> Memrel(A) = {z \<in> A*A. \<exists>x[M]. \<exists>y[M]. z = \<langle>x,y\<rangle> \<and> x \<in> y}"
 unfolding Memrel_def by (blast dest: transM)
 
 lemma (in M_basic) Memrel_closed [intro,simp]: 
      "M(A) \<Longrightarrow> M(Memrel(A))"
   using Memrel_separation by (simp add: M_Memrel_iff) 
 
 
 subsection \<open>Main results of Kunen, Chapter 1 section 6\<close>
 
 text\<open>Subset properties-- proved outside the locale\<close>
 
 lemma linear_rel_subset: 
     "\<lbrakk>linear_rel(M, A, r); B \<subseteq> A\<rbrakk> \<Longrightarrow> linear_rel(M, B, r)"
 by (unfold linear_rel_def, blast)
 
 lemma transitive_rel_subset: 
     "\<lbrakk>transitive_rel(M, A, r); B \<subseteq> A\<rbrakk> \<Longrightarrow> transitive_rel(M, B, r)"
 by (unfold transitive_rel_def, blast)
 
 lemma wellfounded_on_subset: 
     "\<lbrakk>wellfounded_on(M, A, r); B \<subseteq> A\<rbrakk> \<Longrightarrow> wellfounded_on(M, B, r)"
 by (unfold wellfounded_on_def subset_def, blast)
 
 lemma wellordered_subset: 
     "\<lbrakk>wellordered(M, A, r); B \<subseteq> A\<rbrakk> \<Longrightarrow> wellordered(M, B, r)"
-apply (unfold wellordered_def)
+  unfolding wellordered_def
 apply (blast intro: linear_rel_subset transitive_rel_subset 
                     wellfounded_on_subset)
 done
 
 lemma (in M_basic) wellfounded_on_asym:
      "\<lbrakk>wellfounded_on(M,A,r);  \<langle>a,x\<rangle>\<in>r;  a\<in>A; x\<in>A;  M(A)\<rbrakk> \<Longrightarrow> \<langle>x,a\<rangle>\<notin>r"
 apply (simp add: wellfounded_on_def) 
 apply (drule_tac x="{x,a}" in rspec) 
 apply (blast dest: transM)+
 done
 
 lemma (in M_basic) wellordered_asym:
      "\<lbrakk>wellordered(M,A,r);  \<langle>a,x\<rangle>\<in>r;  a\<in>A; x\<in>A;  M(A)\<rbrakk> \<Longrightarrow> \<langle>x,a\<rangle>\<notin>r"
 by (simp add: wellordered_def, blast dest: wellfounded_on_asym)
 
 end
diff --git a/src/ZF/Epsilon.thy b/src/ZF/Epsilon.thy
--- a/src/ZF/Epsilon.thy
+++ b/src/ZF/Epsilon.thy
@@ -1,399 +1,399 @@
 (*  Title:      ZF/Epsilon.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1993  University of Cambridge
 *)
 
 section\<open>Epsilon Induction and Recursion\<close>
 
 theory Epsilon imports Nat begin
 
 definition
   eclose    :: "i\<Rightarrow>i"  where
     "eclose(A) \<equiv> \<Union>n\<in>nat. nat_rec(n, A, \<lambda>m r. \<Union>(r))"
 
 definition
   transrec  :: "[i, [i,i]\<Rightarrow>i] \<Rightarrow>i"  where
     "transrec(a,H) \<equiv> wfrec(Memrel(eclose({a})), a, H)"
 
 definition
   rank      :: "i\<Rightarrow>i"  where
     "rank(a) \<equiv> transrec(a, \<lambda>x f. \<Union>y\<in>x. succ(f`y))"
 
 definition
   transrec2 :: "[i, i, [i,i]\<Rightarrow>i] \<Rightarrow>i"  where
     "transrec2(k, a, b) \<equiv>
        transrec(k,
                 \<lambda>i r. if(i=0, a,
                         if(\<exists>j. i=succ(j),
                            b(THE j. i=succ(j), r`(THE j. i=succ(j))),
                            \<Union>j<i. r`j)))"
 
 definition
   recursor  :: "[i, [i,i]\<Rightarrow>i, i]\<Rightarrow>i"  where
     "recursor(a,b,k) \<equiv>  transrec(k, \<lambda>n f. nat_case(a, \<lambda>m. b(m, f`m), n))"
 
 definition
   rec  :: "[i, i, [i,i]\<Rightarrow>i]\<Rightarrow>i"  where
     "rec(k,a,b) \<equiv> recursor(a,b,k)"
 
 
 subsection\<open>Basic Closure Properties\<close>
 
 lemma arg_subset_eclose: "A \<subseteq> eclose(A)"
-apply (unfold eclose_def)
+  unfolding eclose_def
 apply (rule nat_rec_0 [THEN equalityD2, THEN subset_trans])
 apply (rule nat_0I [THEN UN_upper])
 done
 
 lemmas arg_into_eclose = arg_subset_eclose [THEN subsetD]
 
 lemma Transset_eclose: "Transset(eclose(A))"
 apply (unfold eclose_def Transset_def)
 apply (rule subsetI [THEN ballI])
 apply (erule UN_E)
 apply (rule nat_succI [THEN UN_I], assumption)
 apply (erule nat_rec_succ [THEN ssubst])
 apply (erule UnionI, assumption)
 done
 
 (* @{term"x \<in> eclose(A) \<Longrightarrow> x \<subseteq> eclose(A)"} *)
 lemmas eclose_subset =
        Transset_eclose [unfolded Transset_def, THEN bspec]
 
 (* @{term"\<lbrakk>A \<in> eclose(B); c \<in> A\<rbrakk> \<Longrightarrow> c \<in> eclose(B)"} *)
 lemmas ecloseD = eclose_subset [THEN subsetD]
 
 lemmas arg_in_eclose_sing = arg_subset_eclose [THEN singleton_subsetD]
 lemmas arg_into_eclose_sing = arg_in_eclose_sing [THEN ecloseD]
 
 (* This is epsilon-induction for eclose(A); see also eclose_induct_down...
    \<lbrakk>a \<in> eclose(A);  \<And>x. \<lbrakk>x \<in> eclose(A); \<forall>y\<in>x. P(y)\<rbrakk> \<Longrightarrow> P(x)
 \<rbrakk> \<Longrightarrow> P(a)
 *)
 lemmas eclose_induct =
      Transset_induct [OF _ Transset_eclose, induct set: eclose]
 
 
 (*Epsilon induction*)
 lemma eps_induct:
     "\<lbrakk>\<And>x. \<forall>y\<in>x. P(y) \<Longrightarrow> P(x)\<rbrakk>  \<Longrightarrow>  P(a)"
 by (rule arg_in_eclose_sing [THEN eclose_induct], blast)
 
 
 subsection\<open>Leastness of \<^term>\<open>eclose\<close>\<close>
 
 (** eclose(A) is the least transitive set including A as a subset. **)
 
 lemma eclose_least_lemma:
     "\<lbrakk>Transset(X);  A<=X;  n \<in> nat\<rbrakk> \<Longrightarrow> nat_rec(n, A, \<lambda>m r. \<Union>(r)) \<subseteq> X"
-apply (unfold Transset_def)
+  unfolding Transset_def
 apply (erule nat_induct)
 apply (simp add: nat_rec_0)
 apply (simp add: nat_rec_succ, blast)
 done
 
 lemma eclose_least:
      "\<lbrakk>Transset(X);  A<=X\<rbrakk> \<Longrightarrow> eclose(A) \<subseteq> X"
-apply (unfold eclose_def)
+  unfolding eclose_def
 apply (rule eclose_least_lemma [THEN UN_least], assumption+)
 done
 
 (*COMPLETELY DIFFERENT induction principle from eclose_induct\<And>*)
 lemma eclose_induct_down [consumes 1]:
     "\<lbrakk>a \<in> eclose(b);
         \<And>y.   \<lbrakk>y \<in> b\<rbrakk> \<Longrightarrow> P(y);
         \<And>y z. \<lbrakk>y \<in> eclose(b);  P(y);  z \<in> y\<rbrakk> \<Longrightarrow> P(z)
 \<rbrakk> \<Longrightarrow> P(a)"
 apply (rule eclose_least [THEN subsetD, THEN CollectD2, of "eclose(b)"])
   prefer 3 apply assumption
- apply (unfold Transset_def)
+   unfolding Transset_def
  apply (blast intro: ecloseD)
 apply (blast intro: arg_subset_eclose [THEN subsetD])
 done
 
 lemma Transset_eclose_eq_arg: "Transset(X) \<Longrightarrow> eclose(X) = X"
 apply (erule equalityI [OF eclose_least arg_subset_eclose])
 apply (rule subset_refl)
 done
 
 text\<open>A transitive set either is empty or contains the empty set.\<close>
 lemma Transset_0_lemma [rule_format]: "Transset(A) \<Longrightarrow> x\<in>A \<longrightarrow> 0\<in>A"
 apply (simp add: Transset_def)
 apply (rule_tac a=x in eps_induct, clarify)
 apply (drule bspec, assumption)
 apply (case_tac "x=0", auto)
 done
 
 lemma Transset_0_disj: "Transset(A) \<Longrightarrow> A=0 | 0\<in>A"
 by (blast dest: Transset_0_lemma)
 
 
 subsection\<open>Epsilon Recursion\<close>
 
 (*Unused...*)
 lemma mem_eclose_trans: "\<lbrakk>A \<in> eclose(B);  B \<in> eclose(C)\<rbrakk> \<Longrightarrow> A \<in> eclose(C)"
 by (rule eclose_least [OF Transset_eclose eclose_subset, THEN subsetD],
     assumption+)
 
 (*Variant of the previous lemma in a useable form for the sequel*)
 lemma mem_eclose_sing_trans:
      "\<lbrakk>A \<in> eclose({B});  B \<in> eclose({C})\<rbrakk> \<Longrightarrow> A \<in> eclose({C})"
 by (rule eclose_least [OF Transset_eclose singleton_subsetI, THEN subsetD],
     assumption+)
 
 lemma under_Memrel: "\<lbrakk>Transset(i);  j \<in> i\<rbrakk> \<Longrightarrow> Memrel(i)-``{j} = j"
 by (unfold Transset_def, blast)
 
 lemma lt_Memrel: "j < i \<Longrightarrow> Memrel(i) -`` {j} = j"
 by (simp add: lt_def Ord_def under_Memrel)
 
 (* @{term"j \<in> eclose(A) \<Longrightarrow> Memrel(eclose(A)) -`` j = j"} *)
 lemmas under_Memrel_eclose = Transset_eclose [THEN under_Memrel]
 
 lemmas wfrec_ssubst = wf_Memrel [THEN wfrec, THEN ssubst]
 
 lemma wfrec_eclose_eq:
     "\<lbrakk>k \<in> eclose({j});  j \<in> eclose({i})\<rbrakk> \<Longrightarrow>
      wfrec(Memrel(eclose({i})), k, H) = wfrec(Memrel(eclose({j})), k, H)"
 apply (erule eclose_induct)
 apply (rule wfrec_ssubst)
 apply (rule wfrec_ssubst)
 apply (simp add: under_Memrel_eclose mem_eclose_sing_trans [of _ j i])
 done
 
 lemma wfrec_eclose_eq2:
     "k \<in> i \<Longrightarrow> wfrec(Memrel(eclose({i})),k,H) = wfrec(Memrel(eclose({k})),k,H)"
 apply (rule arg_in_eclose_sing [THEN wfrec_eclose_eq])
 apply (erule arg_into_eclose_sing)
 done
 
 lemma transrec: "transrec(a,H) = H(a, \<lambda>x\<in>a. transrec(x,H))"
-apply (unfold transrec_def)
+  unfolding transrec_def
 apply (rule wfrec_ssubst)
 apply (simp add: wfrec_eclose_eq2 arg_in_eclose_sing under_Memrel_eclose)
 done
 
 (*Avoids explosions in proofs; resolve it with a meta-level definition.*)
 lemma def_transrec:
     "\<lbrakk>\<And>x. f(x)\<equiv>transrec(x,H)\<rbrakk> \<Longrightarrow> f(a) = H(a, \<lambda>x\<in>a. f(x))"
 apply simp
 apply (rule transrec)
 done
 
 lemma transrec_type:
     "\<lbrakk>\<And>x u. \<lbrakk>x \<in> eclose({a});  u \<in> Pi(x,B)\<rbrakk> \<Longrightarrow> H(x,u) \<in> B(x)\<rbrakk>
      \<Longrightarrow> transrec(a,H) \<in> B(a)"
 apply (rule_tac i = a in arg_in_eclose_sing [THEN eclose_induct])
 apply (subst transrec)
 apply (simp add: lam_type)
 done
 
 lemma eclose_sing_Ord: "Ord(i) \<Longrightarrow> eclose({i}) \<subseteq> succ(i)"
 apply (erule Ord_is_Transset [THEN Transset_succ, THEN eclose_least])
 apply (rule succI1 [THEN singleton_subsetI])
 done
 
 lemma succ_subset_eclose_sing: "succ(i) \<subseteq> eclose({i})"
 apply (insert arg_subset_eclose [of "{i}"], simp)
 apply (frule eclose_subset, blast)
 done
 
 lemma eclose_sing_Ord_eq: "Ord(i) \<Longrightarrow> eclose({i}) = succ(i)"
 apply (rule equalityI)
 apply (erule eclose_sing_Ord)
 apply (rule succ_subset_eclose_sing)
 done
 
 lemma Ord_transrec_type:
   assumes jini: "j \<in> i"
       and ordi: "Ord(i)"
       and minor: " \<And>x u. \<lbrakk>x \<in> i;  u \<in> Pi(x,B)\<rbrakk> \<Longrightarrow> H(x,u) \<in> B(x)"
   shows "transrec(j,H) \<in> B(j)"
 apply (rule transrec_type)
 apply (insert jini ordi)
 apply (blast intro!: minor
              intro: Ord_trans
              dest: Ord_in_Ord [THEN eclose_sing_Ord, THEN subsetD])
 done
 
 subsection\<open>Rank\<close>
 
 (*NOT SUITABLE FOR REWRITING -- RECURSIVE!*)
 lemma rank: "rank(a) = (\<Union>y\<in>a. succ(rank(y)))"
 by (subst rank_def [THEN def_transrec], simp)
 
 lemma Ord_rank [simp]: "Ord(rank(a))"
 apply (rule_tac a=a in eps_induct)
 apply (subst rank)
 apply (rule Ord_succ [THEN Ord_UN])
 apply (erule bspec, assumption)
 done
 
 lemma rank_of_Ord: "Ord(i) \<Longrightarrow> rank(i) = i"
 apply (erule trans_induct)
 apply (subst rank)
 apply (simp add: Ord_equality)
 done
 
 lemma rank_lt: "a \<in> b \<Longrightarrow> rank(a) < rank(b)"
 apply (rule_tac a1 = b in rank [THEN ssubst])
 apply (erule UN_I [THEN ltI])
 apply (rule_tac [2] Ord_UN, auto)
 done
 
 lemma eclose_rank_lt: "a \<in> eclose(b) \<Longrightarrow> rank(a) < rank(b)"
 apply (erule eclose_induct_down)
 apply (erule rank_lt)
 apply (erule rank_lt [THEN lt_trans], assumption)
 done
 
 lemma rank_mono: "a<=b \<Longrightarrow> rank(a) \<le> rank(b)"
 apply (rule subset_imp_le)
 apply (auto simp add: rank [of a] rank [of b])
 done
 
 lemma rank_Pow: "rank(Pow(a)) = succ(rank(a))"
 apply (rule rank [THEN trans])
 apply (rule le_anti_sym)
 apply (rule_tac [2] UN_upper_le)
 apply (rule UN_least_le)
 apply (auto intro: rank_mono simp add: Ord_UN)
 done
 
 lemma rank_0 [simp]: "rank(0) = 0"
 by (rule rank [THEN trans], blast)
 
 lemma rank_succ [simp]: "rank(succ(x)) = succ(rank(x))"
 apply (rule rank [THEN trans])
 apply (rule equalityI [OF UN_least succI1 [THEN UN_upper]])
 apply (erule succE, blast)
 apply (erule rank_lt [THEN leI, THEN succ_leI, THEN le_imp_subset])
 done
 
 lemma rank_Union: "rank(\<Union>(A)) = (\<Union>x\<in>A. rank(x))"
 apply (rule equalityI)
 apply (rule_tac [2] rank_mono [THEN le_imp_subset, THEN UN_least])
 apply (erule_tac [2] Union_upper)
 apply (subst rank)
 apply (rule UN_least)
 apply (erule UnionE)
 apply (rule subset_trans)
 apply (erule_tac [2] RepFunI [THEN Union_upper])
 apply (erule rank_lt [THEN succ_leI, THEN le_imp_subset])
 done
 
 lemma rank_eclose: "rank(eclose(a)) = rank(a)"
 apply (rule le_anti_sym)
 apply (rule_tac [2] arg_subset_eclose [THEN rank_mono])
 apply (rule_tac a1 = "eclose (a) " in rank [THEN ssubst])
 apply (rule Ord_rank [THEN UN_least_le])
 apply (erule eclose_rank_lt [THEN succ_leI])
 done
 
 lemma rank_pair1: "rank(a) < rank(\<langle>a,b\<rangle>)"
-apply (unfold Pair_def)
+  unfolding Pair_def
 apply (rule consI1 [THEN rank_lt, THEN lt_trans])
 apply (rule consI1 [THEN consI2, THEN rank_lt])
 done
 
 lemma rank_pair2: "rank(b) < rank(\<langle>a,b\<rangle>)"
-apply (unfold Pair_def)
+  unfolding Pair_def
 apply (rule consI1 [THEN consI2, THEN rank_lt, THEN lt_trans])
 apply (rule consI1 [THEN consI2, THEN rank_lt])
 done
 
 (*Not clear how to remove the P(a) condition, since the "then" part
   must refer to "a"*)
 lemma the_equality_if:
      "P(a) \<Longrightarrow> (THE x. P(x)) = (if (\<exists>!x. P(x)) then a else 0)"
 by (simp add: the_0 the_equality2)
 
 (*The first premise not only fixs i but ensures @{term"f\<noteq>0"}.
   The second premise is now essential.  Consider otherwise the relation
   r = {\<langle>0,0\<rangle>,\<langle>0,1\<rangle>,\<langle>0,2\<rangle>,...}.  Then f`0 = \<Union>(f``{0}) = \<Union>(nat) = nat,
   whose rank equals that of r.*)
 lemma rank_apply: "\<lbrakk>i \<in> domain(f); function(f)\<rbrakk> \<Longrightarrow> rank(f`i) < rank(f)"
 apply clarify
 apply (simp add: function_apply_equality)
 apply (blast intro: lt_trans rank_lt rank_pair2)
 done
 
 
 subsection\<open>Corollaries of Leastness\<close>
 
 lemma mem_eclose_subset: "A \<in> B \<Longrightarrow> eclose(A)<=eclose(B)"
 apply (rule Transset_eclose [THEN eclose_least])
 apply (erule arg_into_eclose [THEN eclose_subset])
 done
 
 lemma eclose_mono: "A<=B \<Longrightarrow> eclose(A) \<subseteq> eclose(B)"
 apply (rule Transset_eclose [THEN eclose_least])
 apply (erule subset_trans)
 apply (rule arg_subset_eclose)
 done
 
 (** Idempotence of eclose **)
 
 lemma eclose_idem: "eclose(eclose(A)) = eclose(A)"
 apply (rule equalityI)
 apply (rule eclose_least [OF Transset_eclose subset_refl])
 apply (rule arg_subset_eclose)
 done
 
 (** Transfinite recursion for definitions based on the
     three cases of ordinals **)
 
 lemma transrec2_0 [simp]: "transrec2(0,a,b) = a"
 by (rule transrec2_def [THEN def_transrec, THEN trans], simp)
 
 lemma transrec2_succ [simp]: "transrec2(succ(i),a,b) = b(i, transrec2(i,a,b))"
 apply (rule transrec2_def [THEN def_transrec, THEN trans])
 apply (simp add: the_equality if_P)
 done
 
 lemma transrec2_Limit:
      "Limit(i) \<Longrightarrow> transrec2(i,a,b) = (\<Union>j<i. transrec2(j,a,b))"
 apply (rule transrec2_def [THEN def_transrec, THEN trans])
 apply (auto simp add: OUnion_def)
 done
 
 lemma def_transrec2:
      "(\<And>x. f(x)\<equiv>transrec2(x,a,b))
       \<Longrightarrow> f(0) = a \<and>
           f(succ(i)) = b(i, f(i)) \<and>
           (Limit(K) \<longrightarrow> f(K) = (\<Union>j<K. f(j)))"
 by (simp add: transrec2_Limit)
 
 
 (** recursor -- better than nat_rec; the succ case has no type requirement! **)
 
 (*NOT suitable for rewriting*)
 lemmas recursor_lemma = recursor_def [THEN def_transrec, THEN trans]
 
 lemma recursor_0: "recursor(a,b,0) = a"
 by (rule nat_case_0 [THEN recursor_lemma])
 
 lemma recursor_succ: "recursor(a,b,succ(m)) = b(m, recursor(a,b,m))"
 by (rule recursor_lemma, simp)
 
 
 (** rec: old version for compatibility **)
 
 lemma rec_0 [simp]: "rec(0,a,b) = a"
-apply (unfold rec_def)
+  unfolding rec_def
 apply (rule recursor_0)
 done
 
 lemma rec_succ [simp]: "rec(succ(m),a,b) = b(m, rec(m,a,b))"
-apply (unfold rec_def)
+  unfolding rec_def
 apply (rule recursor_succ)
 done
 
 lemma rec_type:
     "\<lbrakk>n \<in> nat;
         a \<in> C(0);
         \<And>m z. \<lbrakk>m \<in> nat;  z \<in> C(m)\<rbrakk> \<Longrightarrow> b(m,z): C(succ(m))\<rbrakk>
      \<Longrightarrow> rec(n,a,b) \<in> C(n)"
 by (erule nat_induct, auto)
 
 end
diff --git a/src/ZF/EquivClass.thy b/src/ZF/EquivClass.thy
--- a/src/ZF/EquivClass.thy
+++ b/src/ZF/EquivClass.thy
@@ -1,233 +1,233 @@
 (*  Title:      ZF/EquivClass.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section\<open>Equivalence Relations\<close>
 
 theory EquivClass imports Trancl Perm begin
 
 definition
   quotient   :: "[i,i]\<Rightarrow>i"    (infixl \<open>'/'/\<close> 90)  (*set of equiv classes*)  where
       "A//r \<equiv> {r``{x} . x \<in> A}"
 
 definition
   congruent  :: "[i,i\<Rightarrow>i]\<Rightarrow>o"  where
       "congruent(r,b) \<equiv> \<forall>y z. \<langle>y,z\<rangle>:r \<longrightarrow> b(y)=b(z)"
 
 definition
   congruent2 :: "[i,i,[i,i]\<Rightarrow>i]\<Rightarrow>o"  where
       "congruent2(r1,r2,b) \<equiv> \<forall>y1 z1 y2 z2.
            \<langle>y1,z1\<rangle>:r1 \<longrightarrow> \<langle>y2,z2\<rangle>:r2 \<longrightarrow> b(y1,y2) = b(z1,z2)"
 
 abbreviation
   RESPECTS ::"[i\<Rightarrow>i, i] \<Rightarrow> o"  (infixr \<open>respects\<close> 80) where
   "f respects r \<equiv> congruent(r,f)"
 
 abbreviation
   RESPECTS2 ::"[i\<Rightarrow>i\<Rightarrow>i, i] \<Rightarrow> o"  (infixr \<open>respects2 \<close> 80) where
   "f respects2 r \<equiv> congruent2(r,r,f)"
     \<comment> \<open>Abbreviation for the common case where the relations are identical\<close>
 
 
 subsection\<open>Suppes, Theorem 70:
     \<^term>\<open>r\<close> is an equiv relation iff \<^term>\<open>converse(r) O r = r\<close>\<close>
 
 (** first half: equiv(A,r) \<Longrightarrow> converse(r) O r = r **)
 
 lemma sym_trans_comp_subset:
     "\<lbrakk>sym(r); trans(r)\<rbrakk> \<Longrightarrow> converse(r) O r \<subseteq> r"
 by (unfold trans_def sym_def, blast)
 
 lemma refl_comp_subset:
     "\<lbrakk>refl(A,r); r \<subseteq> A*A\<rbrakk> \<Longrightarrow> r \<subseteq> converse(r) O r"
 by (unfold refl_def, blast)
 
 lemma equiv_comp_eq:
     "equiv(A,r) \<Longrightarrow> converse(r) O r = r"
-apply (unfold equiv_def)
+  unfolding equiv_def
 apply (blast del: subsetI intro!: sym_trans_comp_subset refl_comp_subset)
 done
 
 (*second half*)
 lemma comp_equivI:
     "\<lbrakk>converse(r) O r = r;  domain(r) = A\<rbrakk> \<Longrightarrow> equiv(A,r)"
 apply (unfold equiv_def refl_def sym_def trans_def)
 apply (erule equalityE)
 apply (subgoal_tac "\<forall>x y. \<langle>x,y\<rangle> \<in> r \<longrightarrow> \<langle>y,x\<rangle> \<in> r", blast+)
 done
 
 (** Equivalence classes **)
 
 (*Lemma for the next result*)
 lemma equiv_class_subset:
     "\<lbrakk>sym(r);  trans(r);  \<langle>a,b\<rangle>: r\<rbrakk> \<Longrightarrow> r``{a} \<subseteq> r``{b}"
 by (unfold trans_def sym_def, blast)
 
 lemma equiv_class_eq:
     "\<lbrakk>equiv(A,r);  \<langle>a,b\<rangle>: r\<rbrakk> \<Longrightarrow> r``{a} = r``{b}"
-apply (unfold equiv_def)
+  unfolding equiv_def
 apply (safe del: subsetI intro!: equalityI equiv_class_subset)
 apply (unfold sym_def, blast)
 done
 
 lemma equiv_class_self:
     "\<lbrakk>equiv(A,r);  a \<in> A\<rbrakk> \<Longrightarrow> a \<in> r``{a}"
 by (unfold equiv_def refl_def, blast)
 
 (*Lemma for the next result*)
 lemma subset_equiv_class:
     "\<lbrakk>equiv(A,r);  r``{b} \<subseteq> r``{a};  b \<in> A\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle>: r"
 by (unfold equiv_def refl_def, blast)
 
 lemma eq_equiv_class: "\<lbrakk>r``{a} = r``{b};  equiv(A,r);  b \<in> A\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle>: r"
 by (assumption | rule equalityD2 subset_equiv_class)+
 
 (*thus r``{a} = r``{b} as well*)
 lemma equiv_class_nondisjoint:
     "\<lbrakk>equiv(A,r);  x: (r``{a} \<inter> r``{b})\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle>: r"
 by (unfold equiv_def trans_def sym_def, blast)
 
 lemma equiv_type: "equiv(A,r) \<Longrightarrow> r \<subseteq> A*A"
 by (unfold equiv_def, blast)
 
 lemma equiv_class_eq_iff:
      "equiv(A,r) \<Longrightarrow> \<langle>x,y\<rangle>: r \<longleftrightarrow> r``{x} = r``{y} \<and> x \<in> A \<and> y \<in> A"
 by (blast intro: eq_equiv_class equiv_class_eq dest: equiv_type)
 
 lemma eq_equiv_class_iff:
      "\<lbrakk>equiv(A,r);  x \<in> A;  y \<in> A\<rbrakk> \<Longrightarrow> r``{x} = r``{y} \<longleftrightarrow> \<langle>x,y\<rangle>: r"
 by (blast intro: eq_equiv_class equiv_class_eq dest: equiv_type)
 
 (*** Quotients ***)
 
 (** Introduction/elimination rules -- needed? **)
 
 lemma quotientI [TC]: "x \<in> A \<Longrightarrow> r``{x}: A//r"
-apply (unfold quotient_def)
+  unfolding quotient_def
 apply (erule RepFunI)
 done
 
 lemma quotientE:
     "\<lbrakk>X \<in> A//r;  \<And>x. \<lbrakk>X = r``{x};  x \<in> A\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (unfold quotient_def, blast)
 
 lemma Union_quotient:
     "equiv(A,r) \<Longrightarrow> \<Union>(A//r) = A"
 by (unfold equiv_def refl_def quotient_def, blast)
 
 lemma quotient_disj:
     "\<lbrakk>equiv(A,r);  X \<in> A//r;  Y \<in> A//r\<rbrakk> \<Longrightarrow> X=Y | (X \<inter> Y \<subseteq> 0)"
-apply (unfold quotient_def)
+  unfolding quotient_def
 apply (safe intro!: equiv_class_eq, assumption)
 apply (unfold equiv_def trans_def sym_def, blast)
 done
 
 subsection\<open>Defining Unary Operations upon Equivalence Classes\<close>
 
 (** Could have a locale with the premises equiv(A,r)  and  congruent(r,b)
 **)
 
 (*Conversion rule*)
 lemma UN_equiv_class:
     "\<lbrakk>equiv(A,r);  b respects r;  a \<in> A\<rbrakk> \<Longrightarrow> (\<Union>x\<in>r``{a}. b(x)) = b(a)"
 apply (subgoal_tac "\<forall>x \<in> r``{a}. b(x) = b(a)")
  apply simp
  apply (blast intro: equiv_class_self)
 apply (unfold equiv_def sym_def congruent_def, blast)
 done
 
 (*type checking of  @{term"\<Union>x\<in>r``{a}. b(x)"} *)
 lemma UN_equiv_class_type:
     "\<lbrakk>equiv(A,r);  b respects r;  X \<in> A//r;  \<And>x.  x \<in> A \<Longrightarrow> b(x) \<in> B\<rbrakk>
      \<Longrightarrow> (\<Union>x\<in>X. b(x)) \<in> B"
 apply (unfold quotient_def, safe)
 apply (simp (no_asm_simp) add: UN_equiv_class)
 done
 
 (*Sufficient conditions for injectiveness.  Could weaken premises!
   major premise could be an inclusion; bcong could be \<And>y. y \<in> A \<Longrightarrow> b(y):B
 *)
 lemma UN_equiv_class_inject:
     "\<lbrakk>equiv(A,r);   b respects r;
         (\<Union>x\<in>X. b(x))=(\<Union>y\<in>Y. b(y));  X \<in> A//r;  Y \<in> A//r;
         \<And>x y. \<lbrakk>x \<in> A; y \<in> A; b(x)=b(y)\<rbrakk> \<Longrightarrow> \<langle>x,y\<rangle>:r\<rbrakk>
      \<Longrightarrow> X=Y"
 apply (unfold quotient_def, safe)
 apply (rule equiv_class_eq, assumption)
 apply (simp add: UN_equiv_class [of A r b])
 done
 
 
 subsection\<open>Defining Binary Operations upon Equivalence Classes\<close>
 
 lemma congruent2_implies_congruent:
     "\<lbrakk>equiv(A,r1);  congruent2(r1,r2,b);  a \<in> A\<rbrakk> \<Longrightarrow> congruent(r2,b(a))"
 by (unfold congruent_def congruent2_def equiv_def refl_def, blast)
 
 lemma congruent2_implies_congruent_UN:
     "\<lbrakk>equiv(A1,r1);  equiv(A2,r2);  congruent2(r1,r2,b);  a \<in> A2\<rbrakk> \<Longrightarrow>
      congruent(r1, \<lambda>x1. \<Union>x2 \<in> r2``{a}. b(x1,x2))"
 apply (unfold congruent_def, safe)
 apply (frule equiv_type [THEN subsetD], assumption)
 apply clarify
 apply (simp add: UN_equiv_class congruent2_implies_congruent)
 apply (unfold congruent2_def equiv_def refl_def, blast)
 done
 
 lemma UN_equiv_class2:
     "\<lbrakk>equiv(A1,r1);  equiv(A2,r2);  congruent2(r1,r2,b);  a1: A1;  a2: A2\<rbrakk>
      \<Longrightarrow> (\<Union>x1 \<in> r1``{a1}. \<Union>x2 \<in> r2``{a2}. b(x1,x2)) = b(a1,a2)"
 by (simp add: UN_equiv_class congruent2_implies_congruent
               congruent2_implies_congruent_UN)
 
 (*type checking*)
 lemma UN_equiv_class_type2:
     "\<lbrakk>equiv(A,r);  b respects2 r;
         X1: A//r;  X2: A//r;
         \<And>x1 x2.  \<lbrakk>x1: A; x2: A\<rbrakk> \<Longrightarrow> b(x1,x2) \<in> B
 \<rbrakk> \<Longrightarrow> (\<Union>x1\<in>X1. \<Union>x2\<in>X2. b(x1,x2)) \<in> B"
 apply (unfold quotient_def, safe)
 apply (blast intro: UN_equiv_class_type congruent2_implies_congruent_UN
                     congruent2_implies_congruent quotientI)
 done
 
 
 (*Suggested by John Harrison -- the two subproofs may be MUCH simpler
   than the direct proof*)
 lemma congruent2I:
     "\<lbrakk>equiv(A1,r1);  equiv(A2,r2);
         \<And>y z w. \<lbrakk>w \<in> A2;  \<langle>y,z\<rangle> \<in> r1\<rbrakk> \<Longrightarrow> b(y,w) = b(z,w);
         \<And>y z w. \<lbrakk>w \<in> A1;  \<langle>y,z\<rangle> \<in> r2\<rbrakk> \<Longrightarrow> b(w,y) = b(w,z)
 \<rbrakk> \<Longrightarrow> congruent2(r1,r2,b)"
 apply (unfold congruent2_def equiv_def refl_def, safe)
 apply (blast intro: trans)
 done
 
 lemma congruent2_commuteI:
  assumes equivA: "equiv(A,r)"
      and commute: "\<And>y z. \<lbrakk>y \<in> A;  z \<in> A\<rbrakk> \<Longrightarrow> b(y,z) = b(z,y)"
      and congt:   "\<And>y z w. \<lbrakk>w \<in> A;  \<langle>y,z\<rangle>: r\<rbrakk> \<Longrightarrow> b(w,y) = b(w,z)"
  shows "b respects2 r"
 apply (insert equivA [THEN equiv_type, THEN subsetD])
 apply (rule congruent2I [OF equivA equivA])
 apply (rule commute [THEN trans])
 apply (rule_tac [3] commute [THEN trans, symmetric])
 apply (rule_tac [5] sym)
 apply (blast intro: congt)+
 done
 
 (*Obsolete?*)
 lemma congruent_commuteI:
     "\<lbrakk>equiv(A,r);  Z \<in> A//r;
         \<And>w. \<lbrakk>w \<in> A\<rbrakk> \<Longrightarrow> congruent(r, \<lambda>z. b(w,z));
         \<And>x y. \<lbrakk>x \<in> A;  y \<in> A\<rbrakk> \<Longrightarrow> b(y,x) = b(x,y)
 \<rbrakk> \<Longrightarrow> congruent(r, \<lambda>w. \<Union>z\<in>Z. b(w,z))"
 apply (simp (no_asm) add: congruent_def)
 apply (safe elim!: quotientE)
 apply (frule equiv_type [THEN subsetD], assumption)
 apply (simp add: UN_equiv_class [of A r])
 apply (simp add: congruent_def)
 done
 
 end
diff --git a/src/ZF/Fixedpt.thy b/src/ZF/Fixedpt.thy
--- a/src/ZF/Fixedpt.thy
+++ b/src/ZF/Fixedpt.thy
@@ -1,304 +1,304 @@
 (*  Title:      ZF/Fixedpt.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1992  University of Cambridge
 *)
 
 section\<open>Least and Greatest Fixed Points; the Knaster-Tarski Theorem\<close>
 
 theory Fixedpt imports equalities begin
 
 definition 
   (*monotone operator from Pow(D) to itself*)
   bnd_mono :: "[i,i\<Rightarrow>i]\<Rightarrow>o"  where
      "bnd_mono(D,h) \<equiv> h(D)<=D \<and> (\<forall>W X. W<=X \<longrightarrow> X<=D \<longrightarrow> h(W) \<subseteq> h(X))"
 
 definition 
   lfp      :: "[i,i\<Rightarrow>i]\<Rightarrow>i"  where
      "lfp(D,h) \<equiv> \<Inter>({X: Pow(D). h(X) \<subseteq> X})"
 
 definition 
   gfp      :: "[i,i\<Rightarrow>i]\<Rightarrow>i"  where
      "gfp(D,h) \<equiv> \<Union>({X: Pow(D). X \<subseteq> h(X)})"
 
 text\<open>The theorem is proved in the lattice of subsets of \<^term>\<open>D\<close>, 
       namely \<^term>\<open>Pow(D)\<close>, with Inter as the greatest lower bound.\<close>
 
 subsection\<open>Monotone Operators\<close>
 
 lemma bnd_monoI:
     "\<lbrakk>h(D)<=D;   
         \<And>W X. \<lbrakk>W<=D;  X<=D;  W<=X\<rbrakk> \<Longrightarrow> h(W) \<subseteq> h(X)   
 \<rbrakk> \<Longrightarrow> bnd_mono(D,h)"
 by (unfold bnd_mono_def, clarify, blast)  
 
 lemma bnd_monoD1: "bnd_mono(D,h) \<Longrightarrow> h(D) \<subseteq> D"
-apply (unfold bnd_mono_def)
+  unfolding bnd_mono_def
 apply (erule conjunct1)
 done
 
 lemma bnd_monoD2: "\<lbrakk>bnd_mono(D,h);  W<=X;  X<=D\<rbrakk> \<Longrightarrow> h(W) \<subseteq> h(X)"
 by (unfold bnd_mono_def, blast)
 
 lemma bnd_mono_subset:
     "\<lbrakk>bnd_mono(D,h);  X<=D\<rbrakk> \<Longrightarrow> h(X) \<subseteq> D"
 by (unfold bnd_mono_def, clarify, blast) 
 
 lemma bnd_mono_Un:
      "\<lbrakk>bnd_mono(D,h);  A \<subseteq> D;  B \<subseteq> D\<rbrakk> \<Longrightarrow> h(A) \<union> h(B) \<subseteq> h(A \<union> B)"
-apply (unfold bnd_mono_def)
+  unfolding bnd_mono_def
 apply (rule Un_least, blast+)
 done
 
 (*unused*)
 lemma bnd_mono_UN:
      "\<lbrakk>bnd_mono(D,h);  \<forall>i\<in>I. A(i) \<subseteq> D\<rbrakk> 
       \<Longrightarrow> (\<Union>i\<in>I. h(A(i))) \<subseteq> h((\<Union>i\<in>I. A(i)))"
-apply (unfold bnd_mono_def) 
+  unfolding bnd_mono_def 
 apply (rule UN_least)
 apply (elim conjE) 
 apply (drule_tac x="A(i)" in spec)
 apply (drule_tac x="(\<Union>i\<in>I. A(i))" in spec) 
 apply blast 
 done
 
 (*Useful??*)
 lemma bnd_mono_Int:
      "\<lbrakk>bnd_mono(D,h);  A \<subseteq> D;  B \<subseteq> D\<rbrakk> \<Longrightarrow> h(A \<inter> B) \<subseteq> h(A) \<inter> h(B)"
 apply (rule Int_greatest) 
 apply (erule bnd_monoD2, rule Int_lower1, assumption) 
 apply (erule bnd_monoD2, rule Int_lower2, assumption) 
 done
 
 subsection\<open>Proof of Knaster-Tarski Theorem using \<^term>\<open>lfp\<close>\<close>
 
 (*lfp is contained in each pre-fixedpoint*)
 lemma lfp_lowerbound: 
     "\<lbrakk>h(A) \<subseteq> A;  A<=D\<rbrakk> \<Longrightarrow> lfp(D,h) \<subseteq> A"
 by (unfold lfp_def, blast)
 
 (*Unfolding the defn of Inter dispenses with the premise bnd_mono(D,h)!*)
 lemma lfp_subset: "lfp(D,h) \<subseteq> D"
 by (unfold lfp_def Inter_def, blast)
 
 (*Used in datatype package*)
 lemma def_lfp_subset:  "A \<equiv> lfp(D,h) \<Longrightarrow> A \<subseteq> D"
 apply simp
 apply (rule lfp_subset)
 done
 
 lemma lfp_greatest:  
     "\<lbrakk>h(D) \<subseteq> D;  \<And>X. \<lbrakk>h(X) \<subseteq> X;  X<=D\<rbrakk> \<Longrightarrow> A<=X\<rbrakk> \<Longrightarrow> A \<subseteq> lfp(D,h)"
 by (unfold lfp_def, blast) 
 
 lemma lfp_lemma1:  
     "\<lbrakk>bnd_mono(D,h);  h(A)<=A;  A<=D\<rbrakk> \<Longrightarrow> h(lfp(D,h)) \<subseteq> A"
 apply (erule bnd_monoD2 [THEN subset_trans])
 apply (rule lfp_lowerbound, assumption+)
 done
 
 lemma lfp_lemma2: "bnd_mono(D,h) \<Longrightarrow> h(lfp(D,h)) \<subseteq> lfp(D,h)"
 apply (rule bnd_monoD1 [THEN lfp_greatest])
 apply (rule_tac [2] lfp_lemma1)
 apply (assumption+)
 done
 
 lemma lfp_lemma3: 
     "bnd_mono(D,h) \<Longrightarrow> lfp(D,h) \<subseteq> h(lfp(D,h))"
 apply (rule lfp_lowerbound)
 apply (rule bnd_monoD2, assumption)
 apply (rule lfp_lemma2, assumption)
 apply (erule_tac [2] bnd_mono_subset)
 apply (rule lfp_subset)+
 done
 
 lemma lfp_unfold: "bnd_mono(D,h) \<Longrightarrow> lfp(D,h) = h(lfp(D,h))"
 apply (rule equalityI) 
 apply (erule lfp_lemma3) 
 apply (erule lfp_lemma2) 
 done
 
 (*Definition form, to control unfolding*)
 lemma def_lfp_unfold:
     "\<lbrakk>A\<equiv>lfp(D,h);  bnd_mono(D,h)\<rbrakk> \<Longrightarrow> A = h(A)"
 apply simp
 apply (erule lfp_unfold)
 done
 
 subsection\<open>General Induction Rule for Least Fixedpoints\<close>
 
 lemma Collect_is_pre_fixedpt:
     "\<lbrakk>bnd_mono(D,h);  \<And>x. x \<in> h(Collect(lfp(D,h),P)) \<Longrightarrow> P(x)\<rbrakk>
      \<Longrightarrow> h(Collect(lfp(D,h),P)) \<subseteq> Collect(lfp(D,h),P)"
 by (blast intro: lfp_lemma2 [THEN subsetD] bnd_monoD2 [THEN subsetD] 
                  lfp_subset [THEN subsetD]) 
 
 (*This rule yields an induction hypothesis in which the components of a
   data structure may be assumed to be elements of lfp(D,h)*)
 lemma induct:
     "\<lbrakk>bnd_mono(D,h);  a \<in> lfp(D,h);                    
         \<And>x. x \<in> h(Collect(lfp(D,h),P)) \<Longrightarrow> P(x)         
 \<rbrakk> \<Longrightarrow> P(a)"
 apply (rule Collect_is_pre_fixedpt
               [THEN lfp_lowerbound, THEN subsetD, THEN CollectD2])
 apply (rule_tac [3] lfp_subset [THEN Collect_subset [THEN subset_trans]], 
        blast+)
 done
 
 (*Definition form, to control unfolding*)
 lemma def_induct:
     "\<lbrakk>A \<equiv> lfp(D,h);  bnd_mono(D,h);  a:A;    
         \<And>x. x \<in> h(Collect(A,P)) \<Longrightarrow> P(x)  
 \<rbrakk> \<Longrightarrow> P(a)"
 by (rule induct, blast+)
 
 (*This version is useful when "A" is not a subset of D
   second premise could simply be h(D \<inter> A) \<subseteq> D or \<And>X. X<=D \<Longrightarrow> h(X)<=D *)
 lemma lfp_Int_lowerbound:
     "\<lbrakk>h(D \<inter> A) \<subseteq> A;  bnd_mono(D,h)\<rbrakk> \<Longrightarrow> lfp(D,h) \<subseteq> A" 
 apply (rule lfp_lowerbound [THEN subset_trans])
 apply (erule bnd_mono_subset [THEN Int_greatest], blast+)
 done
 
 (*Monotonicity of lfp, where h precedes i under a domain-like partial order
   monotonicity of h is not strictly necessary; h must be bounded by D*)
 lemma lfp_mono:
   assumes hmono: "bnd_mono(D,h)"
       and imono: "bnd_mono(E,i)"
       and subhi: "\<And>X. X<=D \<Longrightarrow> h(X) \<subseteq> i(X)"
     shows "lfp(D,h) \<subseteq> lfp(E,i)"
 apply (rule bnd_monoD1 [THEN lfp_greatest])
 apply (rule imono)
 apply (rule hmono [THEN [2] lfp_Int_lowerbound])
 apply (rule Int_lower1 [THEN subhi, THEN subset_trans])
 apply (rule imono [THEN bnd_monoD2, THEN subset_trans], auto) 
 done
 
 (*This (unused) version illustrates that monotonicity is not really needed,
   but both lfp's must be over the SAME set D;  Inter is anti-monotonic!*)
 lemma lfp_mono2:
     "\<lbrakk>i(D) \<subseteq> D;  \<And>X. X<=D \<Longrightarrow> h(X) \<subseteq> i(X)\<rbrakk> \<Longrightarrow> lfp(D,h) \<subseteq> lfp(D,i)"
 apply (rule lfp_greatest, assumption)
 apply (rule lfp_lowerbound, blast, assumption)
 done
 
 lemma lfp_cong:
      "\<lbrakk>D=D'; \<And>X. X \<subseteq> D' \<Longrightarrow> h(X) = h'(X)\<rbrakk> \<Longrightarrow> lfp(D,h) = lfp(D',h')"
 apply (simp add: lfp_def)
 apply (rule_tac t=Inter in subst_context)
 apply (rule Collect_cong, simp_all) 
 done 
 
 
 subsection\<open>Proof of Knaster-Tarski Theorem using \<^term>\<open>gfp\<close>\<close>
 
 (*gfp contains each post-fixedpoint that is contained in D*)
 lemma gfp_upperbound: "\<lbrakk>A \<subseteq> h(A);  A<=D\<rbrakk> \<Longrightarrow> A \<subseteq> gfp(D,h)"
-apply (unfold gfp_def)
+  unfolding gfp_def
 apply (rule PowI [THEN CollectI, THEN Union_upper])
 apply (assumption+)
 done
 
 lemma gfp_subset: "gfp(D,h) \<subseteq> D"
 by (unfold gfp_def, blast)
 
 (*Used in datatype package*)
 lemma def_gfp_subset: "A\<equiv>gfp(D,h) \<Longrightarrow> A \<subseteq> D"
 apply simp
 apply (rule gfp_subset)
 done
 
 lemma gfp_least: 
     "\<lbrakk>bnd_mono(D,h);  \<And>X. \<lbrakk>X \<subseteq> h(X);  X<=D\<rbrakk> \<Longrightarrow> X<=A\<rbrakk> \<Longrightarrow>  
      gfp(D,h) \<subseteq> A"
-apply (unfold gfp_def)
+  unfolding gfp_def
 apply (blast dest: bnd_monoD1) 
 done
 
 lemma gfp_lemma1: 
     "\<lbrakk>bnd_mono(D,h);  A<=h(A);  A<=D\<rbrakk> \<Longrightarrow> A \<subseteq> h(gfp(D,h))"
 apply (rule subset_trans, assumption)
 apply (erule bnd_monoD2)
 apply (rule_tac [2] gfp_subset)
 apply (simp add: gfp_upperbound)
 done
 
 lemma gfp_lemma2: "bnd_mono(D,h) \<Longrightarrow> gfp(D,h) \<subseteq> h(gfp(D,h))"
 apply (rule gfp_least)
 apply (rule_tac [2] gfp_lemma1)
 apply (assumption+)
 done
 
 lemma gfp_lemma3: 
     "bnd_mono(D,h) \<Longrightarrow> h(gfp(D,h)) \<subseteq> gfp(D,h)"
 apply (rule gfp_upperbound)
 apply (rule bnd_monoD2, assumption)
 apply (rule gfp_lemma2, assumption)
 apply (erule bnd_mono_subset, rule gfp_subset)+
 done
 
 lemma gfp_unfold: "bnd_mono(D,h) \<Longrightarrow> gfp(D,h) = h(gfp(D,h))"
 apply (rule equalityI) 
 apply (erule gfp_lemma2) 
 apply (erule gfp_lemma3) 
 done
 
 (*Definition form, to control unfolding*)
 lemma def_gfp_unfold:
     "\<lbrakk>A\<equiv>gfp(D,h);  bnd_mono(D,h)\<rbrakk> \<Longrightarrow> A = h(A)"
 apply simp
 apply (erule gfp_unfold)
 done
 
 
 subsection\<open>Coinduction Rules for Greatest Fixed Points\<close>
 
 (*weak version*)
 lemma weak_coinduct: "\<lbrakk>a: X;  X \<subseteq> h(X);  X \<subseteq> D\<rbrakk> \<Longrightarrow> a \<in> gfp(D,h)"
 by (blast intro: gfp_upperbound [THEN subsetD])
 
 lemma coinduct_lemma:
     "\<lbrakk>X \<subseteq> h(X \<union> gfp(D,h));  X \<subseteq> D;  bnd_mono(D,h)\<rbrakk> \<Longrightarrow>   
      X \<union> gfp(D,h) \<subseteq> h(X \<union> gfp(D,h))"
 apply (erule Un_least)
 apply (rule gfp_lemma2 [THEN subset_trans], assumption)
 apply (rule Un_upper2 [THEN subset_trans])
 apply (rule bnd_mono_Un, assumption+) 
 apply (rule gfp_subset)
 done
 
 (*strong version*)
 lemma coinduct:
      "\<lbrakk>bnd_mono(D,h);  a: X;  X \<subseteq> h(X \<union> gfp(D,h));  X \<subseteq> D\<rbrakk>
       \<Longrightarrow> a \<in> gfp(D,h)"
 apply (rule weak_coinduct)
 apply (erule_tac [2] coinduct_lemma)
 apply (simp_all add: gfp_subset Un_subset_iff) 
 done
 
 (*Definition form, to control unfolding*)
 lemma def_coinduct:
     "\<lbrakk>A \<equiv> gfp(D,h);  bnd_mono(D,h);  a: X;  X \<subseteq> h(X \<union> A);  X \<subseteq> D\<rbrakk> \<Longrightarrow>  
      a \<in> A"
 apply simp
 apply (rule coinduct, assumption+)
 done
 
 (*The version used in the induction/coinduction package*)
 lemma def_Collect_coinduct:
     "\<lbrakk>A \<equiv> gfp(D, \<lambda>w. Collect(D,P(w)));  bnd_mono(D, \<lambda>w. Collect(D,P(w)));   
         a: X;  X \<subseteq> D;  \<And>z. z: X \<Longrightarrow> P(X \<union> A, z)\<rbrakk> \<Longrightarrow>  
      a \<in> A"
 apply (rule def_coinduct, assumption+, blast+)
 done
 
 (*Monotonicity of gfp!*)
 lemma gfp_mono:
     "\<lbrakk>bnd_mono(D,h);  D \<subseteq> E;                  
         \<And>X. X<=D \<Longrightarrow> h(X) \<subseteq> i(X)\<rbrakk> \<Longrightarrow> gfp(D,h) \<subseteq> gfp(E,i)"
 apply (rule gfp_upperbound)
 apply (rule gfp_lemma2 [THEN subset_trans], assumption)
 apply (blast del: subsetI intro: gfp_subset) 
 apply (blast del: subsetI intro: subset_trans gfp_subset) 
 done
 
 end
diff --git a/src/ZF/IMP/Equiv.thy b/src/ZF/IMP/Equiv.thy
--- a/src/ZF/IMP/Equiv.thy
+++ b/src/ZF/IMP/Equiv.thy
@@ -1,83 +1,83 @@
 (*  Title:      ZF/IMP/Equiv.thy
     Author:     Heiko Loetzbeyer and Robert Sandner, TU München
 *)
 
 section \<open>Equivalence\<close>
 
 theory Equiv imports Denotation Com begin
 
 lemma aexp_iff [rule_format]:
   "\<lbrakk>a \<in> aexp; sigma: loc -> nat\<rbrakk> 
     \<Longrightarrow> \<forall>n. \<langle>a,sigma\<rangle> -a-> n \<longleftrightarrow> A(a,sigma) = n"
   apply (erule aexp.induct)
      apply (force intro!: evala.intros)+
   done
 
 declare aexp_iff [THEN iffD1, simp]
         aexp_iff [THEN iffD2, intro!]
 
 inductive_cases [elim!]:
   "\<langle>true,sigma\<rangle> -b-> x"
   "\<langle>false,sigma\<rangle> -b-> x"
   "<ROp(f,a0,a1),sigma> -b-> x"
   "<noti(b),sigma> -b-> x"
   "<b0 andi b1,sigma> -b-> x"
   "<b0 ori b1,sigma> -b-> x"
 
 
 lemma bexp_iff [rule_format]:
   "\<lbrakk>b \<in> bexp; sigma: loc -> nat\<rbrakk> 
     \<Longrightarrow> \<forall>w. \<langle>b,sigma\<rangle> -b-> w \<longleftrightarrow> B(b,sigma) = w"
   apply (erule bexp.induct) 
   apply (auto intro!: evalb.intros)
   done
 
 declare bexp_iff [THEN iffD1, simp]
         bexp_iff [THEN iffD2, intro!]
 
 lemma com1: "\<langle>c,sigma\<rangle> -c-> sigma' \<Longrightarrow> <sigma,sigma'> \<in> C(c)"
   apply (erule evalc.induct)
         apply (simp_all (no_asm_simp))
      txt \<open>\<open>assign\<close>\<close>
      apply (simp add: update_type)
     txt \<open>\<open>comp\<close>\<close>
     apply fast
    txt \<open>\<open>while\<close>\<close>
    apply (erule Gamma_bnd_mono [THEN lfp_unfold, THEN ssubst, OF C_subset])
    apply (simp add: Gamma_def)
   txt \<open>recursive case of \<open>while\<close>\<close>
   apply (erule Gamma_bnd_mono [THEN lfp_unfold, THEN ssubst, OF C_subset])
   apply (auto simp add: Gamma_def)
   done
 
 declare B_type [intro!] A_type [intro!]
 declare evalc.intros [intro]
 
 
 lemma com2 [rule_format]: "c \<in> com \<Longrightarrow> \<forall>x \<in> C(c). <c,fst(x)> -c-> snd(x)"
   apply (erule com.induct)
       txt \<open>\<open>skip\<close>\<close>
       apply force
      txt \<open>\<open>assign\<close>\<close>
      apply force
     txt \<open>\<open>comp\<close>\<close>
     apply force
    txt \<open>\<open>while\<close>\<close>
    apply safe
    apply simp_all
    apply (frule Gamma_bnd_mono [OF C_subset], erule Fixedpt.induct, assumption)
-   apply (unfold Gamma_def)
+     unfolding Gamma_def
    apply force
   txt \<open>\<open>if\<close>\<close>
   apply auto
   done
 
 
 subsection \<open>Main theorem\<close>
 
 theorem com_equivalence:
     "c \<in> com \<Longrightarrow> C(c) = {io \<in> (loc->nat) \<times> (loc->nat). <c,fst(io)> -c-> snd(io)}"
   by (force intro: C_subset [THEN subsetD] elim: com2 dest: com1)
 
 end
 
diff --git a/src/ZF/Induct/Comb.thy b/src/ZF/Induct/Comb.thy
--- a/src/ZF/Induct/Comb.thy
+++ b/src/ZF/Induct/Comb.thy
@@ -1,273 +1,273 @@
 (*  Title:      ZF/Induct/Comb.thy
     Author:     Lawrence C Paulson
     Copyright   1994  University of Cambridge
 *)
 
 section \<open>Combinatory Logic example: the Church-Rosser Theorem\<close>
 
 theory Comb
 imports ZF
 begin
 
 text \<open>
   Curiously, combinators do not include free variables.
 
   Example taken from @{cite camilleri92}.
 \<close>
 
 
 subsection \<open>Definitions\<close>
 
 text \<open>Datatype definition of combinators \<open>S\<close> and \<open>K\<close>.\<close>
 
 consts comb :: i
 datatype comb =
   K
 | S
 | app ("p \<in> comb", "q \<in> comb")  (infixl \<open>\<bullet>\<close> 90)
 
 text \<open>
   Inductive definition of contractions, \<open>\<rightarrow>\<^sup>1\<close> and
   (multi-step) reductions, \<open>\<rightarrow>\<close>.
 \<close>
 
 consts contract  :: i
 abbreviation contract_syntax :: "[i,i] \<Rightarrow> o"  (infixl \<open>\<rightarrow>\<^sup>1\<close> 50)
   where "p \<rightarrow>\<^sup>1 q \<equiv> \<langle>p,q\<rangle> \<in> contract"
 
 abbreviation contract_multi :: "[i,i] \<Rightarrow> o"  (infixl \<open>\<rightarrow>\<close> 50)
   where "p \<rightarrow> q \<equiv> \<langle>p,q\<rangle> \<in> contract^*"
 
 inductive
   domains "contract" \<subseteq> "comb \<times> comb"
   intros
     K:   "\<lbrakk>p \<in> comb;  q \<in> comb\<rbrakk> \<Longrightarrow> K\<bullet>p\<bullet>q \<rightarrow>\<^sup>1 p"
     S:   "\<lbrakk>p \<in> comb;  q \<in> comb;  r \<in> comb\<rbrakk> \<Longrightarrow> S\<bullet>p\<bullet>q\<bullet>r \<rightarrow>\<^sup>1 (p\<bullet>r)\<bullet>(q\<bullet>r)"
     Ap1: "\<lbrakk>p\<rightarrow>\<^sup>1q;  r \<in> comb\<rbrakk> \<Longrightarrow> p\<bullet>r \<rightarrow>\<^sup>1 q\<bullet>r"
     Ap2: "\<lbrakk>p\<rightarrow>\<^sup>1q;  r \<in> comb\<rbrakk> \<Longrightarrow> r\<bullet>p \<rightarrow>\<^sup>1 r\<bullet>q"
   type_intros comb.intros
 
 text \<open>
   Inductive definition of parallel contractions, \<open>\<Rrightarrow>\<^sup>1\<close> and
   (multi-step) parallel reductions, \<open>\<Rrightarrow>\<close>.
 \<close>
 
 consts parcontract :: i
 
 abbreviation parcontract_syntax :: "[i,i] \<Rightarrow> o"  (infixl \<open>\<Rrightarrow>\<^sup>1\<close> 50)
   where "p \<Rrightarrow>\<^sup>1 q \<equiv> \<langle>p,q\<rangle> \<in> parcontract"
 
 abbreviation parcontract_multi :: "[i,i] \<Rightarrow> o"  (infixl \<open>\<Rrightarrow>\<close> 50)
   where "p \<Rrightarrow> q \<equiv> \<langle>p,q\<rangle> \<in> parcontract^+"
 
 inductive
   domains "parcontract" \<subseteq> "comb \<times> comb"
   intros
     refl: "\<lbrakk>p \<in> comb\<rbrakk> \<Longrightarrow> p \<Rrightarrow>\<^sup>1 p"
     K:    "\<lbrakk>p \<in> comb;  q \<in> comb\<rbrakk> \<Longrightarrow> K\<bullet>p\<bullet>q \<Rrightarrow>\<^sup>1 p"
     S:    "\<lbrakk>p \<in> comb;  q \<in> comb;  r \<in> comb\<rbrakk> \<Longrightarrow> S\<bullet>p\<bullet>q\<bullet>r \<Rrightarrow>\<^sup>1 (p\<bullet>r)\<bullet>(q\<bullet>r)"
     Ap:   "\<lbrakk>p\<Rrightarrow>\<^sup>1q;  r\<Rrightarrow>\<^sup>1s\<rbrakk> \<Longrightarrow> p\<bullet>r \<Rrightarrow>\<^sup>1 q\<bullet>s"
   type_intros comb.intros
 
 text \<open>
   Misc definitions.
 \<close>
 
 definition I :: i
   where "I \<equiv> S\<bullet>K\<bullet>K"
 
 definition diamond :: "i \<Rightarrow> o"
   where "diamond(r) \<equiv>
     \<forall>x y. \<langle>x,y\<rangle>\<in>r \<longrightarrow> (\<forall>y'. <x,y'>\<in>r \<longrightarrow> (\<exists>z. \<langle>y,z\<rangle>\<in>r \<and> <y',z> \<in> r))"
 
 
 subsection \<open>Transitive closure preserves the Church-Rosser property\<close>
 
 lemma diamond_strip_lemmaD [rule_format]:
   "\<lbrakk>diamond(r);  \<langle>x,y\<rangle>:r^+\<rbrakk> \<Longrightarrow>
     \<forall>y'. <x,y'>:r \<longrightarrow> (\<exists>z. <y',z>: r^+ \<and> \<langle>y,z\<rangle>: r)"
-  apply (unfold diamond_def)
+    unfolding diamond_def
   apply (erule trancl_induct)
    apply (blast intro: r_into_trancl)
   apply clarify
   apply (drule spec [THEN mp], assumption)
   apply (blast intro: r_into_trancl trans_trancl [THEN transD])
   done
 
 lemma diamond_trancl: "diamond(r) \<Longrightarrow> diamond(r^+)"
   apply (simp (no_asm_simp) add: diamond_def)
   apply (rule impI [THEN allI, THEN allI])
   apply (erule trancl_induct)
    apply auto
    apply (best intro: r_into_trancl trans_trancl [THEN transD]
      dest: diamond_strip_lemmaD)+
   done
 
 inductive_cases Ap_E [elim!]: "p\<bullet>q \<in> comb"
 
 
 subsection \<open>Results about Contraction\<close>
 
 text \<open>
   For type checking: replaces \<^term>\<open>a \<rightarrow>\<^sup>1 b\<close> by \<open>a, b \<in>
   comb\<close>.
 \<close>
 
 lemmas contract_combE2 = contract.dom_subset [THEN subsetD, THEN SigmaE2]
   and contract_combD1 = contract.dom_subset [THEN subsetD, THEN SigmaD1]
   and contract_combD2 = contract.dom_subset [THEN subsetD, THEN SigmaD2]
 
 lemma field_contract_eq: "field(contract) = comb"
   by (blast intro: contract.K elim!: contract_combE2)
 
 lemmas reduction_refl =
   field_contract_eq [THEN equalityD2, THEN subsetD, THEN rtrancl_refl]
 
 lemmas rtrancl_into_rtrancl2 =
   r_into_rtrancl [THEN trans_rtrancl [THEN transD]]
 
 declare reduction_refl [intro!] contract.K [intro!] contract.S [intro!]
 
 lemmas reduction_rls =
   contract.K [THEN rtrancl_into_rtrancl2]
   contract.S [THEN rtrancl_into_rtrancl2]
   contract.Ap1 [THEN rtrancl_into_rtrancl2]
   contract.Ap2 [THEN rtrancl_into_rtrancl2]
 
 lemma "p \<in> comb \<Longrightarrow> I\<bullet>p \<rightarrow> p"
   \<comment> \<open>Example only: not used\<close>
   unfolding I_def by (blast intro: reduction_rls)
 
 lemma comb_I: "I \<in> comb"
   unfolding I_def by blast
 
 
 subsection \<open>Non-contraction results\<close>
 
 text \<open>Derive a case for each combinator constructor.\<close>
 
 inductive_cases K_contractE [elim!]: "K \<rightarrow>\<^sup>1 r"
   and S_contractE [elim!]: "S \<rightarrow>\<^sup>1 r"
   and Ap_contractE [elim!]: "p\<bullet>q \<rightarrow>\<^sup>1 r"
 
 lemma I_contract_E: "I \<rightarrow>\<^sup>1 r \<Longrightarrow> P"
   by (auto simp add: I_def)
 
 lemma K1_contractD: "K\<bullet>p \<rightarrow>\<^sup>1 r \<Longrightarrow> (\<exists>q. r = K\<bullet>q \<and> p \<rightarrow>\<^sup>1 q)"
   by auto
 
 lemma Ap_reduce1: "\<lbrakk>p \<rightarrow> q;  r \<in> comb\<rbrakk> \<Longrightarrow> p\<bullet>r \<rightarrow> q\<bullet>r"
   apply (frule rtrancl_type [THEN subsetD, THEN SigmaD1])
   apply (drule field_contract_eq [THEN equalityD1, THEN subsetD])
   apply (erule rtrancl_induct)
    apply (blast intro: reduction_rls)
   apply (erule trans_rtrancl [THEN transD])
   apply (blast intro: contract_combD2 reduction_rls)
   done
 
 lemma Ap_reduce2: "\<lbrakk>p \<rightarrow> q;  r \<in> comb\<rbrakk> \<Longrightarrow> r\<bullet>p \<rightarrow> r\<bullet>q"
   apply (frule rtrancl_type [THEN subsetD, THEN SigmaD1])
   apply (drule field_contract_eq [THEN equalityD1, THEN subsetD])
   apply (erule rtrancl_induct)
    apply (blast intro: reduction_rls)
   apply (blast intro: trans_rtrancl [THEN transD] 
                       contract_combD2 reduction_rls)
   done
 
 text \<open>Counterexample to the diamond property for \<open>\<rightarrow>\<^sup>1\<close>.\<close>
 
 lemma KIII_contract1: "K\<bullet>I\<bullet>(I\<bullet>I) \<rightarrow>\<^sup>1 I"
   by (blast intro: comb_I)
 
 lemma KIII_contract2: "K\<bullet>I\<bullet>(I\<bullet>I) \<rightarrow>\<^sup>1 K\<bullet>I\<bullet>((K\<bullet>I)\<bullet>(K\<bullet>I))"
   by (unfold I_def) (blast intro: contract.intros)
 
 lemma KIII_contract3: "K\<bullet>I\<bullet>((K\<bullet>I)\<bullet>(K\<bullet>I)) \<rightarrow>\<^sup>1 I"
   by (blast intro: comb_I)
 
 lemma not_diamond_contract: "\<not> diamond(contract)"
-  apply (unfold diamond_def)
+    unfolding diamond_def
   apply (blast intro: KIII_contract1 KIII_contract2 KIII_contract3
     elim!: I_contract_E)
   done
 
 
 subsection \<open>Results about Parallel Contraction\<close>
 
 text \<open>For type checking: replaces \<open>a \<Rrightarrow>\<^sup>1 b\<close> by \<open>a, b
   \<in> comb\<close>\<close>
 lemmas parcontract_combE2 = parcontract.dom_subset [THEN subsetD, THEN SigmaE2]
   and parcontract_combD1 = parcontract.dom_subset [THEN subsetD, THEN SigmaD1]
   and parcontract_combD2 = parcontract.dom_subset [THEN subsetD, THEN SigmaD2]
 
 lemma field_parcontract_eq: "field(parcontract) = comb"
   by (blast intro: parcontract.K elim!: parcontract_combE2)
 
 text \<open>Derive a case for each combinator constructor.\<close>
 inductive_cases
       K_parcontractE [elim!]: "K \<Rrightarrow>\<^sup>1 r"
   and S_parcontractE [elim!]: "S \<Rrightarrow>\<^sup>1 r"
   and Ap_parcontractE [elim!]: "p\<bullet>q \<Rrightarrow>\<^sup>1 r"
 
 declare parcontract.intros [intro]
 
 
 subsection \<open>Basic properties of parallel contraction\<close>
 
 lemma K1_parcontractD [dest!]:
     "K\<bullet>p \<Rrightarrow>\<^sup>1 r \<Longrightarrow> (\<exists>p'. r = K\<bullet>p' \<and> p \<Rrightarrow>\<^sup>1 p')"
   by auto
 
 lemma S1_parcontractD [dest!]:
     "S\<bullet>p \<Rrightarrow>\<^sup>1 r \<Longrightarrow> (\<exists>p'. r = S\<bullet>p' \<and> p \<Rrightarrow>\<^sup>1 p')"
   by auto
 
 lemma S2_parcontractD [dest!]:
     "S\<bullet>p\<bullet>q \<Rrightarrow>\<^sup>1 r \<Longrightarrow> (\<exists>p' q'. r = S\<bullet>p'\<bullet>q' \<and> p \<Rrightarrow>\<^sup>1 p' \<and> q \<Rrightarrow>\<^sup>1 q')"
   by auto
 
 lemma diamond_parcontract: "diamond(parcontract)"
   \<comment> \<open>Church-Rosser property for parallel contraction\<close>
-  apply (unfold diamond_def)
+    unfolding diamond_def
   apply (rule impI [THEN allI, THEN allI])
   apply (erule parcontract.induct)
      apply (blast elim!: comb.free_elims  intro: parcontract_combD2)+
   done
 
 text \<open>
   \medskip Equivalence of \<^prop>\<open>p \<rightarrow> q\<close> and \<^prop>\<open>p \<Rrightarrow> q\<close>.
 \<close>
 
 lemma contract_imp_parcontract: "p\<rightarrow>\<^sup>1q \<Longrightarrow> p\<Rrightarrow>\<^sup>1q"
   by (induct set: contract) auto
 
 lemma reduce_imp_parreduce: "p\<rightarrow>q \<Longrightarrow> p\<Rrightarrow>q"
   apply (frule rtrancl_type [THEN subsetD, THEN SigmaD1])
   apply (drule field_contract_eq [THEN equalityD1, THEN subsetD])
   apply (erule rtrancl_induct)
    apply (blast intro: r_into_trancl)
   apply (blast intro: contract_imp_parcontract r_into_trancl
     trans_trancl [THEN transD])
   done
 
 lemma parcontract_imp_reduce: "p\<Rrightarrow>\<^sup>1q \<Longrightarrow> p\<rightarrow>q"
   apply (induct set: parcontract)
      apply (blast intro: reduction_rls)
     apply (blast intro: reduction_rls)
    apply (blast intro: reduction_rls)
   apply (blast intro: trans_rtrancl [THEN transD]
     Ap_reduce1 Ap_reduce2 parcontract_combD1 parcontract_combD2)
   done
 
 lemma parreduce_imp_reduce: "p\<Rrightarrow>q \<Longrightarrow> p\<rightarrow>q"
   apply (frule trancl_type [THEN subsetD, THEN SigmaD1])
   apply (drule field_parcontract_eq [THEN equalityD1, THEN subsetD])
   apply (erule trancl_induct, erule parcontract_imp_reduce)
   apply (erule trans_rtrancl [THEN transD])
   apply (erule parcontract_imp_reduce)
   done
 
 lemma parreduce_iff_reduce: "p\<Rrightarrow>q \<longleftrightarrow> p\<rightarrow>q"
   by (blast intro: parreduce_imp_reduce reduce_imp_parreduce)
 
 end
diff --git a/src/ZF/Induct/FoldSet.thy b/src/ZF/Induct/FoldSet.thy
--- a/src/ZF/Induct/FoldSet.thy
+++ b/src/ZF/Induct/FoldSet.thy
@@ -1,396 +1,396 @@
 (*  Title:      ZF/Induct/FoldSet.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
 
 A "fold" functional for finite sets.  For n non-negative we have
 fold f e {x1,...,xn} = f x1 (... (f xn e)) where f is at
 least left-commutative.  
 *)
 
 theory FoldSet imports ZF begin
 
 consts fold_set :: "[i, i, [i,i]\<Rightarrow>i, i] \<Rightarrow> i"
 
 inductive
   domains "fold_set(A, B, f,e)" \<subseteq> "Fin(A)*B"
   intros
     emptyI: "e\<in>B \<Longrightarrow> \<langle>0, e\<rangle>\<in>fold_set(A, B, f,e)"
     consI:  "\<lbrakk>x\<in>A; x \<notin>C;  \<langle>C,y\<rangle> \<in> fold_set(A, B,f,e); f(x,y):B\<rbrakk>
                 \<Longrightarrow>  <cons(x,C), f(x,y)>\<in>fold_set(A, B, f, e)"
   type_intros Fin.intros
   
 definition
   fold :: "[i, [i,i]\<Rightarrow>i, i, i] \<Rightarrow> i"  (\<open>fold[_]'(_,_,_')\<close>)  where
    "fold[B](f,e, A) \<equiv> THE x. \<langle>A, x\<rangle>\<in>fold_set(A, B, f,e)"
 
 definition
    setsum :: "[i\<Rightarrow>i, i] \<Rightarrow> i"  where
    "setsum(g, C) \<equiv> if Finite(C) then
                      fold[int](\<lambda>x y. g(x) $+ y, #0, C) else #0"
 
 (** foldSet **)
 
 inductive_cases empty_fold_setE: "\<langle>0, x\<rangle> \<in> fold_set(A, B, f,e)"
 inductive_cases cons_fold_setE: "<cons(x,C), y> \<in> fold_set(A, B, f,e)"
 
 (* add-hoc lemmas *)                                                
 
 lemma cons_lemma1: "\<lbrakk>x\<notin>C; x\<notin>B\<rbrakk> \<Longrightarrow> cons(x,B)=cons(x,C) \<longleftrightarrow> B = C"
 by (auto elim: equalityE)
 
 lemma cons_lemma2: "\<lbrakk>cons(x, B)=cons(y, C); x\<noteq>y; x\<notin>B; y\<notin>C\<rbrakk>  
     \<Longrightarrow>  B - {y} = C-{x} \<and> x\<in>C \<and> y\<in>B"
 apply (auto elim: equalityE)
 done
 
 (* fold_set monotonicity *)
 lemma fold_set_mono_lemma:
      "\<langle>C, x\<rangle> \<in> fold_set(A, B, f, e)  
       \<Longrightarrow> \<forall>D. A<=D \<longrightarrow> \<langle>C, x\<rangle> \<in> fold_set(D, B, f, e)"
 apply (erule fold_set.induct)
 apply (auto intro: fold_set.intros)
 done
 
 lemma fold_set_mono: " C<=A \<Longrightarrow> fold_set(C, B, f, e) \<subseteq> fold_set(A, B, f, e)"
 apply clarify
 apply (frule fold_set.dom_subset [THEN subsetD], clarify)
 apply (auto dest: fold_set_mono_lemma)
 done
 
 lemma fold_set_lemma:
      "\<langle>C, x\<rangle>\<in>fold_set(A, B, f, e) \<Longrightarrow> \<langle>C, x\<rangle>\<in>fold_set(C, B, f, e) \<and> C<=A"
 apply (erule fold_set.induct)
 apply (auto intro!: fold_set.intros intro: fold_set_mono [THEN subsetD])
 done
 
 (* Proving that fold_set is deterministic *)
 lemma Diff1_fold_set:
      "\<lbrakk><C-{x},y> \<in> fold_set(A, B, f,e);  x\<in>C; x\<in>A; f(x, y):B\<rbrakk>  
       \<Longrightarrow> <C, f(x, y)> \<in> fold_set(A, B, f, e)"
 apply (frule fold_set.dom_subset [THEN subsetD])
 apply (erule cons_Diff [THEN subst], rule fold_set.intros, auto)
 done
 
 
 locale fold_typing =
  fixes A and B and e and f
  assumes ftype [intro,simp]:  "\<lbrakk>x \<in> A; y \<in> B\<rbrakk> \<Longrightarrow> f(x,y) \<in> B"
      and etype [intro,simp]:  "e \<in> B"
      and fcomm:  "\<lbrakk>x \<in> A; y \<in> A; z \<in> B\<rbrakk> \<Longrightarrow> f(x, f(y, z))=f(y, f(x, z))"
 
 
 lemma (in fold_typing) Fin_imp_fold_set:
      "C\<in>Fin(A) \<Longrightarrow> (\<exists>x. \<langle>C, x\<rangle> \<in> fold_set(A, B, f,e))"
 apply (erule Fin_induct)
 apply (auto dest: fold_set.dom_subset [THEN subsetD] 
             intro: fold_set.intros etype ftype)
 done
 
 lemma Diff_sing_imp:
      "\<lbrakk>C - {b} = D - {a}; a \<noteq> b; b \<in> C\<rbrakk> \<Longrightarrow> C = cons(b,D) - {a}"
 by (blast elim: equalityE)
 
 lemma (in fold_typing) fold_set_determ_lemma [rule_format]: 
 "n\<in>nat
  \<Longrightarrow> \<forall>C. |C|<n \<longrightarrow>  
    (\<forall>x. \<langle>C, x\<rangle> \<in> fold_set(A, B, f,e)\<longrightarrow> 
            (\<forall>y. \<langle>C, y\<rangle> \<in> fold_set(A, B, f,e) \<longrightarrow> y=x))"
 apply (erule nat_induct)
  apply (auto simp add: le_iff)
 apply (erule fold_set.cases)
  apply (force elim!: empty_fold_setE)
 apply (erule fold_set.cases)
  apply (force elim!: empty_fold_setE, clarify)
 (*force simplification of "|C| < |cons(...)|"*)
 apply (frule_tac a = Ca in fold_set.dom_subset [THEN subsetD, THEN SigmaD1])
 apply (frule_tac a = Cb in fold_set.dom_subset [THEN subsetD, THEN SigmaD1])
 apply (simp add: Fin_into_Finite [THEN Finite_imp_cardinal_cons])
 apply (case_tac "x=xb", auto) 
 apply (simp add: cons_lemma1, blast)
 txt\<open>case \<^term>\<open>x\<noteq>xb\<close>\<close>
 apply (drule cons_lemma2, safe)
 apply (frule Diff_sing_imp, assumption+) 
 txt\<open>* LEVEL 17\<close>
 apply (subgoal_tac "|Ca| \<le> |Cb|")
  prefer 2
  apply (rule succ_le_imp_le)
  apply (simp add: Fin_into_Finite Finite_imp_succ_cardinal_Diff 
                   Fin_into_Finite [THEN Finite_imp_cardinal_cons])
 apply (rule_tac C1 = "Ca-{xb}" in Fin_imp_fold_set [THEN exE])
  apply (blast intro: Diff_subset [THEN Fin_subset])
 txt\<open>* LEVEL 24 *\<close>
 apply (frule Diff1_fold_set, blast, blast)
 apply (blast dest!: ftype fold_set.dom_subset [THEN subsetD])
 apply (subgoal_tac "ya = f(xb,xa) ")
  prefer 2 apply (blast del: equalityCE)
 apply (subgoal_tac "<Cb-{x}, xa> \<in> fold_set(A,B,f,e)")
  prefer 2 apply simp
 apply (subgoal_tac "yb = f (x, xa) ")
  apply (drule_tac [2] C = Cb in Diff1_fold_set, simp_all)
   apply (blast intro: fcomm dest!: fold_set.dom_subset [THEN subsetD])
  apply (blast intro: ftype dest!: fold_set.dom_subset [THEN subsetD], blast) 
 done
 
 lemma (in fold_typing) fold_set_determ: 
      "\<lbrakk>\<langle>C, x\<rangle>\<in>fold_set(A, B, f, e);  
          \<langle>C, y\<rangle>\<in>fold_set(A, B, f, e)\<rbrakk> \<Longrightarrow> y=x"
 apply (frule fold_set.dom_subset [THEN subsetD], clarify)
 apply (drule Fin_into_Finite)
 apply (unfold Finite_def, clarify)
 apply (rule_tac n = "succ (n)" in fold_set_determ_lemma) 
 apply (auto intro: eqpoll_imp_lepoll [THEN lepoll_cardinal_le])
 done
 
 (** The fold function **)
 
 lemma (in fold_typing) fold_equality: 
      "\<langle>C,y\<rangle> \<in> fold_set(A,B,f,e) \<Longrightarrow> fold[B](f,e,C) = y"
-apply (unfold fold_def)
+  unfolding fold_def
 apply (frule fold_set.dom_subset [THEN subsetD], clarify)
 apply (rule the_equality)
  apply (rule_tac [2] A=C in fold_typing.fold_set_determ)
 apply (force dest: fold_set_lemma)
 apply (auto dest: fold_set_lemma)
 apply (simp add: fold_typing_def, auto) 
 apply (auto dest: fold_set_lemma intro: ftype etype fcomm)
 done
 
 lemma fold_0 [simp]: "e \<in> B \<Longrightarrow> fold[B](f,e,0) = e"
-apply (unfold fold_def)
+  unfolding fold_def
 apply (blast elim!: empty_fold_setE intro: fold_set.intros)
 done
 
 text\<open>This result is the right-to-left direction of the subsequent result\<close>
 lemma (in fold_typing) fold_set_imp_cons: 
      "\<lbrakk>\<langle>C, y\<rangle> \<in> fold_set(C, B, f, e); C \<in> Fin(A); c \<in> A; c\<notin>C\<rbrakk>
       \<Longrightarrow> <cons(c, C), f(c,y)> \<in> fold_set(cons(c, C), B, f, e)"
 apply (frule FinD [THEN fold_set_mono, THEN subsetD])
  apply assumption
 apply (frule fold_set.dom_subset [of A, THEN subsetD])
 apply (blast intro!: fold_set.consI intro: fold_set_mono [THEN subsetD])
 done
 
 lemma (in fold_typing) fold_cons_lemma [rule_format]: 
 "\<lbrakk>C \<in> Fin(A); c \<in> A; c\<notin>C\<rbrakk>   
      \<Longrightarrow> <cons(c, C), v> \<in> fold_set(cons(c, C), B, f, e) \<longleftrightarrow>   
          (\<exists>y. \<langle>C, y\<rangle> \<in> fold_set(C, B, f, e) \<and> v = f(c, y))"
 apply auto
  prefer 2 apply (blast intro: fold_set_imp_cons) 
  apply (frule_tac Fin.consI [of c, THEN FinD, THEN fold_set_mono, THEN subsetD], assumption+)
 apply (frule_tac fold_set.dom_subset [of A, THEN subsetD])
 apply (drule FinD) 
 apply (rule_tac A1 = "cons(c,C)" and f1=f and B1=B and C1=C and e1=e in fold_typing.Fin_imp_fold_set [THEN exE])
 apply (blast intro: fold_typing.intro ftype etype fcomm) 
 apply (blast intro: Fin_subset [of _ "cons(c,C)"] Finite_into_Fin 
              dest: Fin_into_Finite)  
 apply (rule_tac x = x in exI)
 apply (auto intro: fold_set.intros)
 apply (drule_tac fold_set_lemma [of C], blast)
 apply (blast intro!: fold_set.consI
              intro: fold_set_determ fold_set_mono [THEN subsetD] 
              dest: fold_set.dom_subset [THEN subsetD]) 
 done
 
 lemma (in fold_typing) fold_cons: 
      "\<lbrakk>C\<in>Fin(A); c\<in>A; c\<notin>C\<rbrakk> 
       \<Longrightarrow> fold[B](f, e, cons(c, C)) = f(c, fold[B](f, e, C))"
-apply (unfold fold_def)
+  unfolding fold_def
 apply (simp add: fold_cons_lemma)
 apply (rule the_equality, auto) 
  apply (subgoal_tac [2] "\<langle>C, y\<rangle> \<in> fold_set(A, B, f, e)")
   apply (drule Fin_imp_fold_set)
 apply (auto dest: fold_set_lemma  simp add: fold_def [symmetric] fold_equality) 
 apply (blast intro: fold_set_mono [THEN subsetD] dest!: FinD) 
 done
 
 lemma (in fold_typing) fold_type [simp,TC]: 
      "C\<in>Fin(A) \<Longrightarrow> fold[B](f,e,C):B"
 apply (erule Fin_induct)
 apply (simp_all add: fold_cons ftype etype)
 done
 
 lemma (in fold_typing) fold_commute [rule_format]: 
      "\<lbrakk>C\<in>Fin(A); c\<in>A\<rbrakk>  
       \<Longrightarrow> (\<forall>y\<in>B. f(c, fold[B](f, y, C)) = fold[B](f, f(c, y), C))"
 apply (erule Fin_induct)
 apply (simp_all add: fold_typing.fold_cons [of A B _ f] 
                      fold_typing.fold_type [of A B _ f] 
                      fold_typing_def fcomm)
 done
 
 lemma (in fold_typing) fold_nest_Un_Int: 
      "\<lbrakk>C\<in>Fin(A); D\<in>Fin(A)\<rbrakk>
       \<Longrightarrow> fold[B](f, fold[B](f, e, D), C) =
           fold[B](f, fold[B](f, e, (C \<inter> D)), C \<union> D)"
 apply (erule Fin_induct, auto)
 apply (simp add: Un_cons Int_cons_left fold_type fold_commute
                  fold_typing.fold_cons [of A _ _ f] 
                  fold_typing_def fcomm cons_absorb)
 done
 
 lemma (in fold_typing) fold_nest_Un_disjoint:
      "\<lbrakk>C\<in>Fin(A); D\<in>Fin(A); C \<inter> D = 0\<rbrakk>  
       \<Longrightarrow> fold[B](f,e,C \<union> D) =  fold[B](f, fold[B](f,e,D), C)"
 by (simp add: fold_nest_Un_Int)
 
 lemma Finite_cons_lemma: "Finite(C) \<Longrightarrow> C\<in>Fin(cons(c, C))"
 apply (drule Finite_into_Fin)
 apply (blast intro: Fin_mono [THEN subsetD])
 done
 
 subsection\<open>The Operator \<^term>\<open>setsum\<close>\<close>
 
 lemma setsum_0 [simp]: "setsum(g, 0) = #0"
 by (simp add: setsum_def)
 
 lemma setsum_cons [simp]: 
      "Finite(C) \<Longrightarrow> 
       setsum(g, cons(c,C)) = 
         (if c \<in> C then setsum(g,C) else g(c) $+ setsum(g,C))"
 apply (auto simp add: setsum_def Finite_cons cons_absorb)
 apply (rule_tac A = "cons (c, C)" in fold_typing.fold_cons)
 apply (auto intro: fold_typing.intro Finite_cons_lemma)
 done
 
 lemma setsum_K0: "setsum((\<lambda>i. #0), C) = #0"
 apply (case_tac "Finite (C) ")
  prefer 2 apply (simp add: setsum_def)
 apply (erule Finite_induct, auto)
 done
 
 (*The reversed orientation looks more natural, but LOOPS as a simprule!*)
 lemma setsum_Un_Int:
      "\<lbrakk>Finite(C); Finite(D)\<rbrakk>  
       \<Longrightarrow> setsum(g, C \<union> D) $+ setsum(g, C \<inter> D)  
         = setsum(g, C) $+ setsum(g, D)"
 apply (erule Finite_induct)
 apply (simp_all add: Int_cons_right cons_absorb Un_cons Int_commute Finite_Un
                      Int_lower1 [THEN subset_Finite]) 
 done
 
 lemma setsum_type [simp,TC]: "setsum(g, C):int"
 apply (case_tac "Finite (C) ")
  prefer 2 apply (simp add: setsum_def)
 apply (erule Finite_induct, auto)
 done
 
 lemma setsum_Un_disjoint:
      "\<lbrakk>Finite(C); Finite(D); C \<inter> D = 0\<rbrakk>  
       \<Longrightarrow> setsum(g, C \<union> D) = setsum(g, C) $+ setsum(g,D)"
 apply (subst setsum_Un_Int [symmetric])
 apply (subgoal_tac [3] "Finite (C \<union> D) ")
 apply (auto intro: Finite_Un)
 done
 
 lemma Finite_RepFun [rule_format (no_asm)]:
      "Finite(I) \<Longrightarrow> (\<forall>i\<in>I. Finite(C(i))) \<longrightarrow> Finite(RepFun(I, C))"
 apply (erule Finite_induct, auto)
 done
 
 lemma setsum_UN_disjoint [rule_format (no_asm)]:
      "Finite(I)  
       \<Longrightarrow> (\<forall>i\<in>I. Finite(C(i))) \<longrightarrow>  
           (\<forall>i\<in>I. \<forall>j\<in>I. i\<noteq>j \<longrightarrow> C(i) \<inter> C(j) = 0) \<longrightarrow>  
           setsum(f, \<Union>i\<in>I. C(i)) = setsum (\<lambda>i. setsum(f, C(i)), I)"
 apply (erule Finite_induct, auto)
 apply (subgoal_tac "\<forall>i\<in>B. x \<noteq> i")
  prefer 2 apply blast
 apply (subgoal_tac "C (x) \<inter> (\<Union>i\<in>B. C (i)) = 0")
  prefer 2 apply blast
 apply (subgoal_tac "Finite (\<Union>i\<in>B. C (i)) \<and> Finite (C (x)) \<and> Finite (B) ")
 apply (simp (no_asm_simp) add: setsum_Un_disjoint)
 apply (auto intro: Finite_Union Finite_RepFun)
 done
 
 
 lemma setsum_addf: "setsum(\<lambda>x. f(x) $+ g(x),C) = setsum(f, C) $+ setsum(g, C)"
 apply (case_tac "Finite (C) ")
  prefer 2 apply (simp add: setsum_def)
 apply (erule Finite_induct, auto)
 done
 
 
 lemma fold_set_cong:
      "\<lbrakk>A=A'; B=B'; e=e'; (\<forall>x\<in>A'. \<forall>y\<in>B'. f(x,y) = f'(x,y))\<rbrakk> 
       \<Longrightarrow> fold_set(A,B,f,e) = fold_set(A',B',f',e')"
 apply (simp add: fold_set_def)
 apply (intro refl iff_refl lfp_cong Collect_cong disj_cong ex_cong, auto)
 done
 
 lemma fold_cong:
 "\<lbrakk>B=B'; A=A'; e=e';   
     \<And>x y. \<lbrakk>x\<in>A'; y\<in>B'\<rbrakk> \<Longrightarrow> f(x,y) = f'(x,y)\<rbrakk> \<Longrightarrow>  
    fold[B](f,e,A) = fold[B'](f', e', A')"
 apply (simp add: fold_def)
 apply (subst fold_set_cong)
 apply (rule_tac [5] refl, simp_all)
 done
 
 lemma setsum_cong:
  "\<lbrakk>A=B; \<And>x. x\<in>B \<Longrightarrow> f(x) = g(x)\<rbrakk> \<Longrightarrow>  
      setsum(f, A) = setsum(g, B)"
 by (simp add: setsum_def cong add: fold_cong)
 
 lemma setsum_Un:
      "\<lbrakk>Finite(A); Finite(B)\<rbrakk>  
       \<Longrightarrow> setsum(f, A \<union> B) =  
           setsum(f, A) $+ setsum(f, B) $- setsum(f, A \<inter> B)"
 apply (subst setsum_Un_Int [symmetric], auto)
 done
 
 
 lemma setsum_zneg_or_0 [rule_format (no_asm)]:
      "Finite(A) \<Longrightarrow> (\<forall>x\<in>A. g(x) $\<le> #0) \<longrightarrow> setsum(g, A) $\<le> #0"
 apply (erule Finite_induct)
 apply (auto intro: zneg_or_0_add_zneg_or_0_imp_zneg_or_0)
 done
 
 lemma setsum_succD_lemma [rule_format]:
      "Finite(A)  
       \<Longrightarrow> \<forall>n\<in>nat. setsum(f,A) = $# succ(n) \<longrightarrow> (\<exists>a\<in>A. #0 $< f(a))"
 apply (erule Finite_induct)
 apply (auto simp del: int_of_0 int_of_succ simp add: not_zless_iff_zle int_of_0 [symmetric])
 apply (subgoal_tac "setsum (f, B) $\<le> #0")
 apply simp_all
 prefer 2 apply (blast intro: setsum_zneg_or_0)
 apply (subgoal_tac "$# 1 $\<le> f (x) $+ setsum (f, B) ")
 apply (drule zdiff_zle_iff [THEN iffD2])
 apply (subgoal_tac "$# 1 $\<le> $# 1 $- setsum (f,B) ")
 apply (drule_tac x = "$# 1" in zle_trans)
 apply (rule_tac [2] j = "#1" in zless_zle_trans, auto)
 done
 
 lemma setsum_succD:
      "\<lbrakk>setsum(f, A) = $# succ(n); n\<in>nat\<rbrakk>\<Longrightarrow> \<exists>a\<in>A. #0 $< f(a)"
 apply (case_tac "Finite (A) ")
 apply (blast intro: setsum_succD_lemma)
-apply (unfold setsum_def)
+  unfolding setsum_def
 apply (auto simp del: int_of_0 int_of_succ simp add: int_succ_int_1 [symmetric] int_of_0 [symmetric])
 done
 
 lemma g_zpos_imp_setsum_zpos [rule_format]:
      "Finite(A) \<Longrightarrow> (\<forall>x\<in>A. #0 $\<le> g(x)) \<longrightarrow> #0 $\<le> setsum(g, A)"
 apply (erule Finite_induct)
 apply (simp (no_asm))
 apply (auto intro: zpos_add_zpos_imp_zpos)
 done
 
 lemma g_zpos_imp_setsum_zpos2 [rule_format]:
      "\<lbrakk>Finite(A); \<forall>x. #0 $\<le> g(x)\<rbrakk> \<Longrightarrow> #0 $\<le> setsum(g, A)"
 apply (erule Finite_induct)
 apply (auto intro: zpos_add_zpos_imp_zpos)
 done
 
 lemma g_zspos_imp_setsum_zspos [rule_format]:
      "Finite(A)  
       \<Longrightarrow> (\<forall>x\<in>A. #0 $< g(x)) \<longrightarrow> A \<noteq> 0 \<longrightarrow> (#0 $< setsum(g, A))"
 apply (erule Finite_induct)
 apply (auto intro: zspos_add_zspos_imp_zspos)
 done
 
 lemma setsum_Diff [rule_format]:
      "Finite(A) \<Longrightarrow> \<forall>a. M(a) = #0 \<longrightarrow> setsum(M, A) = setsum(M, A-{a})"
 apply (erule Finite_induct) 
 apply (simp_all add: Diff_cons_eq Finite_Diff) 
 done
 
 end
diff --git a/src/ZF/Induct/Multiset.thy b/src/ZF/Induct/Multiset.thy
--- a/src/ZF/Induct/Multiset.thy
+++ b/src/ZF/Induct/Multiset.thy
@@ -1,1294 +1,1294 @@
 (*  Title:      ZF/Induct/Multiset.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
 
 A definitional theory of multisets,
 including a wellfoundedness proof for the multiset order.
 
 The theory features ordinal multisets and the usual ordering.
 *)
 
 theory Multiset
 imports FoldSet Acc
 begin
 
 abbreviation (input)
   \<comment> \<open>Short cut for multiset space\<close>
   Mult :: "i\<Rightarrow>i" where
   "Mult(A) \<equiv> A -||> nat-{0}"
 
 definition
   (* This is the original "restrict" from ZF.thy.
      Restricts the function f to the domain A
      FIXME: adapt Multiset to the new "restrict". *)
   funrestrict :: "[i,i] \<Rightarrow> i"  where
   "funrestrict(f,A) \<equiv> \<lambda>x \<in> A. f`x"
 
 definition
   (* M is a multiset *)
   multiset :: "i \<Rightarrow> o"  where
   "multiset(M) \<equiv> \<exists>A. M \<in> A -> nat-{0} \<and> Finite(A)"
 
 definition
   mset_of :: "i\<Rightarrow>i"  where
   "mset_of(M) \<equiv> domain(M)"
 
 definition
   munion    :: "[i, i] \<Rightarrow> i" (infixl \<open>+#\<close> 65)  where
   "M +# N \<equiv> \<lambda>x \<in> mset_of(M) \<union> mset_of(N).
      if x \<in> mset_of(M) \<inter> mset_of(N) then  (M`x) #+ (N`x)
      else (if x \<in> mset_of(M) then M`x else N`x)"
 
 definition
   (*convert a function to a multiset by eliminating 0*)
   normalize :: "i \<Rightarrow> i"  where
   "normalize(f) \<equiv>
        if (\<exists>A. f \<in> A -> nat \<and> Finite(A)) then
             funrestrict(f, {x \<in> mset_of(f). 0 < f`x})
        else 0"
 
 definition
   mdiff  :: "[i, i] \<Rightarrow> i" (infixl \<open>-#\<close> 65)  where
   "M -# N \<equiv>  normalize(\<lambda>x \<in> mset_of(M).
                         if x \<in> mset_of(N) then M`x #- N`x else M`x)"
 
 definition
   (* set of elements of a multiset *)
   msingle :: "i \<Rightarrow> i"    (\<open>{#_#}\<close>)  where
   "{#a#} \<equiv> {\<langle>a, 1\<rangle>}"
 
 definition
   MCollect :: "[i, i\<Rightarrow>o] \<Rightarrow> i"  (*comprehension*)  where
   "MCollect(M, P) \<equiv> funrestrict(M, {x \<in> mset_of(M). P(x)})"
 
 definition
   (* Counts the number of occurrences of an element in a multiset *)
   mcount :: "[i, i] \<Rightarrow> i"  where
   "mcount(M, a) \<equiv> if a \<in> mset_of(M) then  M`a else 0"
 
 definition
   msize :: "i \<Rightarrow> i"  where
   "msize(M) \<equiv> setsum(\<lambda>a. $# mcount(M,a), mset_of(M))"
 
 abbreviation
   melem :: "[i,i] \<Rightarrow> o"    (\<open>(_/ :# _)\<close> [50, 51] 50)  where
   "a :# M \<equiv> a \<in> mset_of(M)"
 
 syntax
   "_MColl" :: "[pttrn, i, o] \<Rightarrow> i" (\<open>(1{# _ \<in> _./ _#})\<close>)
 translations
   "{#x \<in> M. P#}" == "CONST MCollect(M, \<lambda>x. P)"
 
   (* multiset orderings *)
 
 definition
    (* multirel1 has to be a set (not a predicate) so that we can form
       its transitive closure and reason about wf(.) and acc(.) *)
   multirel1 :: "[i,i]\<Rightarrow>i"  where
   "multirel1(A, r) \<equiv>
      {\<langle>M, N\<rangle> \<in> Mult(A)*Mult(A).
       \<exists>a \<in> A. \<exists>M0 \<in> Mult(A). \<exists>K \<in> Mult(A).
       N=M0 +# {#a#} \<and> M=M0 +# K \<and> (\<forall>b \<in> mset_of(K). \<langle>b,a\<rangle> \<in> r)}"
 
 definition
   multirel :: "[i, i] \<Rightarrow> i"  where
   "multirel(A, r) \<equiv> multirel1(A, r)^+"
 
   (* ordinal multiset orderings *)
 
 definition
   omultiset :: "i \<Rightarrow> o"  where
   "omultiset(M) \<equiv> \<exists>i. Ord(i) \<and> M \<in> Mult(field(Memrel(i)))"
 
 definition
   mless :: "[i, i] \<Rightarrow> o" (infixl \<open><#\<close> 50)  where
   "M <# N \<equiv>  \<exists>i. Ord(i) \<and> \<langle>M, N\<rangle> \<in> multirel(field(Memrel(i)), Memrel(i))"
 
 definition
   mle  :: "[i, i] \<Rightarrow> o"  (infixl \<open><#=\<close> 50)  where
   "M <#= N \<equiv> (omultiset(M) \<and> M = N) | M <# N"
 
 
 subsection\<open>Properties of the original "restrict" from ZF.thy\<close>
 
 lemma funrestrict_subset: "\<lbrakk>f \<in> Pi(C,B);  A\<subseteq>C\<rbrakk> \<Longrightarrow> funrestrict(f,A) \<subseteq> f"
 by (auto simp add: funrestrict_def lam_def intro: apply_Pair)
 
 lemma funrestrict_type:
     "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> f`x \<in> B(x)\<rbrakk> \<Longrightarrow> funrestrict(f,A) \<in> Pi(A,B)"
 by (simp add: funrestrict_def lam_type)
 
 lemma funrestrict_type2: "\<lbrakk>f \<in> Pi(C,B);  A\<subseteq>C\<rbrakk> \<Longrightarrow> funrestrict(f,A) \<in> Pi(A,B)"
 by (blast intro: apply_type funrestrict_type)
 
 lemma funrestrict [simp]: "a \<in> A \<Longrightarrow> funrestrict(f,A) ` a = f`a"
 by (simp add: funrestrict_def)
 
 lemma funrestrict_empty [simp]: "funrestrict(f,0) = 0"
 by (simp add: funrestrict_def)
 
 lemma domain_funrestrict [simp]: "domain(funrestrict(f,C)) = C"
 by (auto simp add: funrestrict_def lam_def)
 
 lemma fun_cons_funrestrict_eq:
      "f \<in> cons(a, b) -> B \<Longrightarrow> f = cons(<a, f ` a>, funrestrict(f, b))"
 apply (rule equalityI)
 prefer 2 apply (blast intro: apply_Pair funrestrict_subset [THEN subsetD])
 apply (auto dest!: Pi_memberD simp add: funrestrict_def lam_def)
 done
 
 declare domain_of_fun [simp]
 declare domainE [rule del]
 
 
 text\<open>A useful simplification rule\<close>
 lemma multiset_fun_iff:
      "(f \<in> A -> nat-{0}) \<longleftrightarrow> f \<in> A->nat\<and>(\<forall>a \<in> A. f`a \<in> nat \<and> 0 < f`a)"
 apply safe
 apply (rule_tac [4] B1 = "range (f) " in Pi_mono [THEN subsetD])
 apply (auto intro!: Ord_0_lt
             dest: apply_type Diff_subset [THEN Pi_mono, THEN subsetD]
             simp add: range_of_fun apply_iff)
 done
 
 (** The multiset space  **)
 lemma multiset_into_Mult: "\<lbrakk>multiset(M); mset_of(M)\<subseteq>A\<rbrakk> \<Longrightarrow> M \<in> Mult(A)"
 apply (simp add: multiset_def)
 apply (auto simp add: multiset_fun_iff mset_of_def)
 apply (rule_tac B1 = "nat-{0}" in FiniteFun_mono [THEN subsetD], simp_all)
 apply (rule Finite_into_Fin [THEN [2] Fin_mono [THEN subsetD], THEN fun_FiniteFunI])
 apply (simp_all (no_asm_simp) add: multiset_fun_iff)
 done
 
 lemma Mult_into_multiset: "M \<in> Mult(A) \<Longrightarrow> multiset(M) \<and> mset_of(M)\<subseteq>A"
 apply (simp add: multiset_def mset_of_def)
 apply (frule FiniteFun_is_fun)
 apply (drule FiniteFun_domain_Fin)
 apply (frule FinD, clarify)
 apply (rule_tac x = "domain (M) " in exI)
 apply (blast intro: Fin_into_Finite)
 done
 
 lemma Mult_iff_multiset: "M \<in> Mult(A) \<longleftrightarrow> multiset(M) \<and> mset_of(M)\<subseteq>A"
 by (blast dest: Mult_into_multiset intro: multiset_into_Mult)
 
 lemma multiset_iff_Mult_mset_of: "multiset(M) \<longleftrightarrow> M \<in> Mult(mset_of(M))"
 by (auto simp add: Mult_iff_multiset)
 
 
 text\<open>The \<^term>\<open>multiset\<close> operator\<close>
 
 (* the empty multiset is 0 *)
 
 lemma multiset_0 [simp]: "multiset(0)"
 by (auto intro: FiniteFun.intros simp add: multiset_iff_Mult_mset_of)
 
 
 text\<open>The \<^term>\<open>mset_of\<close> operator\<close>
 
 lemma multiset_set_of_Finite [simp]: "multiset(M) \<Longrightarrow> Finite(mset_of(M))"
 by (simp add: multiset_def mset_of_def, auto)
 
 lemma mset_of_0 [iff]: "mset_of(0) = 0"
 by (simp add: mset_of_def)
 
 lemma mset_is_0_iff: "multiset(M) \<Longrightarrow> mset_of(M)=0 \<longleftrightarrow> M=0"
 by (auto simp add: multiset_def mset_of_def)
 
 lemma mset_of_single [iff]: "mset_of({#a#}) = {a}"
 by (simp add: msingle_def mset_of_def)
 
 lemma mset_of_union [iff]: "mset_of(M +# N) = mset_of(M) \<union> mset_of(N)"
 by (simp add: mset_of_def munion_def)
 
 lemma mset_of_diff [simp]: "mset_of(M)\<subseteq>A \<Longrightarrow> mset_of(M -# N) \<subseteq> A"
 by (auto simp add: mdiff_def multiset_def normalize_def mset_of_def)
 
 (* msingle *)
 
 lemma msingle_not_0 [iff]: "{#a#} \<noteq> 0 \<and> 0 \<noteq> {#a#}"
 by (simp add: msingle_def)
 
 lemma msingle_eq_iff [iff]: "({#a#} = {#b#}) \<longleftrightarrow>  (a = b)"
 by (simp add: msingle_def)
 
 lemma msingle_multiset [iff,TC]: "multiset({#a#})"
 apply (simp add: multiset_def msingle_def)
 apply (rule_tac x = "{a}" in exI)
 apply (auto intro: Finite_cons Finite_0 fun_extend3)
 done
 
 (** normalize **)
 
 lemmas Collect_Finite = Collect_subset [THEN subset_Finite]
 
 lemma normalize_idem [simp]: "normalize(normalize(f)) = normalize(f)"
 apply (simp add: normalize_def funrestrict_def mset_of_def)
 apply (case_tac "\<exists>A. f \<in> A -> nat \<and> Finite (A) ")
 apply clarify
 apply (drule_tac x = "{x \<in> domain (f) . 0 < f ` x}" in spec)
 apply auto
 apply (auto  intro!: lam_type simp add: Collect_Finite)
 done
 
 lemma normalize_multiset [simp]: "multiset(M) \<Longrightarrow> normalize(M) = M"
 by (auto simp add: multiset_def normalize_def mset_of_def funrestrict_def multiset_fun_iff)
 
 lemma multiset_normalize [simp]: "multiset(normalize(f))"
 apply (simp add: normalize_def)
 apply (simp add: normalize_def mset_of_def multiset_def, auto)
 apply (rule_tac x = "{x \<in> A . 0<f`x}" in exI)
 apply (auto intro: Collect_subset [THEN subset_Finite] funrestrict_type)
 done
 
 (** Typechecking rules for union and difference of multisets **)
 
 (* union *)
 
 lemma munion_multiset [simp]: "\<lbrakk>multiset(M); multiset(N)\<rbrakk> \<Longrightarrow> multiset(M +# N)"
 apply (unfold multiset_def munion_def mset_of_def, auto)
 apply (rule_tac x = "A \<union> Aa" in exI)
 apply (auto intro!: lam_type intro: Finite_Un simp add: multiset_fun_iff zero_less_add)
 done
 
 (* difference *)
 
 lemma mdiff_multiset [simp]: "multiset(M -# N)"
 by (simp add: mdiff_def)
 
 (** Algebraic properties of multisets **)
 
 (* Union *)
 
 lemma munion_0 [simp]: "multiset(M) \<Longrightarrow> M +# 0 = M \<and> 0 +# M = M"
 apply (simp add: multiset_def)
 apply (auto simp add: munion_def mset_of_def)
 done
 
 lemma munion_commute: "M +# N = N +# M"
 by (auto intro!: lam_cong simp add: munion_def)
 
 lemma munion_assoc: "(M +# N) +# K = M +# (N +# K)"
 apply (unfold munion_def mset_of_def)
 apply (rule lam_cong, auto)
 done
 
 lemma munion_lcommute: "M +# (N +# K) = N +# (M +# K)"
 apply (unfold munion_def mset_of_def)
 apply (rule lam_cong, auto)
 done
 
 lemmas munion_ac = munion_commute munion_assoc munion_lcommute
 
 (* Difference *)
 
 lemma mdiff_self_eq_0 [simp]: "M -# M = 0"
 by (simp add: mdiff_def normalize_def mset_of_def)
 
 lemma mdiff_0 [simp]: "0 -# M = 0"
 by (simp add: mdiff_def normalize_def)
 
 lemma mdiff_0_right [simp]: "multiset(M) \<Longrightarrow> M -# 0 = M"
 by (auto simp add: multiset_def mdiff_def normalize_def multiset_fun_iff mset_of_def funrestrict_def)
 
 lemma mdiff_union_inverse2 [simp]: "multiset(M) \<Longrightarrow> M +# {#a#} -# {#a#} = M"
 apply (unfold multiset_def munion_def mdiff_def msingle_def normalize_def mset_of_def)
 apply (auto cong add: if_cong simp add: ltD multiset_fun_iff funrestrict_def subset_Un_iff2 [THEN iffD1])
 prefer 2 apply (force intro!: lam_type)
 apply (subgoal_tac [2] "{x \<in> A \<union> {a} . x \<noteq> a \<and> x \<in> A} = A")
 apply (rule fun_extension, auto)
 apply (drule_tac x = "A \<union> {a}" in spec)
 apply (simp add: Finite_Un)
 apply (force intro!: lam_type)
 done
 
 (** Count of elements **)
 
 lemma mcount_type [simp,TC]: "multiset(M) \<Longrightarrow> mcount(M, a) \<in> nat"
 by (auto simp add: multiset_def mcount_def mset_of_def multiset_fun_iff)
 
 lemma mcount_0 [simp]: "mcount(0, a) = 0"
 by (simp add: mcount_def)
 
 lemma mcount_single [simp]: "mcount({#b#}, a) = (if a=b then 1 else 0)"
 by (simp add: mcount_def mset_of_def msingle_def)
 
 lemma mcount_union [simp]: "\<lbrakk>multiset(M); multiset(N)\<rbrakk>
                      \<Longrightarrow>  mcount(M +# N, a) = mcount(M, a) #+ mcount (N, a)"
 apply (auto simp add: multiset_def multiset_fun_iff mcount_def munion_def mset_of_def)
 done
 
 lemma mcount_diff [simp]:
      "multiset(M) \<Longrightarrow> mcount(M -# N, a) = mcount(M, a) #- mcount(N, a)"
 apply (simp add: multiset_def)
 apply (auto dest!: not_lt_imp_le
      simp add: mdiff_def multiset_fun_iff mcount_def normalize_def mset_of_def)
 apply (force intro!: lam_type)
 apply (force intro!: lam_type)
 done
 
 lemma mcount_elem: "\<lbrakk>multiset(M); a \<in> mset_of(M)\<rbrakk> \<Longrightarrow> 0 < mcount(M, a)"
 apply (simp add: multiset_def, clarify)
 apply (simp add: mcount_def mset_of_def)
 apply (simp add: multiset_fun_iff)
 done
 
 (** msize **)
 
 lemma msize_0 [simp]: "msize(0) = #0"
 by (simp add: msize_def)
 
 lemma msize_single [simp]: "msize({#a#}) = #1"
 by (simp add: msize_def)
 
 lemma msize_type [simp,TC]: "msize(M) \<in> int"
 by (simp add: msize_def)
 
 lemma msize_zpositive: "multiset(M)\<Longrightarrow> #0 $\<le> msize(M)"
 by (auto simp add: msize_def intro: g_zpos_imp_setsum_zpos)
 
 lemma msize_int_of_nat: "multiset(M) \<Longrightarrow> \<exists>n \<in> nat. msize(M)= $# n"
 apply (rule not_zneg_int_of)
 apply (simp_all (no_asm_simp) add: msize_type [THEN znegative_iff_zless_0] not_zless_iff_zle msize_zpositive)
 done
 
 lemma not_empty_multiset_imp_exist:
      "\<lbrakk>M\<noteq>0; multiset(M)\<rbrakk> \<Longrightarrow> \<exists>a \<in> mset_of(M). 0 < mcount(M, a)"
 apply (simp add: multiset_def)
 apply (erule not_emptyE)
 apply (auto simp add: mset_of_def mcount_def multiset_fun_iff)
 apply (blast dest!: fun_is_rel)
 done
 
 lemma msize_eq_0_iff: "multiset(M) \<Longrightarrow> msize(M)=#0 \<longleftrightarrow> M=0"
 apply (simp add: msize_def, auto)
 apply (rule_tac P = "setsum (u,v) \<noteq> #0" for u v in swap)
 apply blast
 apply (drule not_empty_multiset_imp_exist, assumption, clarify)
 apply (subgoal_tac "Finite (mset_of (M) - {a}) ")
  prefer 2 apply (simp add: Finite_Diff)
 apply (subgoal_tac "setsum (\<lambda>x. $# mcount (M, x), cons (a, mset_of (M) -{a}))=#0")
  prefer 2 apply (simp add: cons_Diff, simp)
 apply (subgoal_tac "#0 $\<le> setsum (\<lambda>x. $# mcount (M, x), mset_of (M) - {a}) ")
 apply (rule_tac [2] g_zpos_imp_setsum_zpos)
 apply (auto simp add: Finite_Diff not_zless_iff_zle [THEN iff_sym] znegative_iff_zless_0 [THEN iff_sym])
 apply (rule not_zneg_int_of [THEN bexE])
 apply (auto simp del: int_of_0 simp add: int_of_add [symmetric] int_of_0 [symmetric])
 done
 
 lemma setsum_mcount_Int:
      "Finite(A) \<Longrightarrow> setsum(\<lambda>a. $# mcount(N, a), A \<inter> mset_of(N))
                   = setsum(\<lambda>a. $# mcount(N, a), A)"
 apply (induct rule: Finite_induct)
  apply auto
 apply (subgoal_tac "Finite (B \<inter> mset_of (N))")
 prefer 2 apply (blast intro: subset_Finite)
 apply (auto simp add: mcount_def Int_cons_left)
 done
 
 lemma msize_union [simp]:
      "\<lbrakk>multiset(M); multiset(N)\<rbrakk> \<Longrightarrow> msize(M +# N) = msize(M) $+ msize(N)"
 apply (simp add: msize_def setsum_Un setsum_addf int_of_add setsum_mcount_Int)
 apply (subst Int_commute)
 apply (simp add: setsum_mcount_Int)
 done
 
 lemma msize_eq_succ_imp_elem: "\<lbrakk>msize(M)= $# succ(n); n \<in> nat\<rbrakk> \<Longrightarrow> \<exists>a. a \<in> mset_of(M)"
-apply (unfold msize_def)
+  unfolding msize_def
 apply (blast dest: setsum_succD)
 done
 
 (** Equality of multisets **)
 
 lemma equality_lemma:
      "\<lbrakk>multiset(M); multiset(N); \<forall>a. mcount(M, a)=mcount(N, a)\<rbrakk>
       \<Longrightarrow> mset_of(M)=mset_of(N)"
 apply (simp add: multiset_def)
 apply (rule sym, rule equalityI)
 apply (auto simp add: multiset_fun_iff mcount_def mset_of_def)
 apply (drule_tac [!] x=x in spec)
 apply (case_tac [2] "x \<in> Aa", case_tac "x \<in> A", auto)
 done
 
 lemma multiset_equality:
   "\<lbrakk>multiset(M); multiset(N)\<rbrakk>\<Longrightarrow> M=N\<longleftrightarrow>(\<forall>a. mcount(M, a)=mcount(N, a))"
 apply auto
 apply (subgoal_tac "mset_of (M) = mset_of (N) ")
 prefer 2 apply (blast intro: equality_lemma)
 apply (simp add: multiset_def mset_of_def)
 apply (auto simp add: multiset_fun_iff)
 apply (rule fun_extension)
 apply (blast, blast)
 apply (drule_tac x = x in spec)
 apply (auto simp add: mcount_def mset_of_def)
 done
 
 (** More algebraic properties of multisets **)
 
 lemma munion_eq_0_iff [simp]: "\<lbrakk>multiset(M); multiset(N)\<rbrakk>\<Longrightarrow>(M +# N =0) \<longleftrightarrow> (M=0 \<and> N=0)"
 by (auto simp add: multiset_equality)
 
 lemma empty_eq_munion_iff [simp]: "\<lbrakk>multiset(M); multiset(N)\<rbrakk>\<Longrightarrow>(0=M +# N) \<longleftrightarrow> (M=0 \<and> N=0)"
 apply (rule iffI, drule sym)
 apply (simp_all add: multiset_equality)
 done
 
 lemma munion_right_cancel [simp]:
      "\<lbrakk>multiset(M); multiset(N); multiset(K)\<rbrakk>\<Longrightarrow>(M +# K = N +# K)\<longleftrightarrow>(M=N)"
 by (auto simp add: multiset_equality)
 
 lemma munion_left_cancel [simp]:
   "\<lbrakk>multiset(K); multiset(M); multiset(N)\<rbrakk> \<Longrightarrow>(K +# M = K +# N) \<longleftrightarrow> (M = N)"
 by (auto simp add: multiset_equality)
 
 lemma nat_add_eq_1_cases: "\<lbrakk>m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> (m #+ n = 1) \<longleftrightarrow> (m=1 \<and> n=0) | (m=0 \<and> n=1)"
 by (induct_tac n) auto
 
 lemma munion_is_single:
      "\<lbrakk>multiset(M); multiset(N)\<rbrakk>
       \<Longrightarrow> (M +# N = {#a#}) \<longleftrightarrow>  (M={#a#} \<and> N=0) | (M = 0 \<and> N = {#a#})"
 apply (simp (no_asm_simp) add: multiset_equality)
 apply safe
 apply simp_all
 apply (case_tac "aa=a")
 apply (drule_tac [2] x = aa in spec)
 apply (drule_tac x = a in spec)
 apply (simp add: nat_add_eq_1_cases, simp)
 apply (case_tac "aaa=aa", simp)
 apply (drule_tac x = aa in spec)
 apply (simp add: nat_add_eq_1_cases)
 apply (case_tac "aaa=a")
 apply (drule_tac [4] x = aa in spec)
 apply (drule_tac [3] x = a in spec)
 apply (drule_tac [2] x = aaa in spec)
 apply (drule_tac x = aa in spec)
 apply (simp_all add: nat_add_eq_1_cases)
 done
 
 lemma msingle_is_union: "\<lbrakk>multiset(M); multiset(N)\<rbrakk>
   \<Longrightarrow> ({#a#} = M +# N) \<longleftrightarrow> ({#a#} = M  \<and> N=0 | M = 0 \<and> {#a#} = N)"
 apply (subgoal_tac " ({#a#} = M +# N) \<longleftrightarrow> (M +# N = {#a#}) ")
 apply (simp (no_asm_simp) add: munion_is_single)
 apply blast
 apply (blast dest: sym)
 done
 
 (** Towards induction over multisets **)
 
 lemma setsum_decr:
 "Finite(A)
   \<Longrightarrow>  (\<forall>M. multiset(M) \<longrightarrow>
   (\<forall>a \<in> mset_of(M). setsum(\<lambda>z. $# mcount(M(a:=M`a #- 1), z), A) =
   (if a \<in> A then setsum(\<lambda>z. $# mcount(M, z), A) $- #1
            else setsum(\<lambda>z. $# mcount(M, z), A))))"
-apply (unfold multiset_def)
+  unfolding multiset_def
 apply (erule Finite_induct)
 apply (auto simp add: multiset_fun_iff)
 apply (unfold mset_of_def mcount_def)
 apply (case_tac "x \<in> A", auto)
 apply (subgoal_tac "$# M ` x $+ #-1 = $# M ` x $- $# 1")
 apply (erule ssubst)
 apply (rule int_of_diff, auto)
 done
 
 lemma setsum_decr2:
      "Finite(A)
       \<Longrightarrow> \<forall>M. multiset(M) \<longrightarrow> (\<forall>a \<in> mset_of(M).
            setsum(\<lambda>x. $# mcount(funrestrict(M, mset_of(M)-{a}), x), A) =
            (if a \<in> A then setsum(\<lambda>x. $# mcount(M, x), A) $- $# M`a
             else setsum(\<lambda>x. $# mcount(M, x), A)))"
 apply (simp add: multiset_def)
 apply (erule Finite_induct)
 apply (auto simp add: multiset_fun_iff mcount_def mset_of_def)
 done
 
 lemma setsum_decr3: "\<lbrakk>Finite(A); multiset(M); a \<in> mset_of(M)\<rbrakk>
       \<Longrightarrow> setsum(\<lambda>x. $# mcount(funrestrict(M, mset_of(M)-{a}), x), A - {a}) =
           (if a \<in> A then setsum(\<lambda>x. $# mcount(M, x), A) $- $# M`a
            else setsum(\<lambda>x. $# mcount(M, x), A))"
 apply (subgoal_tac "setsum (\<lambda>x. $# mcount (funrestrict (M, mset_of (M) -{a}),x),A-{a}) = setsum (\<lambda>x. $# mcount (funrestrict (M, mset_of (M) -{a}),x),A) ")
 apply (rule_tac [2] setsum_Diff [symmetric])
 apply (rule sym, rule ssubst, blast)
 apply (rule sym, drule setsum_decr2, auto)
 apply (simp add: mcount_def mset_of_def)
 done
 
 lemma nat_le_1_cases: "n \<in> nat \<Longrightarrow> n \<le> 1 \<longleftrightarrow> (n=0 | n=1)"
 by (auto elim: natE)
 
 lemma succ_pred_eq_self: "\<lbrakk>0<n; n \<in> nat\<rbrakk> \<Longrightarrow> succ(n #- 1) = n"
 apply (subgoal_tac "1 \<le> n")
 apply (drule add_diff_inverse2, auto)
 done
 
 text\<open>Specialized for use in the proof below.\<close>
 lemma multiset_funrestict:
      "\<lbrakk>\<forall>a\<in>A. M ` a \<in> nat \<and> 0 < M ` a; Finite(A)\<rbrakk>
       \<Longrightarrow> multiset(funrestrict(M, A - {a}))"
 apply (simp add: multiset_def multiset_fun_iff)
 apply (rule_tac x="A-{a}" in exI)
 apply (auto intro: Finite_Diff funrestrict_type)
 done
 
 lemma multiset_induct_aux:
   assumes prem1: "\<And>M a. \<lbrakk>multiset(M); a\<notin>mset_of(M); P(M)\<rbrakk> \<Longrightarrow> P(cons(\<langle>a, 1\<rangle>, M))"
       and prem2: "\<And>M b. \<lbrakk>multiset(M); b \<in> mset_of(M); P(M)\<rbrakk> \<Longrightarrow> P(M(b:= M`b #+ 1))"
   shows
   "\<lbrakk>n \<in> nat; P(0)\<rbrakk>
      \<Longrightarrow> (\<forall>M. multiset(M)\<longrightarrow>
   (setsum(\<lambda>x. $# mcount(M, x), {x \<in> mset_of(M). 0 < M`x}) = $# n) \<longrightarrow> P(M))"
 apply (erule nat_induct, clarify)
 apply (frule msize_eq_0_iff)
 apply (auto simp add: mset_of_def multiset_def multiset_fun_iff msize_def)
 apply (subgoal_tac "setsum (\<lambda>x. $# mcount (M, x), A) =$# succ (x) ")
 apply (drule setsum_succD, auto)
 apply (case_tac "1 <M`a")
 apply (drule_tac [2] not_lt_imp_le)
 apply (simp_all add: nat_le_1_cases)
 apply (subgoal_tac "M= (M (a:=M`a #- 1)) (a:= (M (a:=M`a #- 1))`a #+ 1) ")
 apply (rule_tac [2] A = A and B = "\<lambda>x. nat" and D = "\<lambda>x. nat" in fun_extension)
 apply (rule_tac [3] update_type)+
 apply (simp_all (no_asm_simp))
  apply (rule_tac [2] impI)
  apply (rule_tac [2] succ_pred_eq_self [symmetric])
 apply (simp_all (no_asm_simp))
 apply (rule subst, rule sym, blast, rule prem2)
 apply (simp (no_asm) add: multiset_def multiset_fun_iff)
 apply (rule_tac x = A in exI)
 apply (force intro: update_type)
 apply (simp (no_asm_simp) add: mset_of_def mcount_def)
 apply (drule_tac x = "M (a := M ` a #- 1) " in spec)
 apply (drule mp, drule_tac [2] mp, simp_all)
 apply (rule_tac x = A in exI)
 apply (auto intro: update_type)
 apply (subgoal_tac "Finite ({x \<in> cons (a, A) . x\<noteq>a\<longrightarrow>0<M`x}) ")
 prefer 2 apply (blast intro: Collect_subset [THEN subset_Finite] Finite_cons)
 apply (drule_tac A = "{x \<in> cons (a, A) . x\<noteq>a\<longrightarrow>0<M`x}" in setsum_decr)
 apply (drule_tac x = M in spec)
 apply (subgoal_tac "multiset (M) ")
  prefer 2
  apply (simp add: multiset_def multiset_fun_iff)
  apply (rule_tac x = A in exI, force)
 apply (simp_all add: mset_of_def)
 apply (drule_tac psi = "\<forall>x \<in> A. u(x)" for u in asm_rl)
 apply (drule_tac x = a in bspec)
 apply (simp (no_asm_simp))
 apply (subgoal_tac "cons (a, A) = A")
 prefer 2 apply blast
 apply simp
 apply (subgoal_tac "M=cons (<a, M`a>, funrestrict (M, A-{a}))")
  prefer 2
  apply (rule fun_cons_funrestrict_eq)
  apply (subgoal_tac "cons (a, A-{a}) = A")
   apply force
   apply force
 apply (rule_tac a = "cons (\<langle>a, 1\<rangle>, funrestrict (M, A - {a}))" in ssubst)
 apply simp
 apply (frule multiset_funrestict, assumption)
 apply (rule prem1, assumption)
 apply (simp add: mset_of_def)
 apply (drule_tac x = "funrestrict (M, A-{a}) " in spec)
 apply (drule mp)
 apply (rule_tac x = "A-{a}" in exI)
 apply (auto intro: Finite_Diff funrestrict_type simp add: funrestrict)
 apply (frule_tac A = A and M = M and a = a in setsum_decr3)
 apply (simp (no_asm_simp) add: multiset_def multiset_fun_iff)
 apply blast
 apply (simp (no_asm_simp) add: mset_of_def)
 apply (drule_tac b = "if u then v else w" for u v w in sym, simp_all)
 apply (subgoal_tac "{x \<in> A - {a} . 0 < funrestrict (M, A - {x}) ` x} = A - {a}")
 apply (auto intro!: setsum_cong simp add: zdiff_eq_iff zadd_commute multiset_def multiset_fun_iff mset_of_def)
 done
 
 lemma multiset_induct2:
   "\<lbrakk>multiset(M); P(0);
     (\<And>M a. \<lbrakk>multiset(M); a\<notin>mset_of(M); P(M)\<rbrakk> \<Longrightarrow> P(cons(\<langle>a, 1\<rangle>, M)));
     (\<And>M b. \<lbrakk>multiset(M); b \<in> mset_of(M);  P(M)\<rbrakk> \<Longrightarrow> P(M(b:= M`b #+ 1)))\<rbrakk>
      \<Longrightarrow> P(M)"
 apply (subgoal_tac "\<exists>n \<in> nat. setsum (\<lambda>x. $# mcount (M, x), {x \<in> mset_of (M) . 0 < M ` x}) = $# n")
 apply (rule_tac [2] not_zneg_int_of)
 apply (simp_all (no_asm_simp) add: znegative_iff_zless_0 not_zless_iff_zle)
 apply (rule_tac [2] g_zpos_imp_setsum_zpos)
 prefer 2 apply (blast intro:  multiset_set_of_Finite Collect_subset [THEN subset_Finite])
  prefer 2 apply (simp add: multiset_def multiset_fun_iff, clarify)
 apply (rule multiset_induct_aux [rule_format], auto)
 done
 
 lemma munion_single_case1:
      "\<lbrakk>multiset(M); a \<notin>mset_of(M)\<rbrakk> \<Longrightarrow> M +# {#a#} = cons(\<langle>a, 1\<rangle>, M)"
 apply (simp add: multiset_def msingle_def)
 apply (auto simp add: munion_def)
 apply (unfold mset_of_def, simp)
 apply (rule fun_extension, rule lam_type, simp_all)
 apply (auto simp add: multiset_fun_iff fun_extend_apply)
 apply (drule_tac c = a and b = 1 in fun_extend3)
 apply (auto simp add: cons_eq Un_commute [of _ "{a}"])
 done
 
 lemma munion_single_case2:
      "\<lbrakk>multiset(M); a \<in> mset_of(M)\<rbrakk> \<Longrightarrow> M +# {#a#} = M(a:=M`a #+ 1)"
 apply (simp add: multiset_def)
 apply (auto simp add: munion_def multiset_fun_iff msingle_def)
 apply (unfold mset_of_def, simp)
 apply (subgoal_tac "A \<union> {a} = A")
 apply (rule fun_extension)
 apply (auto dest: domain_type intro: lam_type update_type)
 done
 
 (* Induction principle for multisets *)
 
 lemma multiset_induct:
   assumes M: "multiset(M)"
       and P0: "P(0)"
       and step: "\<And>M a. \<lbrakk>multiset(M); P(M)\<rbrakk> \<Longrightarrow> P(M +# {#a#})"
   shows "P(M)"
 apply (rule multiset_induct2 [OF M])
 apply (simp_all add: P0)
 apply (frule_tac [2] a = b in munion_single_case2 [symmetric])
 apply (frule_tac a = a in munion_single_case1 [symmetric])
 apply (auto intro: step)
 done
 
 (** MCollect **)
 
 lemma MCollect_multiset [simp]:
      "multiset(M) \<Longrightarrow> multiset({# x \<in> M. P(x)#})"
 apply (simp add: MCollect_def multiset_def mset_of_def, clarify)
 apply (rule_tac x = "{x \<in> A. P (x) }" in exI)
 apply (auto dest: CollectD1 [THEN [2] apply_type]
             intro: Collect_subset [THEN subset_Finite] funrestrict_type)
 done
 
 lemma mset_of_MCollect [simp]:
      "multiset(M) \<Longrightarrow> mset_of({# x \<in> M. P(x) #}) \<subseteq> mset_of(M)"
 by (auto simp add: mset_of_def MCollect_def multiset_def funrestrict_def)
 
 lemma MCollect_mem_iff [iff]:
      "x \<in> mset_of({#x \<in> M. P(x)#}) \<longleftrightarrow>  x \<in> mset_of(M) \<and> P(x)"
 by (simp add: MCollect_def mset_of_def)
 
 lemma mcount_MCollect [simp]:
      "mcount({# x \<in> M. P(x) #}, a) = (if P(a) then mcount(M,a) else 0)"
 by (simp add: mcount_def MCollect_def mset_of_def)
 
 lemma multiset_partition: "multiset(M) \<Longrightarrow> M = {# x \<in> M. P(x) #} +# {# x \<in> M. \<not> P(x) #}"
 by (simp add: multiset_equality)
 
 lemma natify_elem_is_self [simp]:
      "\<lbrakk>multiset(M); a \<in> mset_of(M)\<rbrakk> \<Longrightarrow> natify(M`a) = M`a"
 by (auto simp add: multiset_def mset_of_def multiset_fun_iff)
 
 (* and more algebraic laws on multisets *)
 
 lemma munion_eq_conv_diff: "\<lbrakk>multiset(M); multiset(N)\<rbrakk>
   \<Longrightarrow>  (M +# {#a#} = N +# {#b#}) \<longleftrightarrow>  (M = N \<and> a = b |
        M = N -# {#a#} +# {#b#} \<and> N = M -# {#b#} +# {#a#})"
 apply (simp del: mcount_single add: multiset_equality)
 apply (rule iffI, erule_tac [2] disjE, erule_tac [3] conjE)
 apply (case_tac "a=b", auto)
 apply (drule_tac x = a in spec)
 apply (drule_tac [2] x = b in spec)
 apply (drule_tac [3] x = aa in spec)
 apply (drule_tac [4] x = a in spec, auto)
 apply (subgoal_tac [!] "mcount (N,a) :nat")
 apply (erule_tac [3] natE, erule natE, auto)
 done
 
 lemma melem_diff_single:
 "multiset(M) \<Longrightarrow>
   k \<in> mset_of(M -# {#a#}) \<longleftrightarrow> (k=a \<and> 1 < mcount(M,a)) | (k\<noteq> a \<and> k \<in> mset_of(M))"
 apply (simp add: multiset_def)
 apply (simp add: normalize_def mset_of_def msingle_def mdiff_def mcount_def)
 apply (auto dest: domain_type intro: zero_less_diff [THEN iffD1]
             simp add: multiset_fun_iff apply_iff)
 apply (force intro!: lam_type)
 apply (force intro!: lam_type)
 apply (force intro!: lam_type)
 done
 
 lemma munion_eq_conv_exist:
 "\<lbrakk>M \<in> Mult(A); N \<in> Mult(A)\<rbrakk>
   \<Longrightarrow> (M +# {#a#} = N +# {#b#}) \<longleftrightarrow>
       (M=N \<and> a=b | (\<exists>K \<in> Mult(A). M= K +# {#b#} \<and> N=K +# {#a#}))"
 by (auto simp add: Mult_iff_multiset melem_diff_single munion_eq_conv_diff)
 
 
 subsection\<open>Multiset Orderings\<close>
 
 (* multiset on a domain A are finite functions from A to nat-{0} *)
 
 
 (* multirel1 type *)
 
 lemma multirel1_type: "multirel1(A, r) \<subseteq> Mult(A)*Mult(A)"
 by (auto simp add: multirel1_def)
 
 lemma multirel1_0 [simp]: "multirel1(0, r) =0"
 by (auto simp add: multirel1_def)
 
 lemma multirel1_iff:
 " \<langle>N, M\<rangle> \<in> multirel1(A, r) \<longleftrightarrow>
   (\<exists>a. a \<in> A \<and>
   (\<exists>M0. M0 \<in> Mult(A) \<and> (\<exists>K. K \<in> Mult(A) \<and>
    M=M0 +# {#a#} \<and> N=M0 +# K \<and> (\<forall>b \<in> mset_of(K). \<langle>b,a\<rangle> \<in> r))))"
 by (auto simp add: multirel1_def Mult_iff_multiset Bex_def)
 
 
 text\<open>Monotonicity of \<^term>\<open>multirel1\<close>\<close>
 
 lemma multirel1_mono1: "A\<subseteq>B \<Longrightarrow> multirel1(A, r)\<subseteq>multirel1(B, r)"
 apply (auto simp add: multirel1_def)
 apply (auto simp add: Un_subset_iff Mult_iff_multiset)
 apply (rule_tac x = a in bexI)
 apply (rule_tac x = M0 in bexI, simp)
 apply (rule_tac x = K in bexI)
 apply (auto simp add: Mult_iff_multiset)
 done
 
 lemma multirel1_mono2: "r\<subseteq>s \<Longrightarrow> multirel1(A,r)\<subseteq>multirel1(A, s)"
 apply (simp add: multirel1_def, auto)
 apply (rule_tac x = a in bexI)
 apply (rule_tac x = M0 in bexI)
 apply (simp_all add: Mult_iff_multiset)
 apply (rule_tac x = K in bexI)
 apply (simp_all add: Mult_iff_multiset, auto)
 done
 
 lemma multirel1_mono:
      "\<lbrakk>A\<subseteq>B; r\<subseteq>s\<rbrakk> \<Longrightarrow> multirel1(A, r) \<subseteq> multirel1(B, s)"
 apply (rule subset_trans)
 apply (rule multirel1_mono1)
 apply (rule_tac [2] multirel1_mono2, auto)
 done
 
 subsection\<open>Toward the proof of well-foundedness of multirel1\<close>
 
 lemma not_less_0 [iff]: "\<langle>M,0\<rangle> \<notin> multirel1(A, r)"
 by (auto simp add: multirel1_def Mult_iff_multiset)
 
 lemma less_munion: "\<lbrakk><N, M0 +# {#a#}> \<in> multirel1(A, r); M0 \<in> Mult(A)\<rbrakk> \<Longrightarrow>
   (\<exists>M. \<langle>M, M0\<rangle> \<in> multirel1(A, r) \<and> N = M +# {#a#}) |
   (\<exists>K. K \<in> Mult(A) \<and> (\<forall>b \<in> mset_of(K). \<langle>b, a\<rangle> \<in> r) \<and> N = M0 +# K)"
 apply (frule multirel1_type [THEN subsetD])
 apply (simp add: multirel1_iff)
 apply (auto simp add: munion_eq_conv_exist)
 apply (rule_tac x="Ka +# K" in exI, auto, simp add: Mult_iff_multiset)
 apply (simp (no_asm_simp) add: munion_left_cancel munion_assoc)
 apply (auto simp add: munion_commute)
 done
 
 lemma multirel1_base: "\<lbrakk>M \<in> Mult(A); a \<in> A\<rbrakk> \<Longrightarrow> <M, M +# {#a#}> \<in> multirel1(A, r)"
 apply (auto simp add: multirel1_iff)
 apply (simp add: Mult_iff_multiset)
 apply (rule_tac x = a in exI, clarify)
 apply (rule_tac x = M in exI, simp)
 apply (rule_tac x = 0 in exI, auto)
 done
 
 lemma acc_0: "acc(0)=0"
 by (auto intro!: equalityI dest: acc.dom_subset [THEN subsetD])
 
 lemma lemma1: "\<lbrakk>\<forall>b \<in> A. \<langle>b,a\<rangle> \<in> r \<longrightarrow>
     (\<forall>M \<in> acc(multirel1(A, r)). M +# {#b#}:acc(multirel1(A, r)));
     M0 \<in> acc(multirel1(A, r)); a \<in> A;
     \<forall>M. \<langle>M,M0\<rangle> \<in> multirel1(A, r) \<longrightarrow> M +# {#a#} \<in> acc(multirel1(A, r))\<rbrakk>
   \<Longrightarrow> M0 +# {#a#} \<in> acc(multirel1(A, r))"
 apply (subgoal_tac "M0 \<in> Mult(A) ")
  prefer 2
  apply (erule acc.cases)
  apply (erule fieldE)
  apply (auto dest: multirel1_type [THEN subsetD])
 apply (rule accI)
 apply (rename_tac "N")
 apply (drule less_munion, blast)
 apply (auto simp add: Mult_iff_multiset)
 apply (erule_tac P = "\<forall>x \<in> mset_of (K) . \<langle>x, a\<rangle> \<in> r" in rev_mp)
 apply (erule_tac P = "mset_of (K) \<subseteq>A" in rev_mp)
 apply (erule_tac M = K in multiset_induct)
 (* three subgoals *)
 (* subgoal 1 \<in> the induction base case *)
 apply (simp (no_asm_simp))
 (* subgoal 2 \<in> the induction general case *)
 apply (simp add: Ball_def Un_subset_iff, clarify)
 apply (drule_tac x = aa in spec, simp)
 apply (subgoal_tac "aa \<in> A")
 prefer 2 apply blast
 apply (drule_tac x = "M0 +# M" and P =
        "\<lambda>x. x \<in> acc(multirel1(A, r)) \<longrightarrow> Q(x)" for Q in spec)
 apply (simp add: munion_assoc [symmetric])
 (* subgoal 3 \<in> additional conditions *)
 apply (auto intro!: multirel1_base [THEN fieldI2] simp add: Mult_iff_multiset)
 done
 
 lemma lemma2: "\<lbrakk>\<forall>b \<in> A. \<langle>b,a\<rangle> \<in> r
    \<longrightarrow> (\<forall>M \<in> acc(multirel1(A, r)). M +# {#b#} :acc(multirel1(A, r)));
         M \<in> acc(multirel1(A, r)); a \<in> A\<rbrakk> \<Longrightarrow> M +# {#a#} \<in> acc(multirel1(A, r))"
 apply (erule acc_induct)
 apply (blast intro: lemma1)
 done
 
 lemma lemma3: "\<lbrakk>wf[A](r); a \<in> A\<rbrakk>
       \<Longrightarrow> \<forall>M \<in> acc(multirel1(A, r)). M +# {#a#} \<in> acc(multirel1(A, r))"
 apply (erule_tac a = a in wf_on_induct, blast)
 apply (blast intro: lemma2)
 done
 
 lemma lemma4: "multiset(M) \<Longrightarrow> mset_of(M)\<subseteq>A \<longrightarrow>
    wf[A](r) \<longrightarrow> M \<in> field(multirel1(A, r)) \<longrightarrow> M \<in> acc(multirel1(A, r))"
 apply (erule multiset_induct)
 (* proving the base case *)
 apply clarify
 apply (rule accI, force)
 apply (simp add: multirel1_def)
 (* Proving the general case *)
 apply clarify
 apply simp
 apply (subgoal_tac "mset_of (M) \<subseteq>A")
 prefer 2 apply blast
 apply clarify
 apply (drule_tac a = a in lemma3, blast)
 apply (subgoal_tac "M \<in> field (multirel1 (A,r))")
 apply blast
 apply (rule multirel1_base [THEN fieldI1])
 apply (auto simp add: Mult_iff_multiset)
 done
 
 lemma all_accessible: "\<lbrakk>wf[A](r); M \<in> Mult(A); A \<noteq> 0\<rbrakk> \<Longrightarrow> M \<in> acc(multirel1(A, r))"
 apply (erule not_emptyE)
 apply  (rule lemma4 [THEN mp, THEN mp, THEN mp])
 apply (rule_tac [4] multirel1_base [THEN fieldI1])
 apply  (auto simp add: Mult_iff_multiset)
 done
 
 lemma wf_on_multirel1: "wf[A](r) \<Longrightarrow> wf[A-||>nat-{0}](multirel1(A, r))"
 apply (case_tac "A=0")
 apply (simp (no_asm_simp))
 apply (rule wf_imp_wf_on)
 apply (rule wf_on_field_imp_wf)
 apply (simp (no_asm_simp) add: wf_on_0)
 apply (rule_tac A = "acc (multirel1 (A,r))" in wf_on_subset_A)
 apply (rule wf_on_acc)
 apply (blast intro: all_accessible)
 done
 
 lemma wf_multirel1: "wf(r) \<Longrightarrow>wf(multirel1(field(r), r))"
 apply (simp (no_asm_use) add: wf_iff_wf_on_field)
 apply (drule wf_on_multirel1)
 apply (rule_tac A = "field (r) -||> nat - {0}" in wf_on_subset_A)
 apply (simp (no_asm_simp))
 apply (rule field_rel_subset)
 apply (rule multirel1_type)
 done
 
 (** multirel **)
 
 lemma multirel_type: "multirel(A, r) \<subseteq> Mult(A)*Mult(A)"
 apply (simp add: multirel_def)
 apply (rule trancl_type [THEN subset_trans])
 apply (auto dest: multirel1_type [THEN subsetD])
 done
 
 (* Monotonicity of multirel *)
 lemma multirel_mono:
      "\<lbrakk>A\<subseteq>B; r\<subseteq>s\<rbrakk> \<Longrightarrow> multirel(A, r)\<subseteq>multirel(B,s)"
 apply (simp add: multirel_def)
 apply (rule trancl_mono)
 apply (rule multirel1_mono, auto)
 done
 
 (* Equivalence of multirel with the usual (closure-free) definition *)
 
 lemma add_diff_eq: "k \<in> nat \<Longrightarrow> 0 < k \<longrightarrow> n #+ k #- 1 = n #+ (k #- 1)"
 by (erule nat_induct, auto)
 
 lemma mdiff_union_single_conv: "\<lbrakk>a \<in> mset_of(J); multiset(I); multiset(J)\<rbrakk>
    \<Longrightarrow> I +# J -# {#a#} = I +# (J-# {#a#})"
 apply (simp (no_asm_simp) add: multiset_equality)
 apply (case_tac "a \<notin> mset_of (I) ")
 apply (auto simp add: mcount_def mset_of_def multiset_def multiset_fun_iff)
 apply (auto dest: domain_type simp add: add_diff_eq)
 done
 
 lemma diff_add_commute: "\<lbrakk>n \<le> m;  m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk> \<Longrightarrow> m #- n #+ k = m #+ k #- n"
 by (auto simp add: le_iff less_iff_succ_add)
 
 (* One direction *)
 
 lemma multirel_implies_one_step:
 "\<langle>M,N\<rangle> \<in> multirel(A, r) \<Longrightarrow>
      trans[A](r) \<longrightarrow>
      (\<exists>I J K.
          I \<in> Mult(A) \<and> J \<in> Mult(A) \<and>  K \<in> Mult(A) \<and>
          N = I +# J \<and> M = I +# K \<and> J \<noteq> 0 \<and>
         (\<forall>k \<in> mset_of(K). \<exists>j \<in> mset_of(J). \<langle>k,j\<rangle> \<in> r))"
 apply (simp add: multirel_def Ball_def Bex_def)
 apply (erule converse_trancl_induct)
 apply (simp_all add: multirel1_iff Mult_iff_multiset)
 (* Two subgoals remain *)
 (* Subgoal 1 *)
 apply clarify
 apply (rule_tac x = M0 in exI, force)
 (* Subgoal 2 *)
 apply clarify
 apply hypsubst_thin
 apply (case_tac "a \<in> mset_of (Ka) ")
 apply (rule_tac x = I in exI, simp (no_asm_simp))
 apply (rule_tac x = J in exI, simp (no_asm_simp))
 apply (rule_tac x = " (Ka -# {#a#}) +# K" in exI, simp (no_asm_simp))
 apply (simp_all add: Un_subset_iff)
 apply (simp (no_asm_simp) add: munion_assoc [symmetric])
 apply (drule_tac t = "\<lambda>M. M-#{#a#}" in subst_context)
 apply (simp add: mdiff_union_single_conv melem_diff_single, clarify)
 apply (erule disjE, simp)
 apply (erule disjE, simp)
 apply (drule_tac x = a and P = "\<lambda>x. x :# Ka \<longrightarrow> Q(x)" for Q in spec)
 apply clarify
 apply (rule_tac x = xa in exI)
 apply (simp (no_asm_simp))
 apply (blast dest: trans_onD)
 (* new we know that  a\<notin>mset_of(Ka) *)
 apply (subgoal_tac "a :# I")
 apply (rule_tac x = "I-#{#a#}" in exI, simp (no_asm_simp))
 apply (rule_tac x = "J+#{#a#}" in exI)
 apply (simp (no_asm_simp) add: Un_subset_iff)
 apply (rule_tac x = "Ka +# K" in exI)
 apply (simp (no_asm_simp) add: Un_subset_iff)
 apply (rule conjI)
 apply (simp (no_asm_simp) add: multiset_equality mcount_elem [THEN succ_pred_eq_self])
 apply (rule conjI)
 apply (drule_tac t = "\<lambda>M. M-#{#a#}" in subst_context)
 apply (simp add: mdiff_union_inverse2)
 apply (simp_all (no_asm_simp) add: multiset_equality)
 apply (rule diff_add_commute [symmetric])
 apply (auto intro: mcount_elem)
 apply (subgoal_tac "a \<in> mset_of (I +# Ka) ")
 apply (drule_tac [2] sym, auto)
 done
 
 lemma melem_imp_eq_diff_union [simp]: "\<lbrakk>a \<in> mset_of(M); multiset(M)\<rbrakk> \<Longrightarrow> M -# {#a#} +# {#a#} = M"
 by (simp add: multiset_equality mcount_elem [THEN succ_pred_eq_self])
 
 lemma msize_eq_succ_imp_eq_union:
      "\<lbrakk>msize(M)=$# succ(n); M \<in> Mult(A); n \<in> nat\<rbrakk>
       \<Longrightarrow> \<exists>a N. M = N +# {#a#} \<and> N \<in> Mult(A) \<and> a \<in> A"
 apply (drule msize_eq_succ_imp_elem, auto)
 apply (rule_tac x = a in exI)
 apply (rule_tac x = "M -# {#a#}" in exI)
 apply (frule Mult_into_multiset)
 apply (simp (no_asm_simp))
 apply (auto simp add: Mult_iff_multiset)
 done
 
 (* The second direction *)
 
 lemma one_step_implies_multirel_lemma [rule_format (no_asm)]:
 "n \<in> nat \<Longrightarrow>
    (\<forall>I J K.
     I \<in> Mult(A) \<and> J \<in> Mult(A) \<and> K \<in> Mult(A) \<and>
    (msize(J) = $# n \<and> J \<noteq>0 \<and>  (\<forall>k \<in> mset_of(K).  \<exists>j \<in> mset_of(J). \<langle>k, j\<rangle> \<in> r))
     \<longrightarrow> <I +# K, I +# J> \<in> multirel(A, r))"
 apply (simp add: Mult_iff_multiset)
 apply (erule nat_induct, clarify)
 apply (drule_tac M = J in msize_eq_0_iff, auto)
 (* one subgoal remains *)
 apply (subgoal_tac "msize (J) =$# succ (x) ")
  prefer 2 apply simp
 apply (frule_tac A = A in msize_eq_succ_imp_eq_union)
 apply (simp_all add: Mult_iff_multiset, clarify)
 apply (rename_tac "J'", simp)
 apply (case_tac "J' = 0")
 apply (simp add: multirel_def)
 apply (rule r_into_trancl, clarify)
 apply (simp add: multirel1_iff Mult_iff_multiset, force)
 (*Now we know J' \<noteq>  0*)
 apply (drule sym, rotate_tac -1, simp)
 apply (erule_tac V = "$# x = msize (J') " in thin_rl)
 apply (frule_tac M = K and P = "\<lambda>x. \<langle>x,a\<rangle> \<in> r" in multiset_partition)
 apply (erule_tac P = "\<forall>k \<in> mset_of (K) . P(k)" for P in rev_mp)
 apply (erule ssubst)
 apply (simp add: Ball_def, auto)
 apply (subgoal_tac "< (I +# {# x \<in> K. \<langle>x, a\<rangle> \<in> r#}) +# {# x \<in> K. \<langle>x, a\<rangle> \<notin> r#}, (I +# {# x \<in> K. \<langle>x, a\<rangle> \<in> r#}) +# J'> \<in> multirel(A, r) ")
  prefer 2
  apply (drule_tac x = "I +# {# x \<in> K. \<langle>x, a\<rangle> \<in> r#}" in spec)
  apply (rotate_tac -1)
  apply (drule_tac x = "J'" in spec)
  apply (rotate_tac -1)
  apply (drule_tac x = "{# x \<in> K. \<langle>x, a\<rangle> \<notin> r#}" in spec, simp) apply blast
 apply (simp add: munion_assoc [symmetric] multirel_def)
 apply (rule_tac b = "I +# {# x \<in> K. \<langle>x, a\<rangle> \<in> r#} +# J'" in trancl_trans, blast)
 apply (rule r_into_trancl)
 apply (simp add: multirel1_iff Mult_iff_multiset)
 apply (rule_tac x = a in exI)
 apply (simp (no_asm_simp))
 apply (rule_tac x = "I +# J'" in exI)
 apply (auto simp add: munion_ac Un_subset_iff)
 done
 
 lemma one_step_implies_multirel:
      "\<lbrakk>J \<noteq> 0;  \<forall>k \<in> mset_of(K). \<exists>j \<in> mset_of(J). \<langle>k,j\<rangle> \<in> r;
          I \<in> Mult(A); J \<in> Mult(A); K \<in> Mult(A)\<rbrakk>
       \<Longrightarrow> <I+#K, I+#J> \<in> multirel(A, r)"
 apply (subgoal_tac "multiset (J) ")
  prefer 2 apply (simp add: Mult_iff_multiset)
 apply (frule_tac M = J in msize_int_of_nat)
 apply (auto intro: one_step_implies_multirel_lemma)
 done
 
 (** Proving that multisets are partially ordered **)
 
 (*irreflexivity*)
 
 lemma multirel_irrefl_lemma:
      "Finite(A) \<Longrightarrow> part_ord(A, r) \<longrightarrow> (\<forall>x \<in> A. \<exists>y \<in> A. \<langle>x,y\<rangle> \<in> r) \<longrightarrow>A=0"
 apply (erule Finite_induct)
 apply (auto dest: subset_consI [THEN [2] part_ord_subset])
 apply (auto simp add: part_ord_def irrefl_def)
 apply (drule_tac x = xa in bspec)
 apply (drule_tac [2] a = xa and b = x in trans_onD, auto)
 done
 
 lemma irrefl_on_multirel:
      "part_ord(A, r) \<Longrightarrow> irrefl(Mult(A), multirel(A, r))"
 apply (simp add: irrefl_def)
 apply (subgoal_tac "trans[A](r) ")
  prefer 2 apply (simp add: part_ord_def, clarify)
 apply (drule multirel_implies_one_step, clarify)
 apply (simp add: Mult_iff_multiset, clarify)
 apply (subgoal_tac "Finite (mset_of (K))")
 apply (frule_tac r = r in multirel_irrefl_lemma)
 apply (frule_tac B = "mset_of (K) " in part_ord_subset)
 apply simp_all
 apply (auto simp add: multiset_def mset_of_def)
 done
 
 lemma trans_on_multirel: "trans[Mult(A)](multirel(A, r))"
 apply (simp add: multirel_def trans_on_def)
 apply (blast intro: trancl_trans)
 done
 
 lemma multirel_trans:
  "\<lbrakk>\<langle>M, N\<rangle> \<in> multirel(A, r); \<langle>N, K\<rangle> \<in> multirel(A, r)\<rbrakk> \<Longrightarrow>  \<langle>M, K\<rangle> \<in> multirel(A,r)"
 apply (simp add: multirel_def)
 apply (blast intro: trancl_trans)
 done
 
 lemma trans_multirel: "trans(multirel(A,r))"
 apply (simp add: multirel_def)
 apply (rule trans_trancl)
 done
 
 lemma part_ord_multirel: "part_ord(A,r) \<Longrightarrow> part_ord(Mult(A), multirel(A, r))"
 apply (simp (no_asm) add: part_ord_def)
 apply (blast intro: irrefl_on_multirel trans_on_multirel)
 done
 
 (** Monotonicity of multiset union **)
 
 lemma munion_multirel1_mono:
 "\<lbrakk>\<langle>M,N\<rangle> \<in> multirel1(A, r); K \<in> Mult(A)\<rbrakk> \<Longrightarrow> <K +# M, K +# N> \<in> multirel1(A, r)"
 apply (frule multirel1_type [THEN subsetD])
 apply (auto simp add: multirel1_iff Mult_iff_multiset)
 apply (rule_tac x = a in exI)
 apply (simp (no_asm_simp))
 apply (rule_tac x = "K+#M0" in exI)
 apply (simp (no_asm_simp) add: Un_subset_iff)
 apply (rule_tac x = Ka in exI)
 apply (simp (no_asm_simp) add: munion_assoc)
 done
 
 lemma munion_multirel_mono2:
  "\<lbrakk>\<langle>M, N\<rangle> \<in> multirel(A, r); K \<in> Mult(A)\<rbrakk>\<Longrightarrow><K +# M, K +# N> \<in> multirel(A, r)"
 apply (frule multirel_type [THEN subsetD])
 apply (simp (no_asm_use) add: multirel_def)
 apply clarify
 apply (drule_tac psi = "\<langle>M,N\<rangle> \<in> multirel1 (A, r) ^+" in asm_rl)
 apply (erule rev_mp)
 apply (erule rev_mp)
 apply (erule rev_mp)
 apply (erule trancl_induct, clarify)
 apply (blast intro: munion_multirel1_mono r_into_trancl, clarify)
 apply (subgoal_tac "y \<in> Mult(A) ")
  prefer 2
  apply (blast dest: multirel_type [unfolded multirel_def, THEN subsetD])
 apply (subgoal_tac "<K +# y, K +# z> \<in> multirel1 (A, r) ")
 prefer 2 apply (blast intro: munion_multirel1_mono)
 apply (blast intro: r_into_trancl trancl_trans)
 done
 
 lemma munion_multirel_mono1:
      "\<lbrakk>\<langle>M, N\<rangle> \<in> multirel(A, r); K \<in> Mult(A)\<rbrakk> \<Longrightarrow> <M +# K, N +# K> \<in> multirel(A, r)"
 apply (frule multirel_type [THEN subsetD])
 apply (rule_tac P = "\<lambda>x. \<langle>x,u\<rangle> \<in> multirel(A, r)" for u in munion_commute [THEN subst])
 apply (subst munion_commute [of N])
 apply (rule munion_multirel_mono2)
 apply (auto simp add: Mult_iff_multiset)
 done
 
 lemma munion_multirel_mono:
      "\<lbrakk>\<langle>M,K\<rangle> \<in> multirel(A, r); \<langle>N,L\<rangle> \<in> multirel(A, r)\<rbrakk>
       \<Longrightarrow> <M +# N, K +# L> \<in> multirel(A, r)"
 apply (subgoal_tac "M \<in> Mult(A) \<and> N \<in> Mult(A) \<and> K \<in> Mult(A) \<and> L \<in> Mult(A) ")
 prefer 2 apply (blast dest: multirel_type [THEN subsetD])
 apply (blast intro: munion_multirel_mono1 multirel_trans munion_multirel_mono2)
 done
 
 
 subsection\<open>Ordinal Multisets\<close>
 
 (* A \<subseteq> B \<Longrightarrow>  field(Memrel(A)) \<subseteq> field(Memrel(B)) *)
 lemmas field_Memrel_mono = Memrel_mono [THEN field_mono]
 
 (*
 \<lbrakk>Aa \<subseteq> Ba; A \<subseteq> B\<rbrakk> \<Longrightarrow>
 multirel(field(Memrel(Aa)), Memrel(A))\<subseteq> multirel(field(Memrel(Ba)), Memrel(B))
 *)
 
 lemmas multirel_Memrel_mono = multirel_mono [OF field_Memrel_mono Memrel_mono]
 
 lemma omultiset_is_multiset [simp]: "omultiset(M) \<Longrightarrow> multiset(M)"
 apply (simp add: omultiset_def)
 apply (auto simp add: Mult_iff_multiset)
 done
 
 lemma munion_omultiset [simp]: "\<lbrakk>omultiset(M); omultiset(N)\<rbrakk> \<Longrightarrow> omultiset(M +# N)"
 apply (simp add: omultiset_def, clarify)
 apply (rule_tac x = "i \<union> ia" in exI)
 apply (simp add: Mult_iff_multiset Ord_Un Un_subset_iff)
 apply (blast intro: field_Memrel_mono)
 done
 
 lemma mdiff_omultiset [simp]: "omultiset(M) \<Longrightarrow> omultiset(M -# N)"
 apply (simp add: omultiset_def, clarify)
 apply (simp add: Mult_iff_multiset)
 apply (rule_tac x = i in exI)
 apply (simp (no_asm_simp))
 done
 
 (** Proving that Memrel is a partial order **)
 
 lemma irrefl_Memrel: "Ord(i) \<Longrightarrow> irrefl(field(Memrel(i)), Memrel(i))"
 apply (rule irreflI, clarify)
 apply (subgoal_tac "Ord (x) ")
 prefer 2 apply (blast intro: Ord_in_Ord)
 apply (drule_tac i = x in ltI [THEN lt_irrefl], auto)
 done
 
 lemma trans_iff_trans_on: "trans(r) \<longleftrightarrow> trans[field(r)](r)"
 by (simp add: trans_on_def trans_def, auto)
 
 lemma part_ord_Memrel: "Ord(i) \<Longrightarrow>part_ord(field(Memrel(i)), Memrel(i))"
 apply (simp add: part_ord_def)
 apply (simp (no_asm) add: trans_iff_trans_on [THEN iff_sym])
 apply (blast intro: trans_Memrel irrefl_Memrel)
 done
 
 (*
   Ord(i) \<Longrightarrow>
   part_ord(field(Memrel(i))-||>nat-{0}, multirel(field(Memrel(i)), Memrel(i)))
 *)
 
 lemmas part_ord_mless = part_ord_Memrel [THEN part_ord_multirel]
 
 (*irreflexivity*)
 
 lemma mless_not_refl: "\<not>(M <# M)"
 apply (simp add: mless_def, clarify)
 apply (frule multirel_type [THEN subsetD])
 apply (drule part_ord_mless)
 apply (simp add: part_ord_def irrefl_def)
 done
 
 (* N<N \<Longrightarrow> R *)
 lemmas mless_irrefl = mless_not_refl [THEN notE, elim!]
 
 (*transitivity*)
 lemma mless_trans: "\<lbrakk>K <# M; M <# N\<rbrakk> \<Longrightarrow> K <# N"
 apply (simp add: mless_def, clarify)
 apply (rule_tac x = "i \<union> ia" in exI)
 apply (blast dest: multirel_Memrel_mono [OF Un_upper1 Un_upper1, THEN subsetD]
                    multirel_Memrel_mono [OF Un_upper2 Un_upper2, THEN subsetD]
         intro: multirel_trans Ord_Un)
 done
 
 (*asymmetry*)
 lemma mless_not_sym: "M <# N \<Longrightarrow> \<not> N <# M"
 apply clarify
 apply (rule mless_not_refl [THEN notE])
 apply (erule mless_trans, assumption)
 done
 
 lemma mless_asym: "\<lbrakk>M <# N; \<not>P \<Longrightarrow> N <# M\<rbrakk> \<Longrightarrow> P"
 by (blast dest: mless_not_sym)
 
 lemma mle_refl [simp]: "omultiset(M) \<Longrightarrow> M <#= M"
 by (simp add: mle_def)
 
 (*anti-symmetry*)
 lemma mle_antisym:
      "\<lbrakk>M <#= N;  N <#= M\<rbrakk> \<Longrightarrow> M = N"
 apply (simp add: mle_def)
 apply (blast dest: mless_not_sym)
 done
 
 (*transitivity*)
 lemma mle_trans: "\<lbrakk>K <#= M; M <#= N\<rbrakk> \<Longrightarrow> K <#= N"
 apply (simp add: mle_def)
 apply (blast intro: mless_trans)
 done
 
 lemma mless_le_iff: "M <# N \<longleftrightarrow> (M <#= N \<and> M \<noteq> N)"
 by (simp add: mle_def, auto)
 
 (** Monotonicity of mless **)
 
 lemma munion_less_mono2: "\<lbrakk>M <# N; omultiset(K)\<rbrakk> \<Longrightarrow> K +# M <# K +# N"
 apply (simp add: mless_def omultiset_def, clarify)
 apply (rule_tac x = "i \<union> ia" in exI)
 apply (simp add: Mult_iff_multiset Ord_Un Un_subset_iff)
 apply (rule munion_multirel_mono2)
  apply (blast intro: multirel_Memrel_mono [THEN subsetD])
 apply (simp add: Mult_iff_multiset)
 apply (blast intro: field_Memrel_mono [THEN subsetD])
 done
 
 lemma munion_less_mono1: "\<lbrakk>M <# N; omultiset(K)\<rbrakk> \<Longrightarrow> M +# K <# N +# K"
 by (force dest: munion_less_mono2 simp add: munion_commute)
 
 lemma mless_imp_omultiset: "M <# N \<Longrightarrow> omultiset(M) \<and> omultiset(N)"
 by (auto simp add: mless_def omultiset_def dest: multirel_type [THEN subsetD])
 
 lemma munion_less_mono: "\<lbrakk>M <# K; N <# L\<rbrakk> \<Longrightarrow> M +# N <# K +# L"
 apply (frule_tac M = M in mless_imp_omultiset)
 apply (frule_tac M = N in mless_imp_omultiset)
 apply (blast intro: munion_less_mono1 munion_less_mono2 mless_trans)
 done
 
 (* <#= *)
 
 lemma mle_imp_omultiset: "M <#= N \<Longrightarrow> omultiset(M) \<and> omultiset(N)"
 by (auto simp add: mle_def mless_imp_omultiset)
 
 lemma mle_mono: "\<lbrakk>M <#= K;  N <#= L\<rbrakk> \<Longrightarrow> M +# N <#= K +# L"
 apply (frule_tac M = M in mle_imp_omultiset)
 apply (frule_tac M = N in mle_imp_omultiset)
 apply (auto simp add: mle_def intro: munion_less_mono1 munion_less_mono2 munion_less_mono)
 done
 
 lemma omultiset_0 [iff]: "omultiset(0)"
 by (auto simp add: omultiset_def Mult_iff_multiset)
 
 lemma empty_leI [simp]: "omultiset(M) \<Longrightarrow> 0 <#= M"
 apply (simp add: mle_def mless_def)
 apply (subgoal_tac "\<exists>i. Ord (i) \<and> M \<in> Mult(field(Memrel(i))) ")
  prefer 2 apply (simp add: omultiset_def)
 apply (case_tac "M=0", simp_all, clarify)
 apply (subgoal_tac "<0 +# 0, 0 +# M> \<in> multirel(field (Memrel(i)), Memrel(i))")
 apply (rule_tac [2] one_step_implies_multirel)
 apply (auto simp add: Mult_iff_multiset)
 done
 
 lemma munion_upper1: "\<lbrakk>omultiset(M); omultiset(N)\<rbrakk> \<Longrightarrow> M <#= M +# N"
 apply (subgoal_tac "M +# 0 <#= M +# N")
 apply (rule_tac [2] mle_mono, auto)
 done
 
 end
diff --git a/src/ZF/Induct/Primrec.thy b/src/ZF/Induct/Primrec.thy
--- a/src/ZF/Induct/Primrec.thy
+++ b/src/ZF/Induct/Primrec.thy
@@ -1,374 +1,374 @@
 (*  Title:      ZF/Induct/Primrec.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section \<open>Primitive Recursive Functions: the inductive definition\<close>
 
 theory Primrec imports ZF begin
 
 text \<open>
   Proof adopted from @{cite szasz93}.
 
   See also @{cite \<open>page 250, exercise 11\<close> mendelson}.
 \<close>
 
 
 subsection \<open>Basic definitions\<close>
 
 definition
   SC :: "i"  where
   "SC \<equiv> \<lambda>l \<in> list(nat). list_case(0, \<lambda>x xs. succ(x), l)"
 
 definition
   CONSTANT :: "i\<Rightarrow>i"  where
   "CONSTANT(k) \<equiv> \<lambda>l \<in> list(nat). k"
 
 definition
   PROJ :: "i\<Rightarrow>i"  where
   "PROJ(i) \<equiv> \<lambda>l \<in> list(nat). list_case(0, \<lambda>x xs. x, drop(i,l))"
 
 definition
   COMP :: "[i,i]\<Rightarrow>i"  where
   "COMP(g,fs) \<equiv> \<lambda>l \<in> list(nat). g ` map(\<lambda>f. f`l, fs)"
 
 definition
   PREC :: "[i,i]\<Rightarrow>i"  where
   "PREC(f,g) \<equiv>
      \<lambda>l \<in> list(nat). list_case(0,
                       \<lambda>x xs. rec(x, f`xs, \<lambda>y r. g ` Cons(r, Cons(y, xs))), l)"
   \<comment> \<open>Note that \<open>g\<close> is applied first to \<^term>\<open>PREC(f,g)`y\<close> and then to \<open>y\<close>!\<close>
 
 consts
   ACK :: "i\<Rightarrow>i"
 primrec
   "ACK(0) = SC"
   "ACK(succ(i)) = PREC (CONSTANT (ACK(i) ` [1]), COMP(ACK(i), [PROJ(0)]))"
 
 abbreviation
   ack :: "[i,i]\<Rightarrow>i" where
   "ack(x,y) \<equiv> ACK(x) ` [y]"
 
 
 text \<open>
   \medskip Useful special cases of evaluation.
 \<close>
 
 lemma SC: "\<lbrakk>x \<in> nat;  l \<in> list(nat)\<rbrakk> \<Longrightarrow> SC ` (Cons(x,l)) = succ(x)"
   by (simp add: SC_def)
 
 lemma CONSTANT: "l \<in> list(nat) \<Longrightarrow> CONSTANT(k) ` l = k"
   by (simp add: CONSTANT_def)
 
 lemma PROJ_0: "\<lbrakk>x \<in> nat;  l \<in> list(nat)\<rbrakk> \<Longrightarrow> PROJ(0) ` (Cons(x,l)) = x"
   by (simp add: PROJ_def)
 
 lemma COMP_1: "l \<in> list(nat) \<Longrightarrow> COMP(g,[f]) ` l = g` [f`l]"
   by (simp add: COMP_def)
 
 lemma PREC_0: "l \<in> list(nat) \<Longrightarrow> PREC(f,g) ` (Cons(0,l)) = f`l"
   by (simp add: PREC_def)
 
 lemma PREC_succ:
   "\<lbrakk>x \<in> nat;  l \<in> list(nat)\<rbrakk>
     \<Longrightarrow> PREC(f,g) ` (Cons(succ(x),l)) =
       g ` Cons(PREC(f,g)`(Cons(x,l)), Cons(x,l))"
   by (simp add: PREC_def)
 
 
 subsection \<open>Inductive definition of the PR functions\<close>
 
 consts
   prim_rec :: i
 
 inductive
   domains prim_rec \<subseteq> "list(nat)->nat"
   intros
     "SC \<in> prim_rec"
     "k \<in> nat \<Longrightarrow> CONSTANT(k) \<in> prim_rec"
     "i \<in> nat \<Longrightarrow> PROJ(i) \<in> prim_rec"
     "\<lbrakk>g \<in> prim_rec; fs\<in>list(prim_rec)\<rbrakk> \<Longrightarrow> COMP(g,fs) \<in> prim_rec"
     "\<lbrakk>f \<in> prim_rec; g \<in> prim_rec\<rbrakk> \<Longrightarrow> PREC(f,g) \<in> prim_rec"
   monos list_mono
   con_defs SC_def CONSTANT_def PROJ_def COMP_def PREC_def
   type_intros nat_typechecks list.intros
     lam_type list_case_type drop_type map_type
     apply_type rec_type
 
 
 lemma prim_rec_into_fun [TC]: "c \<in> prim_rec \<Longrightarrow> c \<in> list(nat) -> nat"
   by (erule subsetD [OF prim_rec.dom_subset])
 
 lemmas [TC] = apply_type [OF prim_rec_into_fun]
 
 declare prim_rec.intros [TC]
 declare nat_into_Ord [TC]
 declare rec_type [TC]
 
 lemma ACK_in_prim_rec [TC]: "i \<in> nat \<Longrightarrow> ACK(i) \<in> prim_rec"
   by (induct set: nat) simp_all
 
 lemma ack_type [TC]: "\<lbrakk>i \<in> nat;  j \<in> nat\<rbrakk> \<Longrightarrow>  ack(i,j) \<in> nat"
   by auto
 
 
 subsection \<open>Ackermann's function cases\<close>
 
 lemma ack_0: "j \<in> nat \<Longrightarrow> ack(0,j) = succ(j)"
   \<comment> \<open>PROPERTY A 1\<close>
   by (simp add: SC)
 
 lemma ack_succ_0: "ack(succ(i), 0) = ack(i,1)"
   \<comment> \<open>PROPERTY A 2\<close>
   by (simp add: CONSTANT PREC_0)
 
 lemma ack_succ_succ:
   "\<lbrakk>i\<in>nat;  j\<in>nat\<rbrakk> \<Longrightarrow> ack(succ(i), succ(j)) = ack(i, ack(succ(i), j))"
   \<comment> \<open>PROPERTY A 3\<close>
   by (simp add: CONSTANT PREC_succ COMP_1 PROJ_0)
 
 lemmas [simp] = ack_0 ack_succ_0 ack_succ_succ ack_type
   and [simp del] = ACK.simps
 
 
 lemma lt_ack2: "i \<in> nat \<Longrightarrow> j \<in> nat \<Longrightarrow> j < ack(i,j)"
   \<comment> \<open>PROPERTY A 4\<close>
   apply (induct i arbitrary: j set: nat)
    apply simp
   apply (induct_tac j)
    apply (erule_tac [2] succ_leI [THEN lt_trans1])
    apply (rule nat_0I [THEN nat_0_le, THEN lt_trans])
    apply auto
   done
 
 lemma ack_lt_ack_succ2: "\<lbrakk>i\<in>nat; j\<in>nat\<rbrakk> \<Longrightarrow> ack(i,j) < ack(i, succ(j))"
   \<comment> \<open>PROPERTY A 5-, the single-step lemma\<close>
   by (induct set: nat) (simp_all add: lt_ack2)
 
 lemma ack_lt_mono2: "\<lbrakk>j<k; i \<in> nat; k \<in> nat\<rbrakk> \<Longrightarrow> ack(i,j) < ack(i,k)"
   \<comment> \<open>PROPERTY A 5, monotonicity for \<open><\<close>\<close>
   apply (frule lt_nat_in_nat, assumption)
   apply (erule succ_lt_induct)
     apply assumption
    apply (rule_tac [2] lt_trans)
     apply (auto intro: ack_lt_ack_succ2)
   done
 
 lemma ack_le_mono2: "\<lbrakk>j\<le>k;  i\<in>nat;  k\<in>nat\<rbrakk> \<Longrightarrow> ack(i,j) \<le> ack(i,k)"
   \<comment> \<open>PROPERTY A 5', monotonicity for \<open>\<le>\<close>\<close>
   apply (rule_tac f = "\<lambda>j. ack (i,j) " in Ord_lt_mono_imp_le_mono)
      apply (assumption | rule ack_lt_mono2 ack_type [THEN nat_into_Ord])+
   done
 
 lemma ack2_le_ack1:
   "\<lbrakk>i\<in>nat;  j\<in>nat\<rbrakk> \<Longrightarrow> ack(i, succ(j)) \<le> ack(succ(i), j)"
   \<comment> \<open>PROPERTY A 6\<close>
   apply (induct_tac j)
    apply simp_all
   apply (rule ack_le_mono2)
     apply (rule lt_ack2 [THEN succ_leI, THEN le_trans])
       apply auto
   done
 
 lemma ack_lt_ack_succ1: "\<lbrakk>i \<in> nat; j \<in> nat\<rbrakk> \<Longrightarrow> ack(i,j) < ack(succ(i),j)"
   \<comment> \<open>PROPERTY A 7-, the single-step lemma\<close>
   apply (rule ack_lt_mono2 [THEN lt_trans2])
      apply (rule_tac [4] ack2_le_ack1)
       apply auto
   done
 
 lemma ack_lt_mono1: "\<lbrakk>i<j; j \<in> nat; k \<in> nat\<rbrakk> \<Longrightarrow> ack(i,k) < ack(j,k)"
   \<comment> \<open>PROPERTY A 7, monotonicity for \<open><\<close>\<close>
   apply (frule lt_nat_in_nat, assumption)
   apply (erule succ_lt_induct)
     apply assumption
    apply (rule_tac [2] lt_trans)
     apply (auto intro: ack_lt_ack_succ1)
   done
 
 lemma ack_le_mono1: "\<lbrakk>i\<le>j; j \<in> nat; k \<in> nat\<rbrakk> \<Longrightarrow> ack(i,k) \<le> ack(j,k)"
   \<comment> \<open>PROPERTY A 7', monotonicity for \<open>\<le>\<close>\<close>
   apply (rule_tac f = "\<lambda>j. ack (j,k) " in Ord_lt_mono_imp_le_mono)
      apply (assumption | rule ack_lt_mono1 ack_type [THEN nat_into_Ord])+
   done
 
 lemma ack_1: "j \<in> nat \<Longrightarrow> ack(1,j) = succ(succ(j))"
   \<comment> \<open>PROPERTY A 8\<close>
   by (induct set: nat) simp_all
 
 lemma ack_2: "j \<in> nat \<Longrightarrow> ack(succ(1),j) = succ(succ(succ(j#+j)))"
   \<comment> \<open>PROPERTY A 9\<close>
   by (induct set: nat) (simp_all add: ack_1)
 
 lemma ack_nest_bound:
   "\<lbrakk>i1 \<in> nat; i2 \<in> nat; j \<in> nat\<rbrakk>
     \<Longrightarrow> ack(i1, ack(i2,j)) < ack(succ(succ(i1#+i2)), j)"
   \<comment> \<open>PROPERTY A 10\<close>
   apply (rule lt_trans2 [OF _ ack2_le_ack1])
     apply simp
     apply (rule add_le_self [THEN ack_le_mono1, THEN lt_trans1])
        apply auto
   apply (force intro: add_le_self2 [THEN ack_lt_mono1, THEN ack_lt_mono2])
   done
 
 lemma ack_add_bound:
   "\<lbrakk>i1 \<in> nat; i2 \<in> nat; j \<in> nat\<rbrakk>
     \<Longrightarrow> ack(i1,j) #+ ack(i2,j) < ack(succ(succ(succ(succ(i1#+i2)))), j)"
   \<comment> \<open>PROPERTY A 11\<close>
   apply (rule_tac j = "ack (succ (1), ack (i1 #+ i2, j))" in lt_trans)
    apply (simp add: ack_2)
    apply (rule_tac [2] ack_nest_bound [THEN lt_trans2])
       apply (rule add_le_mono [THEN leI, THEN leI])
          apply (auto intro: add_le_self add_le_self2 ack_le_mono1)
   done
 
 lemma ack_add_bound2:
      "\<lbrakk>i < ack(k,j);  j \<in> nat;  k \<in> nat\<rbrakk>
       \<Longrightarrow> i#+j < ack(succ(succ(succ(succ(k)))), j)"
   \<comment> \<open>PROPERTY A 12.\<close>
   \<comment> \<open>Article uses existential quantifier but the ALF proof used \<^term>\<open>k#+#4\<close>.\<close>
   \<comment> \<open>Quantified version must be nested \<open>\<exists>k'. \<forall>i,j \<dots>\<close>.\<close>
   apply (rule_tac j = "ack (k,j) #+ ack (0,j) " in lt_trans)
    apply (rule_tac [2] ack_add_bound [THEN lt_trans2])
       apply (rule add_lt_mono)
          apply auto
   done
 
 
 subsection \<open>Main result\<close>
 
 declare list_add_type [simp]
 
 lemma SC_case: "l \<in> list(nat) \<Longrightarrow> SC ` l < ack(1, list_add(l))"
-  apply (unfold SC_def)
+    unfolding SC_def
   apply (erule list.cases)
    apply (simp add: succ_iff)
   apply (simp add: ack_1 add_le_self)
   done
 
 lemma lt_ack1: "\<lbrakk>i \<in> nat; j \<in> nat\<rbrakk> \<Longrightarrow> i < ack(i,j)"
   \<comment> \<open>PROPERTY A 4'? Extra lemma needed for \<open>CONSTANT\<close> case, constant functions.\<close>
   apply (induct_tac i)
    apply (simp add: nat_0_le)
   apply (erule lt_trans1 [OF succ_leI ack_lt_ack_succ1])
    apply auto
   done
 
 lemma CONSTANT_case:
     "\<lbrakk>l \<in> list(nat);  k \<in> nat\<rbrakk> \<Longrightarrow> CONSTANT(k) ` l < ack(k, list_add(l))"
   by (simp add: CONSTANT_def lt_ack1)
 
 lemma PROJ_case [rule_format]:
     "l \<in> list(nat) \<Longrightarrow> \<forall>i \<in> nat. PROJ(i) ` l < ack(0, list_add(l))"
-  apply (unfold PROJ_def)
+    unfolding PROJ_def
   apply simp
   apply (erule list.induct)
    apply (simp add: nat_0_le)
   apply simp
   apply (rule ballI)
   apply (erule_tac n = i in natE)
    apply (simp add: add_le_self)
   apply simp
   apply (erule bspec [THEN lt_trans2])
    apply (rule_tac [2] add_le_self2 [THEN succ_leI])
    apply auto
   done
 
 text \<open>
   \medskip \<open>COMP\<close> case.
 \<close>
 
 lemma COMP_map_lemma:
   "fs \<in> list({f \<in> prim_rec. \<exists>kf \<in> nat. \<forall>l \<in> list(nat). f`l < ack(kf, list_add(l))})
     \<Longrightarrow> \<exists>k \<in> nat. \<forall>l \<in> list(nat).
       list_add(map(\<lambda>f. f ` l, fs)) < ack(k, list_add(l))"
   apply (induct set: list)
    apply (rule_tac x = 0 in bexI)
     apply (simp_all add: lt_ack1 nat_0_le)
   apply clarify
   apply (rule ballI [THEN bexI])
   apply (rule add_lt_mono [THEN lt_trans])
        apply (rule_tac [5] ack_add_bound)
          apply blast
         apply auto
   done
 
 lemma COMP_case:
  "\<lbrakk>kg\<in>nat;
      \<forall>l \<in> list(nat). g`l < ack(kg, list_add(l));
      fs \<in> list({f \<in> prim_rec .
                  \<exists>kf \<in> nat. \<forall>l \<in> list(nat).
                         f`l < ack(kf, list_add(l))})\<rbrakk>
    \<Longrightarrow> \<exists>k \<in> nat. \<forall>l \<in> list(nat). COMP(g,fs)`l < ack(k, list_add(l))"
   apply (simp add: COMP_def)
   apply (frule list_CollectD)
   apply (erule COMP_map_lemma [THEN bexE])
   apply (rule ballI [THEN bexI])
    apply (erule bspec [THEN lt_trans])
     apply (rule_tac [2] lt_trans)
      apply (rule_tac [3] ack_nest_bound)
        apply (erule_tac [2] bspec [THEN ack_lt_mono2])
          apply auto
   done
 
 text \<open>
   \medskip \<open>PREC\<close> case.
 \<close>
 
 lemma PREC_case_lemma:
  "\<lbrakk>\<forall>l \<in> list(nat). f`l #+ list_add(l) < ack(kf, list_add(l));
      \<forall>l \<in> list(nat). g`l #+ list_add(l) < ack(kg, list_add(l));
      f \<in> prim_rec;  kf\<in>nat;
      g \<in> prim_rec;  kg\<in>nat;
      l \<in> list(nat)\<rbrakk>
   \<Longrightarrow> PREC(f,g)`l #+ list_add(l) < ack(succ(kf#+kg), list_add(l))"
-  apply (unfold PREC_def)
+    unfolding PREC_def
   apply (erule list.cases)
    apply (simp add: lt_trans [OF nat_le_refl lt_ack2])
   apply simp
   apply (erule ssubst)  \<comment> \<open>get rid of the needless assumption\<close>
   apply (induct_tac a)
    apply simp_all
    txt \<open>base case\<close>
    apply (rule lt_trans, erule bspec, assumption)
    apply (simp add: add_le_self [THEN ack_lt_mono1])
   txt \<open>ind step\<close>
   apply (rule succ_leI [THEN lt_trans1])
    apply (rule_tac j = "g ` ll #+ mm" for ll mm in lt_trans1)
     apply (erule_tac [2] bspec)
     apply (rule nat_le_refl [THEN add_le_mono])
        apply typecheck
    apply (simp add: add_le_self2)
    txt \<open>final part of the simplification\<close>
   apply simp
   apply (rule add_le_self2 [THEN ack_le_mono1, THEN lt_trans1])
      apply (erule_tac [4] ack_lt_mono2)
       apply auto
   done
 
 lemma PREC_case:
    "\<lbrakk>f \<in> prim_rec;  kf\<in>nat;
        g \<in> prim_rec;  kg\<in>nat;
        \<forall>l \<in> list(nat). f`l < ack(kf, list_add(l));
        \<forall>l \<in> list(nat). g`l < ack(kg, list_add(l))\<rbrakk>
     \<Longrightarrow> \<exists>k \<in> nat. \<forall>l \<in> list(nat). PREC(f,g)`l< ack(k, list_add(l))"
   apply (rule ballI [THEN bexI])
    apply (rule lt_trans1 [OF add_le_self PREC_case_lemma])
           apply typecheck
      apply (blast intro: ack_add_bound2 list_add_type)+
   done
 
 lemma ack_bounds_prim_rec:
     "f \<in> prim_rec \<Longrightarrow> \<exists>k \<in> nat. \<forall>l \<in> list(nat). f`l < ack(k, list_add(l))"
   apply (induct set: prim_rec)
   apply (auto intro: SC_case CONSTANT_case PROJ_case COMP_case PREC_case)
   done
 
 theorem ack_not_prim_rec:
     "(\<lambda>l \<in> list(nat). list_case(0, \<lambda>x xs. ack(x,x), l)) \<notin> prim_rec"
   apply (rule notI)
   apply (drule ack_bounds_prim_rec)
   apply force
   done
 
 end
diff --git a/src/ZF/Induct/PropLog.thy b/src/ZF/Induct/PropLog.thy
--- a/src/ZF/Induct/PropLog.thy
+++ b/src/ZF/Induct/PropLog.thy
@@ -1,340 +1,340 @@
 (*  Title:      ZF/Induct/PropLog.thy
     Author:     Tobias Nipkow \<and> Lawrence C Paulson
     Copyright   1993  University of Cambridge
 *)
 
 section \<open>Meta-theory of propositional logic\<close>
 
 theory PropLog imports ZF begin
 
 text \<open>
   Datatype definition of propositional logic formulae and inductive
   definition of the propositional tautologies.
 
   Inductive definition of propositional logic.  Soundness and
   completeness w.r.t.\ truth-tables.
 
   Prove: If \<open>H |= p\<close> then \<open>G |= p\<close> where \<open>G \<in>
   Fin(H)\<close>
 \<close>
 
 
 subsection \<open>The datatype of propositions\<close>
 
 consts
   propn :: i
 
 datatype propn =
     Fls
   | Var ("n \<in> nat")    (\<open>#_\<close> [100] 100)
   | Imp ("p \<in> propn", "q \<in> propn")    (infixr \<open>\<Rightarrow>\<close> 90)
 
 
 subsection \<open>The proof system\<close>
 
 consts thms     :: "i \<Rightarrow> i"
 
 abbreviation
   thms_syntax :: "[i,i] \<Rightarrow> o"    (infixl \<open>|-\<close> 50)
   where "H |- p \<equiv> p \<in> thms(H)"
 
 inductive
   domains "thms(H)" \<subseteq> "propn"
   intros
     H:  "\<lbrakk>p \<in> H;  p \<in> propn\<rbrakk> \<Longrightarrow> H |- p"
     K:  "\<lbrakk>p \<in> propn;  q \<in> propn\<rbrakk> \<Longrightarrow> H |- p\<Rightarrow>q\<Rightarrow>p"
     S:  "\<lbrakk>p \<in> propn;  q \<in> propn;  r \<in> propn\<rbrakk>
          \<Longrightarrow> H |- (p\<Rightarrow>q\<Rightarrow>r) \<Rightarrow> (p\<Rightarrow>q) \<Rightarrow> p\<Rightarrow>r"
     DN: "p \<in> propn \<Longrightarrow> H |- ((p\<Rightarrow>Fls) \<Rightarrow> Fls) \<Rightarrow> p"
     MP: "\<lbrakk>H |- p\<Rightarrow>q;  H |- p;  p \<in> propn;  q \<in> propn\<rbrakk> \<Longrightarrow> H |- q"
   type_intros "propn.intros"
 
 declare propn.intros [simp]
 
 
 subsection \<open>The semantics\<close>
 
 subsubsection \<open>Semantics of propositional logic.\<close>
 
 consts
   is_true_fun :: "[i,i] \<Rightarrow> i"
 primrec
   "is_true_fun(Fls, t) = 0"
   "is_true_fun(Var(v), t) = (if v \<in> t then 1 else 0)"
   "is_true_fun(p\<Rightarrow>q, t) = (if is_true_fun(p,t) = 1 then is_true_fun(q,t) else 1)"
 
 definition
   is_true :: "[i,i] \<Rightarrow> o"  where
   "is_true(p,t) \<equiv> is_true_fun(p,t) = 1"
   \<comment> \<open>this definition is required since predicates can't be recursive\<close>
 
 lemma is_true_Fls [simp]: "is_true(Fls,t) \<longleftrightarrow> False"
   by (simp add: is_true_def)
 
 lemma is_true_Var [simp]: "is_true(#v,t) \<longleftrightarrow> v \<in> t"
   by (simp add: is_true_def)
 
 lemma is_true_Imp [simp]: "is_true(p\<Rightarrow>q,t) \<longleftrightarrow> (is_true(p,t)\<longrightarrow>is_true(q,t))"
   by (simp add: is_true_def)
 
 
 subsubsection \<open>Logical consequence\<close>
 
 text \<open>
   For every valuation, if all elements of \<open>H\<close> are true then so
   is \<open>p\<close>.
 \<close>
 
 definition
   logcon :: "[i,i] \<Rightarrow> o"    (infixl \<open>|=\<close> 50)  where
   "H |= p \<equiv> \<forall>t. (\<forall>q \<in> H. is_true(q,t)) \<longrightarrow> is_true(p,t)"
 
 
 text \<open>
   A finite set of hypotheses from \<open>t\<close> and the \<open>Var\<close>s in
   \<open>p\<close>.
 \<close>
 
 consts
   hyps :: "[i,i] \<Rightarrow> i"
 primrec
   "hyps(Fls, t) = 0"
   "hyps(Var(v), t) = (if v \<in> t then {#v} else {#v\<Rightarrow>Fls})"
   "hyps(p\<Rightarrow>q, t) = hyps(p,t) \<union> hyps(q,t)"
 
 
 
 subsection \<open>Proof theory of propositional logic\<close>
 
 lemma thms_mono: "G \<subseteq> H \<Longrightarrow> thms(G) \<subseteq> thms(H)"
   apply (unfold thms.defs)
   apply (rule lfp_mono)
     apply (rule thms.bnd_mono)+
   apply (assumption | rule univ_mono basic_monos)+
   done
 
 lemmas thms_in_pl = thms.dom_subset [THEN subsetD]
 
 inductive_cases ImpE: "p\<Rightarrow>q \<in> propn"
 
 lemma thms_MP: "\<lbrakk>H |- p\<Rightarrow>q;  H |- p\<rbrakk> \<Longrightarrow> H |- q"
   \<comment> \<open>Stronger Modus Ponens rule: no typechecking!\<close>
   apply (rule thms.MP)
      apply (erule asm_rl thms_in_pl thms_in_pl [THEN ImpE])+
   done
 
 lemma thms_I: "p \<in> propn \<Longrightarrow> H |- p\<Rightarrow>p"
   \<comment> \<open>Rule is called \<open>I\<close> for Identity Combinator, not for Introduction.\<close>
   apply (rule thms.S [THEN thms_MP, THEN thms_MP])
       apply (rule_tac [5] thms.K)
        apply (rule_tac [4] thms.K)
          apply simp_all
   done
 
 
 subsubsection \<open>Weakening, left and right\<close>
 
 lemma weaken_left: "\<lbrakk>G \<subseteq> H;  G|-p\<rbrakk> \<Longrightarrow> H|-p"
   \<comment> \<open>Order of premises is convenient with \<open>THEN\<close>\<close>
   by (erule thms_mono [THEN subsetD])
 
 lemma weaken_left_cons: "H |- p \<Longrightarrow> cons(a,H) |- p"
   by (erule subset_consI [THEN weaken_left])
 
 lemmas weaken_left_Un1  = Un_upper1 [THEN weaken_left]
 lemmas weaken_left_Un2  = Un_upper2 [THEN weaken_left]
 
 lemma weaken_right: "\<lbrakk>H |- q;  p \<in> propn\<rbrakk> \<Longrightarrow> H |- p\<Rightarrow>q"
   by (simp_all add: thms.K [THEN thms_MP] thms_in_pl)
 
 
 subsubsection \<open>The deduction theorem\<close>
 
 theorem deduction: "\<lbrakk>cons(p,H) |- q;  p \<in> propn\<rbrakk> \<Longrightarrow>  H |- p\<Rightarrow>q"
   apply (erule thms.induct)
       apply (blast intro: thms_I thms.H [THEN weaken_right])
      apply (blast intro: thms.K [THEN weaken_right])
     apply (blast intro: thms.S [THEN weaken_right])
    apply (blast intro: thms.DN [THEN weaken_right])
   apply (blast intro: thms.S [THEN thms_MP [THEN thms_MP]])
   done
 
 
 subsubsection \<open>The cut rule\<close>
 
 lemma cut: "\<lbrakk>H|-p;  cons(p,H) |- q\<rbrakk> \<Longrightarrow>  H |- q"
   apply (rule deduction [THEN thms_MP])
     apply (simp_all add: thms_in_pl)
   done
 
 lemma thms_FlsE: "\<lbrakk>H |- Fls; p \<in> propn\<rbrakk> \<Longrightarrow> H |- p"
   apply (rule thms.DN [THEN thms_MP])
    apply (rule_tac [2] weaken_right)
     apply (simp_all add: propn.intros)
   done
 
 lemma thms_notE: "\<lbrakk>H |- p\<Rightarrow>Fls;  H |- p;  q \<in> propn\<rbrakk> \<Longrightarrow> H |- q"
   by (erule thms_MP [THEN thms_FlsE])
 
 
 subsubsection \<open>Soundness of the rules wrt truth-table semantics\<close>
 
 theorem soundness: "H |- p \<Longrightarrow> H |= p"
-  apply (unfold logcon_def)
+    unfolding logcon_def
   apply (induct set: thms)
       apply auto
   done
 
 
 subsection \<open>Completeness\<close>
 
 subsubsection \<open>Towards the completeness proof\<close>
 
 lemma Fls_Imp: "\<lbrakk>H |- p\<Rightarrow>Fls; q \<in> propn\<rbrakk> \<Longrightarrow> H |- p\<Rightarrow>q"
   apply (frule thms_in_pl)
   apply (rule deduction)
    apply (rule weaken_left_cons [THEN thms_notE])
      apply (blast intro: thms.H elim: ImpE)+
   done
 
 lemma Imp_Fls: "\<lbrakk>H |- p;  H |- q\<Rightarrow>Fls\<rbrakk> \<Longrightarrow> H |- (p\<Rightarrow>q)\<Rightarrow>Fls"
   apply (frule thms_in_pl)
   apply (frule thms_in_pl [of concl: "q\<Rightarrow>Fls"])
   apply (rule deduction)
    apply (erule weaken_left_cons [THEN thms_MP])
    apply (rule consI1 [THEN thms.H, THEN thms_MP])
     apply (blast intro: weaken_left_cons elim: ImpE)+
   done
 
 lemma hyps_thms_if:
     "p \<in> propn \<Longrightarrow> hyps(p,t) |- (if is_true(p,t) then p else p\<Rightarrow>Fls)"
   \<comment> \<open>Typical example of strengthening the induction statement.\<close>
   apply simp
   apply (induct_tac p)
     apply (simp_all add: thms_I thms.H)
   apply (safe elim!: Fls_Imp [THEN weaken_left_Un1] Fls_Imp [THEN weaken_left_Un2])
   apply (blast intro: weaken_left_Un1 weaken_left_Un2 weaken_right Imp_Fls)+
   done
 
 lemma logcon_thms_p: "\<lbrakk>p \<in> propn;  0 |= p\<rbrakk> \<Longrightarrow> hyps(p,t) |- p"
   \<comment> \<open>Key lemma for completeness; yields a set of assumptions satisfying \<open>p\<close>\<close>
   apply (drule hyps_thms_if)
   apply (simp add: logcon_def)
   done
 
 text \<open>
   For proving certain theorems in our new propositional logic.
 \<close>
 
 lemmas propn_SIs = propn.intros deduction
   and propn_Is = thms_in_pl thms.H thms.H [THEN thms_MP]
 
 text \<open>
   The excluded middle in the form of an elimination rule.
 \<close>
 
 lemma thms_excluded_middle:
     "\<lbrakk>p \<in> propn;  q \<in> propn\<rbrakk> \<Longrightarrow> H |- (p\<Rightarrow>q) \<Rightarrow> ((p\<Rightarrow>Fls)\<Rightarrow>q) \<Rightarrow> q"
   apply (rule deduction [THEN deduction])
     apply (rule thms.DN [THEN thms_MP])
      apply (best intro!: propn_SIs intro: propn_Is)+
   done
 
 lemma thms_excluded_middle_rule:
   "\<lbrakk>cons(p,H) |- q;  cons(p\<Rightarrow>Fls,H) |- q;  p \<in> propn\<rbrakk> \<Longrightarrow> H |- q"
   \<comment> \<open>Hard to prove directly because it requires cuts\<close>
   apply (rule thms_excluded_middle [THEN thms_MP, THEN thms_MP])
      apply (blast intro!: propn_SIs intro: propn_Is)+
   done
 
 
 subsubsection \<open>Completeness -- lemmas for reducing the set of assumptions\<close>
 
 text \<open>
   For the case \<^prop>\<open>hyps(p,t)-cons(#v,Y) |- p\<close> we also have \<^prop>\<open>hyps(p,t)-{#v} \<subseteq> hyps(p, t-{v})\<close>.
 \<close>
 
 lemma hyps_Diff:
     "p \<in> propn \<Longrightarrow> hyps(p, t-{v}) \<subseteq> cons(#v\<Rightarrow>Fls, hyps(p,t)-{#v})"
   by (induct set: propn) auto
 
 text \<open>
   For the case \<^prop>\<open>hyps(p,t)-cons(#v \<Rightarrow> Fls,Y) |- p\<close> we also have
   \<^prop>\<open>hyps(p,t)-{#v\<Rightarrow>Fls} \<subseteq> hyps(p, cons(v,t))\<close>.
 \<close>
 
 lemma hyps_cons:
     "p \<in> propn \<Longrightarrow> hyps(p, cons(v,t)) \<subseteq> cons(#v, hyps(p,t)-{#v\<Rightarrow>Fls})"
   by (induct set: propn) auto
 
 text \<open>Two lemmas for use with \<open>weaken_left\<close>\<close>
 
 lemma cons_Diff_same: "B-C \<subseteq> cons(a, B-cons(a,C))"
   by blast
 
 lemma cons_Diff_subset2: "cons(a, B-{c}) - D \<subseteq> cons(a, B-cons(c,D))"
   by blast
 
 text \<open>
   The set \<^term>\<open>hyps(p,t)\<close> is finite, and elements have the form
   \<^term>\<open>#v\<close> or \<^term>\<open>#v\<Rightarrow>Fls\<close>; could probably prove the stronger
   \<^prop>\<open>hyps(p,t) \<in> Fin(hyps(p,0) \<union> hyps(p,nat))\<close>.
 \<close>
 
 lemma hyps_finite: "p \<in> propn \<Longrightarrow> hyps(p,t) \<in> Fin(\<Union>v \<in> nat. {#v, #v\<Rightarrow>Fls})"
   by (induct set: propn) auto
 
 lemmas Diff_weaken_left = Diff_mono [OF _ subset_refl, THEN weaken_left]
 
 text \<open>
   Induction on the finite set of assumptions \<^term>\<open>hyps(p,t0)\<close>.  We
   may repeatedly subtract assumptions until none are left!
 \<close>
 
 lemma completeness_0_lemma [rule_format]:
     "\<lbrakk>p \<in> propn;  0 |= p\<rbrakk> \<Longrightarrow> \<forall>t. hyps(p,t) - hyps(p,t0) |- p"
   apply (frule hyps_finite)
   apply (erule Fin_induct)
    apply (simp add: logcon_thms_p Diff_0)
   txt \<open>inductive step\<close>
   apply safe
    txt \<open>Case \<^prop>\<open>hyps(p,t)-cons(#v,Y) |- p\<close>\<close>
    apply (rule thms_excluded_middle_rule)
      apply (erule_tac [3] propn.intros)
     apply (blast intro: cons_Diff_same [THEN weaken_left])
    apply (blast intro: cons_Diff_subset2 [THEN weaken_left]
      hyps_Diff [THEN Diff_weaken_left])
   txt \<open>Case \<^prop>\<open>hyps(p,t)-cons(#v \<Rightarrow> Fls,Y) |- p\<close>\<close>
   apply (rule thms_excluded_middle_rule)
     apply (erule_tac [3] propn.intros)
    apply (blast intro: cons_Diff_subset2 [THEN weaken_left]
      hyps_cons [THEN Diff_weaken_left])
   apply (blast intro: cons_Diff_same [THEN weaken_left])
   done
 
 
 subsubsection \<open>Completeness theorem\<close>
 
 lemma completeness_0: "\<lbrakk>p \<in> propn;  0 |= p\<rbrakk> \<Longrightarrow> 0 |- p"
   \<comment> \<open>The base case for completeness\<close>
   apply (rule Diff_cancel [THEN subst])
   apply (blast intro: completeness_0_lemma)
   done
 
 lemma logcon_Imp: "\<lbrakk>cons(p,H) |= q\<rbrakk> \<Longrightarrow> H |= p\<Rightarrow>q"
   \<comment> \<open>A semantic analogue of the Deduction Theorem\<close>
   by (simp add: logcon_def)
 
 lemma completeness:
      "H \<in> Fin(propn) \<Longrightarrow> p \<in> propn \<Longrightarrow> H |= p \<Longrightarrow> H |- p"
   apply (induct arbitrary: p set: Fin)
    apply (safe intro!: completeness_0)
   apply (rule weaken_left_cons [THEN thms_MP])
    apply (blast intro!: logcon_Imp propn.intros)
   apply (blast intro: propn_Is)
   done
 
 theorem thms_iff: "H \<in> Fin(propn) \<Longrightarrow> H |- p \<longleftrightarrow> H |= p \<and> p \<in> propn"
   by (blast intro: soundness completeness thms_in_pl)
 
 end
diff --git a/src/ZF/Induct/Rmap.thy b/src/ZF/Induct/Rmap.thy
--- a/src/ZF/Induct/Rmap.thy
+++ b/src/ZF/Induct/Rmap.thy
@@ -1,70 +1,70 @@
 (*  Title:      ZF/Induct/Rmap.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section \<open>An operator to ``map'' a relation over a list\<close>
 
 theory Rmap imports ZF begin
 
 consts
   rmap :: "i\<Rightarrow>i"
 
 inductive
   domains "rmap(r)" \<subseteq> "list(domain(r)) \<times> list(range(r))"
   intros
     NilI:  "\<langle>Nil,Nil\<rangle> \<in> rmap(r)"
 
     ConsI: "\<lbrakk>\<langle>x,y\<rangle>: r;  \<langle>xs,ys\<rangle> \<in> rmap(r)\<rbrakk>
             \<Longrightarrow> <Cons(x,xs), Cons(y,ys)> \<in> rmap(r)"
 
   type_intros domainI rangeI list.intros
 
 lemma rmap_mono: "r \<subseteq> s \<Longrightarrow> rmap(r) \<subseteq> rmap(s)"
   apply (unfold rmap.defs)
   apply (rule lfp_mono)
     apply (rule rmap.bnd_mono)+
   apply (assumption | rule Sigma_mono list_mono domain_mono range_mono basic_monos)+
   done
 
 inductive_cases
       Nil_rmap_case [elim!]: "\<langle>Nil,zs\<rangle> \<in> rmap(r)"
   and Cons_rmap_case [elim!]: "<Cons(x,xs),zs> \<in> rmap(r)"
 
 declare rmap.intros [intro]
 
 lemma rmap_rel_type: "r \<subseteq> A \<times> B \<Longrightarrow> rmap(r) \<subseteq> list(A) \<times> list(B)"
   apply (rule rmap.dom_subset [THEN subset_trans])
   apply (assumption |
     rule domain_rel_subset range_rel_subset Sigma_mono list_mono)+
   done
 
 lemma rmap_total: "A \<subseteq> domain(r) \<Longrightarrow> list(A) \<subseteq> domain(rmap(r))"
   apply (rule subsetI)
   apply (erule list.induct)
    apply blast+
   done
 
 lemma rmap_functional: "function(r) \<Longrightarrow> function(rmap(r))"
-  apply (unfold function_def)
+    unfolding function_def
   apply (rule impI [THEN allI, THEN allI])
   apply (erule rmap.induct)
    apply blast+
   done
 
 text \<open>
   \medskip If \<open>f\<close> is a function then \<open>rmap(f)\<close> behaves
   as expected.
 \<close>
 
 lemma rmap_fun_type: "f \<in> A->B \<Longrightarrow> rmap(f): list(A)->list(B)"
   by (simp add: Pi_iff rmap_rel_type rmap_functional rmap_total)
 
 lemma rmap_Nil: "rmap(f)`Nil = Nil"
   by (unfold apply_def) blast
 
 lemma rmap_Cons: "\<lbrakk>f \<in> A->B;  x \<in> A;  xs: list(A)\<rbrakk>
       \<Longrightarrow> rmap(f) ` Cons(x,xs) = Cons(f`x, rmap(f)`xs)"
   by (blast intro: apply_equality apply_Pair rmap_fun_type rmap.intros)
 
 end
diff --git a/src/ZF/Induct/Term.thy b/src/ZF/Induct/Term.thy
--- a/src/ZF/Induct/Term.thy
+++ b/src/ZF/Induct/Term.thy
@@ -1,284 +1,284 @@
 (*  Title:      ZF/Induct/Term.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section \<open>Terms over an alphabet\<close>
 
 theory Term imports ZF begin
 
 text \<open>
   Illustrates the list functor (essentially the same type as in \<open>Trees_Forest\<close>).
 \<close>
 
 consts
   "term" :: "i \<Rightarrow> i"
 
 datatype "term(A)" = Apply ("a \<in> A", "l \<in> list(term(A))")
   monos list_mono
   type_elims list_univ [THEN subsetD, elim_format]
 
 declare Apply [TC]
 
 definition
   term_rec :: "[i, [i, i, i] \<Rightarrow> i] \<Rightarrow> i"  where
   "term_rec(t,d) \<equiv>
     Vrec(t, \<lambda>t g. term_case(\<lambda>x zs. d(x, zs, map(\<lambda>z. g`z, zs)), t))"
 
 definition
   term_map :: "[i \<Rightarrow> i, i] \<Rightarrow> i"  where
   "term_map(f,t) \<equiv> term_rec(t, \<lambda>x zs rs. Apply(f(x), rs))"
 
 definition
   term_size :: "i \<Rightarrow> i"  where
   "term_size(t) \<equiv> term_rec(t, \<lambda>x zs rs. succ(list_add(rs)))"
 
 definition
   reflect :: "i \<Rightarrow> i"  where
   "reflect(t) \<equiv> term_rec(t, \<lambda>x zs rs. Apply(x, rev(rs)))"
 
 definition
   preorder :: "i \<Rightarrow> i"  where
   "preorder(t) \<equiv> term_rec(t, \<lambda>x zs rs. Cons(x, flat(rs)))"
 
 definition
   postorder :: "i \<Rightarrow> i"  where
   "postorder(t) \<equiv> term_rec(t, \<lambda>x zs rs. flat(rs) @ [x])"
 
 lemma term_unfold: "term(A) = A * list(term(A))"
   by (fast intro!: term.intros [unfolded term.con_defs]
     elim: term.cases [unfolded term.con_defs])
 
 lemma term_induct2:
   "\<lbrakk>t \<in> term(A);
       \<And>x.      \<lbrakk>x \<in> A\<rbrakk> \<Longrightarrow> P(Apply(x,Nil));
       \<And>x z zs. \<lbrakk>x \<in> A;  z \<in> term(A);  zs: list(term(A));  P(Apply(x,zs))
 \<rbrakk> \<Longrightarrow> P(Apply(x, Cons(z,zs)))
 \<rbrakk> \<Longrightarrow> P(t)"
   \<comment> \<open>Induction on \<^term>\<open>term(A)\<close> followed by induction on \<^term>\<open>list\<close>.\<close>
   apply (induct_tac t)
   apply (erule list.induct)
    apply (auto dest: list_CollectD)
   done
 
 lemma term_induct_eqn [consumes 1, case_names Apply]:
   "\<lbrakk>t \<in> term(A);
       \<And>x zs. \<lbrakk>x \<in> A;  zs: list(term(A));  map(f,zs) = map(g,zs)\<rbrakk> \<Longrightarrow>
               f(Apply(x,zs)) = g(Apply(x,zs))
 \<rbrakk> \<Longrightarrow> f(t) = g(t)"
   \<comment> \<open>Induction on \<^term>\<open>term(A)\<close> to prove an equation.\<close>
   apply (induct_tac t)
   apply (auto dest: map_list_Collect list_CollectD)
   done
 
 text \<open>
   \medskip Lemmas to justify using \<^term>\<open>term\<close> in other recursive
   type definitions.
 \<close>
 
 lemma term_mono: "A \<subseteq> B \<Longrightarrow> term(A) \<subseteq> term(B)"
   apply (unfold term.defs)
   apply (rule lfp_mono)
     apply (rule term.bnd_mono)+
   apply (rule univ_mono basic_monos| assumption)+
   done
 
 lemma term_univ: "term(univ(A)) \<subseteq> univ(A)"
   \<comment> \<open>Easily provable by induction also\<close>
   apply (unfold term.defs term.con_defs)
   apply (rule lfp_lowerbound)
    apply (rule_tac [2] A_subset_univ [THEN univ_mono])
   apply safe
   apply (assumption | rule Pair_in_univ list_univ [THEN subsetD])+
   done
 
 lemma term_subset_univ: "A \<subseteq> univ(B) \<Longrightarrow> term(A) \<subseteq> univ(B)"
   apply (rule subset_trans)
    apply (erule term_mono)
   apply (rule term_univ)
   done
 
 lemma term_into_univ: "\<lbrakk>t \<in> term(A);  A \<subseteq> univ(B)\<rbrakk> \<Longrightarrow> t \<in> univ(B)"
   by (rule term_subset_univ [THEN subsetD])
 
 text \<open>
   \medskip \<open>term_rec\<close> -- by \<open>Vset\<close> recursion.
 \<close>
 
 lemma map_lemma: "\<lbrakk>l \<in> list(A);  Ord(i);  rank(l)<i\<rbrakk>
     \<Longrightarrow> map(\<lambda>z. (\<lambda>x \<in> Vset(i).h(x)) ` z, l) = map(h,l)"
   \<comment> \<open>\<^term>\<open>map\<close> works correctly on the underlying list of terms.\<close>
   apply (induct set: list)
    apply simp
   apply (subgoal_tac "rank (a) <i \<and> rank (l) < i")
    apply (simp add: rank_of_Ord)
   apply (simp add: list.con_defs)
   apply (blast dest: rank_rls [THEN lt_trans])
   done
 
 lemma term_rec [simp]: "ts \<in> list(A) \<Longrightarrow>
   term_rec(Apply(a,ts), d) = d(a, ts, map (\<lambda>z. term_rec(z,d), ts))"
   \<comment> \<open>Typing premise is necessary to invoke \<open>map_lemma\<close>.\<close>
   apply (rule term_rec_def [THEN def_Vrec, THEN trans])
   apply (unfold term.con_defs)
   apply (simp add: rank_pair2 map_lemma)
   done
 
 lemma term_rec_type:
   assumes t: "t \<in> term(A)"
     and a: "\<And>x zs r. \<lbrakk>x \<in> A;  zs: list(term(A));
                    r \<in> list(\<Union>t \<in> term(A). C(t))\<rbrakk>
                 \<Longrightarrow> d(x, zs, r): C(Apply(x,zs))"
   shows "term_rec(t,d) \<in> C(t)"
   \<comment> \<open>Slightly odd typing condition on \<open>r\<close> in the second premise!\<close>
   using t
   apply induct
   apply (frule list_CollectD)
   apply (subst term_rec)
    apply (assumption | rule a)+
   apply (erule list.induct)
    apply auto
   done
 
 lemma def_term_rec:
   "\<lbrakk>\<And>t. j(t)\<equiv>term_rec(t,d);  ts: list(A)\<rbrakk> \<Longrightarrow>
     j(Apply(a,ts)) = d(a, ts, map(\<lambda>Z. j(Z), ts))"
   apply (simp only:)
   apply (erule term_rec)
   done
 
 lemma term_rec_simple_type [TC]:
   "\<lbrakk>t \<in> term(A);
       \<And>x zs r. \<lbrakk>x \<in> A;  zs: list(term(A));  r \<in> list(C)\<rbrakk>
                 \<Longrightarrow> d(x, zs, r): C
 \<rbrakk> \<Longrightarrow> term_rec(t,d) \<in> C"
   apply (erule term_rec_type)
   apply (drule subset_refl [THEN UN_least, THEN list_mono, THEN subsetD])
   apply simp
   done
 
 
 text \<open>
   \medskip \<^term>\<open>term_map\<close>.
 \<close>
 
 lemma term_map [simp]:
   "ts \<in> list(A) \<Longrightarrow>
     term_map(f, Apply(a, ts)) = Apply(f(a), map(term_map(f), ts))"
   by (rule term_map_def [THEN def_term_rec])
 
 lemma term_map_type [TC]:
     "\<lbrakk>t \<in> term(A);  \<And>x. x \<in> A \<Longrightarrow> f(x): B\<rbrakk> \<Longrightarrow> term_map(f,t) \<in> term(B)"
-  apply (unfold term_map_def)
+    unfolding term_map_def
   apply (erule term_rec_simple_type)
   apply fast
   done
 
 lemma term_map_type2 [TC]:
     "t \<in> term(A) \<Longrightarrow> term_map(f,t) \<in> term({f(u). u \<in> A})"
   apply (erule term_map_type)
   apply (erule RepFunI)
   done
 
 text \<open>
   \medskip \<^term>\<open>term_size\<close>.
 \<close>
 
 lemma term_size [simp]:
     "ts \<in> list(A) \<Longrightarrow> term_size(Apply(a, ts)) = succ(list_add(map(term_size, ts)))"
   by (rule term_size_def [THEN def_term_rec])
 
 lemma term_size_type [TC]: "t \<in> term(A) \<Longrightarrow> term_size(t) \<in> nat"
   by (auto simp add: term_size_def)
 
 
 text \<open>
   \medskip \<open>reflect\<close>.
 \<close>
 
 lemma reflect [simp]:
     "ts \<in> list(A) \<Longrightarrow> reflect(Apply(a, ts)) = Apply(a, rev(map(reflect, ts)))"
   by (rule reflect_def [THEN def_term_rec])
 
 lemma reflect_type [TC]: "t \<in> term(A) \<Longrightarrow> reflect(t) \<in> term(A)"
   by (auto simp add: reflect_def)
 
 
 text \<open>
   \medskip \<open>preorder\<close>.
 \<close>
 
 lemma preorder [simp]:
     "ts \<in> list(A) \<Longrightarrow> preorder(Apply(a, ts)) = Cons(a, flat(map(preorder, ts)))"
   by (rule preorder_def [THEN def_term_rec])
 
 lemma preorder_type [TC]: "t \<in> term(A) \<Longrightarrow> preorder(t) \<in> list(A)"
   by (simp add: preorder_def)
 
 
 text \<open>
   \medskip \<open>postorder\<close>.
 \<close>
 
 lemma postorder [simp]:
     "ts \<in> list(A) \<Longrightarrow> postorder(Apply(a, ts)) = flat(map(postorder, ts)) @ [a]"
   by (rule postorder_def [THEN def_term_rec])
 
 lemma postorder_type [TC]: "t \<in> term(A) \<Longrightarrow> postorder(t) \<in> list(A)"
   by (simp add: postorder_def)
 
 
 text \<open>
   \medskip Theorems about \<open>term_map\<close>.
 \<close>
 
 declare map_compose [simp]
 
 lemma term_map_ident: "t \<in> term(A) \<Longrightarrow> term_map(\<lambda>u. u, t) = t"
   by (induct rule: term_induct_eqn) simp
 
 lemma term_map_compose:
     "t \<in> term(A) \<Longrightarrow> term_map(f, term_map(g,t)) = term_map(\<lambda>u. f(g(u)), t)"
   by (induct rule: term_induct_eqn) simp
 
 lemma term_map_reflect:
     "t \<in> term(A) \<Longrightarrow> term_map(f, reflect(t)) = reflect(term_map(f,t))"
   by (induct rule: term_induct_eqn) (simp add: rev_map_distrib [symmetric])
 
 
 text \<open>
   \medskip Theorems about \<open>term_size\<close>.
 \<close>
 
 lemma term_size_term_map: "t \<in> term(A) \<Longrightarrow> term_size(term_map(f,t)) = term_size(t)"
   by (induct rule: term_induct_eqn) simp
 
 lemma term_size_reflect: "t \<in> term(A) \<Longrightarrow> term_size(reflect(t)) = term_size(t)"
   by (induct rule: term_induct_eqn) (simp add: rev_map_distrib [symmetric] list_add_rev)
 
 lemma term_size_length: "t \<in> term(A) \<Longrightarrow> term_size(t) = length(preorder(t))"
   by (induct rule: term_induct_eqn) (simp add: length_flat)
 
 
 text \<open>
   \medskip Theorems about \<open>reflect\<close>.
 \<close>
 
 lemma reflect_reflect_ident: "t \<in> term(A) \<Longrightarrow> reflect(reflect(t)) = t"
   by (induct rule: term_induct_eqn) (simp add: rev_map_distrib)
 
 
 text \<open>
   \medskip Theorems about preorder.
 \<close>
 
 lemma preorder_term_map:
     "t \<in> term(A) \<Longrightarrow> preorder(term_map(f,t)) = map(f, preorder(t))"
   by (induct rule: term_induct_eqn) (simp add: map_flat)
 
 lemma preorder_reflect_eq_rev_postorder:
     "t \<in> term(A) \<Longrightarrow> preorder(reflect(t)) = rev(postorder(t))"
   by (induct rule: term_induct_eqn)
     (simp add: rev_app_distrib rev_flat rev_map_distrib [symmetric])
 
 end
diff --git a/src/ZF/Induct/Tree_Forest.thy b/src/ZF/Induct/Tree_Forest.thy
--- a/src/ZF/Induct/Tree_Forest.thy
+++ b/src/ZF/Induct/Tree_Forest.thy
@@ -1,251 +1,251 @@
 (*  Title:      ZF/Induct/Tree_Forest.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section \<open>Trees and forests, a mutually recursive type definition\<close>
 
 theory Tree_Forest imports ZF begin
 
 subsection \<open>Datatype definition\<close>
 
 consts
   tree :: "i \<Rightarrow> i"
   forest :: "i \<Rightarrow> i"
   tree_forest :: "i \<Rightarrow> i"
 
 datatype "tree(A)" = Tcons ("a \<in> A", "f \<in> forest(A)")
   and "forest(A)" = Fnil | Fcons ("t \<in> tree(A)", "f \<in> forest(A)")
 
 (* FIXME *)
 lemmas tree'induct =
     tree_forest.mutual_induct [THEN conjunct1, THEN spec, THEN [2] rev_mp, of concl: _ t, consumes 1]
   and forest'induct =
     tree_forest.mutual_induct [THEN conjunct2, THEN spec, THEN [2] rev_mp, of concl: _ f, consumes 1]
   for t f
 
 declare tree_forest.intros [simp, TC]
 
 lemma tree_def: "tree(A) \<equiv> Part(tree_forest(A), Inl)"
   by (simp only: tree_forest.defs)
 
 lemma forest_def: "forest(A) \<equiv> Part(tree_forest(A), Inr)"
   by (simp only: tree_forest.defs)
 
 
 text \<open>
   \medskip \<^term>\<open>tree_forest(A)\<close> as the union of \<^term>\<open>tree(A)\<close>
   and \<^term>\<open>forest(A)\<close>.
 \<close>
 
 lemma tree_subset_TF: "tree(A) \<subseteq> tree_forest(A)"
   apply (unfold tree_forest.defs)
   apply (rule Part_subset)
   done
 
 lemma treeI [TC]: "x \<in> tree(A) \<Longrightarrow> x \<in> tree_forest(A)"
   by (rule tree_subset_TF [THEN subsetD])
 
 lemma forest_subset_TF: "forest(A) \<subseteq> tree_forest(A)"
   apply (unfold tree_forest.defs)
   apply (rule Part_subset)
   done
 
 lemma treeI' [TC]: "x \<in> forest(A) \<Longrightarrow> x \<in> tree_forest(A)"
   by (rule forest_subset_TF [THEN subsetD])
 
 lemma TF_equals_Un: "tree(A) \<union> forest(A) = tree_forest(A)"
   apply (insert tree_subset_TF forest_subset_TF)
   apply (auto intro!: equalityI tree_forest.intros elim: tree_forest.cases)
   done
 
 lemma tree_forest_unfold:
   "tree_forest(A) = (A \<times> forest(A)) + ({0} + tree(A) \<times> forest(A))"
     \<comment> \<open>NOT useful, but interesting \dots\<close>
   supply rews = tree_forest.con_defs tree_def forest_def
   apply (unfold tree_def forest_def)
   apply (fast intro!: tree_forest.intros [unfolded rews, THEN PartD1]
     elim: tree_forest.cases [unfolded rews])
   done
 
 lemma tree_forest_unfold':
   "tree_forest(A) =
     A \<times> Part(tree_forest(A), \<lambda>w. Inr(w)) +
     {0} + Part(tree_forest(A), \<lambda>w. Inl(w)) * Part(tree_forest(A), \<lambda>w. Inr(w))"
   by (rule tree_forest_unfold [unfolded tree_def forest_def])
 
 lemma tree_unfold: "tree(A) = {Inl(x). x \<in> A \<times> forest(A)}"
   apply (unfold tree_def forest_def)
   apply (rule Part_Inl [THEN subst])
   apply (rule tree_forest_unfold' [THEN subst_context])
   done
 
 lemma forest_unfold: "forest(A) = {Inr(x). x \<in> {0} + tree(A)*forest(A)}"
   apply (unfold tree_def forest_def)
   apply (rule Part_Inr [THEN subst])
   apply (rule tree_forest_unfold' [THEN subst_context])
   done
 
 text \<open>
   \medskip Type checking for recursor: Not needed; possibly interesting?
 \<close>
 
 lemma TF_rec_type:
   "\<lbrakk>z \<in> tree_forest(A);
       \<And>x f r. \<lbrakk>x \<in> A;  f \<in> forest(A);  r \<in> C(f)
 \<rbrakk> \<Longrightarrow> b(x,f,r) \<in> C(Tcons(x,f));
       c \<in> C(Fnil);
       \<And>t f r1 r2. \<lbrakk>t \<in> tree(A);  f \<in> forest(A);  r1 \<in> C(t); r2 \<in> C(f)
 \<rbrakk> \<Longrightarrow> d(t,f,r1,r2) \<in> C(Fcons(t,f))
 \<rbrakk> \<Longrightarrow> tree_forest_rec(b,c,d,z) \<in> C(z)"
   by (induct_tac z) simp_all
 
 lemma tree_forest_rec_type:
   "\<lbrakk>\<And>x f r. \<lbrakk>x \<in> A;  f \<in> forest(A);  r \<in> D(f)
 \<rbrakk> \<Longrightarrow> b(x,f,r) \<in> C(Tcons(x,f));
       c \<in> D(Fnil);
       \<And>t f r1 r2. \<lbrakk>t \<in> tree(A);  f \<in> forest(A);  r1 \<in> C(t); r2 \<in> D(f)
 \<rbrakk> \<Longrightarrow> d(t,f,r1,r2) \<in> D(Fcons(t,f))
 \<rbrakk> \<Longrightarrow> (\<forall>t \<in> tree(A).    tree_forest_rec(b,c,d,t) \<in> C(t)) \<and>
           (\<forall>f \<in> forest(A). tree_forest_rec(b,c,d,f) \<in> D(f))"
     \<comment> \<open>Mutually recursive version.\<close>
-  apply (unfold Ball_def)
+    unfolding Ball_def
   apply (rule tree_forest.mutual_induct)
   apply simp_all
   done
 
 
 subsection \<open>Operations\<close>
 
 consts
   map :: "[i \<Rightarrow> i, i] \<Rightarrow> i"
   size :: "i \<Rightarrow> i"
   preorder :: "i \<Rightarrow> i"
   list_of_TF :: "i \<Rightarrow> i"
   of_list :: "i \<Rightarrow> i"
   reflect :: "i \<Rightarrow> i"
 
 primrec
   "list_of_TF (Tcons(x,f)) = [Tcons(x,f)]"
   "list_of_TF (Fnil) = []"
   "list_of_TF (Fcons(t,tf)) = Cons (t, list_of_TF(tf))"
 
 primrec
   "of_list([]) = Fnil"
   "of_list(Cons(t,l)) = Fcons(t, of_list(l))"
 
 primrec
   "map (h, Tcons(x,f)) = Tcons(h(x), map(h,f))"
   "map (h, Fnil) = Fnil"
   "map (h, Fcons(t,tf)) = Fcons (map(h, t), map(h, tf))"
 
 primrec
   "size (Tcons(x,f)) = succ(size(f))"
   "size (Fnil) = 0"
   "size (Fcons(t,tf)) = size(t) #+ size(tf)"
 
 primrec
   "preorder (Tcons(x,f)) = Cons(x, preorder(f))"
   "preorder (Fnil) = Nil"
   "preorder (Fcons(t,tf)) = preorder(t) @ preorder(tf)"
 
 primrec
   "reflect (Tcons(x,f)) = Tcons(x, reflect(f))"
   "reflect (Fnil) = Fnil"
   "reflect (Fcons(t,tf)) =
     of_list (list_of_TF (reflect(tf)) @ Cons(reflect(t), Nil))"
 
 
 text \<open>
   \medskip \<open>list_of_TF\<close> and \<open>of_list\<close>.
 \<close>
 
 lemma list_of_TF_type [TC]:
     "z \<in> tree_forest(A) \<Longrightarrow> list_of_TF(z) \<in> list(tree(A))"
   by (induct set: tree_forest) simp_all
 
 lemma of_list_type [TC]: "l \<in> list(tree(A)) \<Longrightarrow> of_list(l) \<in> forest(A)"
   by (induct set: list) simp_all
 
 text \<open>
   \medskip \<open>map\<close>.
 \<close>
 
 lemma
   assumes "\<And>x. x \<in> A \<Longrightarrow> h(x): B"
   shows map_tree_type: "t \<in> tree(A) \<Longrightarrow> map(h,t) \<in> tree(B)"
     and map_forest_type: "f \<in> forest(A) \<Longrightarrow> map(h,f) \<in> forest(B)"
   using assms
   by (induct rule: tree'induct forest'induct) simp_all
 
 text \<open>
   \medskip \<open>size\<close>.
 \<close>
 
 lemma size_type [TC]: "z \<in> tree_forest(A) \<Longrightarrow> size(z) \<in> nat"
   by (induct set: tree_forest) simp_all
 
 
 text \<open>
   \medskip \<open>preorder\<close>.
 \<close>
 
 lemma preorder_type [TC]: "z \<in> tree_forest(A) \<Longrightarrow> preorder(z) \<in> list(A)"
   by (induct set: tree_forest) simp_all
 
 
 text \<open>
   \medskip Theorems about \<open>list_of_TF\<close> and \<open>of_list\<close>.
 \<close>
 
 lemma forest_induct [consumes 1, case_names Fnil Fcons]:
   "\<lbrakk>f \<in> forest(A);
       R(Fnil);
       \<And>t f. \<lbrakk>t \<in> tree(A);  f \<in> forest(A);  R(f)\<rbrakk> \<Longrightarrow> R(Fcons(t,f))
 \<rbrakk> \<Longrightarrow> R(f)"
   \<comment> \<open>Essentially the same as list induction.\<close>
   apply (erule tree_forest.mutual_induct
       [THEN conjunct2, THEN spec, THEN [2] rev_mp])
     apply (rule TrueI)
    apply simp
   apply simp
   done
 
 lemma forest_iso: "f \<in> forest(A) \<Longrightarrow> of_list(list_of_TF(f)) = f"
   by (induct rule: forest_induct) simp_all
 
 lemma tree_list_iso: "ts: list(tree(A)) \<Longrightarrow> list_of_TF(of_list(ts)) = ts"
   by (induct set: list) simp_all
 
 
 text \<open>
   \medskip Theorems about \<open>map\<close>.
 \<close>
 
 lemma map_ident: "z \<in> tree_forest(A) \<Longrightarrow> map(\<lambda>u. u, z) = z"
   by (induct set: tree_forest) simp_all
 
 lemma map_compose:
     "z \<in> tree_forest(A) \<Longrightarrow> map(h, map(j,z)) = map(\<lambda>u. h(j(u)), z)"
   by (induct set: tree_forest) simp_all
 
 
 text \<open>
   \medskip Theorems about \<open>size\<close>.
 \<close>
 
 lemma size_map: "z \<in> tree_forest(A) \<Longrightarrow> size(map(h,z)) = size(z)"
   by (induct set: tree_forest) simp_all
 
 lemma size_length: "z \<in> tree_forest(A) \<Longrightarrow> size(z) = length(preorder(z))"
   by (induct set: tree_forest) (simp_all add: length_app)
 
 text \<open>
   \medskip Theorems about \<open>preorder\<close>.
 \<close>
 
 lemma preorder_map:
     "z \<in> tree_forest(A) \<Longrightarrow> preorder(map(h,z)) = List.map(h, preorder(z))"
   by (induct set: tree_forest) (simp_all add: map_app_distrib)
 
 end
diff --git a/src/ZF/IntDiv.thy b/src/ZF/IntDiv.thy
--- a/src/ZF/IntDiv.thy
+++ b/src/ZF/IntDiv.thy
@@ -1,1771 +1,1771 @@
 (*  Title:      ZF/IntDiv.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1999  University of Cambridge
 
 Here is the division algorithm in ML:
 
     fun posDivAlg (a,b) =
       if a<b then (0,a)
       else let val (q,r) = posDivAlg(a, 2*b)
                in  if 0<=r-b then (2*q+1, r-b) else (2*q, r)
            end
 
     fun negDivAlg (a,b) =
       if 0<=a+b then (\<not>1,a+b)
       else let val (q,r) = negDivAlg(a, 2*b)
                in  if 0<=r-b then (2*q+1, r-b) else (2*q, r)
            end;
 
     fun negateSnd (q,r:int) = (q,\<not>r);
 
     fun divAlg (a,b) = if 0<=a then
                           if b>0 then posDivAlg (a,b)
                            else if a=0 then (0,0)
                                 else negateSnd (negDivAlg (\<not>a,\<not>b))
                        else
                           if 0<b then negDivAlg (a,b)
                           else        negateSnd (posDivAlg (\<not>a,\<not>b));
 *)
 
 section\<open>The Division Operators Div and Mod\<close>
 
 theory IntDiv
 imports Bin OrderArith
 begin
 
 definition
   quorem :: "[i,i] \<Rightarrow> o"  where
     "quorem \<equiv> \<lambda>\<langle>a,b\<rangle> \<langle>q,r\<rangle>.
                       a = b$*q $+ r \<and>
                       (#0$<b \<and> #0$\<le>r \<and> r$<b | \<not>(#0$<b) \<and> b$<r \<and> r $\<le> #0)"
 
 definition
   adjust :: "[i,i] \<Rightarrow> i"  where
     "adjust(b) \<equiv> \<lambda>\<langle>q,r\<rangle>. if #0 $\<le> r$-b then <#2$*q $+ #1,r$-b>
                           else <#2$*q,r>"
 
 
 (** the division algorithm **)
 
 definition
   posDivAlg :: "i \<Rightarrow> i"  where
 (*for the case a>=0, b>0*)
 (*recdef posDivAlg "inv_image less_than (\<lambda>\<langle>a,b\<rangle>. nat_of(a $- b $+ #1))"*)
     "posDivAlg(ab) \<equiv>
        wfrec(measure(int*int, \<lambda>\<langle>a,b\<rangle>. nat_of (a $- b $+ #1)),
              ab,
              \<lambda>\<langle>a,b\<rangle> f. if (a$<b | b$\<le>#0) then <#0,a>
                        else adjust(b, f ` <a,#2$*b>))"
 
 
 (*for the case a\<langle>0, b\<rangle>0*)
 definition
   negDivAlg :: "i \<Rightarrow> i"  where
 (*recdef negDivAlg "inv_image less_than (\<lambda>\<langle>a,b\<rangle>. nat_of(- a $- b))"*)
     "negDivAlg(ab) \<equiv>
        wfrec(measure(int*int, \<lambda>\<langle>a,b\<rangle>. nat_of ($- a $- b)),
              ab,
              \<lambda>\<langle>a,b\<rangle> f. if (#0 $\<le> a$+b | b$\<le>#0) then <#-1,a$+b>
                        else adjust(b, f ` <a,#2$*b>))"
 
 (*for the general case @{term"b\<noteq>0"}*)
 
 definition
   negateSnd :: "i \<Rightarrow> i"  where
     "negateSnd \<equiv> \<lambda>\<langle>q,r\<rangle>. <q, $-r>"
 
   (*The full division algorithm considers all possible signs for a, b
     including the special case a=0, b<0, because negDivAlg requires a<0*)
 definition
   divAlg :: "i \<Rightarrow> i"  where
     "divAlg \<equiv>
        \<lambda>\<langle>a,b\<rangle>. if #0 $\<le> a then
                   if #0 $\<le> b then posDivAlg (\<langle>a,b\<rangle>)
                   else if a=#0 then <#0,#0>
                        else negateSnd (negDivAlg (<$-a,$-b>))
                else
                   if #0$<b then negDivAlg (\<langle>a,b\<rangle>)
                   else         negateSnd (posDivAlg (<$-a,$-b>))"
 
 definition
   zdiv  :: "[i,i]\<Rightarrow>i"                    (infixl \<open>zdiv\<close> 70)  where
     "a zdiv b \<equiv> fst (divAlg (<intify(a), intify(b)>))"
 
 definition
   zmod  :: "[i,i]\<Rightarrow>i"                    (infixl \<open>zmod\<close> 70)  where
     "a zmod b \<equiv> snd (divAlg (<intify(a), intify(b)>))"
 
 
 (** Some basic laws by Sidi Ehmety (need linear arithmetic!) **)
 
 lemma zspos_add_zspos_imp_zspos: "\<lbrakk>#0 $< x;  #0 $< y\<rbrakk> \<Longrightarrow> #0 $< x $+ y"
 apply (rule_tac y = "y" in zless_trans)
 apply (rule_tac [2] zdiff_zless_iff [THEN iffD1])
 apply auto
 done
 
 lemma zpos_add_zpos_imp_zpos: "\<lbrakk>#0 $\<le> x;  #0 $\<le> y\<rbrakk> \<Longrightarrow> #0 $\<le> x $+ y"
 apply (rule_tac y = "y" in zle_trans)
 apply (rule_tac [2] zdiff_zle_iff [THEN iffD1])
 apply auto
 done
 
 lemma zneg_add_zneg_imp_zneg: "\<lbrakk>x $< #0;  y $< #0\<rbrakk> \<Longrightarrow> x $+ y $< #0"
 apply (rule_tac y = "y" in zless_trans)
 apply (rule zless_zdiff_iff [THEN iffD1])
 apply auto
 done
 
 (* this theorem is used below *)
 lemma zneg_or_0_add_zneg_or_0_imp_zneg_or_0:
      "\<lbrakk>x $\<le> #0;  y $\<le> #0\<rbrakk> \<Longrightarrow> x $+ y $\<le> #0"
 apply (rule_tac y = "y" in zle_trans)
 apply (rule zle_zdiff_iff [THEN iffD1])
 apply auto
 done
 
 lemma zero_lt_zmagnitude: "\<lbrakk>#0 $< k; k \<in> int\<rbrakk> \<Longrightarrow> 0 < zmagnitude(k)"
 apply (drule zero_zless_imp_znegative_zminus)
 apply (drule_tac [2] zneg_int_of)
 apply (auto simp add: zminus_equation [of k])
 apply (subgoal_tac "0 < zmagnitude ($# succ (n))")
  apply simp
 apply (simp only: zmagnitude_int_of)
 apply simp
 done
 
 
 (*** Inequality lemmas involving $#succ(m) ***)
 
 lemma zless_add_succ_iff:
      "(w $< z $+ $# succ(m)) \<longleftrightarrow> (w $< z $+ $#m | intify(w) = z $+ $#m)"
 apply (auto simp add: zless_iff_succ_zadd zadd_assoc int_of_add [symmetric])
 apply (rule_tac [3] x = "0" in bexI)
 apply (cut_tac m = "m" in int_succ_int_1)
 apply (cut_tac m = "n" in int_succ_int_1)
 apply simp
 apply (erule natE)
 apply auto
 apply (rule_tac x = "succ (n) " in bexI)
 apply auto
 done
 
 lemma zadd_succ_lemma:
      "z \<in> int \<Longrightarrow> (w $+ $# succ(m) $\<le> z) \<longleftrightarrow> (w $+ $#m $< z)"
 apply (simp only: not_zless_iff_zle [THEN iff_sym] zless_add_succ_iff)
 apply (auto intro: zle_anti_sym elim: zless_asym
             simp add: zless_imp_zle not_zless_iff_zle)
 done
 
 lemma zadd_succ_zle_iff: "(w $+ $# succ(m) $\<le> z) \<longleftrightarrow> (w $+ $#m $< z)"
 apply (cut_tac z = "intify (z)" in zadd_succ_lemma)
 apply auto
 done
 
 (** Inequality reasoning **)
 
 lemma zless_add1_iff_zle: "(w $< z $+ #1) \<longleftrightarrow> (w$\<le>z)"
 apply (subgoal_tac "#1 = $# 1")
 apply (simp only: zless_add_succ_iff zle_def)
 apply auto
 done
 
 lemma add1_zle_iff: "(w $+ #1 $\<le> z) \<longleftrightarrow> (w $< z)"
 apply (subgoal_tac "#1 = $# 1")
 apply (simp only: zadd_succ_zle_iff)
 apply auto
 done
 
 lemma add1_left_zle_iff: "(#1 $+ w $\<le> z) \<longleftrightarrow> (w $< z)"
 apply (subst zadd_commute)
 apply (rule add1_zle_iff)
 done
 
 
 (*** Monotonicity of Multiplication ***)
 
 lemma zmult_mono_lemma: "k \<in> nat \<Longrightarrow> i $\<le> j \<Longrightarrow> i $* $#k $\<le> j $* $#k"
 apply (induct_tac "k")
  prefer 2 apply (subst int_succ_int_1)
 apply (simp_all (no_asm_simp) add: zadd_zmult_distrib2 zadd_zle_mono)
 done
 
 lemma zmult_zle_mono1: "\<lbrakk>i $\<le> j;  #0 $\<le> k\<rbrakk> \<Longrightarrow> i$*k $\<le> j$*k"
 apply (subgoal_tac "i $* intify (k) $\<le> j $* intify (k) ")
 apply (simp (no_asm_use))
 apply (rule_tac b = "intify (k)" in not_zneg_mag [THEN subst])
 apply (rule_tac [3] zmult_mono_lemma)
 apply auto
 apply (simp add: znegative_iff_zless_0 not_zless_iff_zle [THEN iff_sym])
 done
 
 lemma zmult_zle_mono1_neg: "\<lbrakk>i $\<le> j;  k $\<le> #0\<rbrakk> \<Longrightarrow> j$*k $\<le> i$*k"
 apply (rule zminus_zle_zminus [THEN iffD1])
 apply (simp del: zmult_zminus_right
             add: zmult_zminus_right [symmetric] zmult_zle_mono1 zle_zminus)
 done
 
 lemma zmult_zle_mono2: "\<lbrakk>i $\<le> j;  #0 $\<le> k\<rbrakk> \<Longrightarrow> k$*i $\<le> k$*j"
 apply (drule zmult_zle_mono1)
 apply (simp_all add: zmult_commute)
 done
 
 lemma zmult_zle_mono2_neg: "\<lbrakk>i $\<le> j;  k $\<le> #0\<rbrakk> \<Longrightarrow> k$*j $\<le> k$*i"
 apply (drule zmult_zle_mono1_neg)
 apply (simp_all add: zmult_commute)
 done
 
 (* $\<le> monotonicity, BOTH arguments*)
 lemma zmult_zle_mono:
      "\<lbrakk>i $\<le> j;  k $\<le> l;  #0 $\<le> j;  #0 $\<le> k\<rbrakk> \<Longrightarrow> i$*k $\<le> j$*l"
 apply (erule zmult_zle_mono1 [THEN zle_trans])
 apply assumption
 apply (erule zmult_zle_mono2)
 apply assumption
 done
 
 
 (** strict, in 1st argument; proof is by induction on k>0 **)
 
 lemma zmult_zless_mono2_lemma [rule_format]:
      "\<lbrakk>i$<j; k \<in> nat\<rbrakk> \<Longrightarrow> 0<k \<longrightarrow> $#k $* i $< $#k $* j"
 apply (induct_tac "k")
  prefer 2
  apply (subst int_succ_int_1)
  apply (erule natE)
 apply (simp_all add: zadd_zmult_distrib zadd_zless_mono zle_def)
 apply (frule nat_0_le)
 apply (subgoal_tac "i $+ (i $+ $# xa $* i) $< j $+ (j $+ $# xa $* j) ")
 apply (simp (no_asm_use))
 apply (rule zadd_zless_mono)
 apply (simp_all (no_asm_simp) add: zle_def)
 done
 
 lemma zmult_zless_mono2: "\<lbrakk>i$<j;  #0 $< k\<rbrakk> \<Longrightarrow> k$*i $< k$*j"
 apply (subgoal_tac "intify (k) $* i $< intify (k) $* j")
 apply (simp (no_asm_use))
 apply (rule_tac b = "intify (k)" in not_zneg_mag [THEN subst])
 apply (rule_tac [3] zmult_zless_mono2_lemma)
 apply auto
 apply (simp add: znegative_iff_zless_0)
 apply (drule zless_trans, assumption)
 apply (auto simp add: zero_lt_zmagnitude)
 done
 
 lemma zmult_zless_mono1: "\<lbrakk>i$<j;  #0 $< k\<rbrakk> \<Longrightarrow> i$*k $< j$*k"
 apply (drule zmult_zless_mono2)
 apply (simp_all add: zmult_commute)
 done
 
 (* < monotonicity, BOTH arguments*)
 lemma zmult_zless_mono:
      "\<lbrakk>i $< j;  k $< l;  #0 $< j;  #0 $< k\<rbrakk> \<Longrightarrow> i$*k $< j$*l"
 apply (erule zmult_zless_mono1 [THEN zless_trans])
 apply assumption
 apply (erule zmult_zless_mono2)
 apply assumption
 done
 
 lemma zmult_zless_mono1_neg: "\<lbrakk>i $< j;  k $< #0\<rbrakk> \<Longrightarrow> j$*k $< i$*k"
 apply (rule zminus_zless_zminus [THEN iffD1])
 apply (simp del: zmult_zminus_right
             add: zmult_zminus_right [symmetric] zmult_zless_mono1 zless_zminus)
 done
 
 lemma zmult_zless_mono2_neg: "\<lbrakk>i $< j;  k $< #0\<rbrakk> \<Longrightarrow> k$*j $< k$*i"
 apply (rule zminus_zless_zminus [THEN iffD1])
 apply (simp del: zmult_zminus
             add: zmult_zminus [symmetric] zmult_zless_mono2 zless_zminus)
 done
 
 
 (** Products of zeroes **)
 
 lemma zmult_eq_lemma:
      "\<lbrakk>m \<in> int; n \<in> int\<rbrakk> \<Longrightarrow> (m = #0 | n = #0) \<longleftrightarrow> (m$*n = #0)"
 apply (case_tac "m $< #0")
 apply (auto simp add: not_zless_iff_zle zle_def neq_iff_zless)
 apply (force dest: zmult_zless_mono1_neg zmult_zless_mono1)+
 done
 
 lemma zmult_eq_0_iff [iff]: "(m$*n = #0) \<longleftrightarrow> (intify(m) = #0 | intify(n) = #0)"
 apply (simp add: zmult_eq_lemma)
 done
 
 
 (** Cancellation laws for k*m < k*n and m*k < n*k, also for @{text"\<le>"} and =,
     but not (yet?) for k*m < n*k. **)
 
 lemma zmult_zless_lemma:
      "\<lbrakk>k \<in> int; m \<in> int; n \<in> int\<rbrakk>
       \<Longrightarrow> (m$*k $< n$*k) \<longleftrightarrow> ((#0 $< k \<and> m$<n) | (k $< #0 \<and> n$<m))"
 apply (case_tac "k = #0")
 apply (auto simp add: neq_iff_zless zmult_zless_mono1 zmult_zless_mono1_neg)
 apply (auto simp add: not_zless_iff_zle
                       not_zle_iff_zless [THEN iff_sym, of "m$*k"]
                       not_zle_iff_zless [THEN iff_sym, of m])
 apply (auto elim: notE
             simp add: zless_imp_zle zmult_zle_mono1 zmult_zle_mono1_neg)
 done
 
 lemma zmult_zless_cancel2:
      "(m$*k $< n$*k) \<longleftrightarrow> ((#0 $< k \<and> m$<n) | (k $< #0 \<and> n$<m))"
 apply (cut_tac k = "intify (k)" and m = "intify (m)" and n = "intify (n)"
        in zmult_zless_lemma)
 apply auto
 done
 
 lemma zmult_zless_cancel1:
      "(k$*m $< k$*n) \<longleftrightarrow> ((#0 $< k \<and> m$<n) | (k $< #0 \<and> n$<m))"
 by (simp add: zmult_commute [of k] zmult_zless_cancel2)
 
 lemma zmult_zle_cancel2:
      "(m$*k $\<le> n$*k) \<longleftrightarrow> ((#0 $< k \<longrightarrow> m$\<le>n) \<and> (k $< #0 \<longrightarrow> n$\<le>m))"
 by (auto simp add: not_zless_iff_zle [THEN iff_sym] zmult_zless_cancel2)
 
 lemma zmult_zle_cancel1:
      "(k$*m $\<le> k$*n) \<longleftrightarrow> ((#0 $< k \<longrightarrow> m$\<le>n) \<and> (k $< #0 \<longrightarrow> n$\<le>m))"
 by (auto simp add: not_zless_iff_zle [THEN iff_sym] zmult_zless_cancel1)
 
 lemma int_eq_iff_zle: "\<lbrakk>m \<in> int; n \<in> int\<rbrakk> \<Longrightarrow> m=n \<longleftrightarrow> (m $\<le> n \<and> n $\<le> m)"
 apply (blast intro: zle_refl zle_anti_sym)
 done
 
 lemma zmult_cancel2_lemma:
      "\<lbrakk>k \<in> int; m \<in> int; n \<in> int\<rbrakk> \<Longrightarrow> (m$*k = n$*k) \<longleftrightarrow> (k=#0 | m=n)"
 apply (simp add: int_eq_iff_zle [of "m$*k"] int_eq_iff_zle [of m])
 apply (auto simp add: zmult_zle_cancel2 neq_iff_zless)
 done
 
 lemma zmult_cancel2 [simp]:
      "(m$*k = n$*k) \<longleftrightarrow> (intify(k) = #0 | intify(m) = intify(n))"
 apply (rule iff_trans)
 apply (rule_tac [2] zmult_cancel2_lemma)
 apply auto
 done
 
 lemma zmult_cancel1 [simp]:
      "(k$*m = k$*n) \<longleftrightarrow> (intify(k) = #0 | intify(m) = intify(n))"
 by (simp add: zmult_commute [of k] zmult_cancel2)
 
 
 subsection\<open>Uniqueness and monotonicity of quotients and remainders\<close>
 
 lemma unique_quotient_lemma:
      "\<lbrakk>b$*q' $+ r' $\<le> b$*q $+ r;  #0 $\<le> r';  #0 $< b;  r $< b\<rbrakk>
       \<Longrightarrow> q' $\<le> q"
 apply (subgoal_tac "r' $+ b $* (q'$-q) $\<le> r")
  prefer 2 apply (simp add: zdiff_zmult_distrib2 zadd_ac zcompare_rls)
 apply (subgoal_tac "#0 $< b $* (#1 $+ q $- q') ")
  prefer 2
  apply (erule zle_zless_trans)
  apply (simp add: zdiff_zmult_distrib2 zadd_zmult_distrib2 zadd_ac zcompare_rls)
  apply (erule zle_zless_trans)
  apply simp
 apply (subgoal_tac "b $* q' $< b $* (#1 $+ q)")
  prefer 2
  apply (simp add: zdiff_zmult_distrib2 zadd_zmult_distrib2 zadd_ac zcompare_rls)
 apply (auto elim: zless_asym
         simp add: zmult_zless_cancel1 zless_add1_iff_zle zadd_ac zcompare_rls)
 done
 
 lemma unique_quotient_lemma_neg:
      "\<lbrakk>b$*q' $+ r' $\<le> b$*q $+ r;  r $\<le> #0;  b $< #0;  b $< r'\<rbrakk>
       \<Longrightarrow> q $\<le> q'"
 apply (rule_tac b = "$-b" and r = "$-r'" and r' = "$-r"
        in unique_quotient_lemma)
 apply (auto simp del: zminus_zadd_distrib
             simp add: zminus_zadd_distrib [symmetric] zle_zminus zless_zminus)
 done
 
 
 lemma unique_quotient:
      "\<lbrakk>quorem (\<langle>a,b\<rangle>, \<langle>q,r\<rangle>);  quorem (\<langle>a,b\<rangle>, <q',r'>);  b \<in> int; b \<noteq> #0;
          q \<in> int; q' \<in> int\<rbrakk> \<Longrightarrow> q = q'"
 apply (simp add: split_ifs quorem_def neq_iff_zless)
 apply safe
 apply simp_all
 apply (blast intro: zle_anti_sym
              dest: zle_eq_refl [THEN unique_quotient_lemma]
                    zle_eq_refl [THEN unique_quotient_lemma_neg] sym)+
 done
 
 lemma unique_remainder:
      "\<lbrakk>quorem (\<langle>a,b\<rangle>, \<langle>q,r\<rangle>);  quorem (\<langle>a,b\<rangle>, <q',r'>);  b \<in> int; b \<noteq> #0;
          q \<in> int; q' \<in> int;
          r \<in> int; r' \<in> int\<rbrakk> \<Longrightarrow> r = r'"
 apply (subgoal_tac "q = q'")
  prefer 2 apply (blast intro: unique_quotient)
 apply (simp add: quorem_def)
 done
 
 
 subsection\<open>Correctness of posDivAlg,
            the Division Algorithm for \<open>a\<ge>0\<close> and \<open>b>0\<close>\<close>
 
 lemma adjust_eq [simp]:
      "adjust(b, \<langle>q,r\<rangle>) = (let diff = r$-b in
                           if #0 $\<le> diff then <#2$*q $+ #1,diff>
                                          else <#2$*q,r>)"
 by (simp add: Let_def adjust_def)
 
 
 lemma posDivAlg_termination:
      "\<lbrakk>#0 $< b; \<not> a $< b\<rbrakk>
       \<Longrightarrow> nat_of(a $- #2 $* b $+ #1) < nat_of(a $- b $+ #1)"
 apply (simp (no_asm) add: zless_nat_conj)
 apply (simp add: not_zless_iff_zle zless_add1_iff_zle zcompare_rls)
 done
 
 lemmas posDivAlg_unfold = def_wfrec [OF posDivAlg_def wf_measure]
 
 lemma posDivAlg_eqn:
      "\<lbrakk>#0 $< b; a \<in> int; b \<in> int\<rbrakk> \<Longrightarrow>
       posDivAlg(\<langle>a,b\<rangle>) =
        (if a$<b then <#0,a> else adjust(b, posDivAlg (<a, #2$*b>)))"
 apply (rule posDivAlg_unfold [THEN trans])
 apply (simp add: vimage_iff not_zless_iff_zle [THEN iff_sym])
 apply (blast intro: posDivAlg_termination)
 done
 
 lemma posDivAlg_induct_lemma [rule_format]:
   assumes prem:
         "\<And>a b. \<lbrakk>a \<in> int; b \<in> int;
                    \<not> (a $< b | b $\<le> #0) \<longrightarrow> P(<a, #2 $* b>)\<rbrakk> \<Longrightarrow> P(\<langle>a,b\<rangle>)"
   shows "\<langle>u,v\<rangle> \<in> int*int \<Longrightarrow> P(\<langle>u,v\<rangle>)"
 using wf_measure [where A = "int*int" and f = "\<lambda>\<langle>a,b\<rangle>.nat_of (a $- b $+ #1)"]
 proof (induct "\<langle>u,v\<rangle>" arbitrary: u v rule: wf_induct)
   case (step x)
   hence uv: "u \<in> int" "v \<in> int" by auto
   thus ?case
     apply (rule prem) 
     apply (rule impI) 
     apply (rule step) 
     apply (auto simp add: step uv not_zle_iff_zless posDivAlg_termination)
     done
 qed
 
 
 lemma posDivAlg_induct [consumes 2]:
   assumes u_int: "u \<in> int"
       and v_int: "v \<in> int"
       and ih: "\<And>a b. \<lbrakk>a \<in> int; b \<in> int;
                      \<not> (a $< b | b $\<le> #0) \<longrightarrow> P(a, #2 $* b)\<rbrakk> \<Longrightarrow> P(a,b)"
   shows "P(u,v)"
 apply (subgoal_tac "(\<lambda>\<langle>x,y\<rangle>. P (x,y)) (\<langle>u,v\<rangle>)")
 apply simp
 apply (rule posDivAlg_induct_lemma)
 apply (simp (no_asm_use))
 apply (rule ih)
 apply (auto simp add: u_int v_int)
 done
 
 (*FIXME: use intify in integ_of so that we always have @{term"integ_of w \<in> int"}.
     then this rewrite can work for all constants\<And>*)
 lemma intify_eq_0_iff_zle: "intify(m) = #0 \<longleftrightarrow> (m $\<le> #0 \<and> #0 $\<le> m)"
   by (simp add: int_eq_iff_zle)
 
 
 subsection\<open>Some convenient biconditionals for products of signs\<close>
 
 lemma zmult_pos: "\<lbrakk>#0 $< i; #0 $< j\<rbrakk> \<Longrightarrow> #0 $< i $* j"
   by (drule zmult_zless_mono1, auto)
 
 lemma zmult_neg: "\<lbrakk>i $< #0; j $< #0\<rbrakk> \<Longrightarrow> #0 $< i $* j"
   by (drule zmult_zless_mono1_neg, auto)
 
 lemma zmult_pos_neg: "\<lbrakk>#0 $< i; j $< #0\<rbrakk> \<Longrightarrow> i $* j $< #0"
   by (drule zmult_zless_mono1_neg, auto)
 
 
 (** Inequality reasoning **)
 
 lemma int_0_less_lemma:
      "\<lbrakk>x \<in> int; y \<in> int\<rbrakk>
       \<Longrightarrow> (#0 $< x $* y) \<longleftrightarrow> (#0 $< x \<and> #0 $< y | x $< #0 \<and> y $< #0)"
 apply (auto simp add: zle_def not_zless_iff_zle zmult_pos zmult_neg)
 apply (rule ccontr)
 apply (rule_tac [2] ccontr)
 apply (auto simp add: zle_def not_zless_iff_zle)
 apply (erule_tac P = "#0$< x$* y" in rev_mp)
 apply (erule_tac [2] P = "#0$< x$* y" in rev_mp)
 apply (drule zmult_pos_neg, assumption)
  prefer 2
  apply (drule zmult_pos_neg, assumption)
 apply (auto dest: zless_not_sym simp add: zmult_commute)
 done
 
 lemma int_0_less_mult_iff:
      "(#0 $< x $* y) \<longleftrightarrow> (#0 $< x \<and> #0 $< y | x $< #0 \<and> y $< #0)"
 apply (cut_tac x = "intify (x)" and y = "intify (y)" in int_0_less_lemma)
 apply auto
 done
 
 lemma int_0_le_lemma:
      "\<lbrakk>x \<in> int; y \<in> int\<rbrakk>
       \<Longrightarrow> (#0 $\<le> x $* y) \<longleftrightarrow> (#0 $\<le> x \<and> #0 $\<le> y | x $\<le> #0 \<and> y $\<le> #0)"
 by (auto simp add: zle_def not_zless_iff_zle int_0_less_mult_iff)
 
 lemma int_0_le_mult_iff:
      "(#0 $\<le> x $* y) \<longleftrightarrow> ((#0 $\<le> x \<and> #0 $\<le> y) | (x $\<le> #0 \<and> y $\<le> #0))"
 apply (cut_tac x = "intify (x)" and y = "intify (y)" in int_0_le_lemma)
 apply auto
 done
 
 lemma zmult_less_0_iff:
      "(x $* y $< #0) \<longleftrightarrow> (#0 $< x \<and> y $< #0 | x $< #0 \<and> #0 $< y)"
 apply (auto simp add: int_0_le_mult_iff not_zle_iff_zless [THEN iff_sym])
 apply (auto dest: zless_not_sym simp add: not_zle_iff_zless)
 done
 
 lemma zmult_le_0_iff:
      "(x $* y $\<le> #0) \<longleftrightarrow> (#0 $\<le> x \<and> y $\<le> #0 | x $\<le> #0 \<and> #0 $\<le> y)"
 by (auto dest: zless_not_sym
          simp add: int_0_less_mult_iff not_zless_iff_zle [THEN iff_sym])
 
 
 (*Typechecking for posDivAlg*)
 lemma posDivAlg_type [rule_format]:
      "\<lbrakk>a \<in> int; b \<in> int\<rbrakk> \<Longrightarrow> posDivAlg(\<langle>a,b\<rangle>) \<in> int * int"
 apply (rule_tac u = "a" and v = "b" in posDivAlg_induct)
 apply assumption+
 apply (case_tac "#0 $< ba")
  apply (simp add: posDivAlg_eqn adjust_def integ_of_type
              split: split_if_asm)
  apply clarify
  apply (simp add: int_0_less_mult_iff not_zle_iff_zless)
 apply (simp add: not_zless_iff_zle)
 apply (subst posDivAlg_unfold)
 apply simp
 done
 
 (*Correctness of posDivAlg: it computes quotients correctly*)
 lemma posDivAlg_correct [rule_format]:
      "\<lbrakk>a \<in> int; b \<in> int\<rbrakk>
       \<Longrightarrow> #0 $\<le> a \<longrightarrow> #0 $< b \<longrightarrow> quorem (\<langle>a,b\<rangle>, posDivAlg(\<langle>a,b\<rangle>))"
 apply (rule_tac u = "a" and v = "b" in posDivAlg_induct)
 apply auto
    apply (simp_all add: quorem_def)
    txt\<open>base case: a<b\<close>
    apply (simp add: posDivAlg_eqn)
   apply (simp add: not_zless_iff_zle [THEN iff_sym])
  apply (simp add: int_0_less_mult_iff)
 txt\<open>main argument\<close>
 apply (subst posDivAlg_eqn)
 apply (simp_all (no_asm_simp))
 apply (erule splitE)
 apply (rule posDivAlg_type)
 apply (simp_all add: int_0_less_mult_iff)
 apply (auto simp add: zadd_zmult_distrib2 Let_def)
 txt\<open>now just linear arithmetic\<close>
 apply (simp add: not_zle_iff_zless zdiff_zless_iff)
 done
 
 
 subsection\<open>Correctness of negDivAlg, the division algorithm for a<0 and b>0\<close>
 
 lemma negDivAlg_termination:
      "\<lbrakk>#0 $< b; a $+ b $< #0\<rbrakk>
       \<Longrightarrow> nat_of($- a $- #2 $* b) < nat_of($- a $- b)"
 apply (simp (no_asm) add: zless_nat_conj)
 apply (simp add: zcompare_rls not_zle_iff_zless zless_zdiff_iff [THEN iff_sym]
                  zless_zminus)
 done
 
 lemmas negDivAlg_unfold = def_wfrec [OF negDivAlg_def wf_measure]
 
 lemma negDivAlg_eqn:
      "\<lbrakk>#0 $< b; a \<in> int; b \<in> int\<rbrakk> \<Longrightarrow>
       negDivAlg(\<langle>a,b\<rangle>) =
        (if #0 $\<le> a$+b then <#-1,a$+b>
                        else adjust(b, negDivAlg (<a, #2$*b>)))"
 apply (rule negDivAlg_unfold [THEN trans])
 apply (simp (no_asm_simp) add: vimage_iff not_zless_iff_zle [THEN iff_sym])
 apply (blast intro: negDivAlg_termination)
 done
 
 lemma negDivAlg_induct_lemma [rule_format]:
   assumes prem:
         "\<And>a b. \<lbrakk>a \<in> int; b \<in> int;
                    \<not> (#0 $\<le> a $+ b | b $\<le> #0) \<longrightarrow> P(<a, #2 $* b>)\<rbrakk>
                 \<Longrightarrow> P(\<langle>a,b\<rangle>)"
   shows "\<langle>u,v\<rangle> \<in> int*int \<Longrightarrow> P(\<langle>u,v\<rangle>)"
 using wf_measure [where A = "int*int" and f = "\<lambda>\<langle>a,b\<rangle>.nat_of ($- a $- b)"]
 proof (induct "\<langle>u,v\<rangle>" arbitrary: u v rule: wf_induct)
   case (step x)
   hence uv: "u \<in> int" "v \<in> int" by auto
   thus ?case
     apply (rule prem) 
     apply (rule impI) 
     apply (rule step) 
     apply (auto simp add: step uv not_zle_iff_zless negDivAlg_termination)
     done
 qed
 
 lemma negDivAlg_induct [consumes 2]:
   assumes u_int: "u \<in> int"
       and v_int: "v \<in> int"
       and ih: "\<And>a b. \<lbrakk>a \<in> int; b \<in> int;
                          \<not> (#0 $\<le> a $+ b | b $\<le> #0) \<longrightarrow> P(a, #2 $* b)\<rbrakk>
                       \<Longrightarrow> P(a,b)"
   shows "P(u,v)"
 apply (subgoal_tac " (\<lambda>\<langle>x,y\<rangle>. P (x,y)) (\<langle>u,v\<rangle>)")
 apply simp
 apply (rule negDivAlg_induct_lemma)
 apply (simp (no_asm_use))
 apply (rule ih)
 apply (auto simp add: u_int v_int)
 done
 
 
 (*Typechecking for negDivAlg*)
 lemma negDivAlg_type:
      "\<lbrakk>a \<in> int; b \<in> int\<rbrakk> \<Longrightarrow> negDivAlg(\<langle>a,b\<rangle>) \<in> int * int"
 apply (rule_tac u = "a" and v = "b" in negDivAlg_induct)
 apply assumption+
 apply (case_tac "#0 $< ba")
  apply (simp add: negDivAlg_eqn adjust_def integ_of_type
              split: split_if_asm)
  apply clarify
  apply (simp add: int_0_less_mult_iff not_zle_iff_zless)
 apply (simp add: not_zless_iff_zle)
 apply (subst negDivAlg_unfold)
 apply simp
 done
 
 
 (*Correctness of negDivAlg: it computes quotients correctly
   It doesn't work if a=0 because the 0/b=0 rather than -1*)
 lemma negDivAlg_correct [rule_format]:
      "\<lbrakk>a \<in> int; b \<in> int\<rbrakk>
       \<Longrightarrow> a $< #0 \<longrightarrow> #0 $< b \<longrightarrow> quorem (\<langle>a,b\<rangle>, negDivAlg(\<langle>a,b\<rangle>))"
 apply (rule_tac u = "a" and v = "b" in negDivAlg_induct)
   apply auto
    apply (simp_all add: quorem_def)
    txt\<open>base case: \<^term>\<open>0$\<le>a$+b\<close>\<close>
    apply (simp add: negDivAlg_eqn)
   apply (simp add: not_zless_iff_zle [THEN iff_sym])
  apply (simp add: int_0_less_mult_iff)
 txt\<open>main argument\<close>
 apply (subst negDivAlg_eqn)
 apply (simp_all (no_asm_simp))
 apply (erule splitE)
 apply (rule negDivAlg_type)
 apply (simp_all add: int_0_less_mult_iff)
 apply (auto simp add: zadd_zmult_distrib2 Let_def)
 txt\<open>now just linear arithmetic\<close>
 apply (simp add: not_zle_iff_zless zdiff_zless_iff)
 done
 
 
 subsection\<open>Existence shown by proving the division algorithm to be correct\<close>
 
 (*the case a=0*)
 lemma quorem_0: "\<lbrakk>b \<noteq> #0;  b \<in> int\<rbrakk> \<Longrightarrow> quorem (<#0,b>, <#0,#0>)"
 by (force simp add: quorem_def neq_iff_zless)
 
 lemma posDivAlg_zero_divisor: "posDivAlg(<a,#0>) = <#0,a>"
 apply (subst posDivAlg_unfold)
 apply simp
 done
 
 lemma posDivAlg_0 [simp]: "posDivAlg (<#0,b>) = <#0,#0>"
 apply (subst posDivAlg_unfold)
 apply (simp add: not_zle_iff_zless)
 done
 
 
 (*Needed below.  Actually it's an equivalence.*)
 lemma linear_arith_lemma: "\<not> (#0 $\<le> #-1 $+ b) \<Longrightarrow> (b $\<le> #0)"
 apply (simp add: not_zle_iff_zless)
 apply (drule zminus_zless_zminus [THEN iffD2])
 apply (simp add: zadd_commute zless_add1_iff_zle zle_zminus)
 done
 
 lemma negDivAlg_minus1 [simp]: "negDivAlg (<#-1,b>) = <#-1, b$-#1>"
 apply (subst negDivAlg_unfold)
 apply (simp add: linear_arith_lemma integ_of_type vimage_iff)
 done
 
 lemma negateSnd_eq [simp]: "negateSnd (\<langle>q,r\<rangle>) = <q, $-r>"
-apply (unfold negateSnd_def)
+  unfolding negateSnd_def
 apply auto
 done
 
 lemma negateSnd_type: "qr \<in> int * int \<Longrightarrow> negateSnd (qr) \<in> int * int"
-apply (unfold negateSnd_def)
+  unfolding negateSnd_def
 apply auto
 done
 
 lemma quorem_neg:
      "\<lbrakk>quorem (<$-a,$-b>, qr);  a \<in> int;  b \<in> int;  qr \<in> int * int\<rbrakk>
       \<Longrightarrow> quorem (\<langle>a,b\<rangle>, negateSnd(qr))"
 apply clarify
 apply (auto elim: zless_asym simp add: quorem_def zless_zminus)
 txt\<open>linear arithmetic from here on\<close>
 apply (simp_all add: zminus_equation [of a] zminus_zless)
 apply (cut_tac [2] z = "b" and w = "#0" in zless_linear)
 apply (cut_tac [1] z = "b" and w = "#0" in zless_linear)
 apply auto
 apply (blast dest: zle_zless_trans)+
 done
 
 lemma divAlg_correct:
      "\<lbrakk>b \<noteq> #0;  a \<in> int;  b \<in> int\<rbrakk> \<Longrightarrow> quorem (\<langle>a,b\<rangle>, divAlg(\<langle>a,b\<rangle>))"
 apply (auto simp add: quorem_0 divAlg_def)
 apply (safe intro!: quorem_neg posDivAlg_correct negDivAlg_correct
                     posDivAlg_type negDivAlg_type)
 apply (auto simp add: quorem_def neq_iff_zless)
 txt\<open>linear arithmetic from here on\<close>
 apply (auto simp add: zle_def)
 done
 
 lemma divAlg_type: "\<lbrakk>a \<in> int;  b \<in> int\<rbrakk> \<Longrightarrow> divAlg(\<langle>a,b\<rangle>) \<in> int * int"
 apply (auto simp add: divAlg_def)
 apply (auto simp add: posDivAlg_type negDivAlg_type negateSnd_type)
 done
 
 
 (** intify cancellation **)
 
 lemma zdiv_intify1 [simp]: "intify(x) zdiv y = x zdiv y"
   by (simp add: zdiv_def)
 
 lemma zdiv_intify2 [simp]: "x zdiv intify(y) = x zdiv y"
   by (simp add: zdiv_def)
 
 lemma zdiv_type [iff,TC]: "z zdiv w \<in> int"
-apply (unfold zdiv_def)
+  unfolding zdiv_def
 apply (blast intro: fst_type divAlg_type)
 done
 
 lemma zmod_intify1 [simp]: "intify(x) zmod y = x zmod y"
   by (simp add: zmod_def)
 
 lemma zmod_intify2 [simp]: "x zmod intify(y) = x zmod y"
   by (simp add: zmod_def)
 
 lemma zmod_type [iff,TC]: "z zmod w \<in> int"
-apply (unfold zmod_def)
+  unfolding zmod_def
 apply (rule snd_type)
 apply (blast intro: divAlg_type)
 done
 
 
 (** Arbitrary definitions for division by zero.  Useful to simplify
     certain equations **)
 
 lemma DIVISION_BY_ZERO_ZDIV: "a zdiv #0 = #0"
   by (simp add: zdiv_def divAlg_def posDivAlg_zero_divisor)
 
 lemma DIVISION_BY_ZERO_ZMOD: "a zmod #0 = intify(a)"
   by (simp add: zmod_def divAlg_def posDivAlg_zero_divisor)
 
 
 (** Basic laws about division and remainder **)
 
 lemma raw_zmod_zdiv_equality:
      "\<lbrakk>a \<in> int; b \<in> int\<rbrakk> \<Longrightarrow> a = b $* (a zdiv b) $+ (a zmod b)"
 apply (case_tac "b = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (cut_tac a = "a" and b = "b" in divAlg_correct)
 apply (auto simp add: quorem_def zdiv_def zmod_def split_def)
 done
 
 lemma zmod_zdiv_equality: "intify(a) = b $* (a zdiv b) $+ (a zmod b)"
 apply (rule trans)
 apply (rule_tac b = "intify (b)" in raw_zmod_zdiv_equality)
 apply auto
 done
 
 lemma pos_mod: "#0 $< b \<Longrightarrow> #0 $\<le> a zmod b \<and> a zmod b $< b"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" in divAlg_correct)
 apply (auto simp add: intify_eq_0_iff_zle quorem_def zmod_def split_def)
 apply (blast dest: zle_zless_trans)+
 done
 
 lemmas pos_mod_sign = pos_mod [THEN conjunct1]
   and pos_mod_bound = pos_mod [THEN conjunct2]
 
 lemma neg_mod: "b $< #0 \<Longrightarrow> a zmod b $\<le> #0 \<and> b $< a zmod b"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" in divAlg_correct)
 apply (auto simp add: intify_eq_0_iff_zle quorem_def zmod_def split_def)
 apply (blast dest: zle_zless_trans)
 apply (blast dest: zless_trans)+
 done
 
 lemmas neg_mod_sign = neg_mod [THEN conjunct1]
   and neg_mod_bound = neg_mod [THEN conjunct2]
 
 
 (** proving general properties of zdiv and zmod **)
 
 lemma quorem_div_mod:
      "\<lbrakk>b \<noteq> #0;  a \<in> int;  b \<in> int\<rbrakk>
       \<Longrightarrow> quorem (\<langle>a,b\<rangle>, <a zdiv b, a zmod b>)"
 apply (cut_tac a = "a" and b = "b" in zmod_zdiv_equality)
 apply (auto simp add: quorem_def neq_iff_zless pos_mod_sign pos_mod_bound
                       neg_mod_sign neg_mod_bound)
 done
 
 (*Surely quorem(\<langle>a,b\<rangle>,\<langle>q,r\<rangle>) implies @{term"a \<in> int"}, but it doesn't matter*)
 lemma quorem_div:
      "\<lbrakk>quorem(\<langle>a,b\<rangle>,\<langle>q,r\<rangle>);  b \<noteq> #0;  a \<in> int;  b \<in> int;  q \<in> int\<rbrakk>
       \<Longrightarrow> a zdiv b = q"
 by (blast intro: quorem_div_mod [THEN unique_quotient])
 
 lemma quorem_mod:
      "\<lbrakk>quorem(\<langle>a,b\<rangle>,\<langle>q,r\<rangle>); b \<noteq> #0; a \<in> int; b \<in> int; q \<in> int; r \<in> int\<rbrakk>
       \<Longrightarrow> a zmod b = r"
 by (blast intro: quorem_div_mod [THEN unique_remainder])
 
 lemma zdiv_pos_pos_trivial_raw:
      "\<lbrakk>a \<in> int;  b \<in> int;  #0 $\<le> a;  a $< b\<rbrakk> \<Longrightarrow> a zdiv b = #0"
 apply (rule quorem_div)
 apply (auto simp add: quorem_def)
 (*linear arithmetic*)
 apply (blast dest: zle_zless_trans)+
 done
 
 lemma zdiv_pos_pos_trivial: "\<lbrakk>#0 $\<le> a;  a $< b\<rbrakk> \<Longrightarrow> a zdiv b = #0"
 apply (cut_tac a = "intify (a)" and b = "intify (b)"
        in zdiv_pos_pos_trivial_raw)
 apply auto
 done
 
 lemma zdiv_neg_neg_trivial_raw:
      "\<lbrakk>a \<in> int;  b \<in> int;  a $\<le> #0;  b $< a\<rbrakk> \<Longrightarrow> a zdiv b = #0"
 apply (rule_tac r = "a" in quorem_div)
 apply (auto simp add: quorem_def)
 (*linear arithmetic*)
 apply (blast dest: zle_zless_trans zless_trans)+
 done
 
 lemma zdiv_neg_neg_trivial: "\<lbrakk>a $\<le> #0;  b $< a\<rbrakk> \<Longrightarrow> a zdiv b = #0"
 apply (cut_tac a = "intify (a)" and b = "intify (b)"
        in zdiv_neg_neg_trivial_raw)
 apply auto
 done
 
 lemma zadd_le_0_lemma: "\<lbrakk>a$+b $\<le> #0;  #0 $< a;  #0 $< b\<rbrakk> \<Longrightarrow> False"
 apply (drule_tac z' = "#0" and z = "b" in zadd_zless_mono)
 apply (auto simp add: zle_def)
 apply (blast dest: zless_trans)
 done
 
 lemma zdiv_pos_neg_trivial_raw:
      "\<lbrakk>a \<in> int;  b \<in> int;  #0 $< a;  a$+b $\<le> #0\<rbrakk> \<Longrightarrow> a zdiv b = #-1"
 apply (rule_tac r = "a $+ b" in quorem_div)
 apply (auto simp add: quorem_def)
 (*linear arithmetic*)
 apply (blast dest: zadd_le_0_lemma zle_zless_trans)+
 done
 
 lemma zdiv_pos_neg_trivial: "\<lbrakk>#0 $< a;  a$+b $\<le> #0\<rbrakk> \<Longrightarrow> a zdiv b = #-1"
 apply (cut_tac a = "intify (a)" and b = "intify (b)"
        in zdiv_pos_neg_trivial_raw)
 apply auto
 done
 
 (*There is no zdiv_neg_pos_trivial because  #0 zdiv b = #0 would supersede it*)
 
 
 lemma zmod_pos_pos_trivial_raw:
      "\<lbrakk>a \<in> int;  b \<in> int;  #0 $\<le> a;  a $< b\<rbrakk> \<Longrightarrow> a zmod b = a"
 apply (rule_tac q = "#0" in quorem_mod)
 apply (auto simp add: quorem_def)
 (*linear arithmetic*)
 apply (blast dest: zle_zless_trans)+
 done
 
 lemma zmod_pos_pos_trivial: "\<lbrakk>#0 $\<le> a;  a $< b\<rbrakk> \<Longrightarrow> a zmod b = intify(a)"
 apply (cut_tac a = "intify (a)" and b = "intify (b)"
        in zmod_pos_pos_trivial_raw)
 apply auto
 done
 
 lemma zmod_neg_neg_trivial_raw:
      "\<lbrakk>a \<in> int;  b \<in> int;  a $\<le> #0;  b $< a\<rbrakk> \<Longrightarrow> a zmod b = a"
 apply (rule_tac q = "#0" in quorem_mod)
 apply (auto simp add: quorem_def)
 (*linear arithmetic*)
 apply (blast dest: zle_zless_trans zless_trans)+
 done
 
 lemma zmod_neg_neg_trivial: "\<lbrakk>a $\<le> #0;  b $< a\<rbrakk> \<Longrightarrow> a zmod b = intify(a)"
 apply (cut_tac a = "intify (a)" and b = "intify (b)"
        in zmod_neg_neg_trivial_raw)
 apply auto
 done
 
 lemma zmod_pos_neg_trivial_raw:
      "\<lbrakk>a \<in> int;  b \<in> int;  #0 $< a;  a$+b $\<le> #0\<rbrakk> \<Longrightarrow> a zmod b = a$+b"
 apply (rule_tac q = "#-1" in quorem_mod)
 apply (auto simp add: quorem_def)
 (*linear arithmetic*)
 apply (blast dest: zadd_le_0_lemma zle_zless_trans)+
 done
 
 lemma zmod_pos_neg_trivial: "\<lbrakk>#0 $< a;  a$+b $\<le> #0\<rbrakk> \<Longrightarrow> a zmod b = a$+b"
 apply (cut_tac a = "intify (a)" and b = "intify (b)"
        in zmod_pos_neg_trivial_raw)
 apply auto
 done
 
 (*There is no zmod_neg_pos_trivial...*)
 
 
 (*Simpler laws such as -a zdiv b = -(a zdiv b) FAIL*)
 
 lemma zdiv_zminus_zminus_raw:
      "\<lbrakk>a \<in> int;  b \<in> int\<rbrakk> \<Longrightarrow> ($-a) zdiv ($-b) = a zdiv b"
 apply (case_tac "b = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (subst quorem_div_mod [THEN quorem_neg, simplified, THEN quorem_div])
 apply auto
 done
 
 lemma zdiv_zminus_zminus [simp]: "($-a) zdiv ($-b) = a zdiv b"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" in zdiv_zminus_zminus_raw)
 apply auto
 done
 
 (*Simpler laws such as -a zmod b = -(a zmod b) FAIL*)
 lemma zmod_zminus_zminus_raw:
      "\<lbrakk>a \<in> int;  b \<in> int\<rbrakk> \<Longrightarrow> ($-a) zmod ($-b) = $- (a zmod b)"
 apply (case_tac "b = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (subst quorem_div_mod [THEN quorem_neg, simplified, THEN quorem_mod])
 apply auto
 done
 
 lemma zmod_zminus_zminus [simp]: "($-a) zmod ($-b) = $- (a zmod b)"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" in zmod_zminus_zminus_raw)
 apply auto
 done
 
 
 subsection\<open>division of a number by itself\<close>
 
 lemma self_quotient_aux1: "\<lbrakk>#0 $< a; a = r $+ a$*q; r $< a\<rbrakk> \<Longrightarrow> #1 $\<le> q"
 apply (subgoal_tac "#0 $< a$*q")
 apply (cut_tac w = "#0" and z = "q" in add1_zle_iff)
 apply (simp add: int_0_less_mult_iff)
 apply (blast dest: zless_trans)
 (*linear arithmetic...*)
 apply (drule_tac t = "\<lambda>x. x $- r" in subst_context)
 apply (drule sym)
 apply (simp add: zcompare_rls)
 done
 
 lemma self_quotient_aux2: "\<lbrakk>#0 $< a; a = r $+ a$*q; #0 $\<le> r\<rbrakk> \<Longrightarrow> q $\<le> #1"
 apply (subgoal_tac "#0 $\<le> a$* (#1$-q)")
  apply (simp add: int_0_le_mult_iff zcompare_rls)
  apply (blast dest: zle_zless_trans)
 apply (simp add: zdiff_zmult_distrib2)
 apply (drule_tac t = "\<lambda>x. x $- a $* q" in subst_context)
 apply (simp add: zcompare_rls)
 done
 
 lemma self_quotient:
      "\<lbrakk>quorem(\<langle>a,a\<rangle>,\<langle>q,r\<rangle>);  a \<in> int;  q \<in> int;  a \<noteq> #0\<rbrakk> \<Longrightarrow> q = #1"
 apply (simp add: split_ifs quorem_def neq_iff_zless)
 apply (rule zle_anti_sym)
 apply safe
 apply auto
 prefer 4 apply (blast dest: zless_trans)
 apply (blast dest: zless_trans)
 apply (rule_tac [3] a = "$-a" and r = "$-r" in self_quotient_aux1)
 apply (rule_tac a = "$-a" and r = "$-r" in self_quotient_aux2)
 apply (rule_tac [6] zminus_equation [THEN iffD1])
 apply (rule_tac [2] zminus_equation [THEN iffD1])
 apply (force intro: self_quotient_aux1 self_quotient_aux2
   simp add: zadd_commute zmult_zminus)+
 done
 
 lemma self_remainder:
      "\<lbrakk>quorem(\<langle>a,a\<rangle>,\<langle>q,r\<rangle>); a \<in> int; q \<in> int; r \<in> int; a \<noteq> #0\<rbrakk> \<Longrightarrow> r = #0"
 apply (frule self_quotient)
 apply (auto simp add: quorem_def)
 done
 
 lemma zdiv_self_raw: "\<lbrakk>a \<noteq> #0; a \<in> int\<rbrakk> \<Longrightarrow> a zdiv a = #1"
 apply (blast intro: quorem_div_mod [THEN self_quotient])
 done
 
 lemma zdiv_self [simp]: "intify(a) \<noteq> #0 \<Longrightarrow> a zdiv a = #1"
 apply (drule zdiv_self_raw)
 apply auto
 done
 
 (*Here we have 0 zmod 0 = 0, also assumed by Knuth (who puts m zmod 0 = 0) *)
 lemma zmod_self_raw: "a \<in> int \<Longrightarrow> a zmod a = #0"
 apply (case_tac "a = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (blast intro: quorem_div_mod [THEN self_remainder])
 done
 
 lemma zmod_self [simp]: "a zmod a = #0"
 apply (cut_tac a = "intify (a)" in zmod_self_raw)
 apply auto
 done
 
 
 subsection\<open>Computation of division and remainder\<close>
 
 lemma zdiv_zero [simp]: "#0 zdiv b = #0"
   by (simp add: zdiv_def divAlg_def)
 
 lemma zdiv_eq_minus1: "#0 $< b \<Longrightarrow> #-1 zdiv b = #-1"
   by (simp (no_asm_simp) add: zdiv_def divAlg_def)
 
 lemma zmod_zero [simp]: "#0 zmod b = #0"
   by (simp add: zmod_def divAlg_def)
 
 lemma zdiv_minus1: "#0 $< b \<Longrightarrow> #-1 zdiv b = #-1"
   by (simp add: zdiv_def divAlg_def)
 
 lemma zmod_minus1: "#0 $< b \<Longrightarrow> #-1 zmod b = b $- #1"
   by (simp add: zmod_def divAlg_def)
 
 (** a positive, b positive **)
 
 lemma zdiv_pos_pos: "\<lbrakk>#0 $< a;  #0 $\<le> b\<rbrakk>
       \<Longrightarrow> a zdiv b = fst (posDivAlg(<intify(a), intify(b)>))"
 apply (simp (no_asm_simp) add: zdiv_def divAlg_def)
 apply (auto simp add: zle_def)
 done
 
 lemma zmod_pos_pos:
      "\<lbrakk>#0 $< a;  #0 $\<le> b\<rbrakk>
       \<Longrightarrow> a zmod b = snd (posDivAlg(<intify(a), intify(b)>))"
 apply (simp (no_asm_simp) add: zmod_def divAlg_def)
 apply (auto simp add: zle_def)
 done
 
 (** a negative, b positive **)
 
 lemma zdiv_neg_pos:
      "\<lbrakk>a $< #0;  #0 $< b\<rbrakk>
       \<Longrightarrow> a zdiv b = fst (negDivAlg(<intify(a), intify(b)>))"
 apply (simp (no_asm_simp) add: zdiv_def divAlg_def)
 apply (blast dest: zle_zless_trans)
 done
 
 lemma zmod_neg_pos:
      "\<lbrakk>a $< #0;  #0 $< b\<rbrakk>
       \<Longrightarrow> a zmod b = snd (negDivAlg(<intify(a), intify(b)>))"
 apply (simp (no_asm_simp) add: zmod_def divAlg_def)
 apply (blast dest: zle_zless_trans)
 done
 
 (** a positive, b negative **)
 
 lemma zdiv_pos_neg:
      "\<lbrakk>#0 $< a;  b $< #0\<rbrakk>
       \<Longrightarrow> a zdiv b = fst (negateSnd(negDivAlg (<$-a, $-b>)))"
 apply (simp (no_asm_simp) add: zdiv_def divAlg_def intify_eq_0_iff_zle)
 apply auto
 apply (blast dest: zle_zless_trans)+
 apply (blast dest: zless_trans)
 apply (blast intro: zless_imp_zle)
 done
 
 lemma zmod_pos_neg:
      "\<lbrakk>#0 $< a;  b $< #0\<rbrakk>
       \<Longrightarrow> a zmod b = snd (negateSnd(negDivAlg (<$-a, $-b>)))"
 apply (simp (no_asm_simp) add: zmod_def divAlg_def intify_eq_0_iff_zle)
 apply auto
 apply (blast dest: zle_zless_trans)+
 apply (blast dest: zless_trans)
 apply (blast intro: zless_imp_zle)
 done
 
 (** a negative, b negative **)
 
 lemma zdiv_neg_neg:
      "\<lbrakk>a $< #0;  b $\<le> #0\<rbrakk>
       \<Longrightarrow> a zdiv b = fst (negateSnd(posDivAlg(<$-a, $-b>)))"
 apply (simp (no_asm_simp) add: zdiv_def divAlg_def)
 apply auto
 apply (blast dest!: zle_zless_trans)+
 done
 
 lemma zmod_neg_neg:
      "\<lbrakk>a $< #0;  b $\<le> #0\<rbrakk>
       \<Longrightarrow> a zmod b = snd (negateSnd(posDivAlg(<$-a, $-b>)))"
 apply (simp (no_asm_simp) add: zmod_def divAlg_def)
 apply auto
 apply (blast dest!: zle_zless_trans)+
 done
 
 declare zdiv_pos_pos [of "integ_of (v)" "integ_of (w)", simp] for v w
 declare zdiv_neg_pos [of "integ_of (v)" "integ_of (w)", simp] for v w
 declare zdiv_pos_neg [of "integ_of (v)" "integ_of (w)", simp] for v w
 declare zdiv_neg_neg [of "integ_of (v)" "integ_of (w)", simp] for v w
 declare zmod_pos_pos [of "integ_of (v)" "integ_of (w)", simp] for v w
 declare zmod_neg_pos [of "integ_of (v)" "integ_of (w)", simp] for v w
 declare zmod_pos_neg [of "integ_of (v)" "integ_of (w)", simp] for v w
 declare zmod_neg_neg [of "integ_of (v)" "integ_of (w)", simp] for v w
 declare posDivAlg_eqn [of concl: "integ_of (v)" "integ_of (w)", simp] for v w
 declare negDivAlg_eqn [of concl: "integ_of (v)" "integ_of (w)", simp] for v w
 
 
 (** Special-case simplification **)
 
 lemma zmod_1 [simp]: "a zmod #1 = #0"
 apply (cut_tac a = "a" and b = "#1" in pos_mod_sign)
 apply (cut_tac [2] a = "a" and b = "#1" in pos_mod_bound)
 apply auto
 (*arithmetic*)
 apply (drule add1_zle_iff [THEN iffD2])
 apply (rule zle_anti_sym)
 apply auto
 done
 
 lemma zdiv_1 [simp]: "a zdiv #1 = intify(a)"
 apply (cut_tac a = "a" and b = "#1" in zmod_zdiv_equality)
 apply auto
 done
 
 lemma zmod_minus1_right [simp]: "a zmod #-1 = #0"
 apply (cut_tac a = "a" and b = "#-1" in neg_mod_sign)
 apply (cut_tac [2] a = "a" and b = "#-1" in neg_mod_bound)
 apply auto
 (*arithmetic*)
 apply (drule add1_zle_iff [THEN iffD2])
 apply (rule zle_anti_sym)
 apply auto
 done
 
 lemma zdiv_minus1_right_raw: "a \<in> int \<Longrightarrow> a zdiv #-1 = $-a"
 apply (cut_tac a = "a" and b = "#-1" in zmod_zdiv_equality)
 apply auto
 apply (rule equation_zminus [THEN iffD2])
 apply auto
 done
 
 lemma zdiv_minus1_right: "a zdiv #-1 = $-a"
 apply (cut_tac a = "intify (a)" in zdiv_minus1_right_raw)
 apply auto
 done
 declare zdiv_minus1_right [simp]
 
 
 subsection\<open>Monotonicity in the first argument (divisor)\<close>
 
 lemma zdiv_mono1: "\<lbrakk>a $\<le> a';  #0 $< b\<rbrakk> \<Longrightarrow> a zdiv b $\<le> a' zdiv b"
 apply (cut_tac a = "a" and b = "b" in zmod_zdiv_equality)
 apply (cut_tac a = "a'" and b = "b" in zmod_zdiv_equality)
 apply (rule unique_quotient_lemma)
 apply (erule subst)
 apply (erule subst)
 apply (simp_all (no_asm_simp) add: pos_mod_sign pos_mod_bound)
 done
 
 lemma zdiv_mono1_neg: "\<lbrakk>a $\<le> a';  b $< #0\<rbrakk> \<Longrightarrow> a' zdiv b $\<le> a zdiv b"
 apply (cut_tac a = "a" and b = "b" in zmod_zdiv_equality)
 apply (cut_tac a = "a'" and b = "b" in zmod_zdiv_equality)
 apply (rule unique_quotient_lemma_neg)
 apply (erule subst)
 apply (erule subst)
 apply (simp_all (no_asm_simp) add: neg_mod_sign neg_mod_bound)
 done
 
 
 subsection\<open>Monotonicity in the second argument (dividend)\<close>
 
 lemma q_pos_lemma:
      "\<lbrakk>#0 $\<le> b'$*q' $+ r'; r' $< b';  #0 $< b'\<rbrakk> \<Longrightarrow> #0 $\<le> q'"
 apply (subgoal_tac "#0 $< b'$* (q' $+ #1)")
  apply (simp add: int_0_less_mult_iff)
  apply (blast dest: zless_trans intro: zless_add1_iff_zle [THEN iffD1])
 apply (simp add: zadd_zmult_distrib2)
 apply (erule zle_zless_trans)
 apply (erule zadd_zless_mono2)
 done
 
 lemma zdiv_mono2_lemma:
      "\<lbrakk>b$*q $+ r = b'$*q' $+ r';  #0 $\<le> b'$*q' $+ r';
          r' $< b';  #0 $\<le> r;  #0 $< b';  b' $\<le> b\<rbrakk>
       \<Longrightarrow> q $\<le> q'"
 apply (frule q_pos_lemma, assumption+)
 apply (subgoal_tac "b$*q $< b$* (q' $+ #1)")
  apply (simp add: zmult_zless_cancel1)
  apply (force dest: zless_add1_iff_zle [THEN iffD1] zless_trans zless_zle_trans)
 apply (subgoal_tac "b$*q = r' $- r $+ b'$*q'")
  prefer 2 apply (simp add: zcompare_rls)
 apply (simp (no_asm_simp) add: zadd_zmult_distrib2)
 apply (subst zadd_commute [of "b $* q'"], rule zadd_zless_mono)
  prefer 2 apply (blast intro: zmult_zle_mono1)
 apply (subgoal_tac "r' $+ #0 $< b $+ r")
  apply (simp add: zcompare_rls)
 apply (rule zadd_zless_mono)
  apply auto
 apply (blast dest: zless_zle_trans)
 done
 
 
 lemma zdiv_mono2_raw:
      "\<lbrakk>#0 $\<le> a;  #0 $< b';  b' $\<le> b;  a \<in> int\<rbrakk>
       \<Longrightarrow> a zdiv b $\<le> a zdiv b'"
 apply (subgoal_tac "#0 $< b")
  prefer 2 apply (blast dest: zless_zle_trans)
 apply (cut_tac a = "a" and b = "b" in zmod_zdiv_equality)
 apply (cut_tac a = "a" and b = "b'" in zmod_zdiv_equality)
 apply (rule zdiv_mono2_lemma)
 apply (erule subst)
 apply (erule subst)
 apply (simp_all add: pos_mod_sign pos_mod_bound)
 done
 
 lemma zdiv_mono2:
      "\<lbrakk>#0 $\<le> a;  #0 $< b';  b' $\<le> b\<rbrakk>
       \<Longrightarrow> a zdiv b $\<le> a zdiv b'"
 apply (cut_tac a = "intify (a)" in zdiv_mono2_raw)
 apply auto
 done
 
 lemma q_neg_lemma:
      "\<lbrakk>b'$*q' $+ r' $< #0;  #0 $\<le> r';  #0 $< b'\<rbrakk> \<Longrightarrow> q' $< #0"
 apply (subgoal_tac "b'$*q' $< #0")
  prefer 2 apply (force intro: zle_zless_trans)
 apply (simp add: zmult_less_0_iff)
 apply (blast dest: zless_trans)
 done
 
 
 
 lemma zdiv_mono2_neg_lemma:
      "\<lbrakk>b$*q $+ r = b'$*q' $+ r';  b'$*q' $+ r' $< #0;
          r $< b;  #0 $\<le> r';  #0 $< b';  b' $\<le> b\<rbrakk>
       \<Longrightarrow> q' $\<le> q"
 apply (subgoal_tac "#0 $< b")
  prefer 2 apply (blast dest: zless_zle_trans)
 apply (frule q_neg_lemma, assumption+)
 apply (subgoal_tac "b$*q' $< b$* (q $+ #1)")
  apply (simp add: zmult_zless_cancel1)
  apply (blast dest: zless_trans zless_add1_iff_zle [THEN iffD1])
 apply (simp (no_asm_simp) add: zadd_zmult_distrib2)
 apply (subgoal_tac "b$*q' $\<le> b'$*q'")
  prefer 2
  apply (simp add: zmult_zle_cancel2)
  apply (blast dest: zless_trans)
 apply (subgoal_tac "b'$*q' $+ r $< b $+ (b$*q $+ r)")
  prefer 2
  apply (erule ssubst)
  apply simp
  apply (drule_tac w' = "r" and z' = "#0" in zadd_zless_mono)
   apply (assumption)
  apply simp
 apply (simp (no_asm_use) add: zadd_commute)
 apply (rule zle_zless_trans)
  prefer 2 apply (assumption)
 apply (simp (no_asm_simp) add: zmult_zle_cancel2)
 apply (blast dest: zless_trans)
 done
 
 lemma zdiv_mono2_neg_raw:
      "\<lbrakk>a $< #0;  #0 $< b';  b' $\<le> b;  a \<in> int\<rbrakk>
       \<Longrightarrow> a zdiv b' $\<le> a zdiv b"
 apply (subgoal_tac "#0 $< b")
  prefer 2 apply (blast dest: zless_zle_trans)
 apply (cut_tac a = "a" and b = "b" in zmod_zdiv_equality)
 apply (cut_tac a = "a" and b = "b'" in zmod_zdiv_equality)
 apply (rule zdiv_mono2_neg_lemma)
 apply (erule subst)
 apply (erule subst)
 apply (simp_all add: pos_mod_sign pos_mod_bound)
 done
 
 lemma zdiv_mono2_neg: "\<lbrakk>a $< #0;  #0 $< b';  b' $\<le> b\<rbrakk>
       \<Longrightarrow> a zdiv b' $\<le> a zdiv b"
 apply (cut_tac a = "intify (a)" in zdiv_mono2_neg_raw)
 apply auto
 done
 
 
 
 subsection\<open>More algebraic laws for zdiv and zmod\<close>
 
 (** proving (a*b) zdiv c = a $* (b zdiv c) $+ a * (b zmod c) **)
 
 lemma zmult1_lemma:
      "\<lbrakk>quorem(\<langle>b,c\<rangle>, \<langle>q,r\<rangle>);  c \<in> int;  c \<noteq> #0\<rbrakk>
       \<Longrightarrow> quorem (<a$*b, c>, <a$*q $+ (a$*r) zdiv c, (a$*r) zmod c>)"
 apply (auto simp add: split_ifs quorem_def neq_iff_zless zadd_zmult_distrib2
                       pos_mod_sign pos_mod_bound neg_mod_sign neg_mod_bound)
 apply (auto intro: raw_zmod_zdiv_equality)
 done
 
 lemma zdiv_zmult1_eq_raw:
      "\<lbrakk>b \<in> int;  c \<in> int\<rbrakk>
       \<Longrightarrow> (a$*b) zdiv c = a$*(b zdiv c) $+ a$*(b zmod c) zdiv c"
 apply (case_tac "c = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (rule quorem_div_mod [THEN zmult1_lemma, THEN quorem_div])
 apply auto
 done
 
 lemma zdiv_zmult1_eq: "(a$*b) zdiv c = a$*(b zdiv c) $+ a$*(b zmod c) zdiv c"
 apply (cut_tac b = "intify (b)" and c = "intify (c)" in zdiv_zmult1_eq_raw)
 apply auto
 done
 
 lemma zmod_zmult1_eq_raw:
      "\<lbrakk>b \<in> int;  c \<in> int\<rbrakk> \<Longrightarrow> (a$*b) zmod c = a$*(b zmod c) zmod c"
 apply (case_tac "c = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (rule quorem_div_mod [THEN zmult1_lemma, THEN quorem_mod])
 apply auto
 done
 
 lemma zmod_zmult1_eq: "(a$*b) zmod c = a$*(b zmod c) zmod c"
 apply (cut_tac b = "intify (b)" and c = "intify (c)" in zmod_zmult1_eq_raw)
 apply auto
 done
 
 lemma zmod_zmult1_eq': "(a$*b) zmod c = ((a zmod c) $* b) zmod c"
 apply (rule trans)
 apply (rule_tac b = " (b $* a) zmod c" in trans)
 apply (rule_tac [2] zmod_zmult1_eq)
 apply (simp_all (no_asm) add: zmult_commute)
 done
 
 lemma zmod_zmult_distrib: "(a$*b) zmod c = ((a zmod c) $* (b zmod c)) zmod c"
 apply (rule zmod_zmult1_eq' [THEN trans])
 apply (rule zmod_zmult1_eq)
 done
 
 lemma zdiv_zmult_self1 [simp]: "intify(b) \<noteq> #0 \<Longrightarrow> (a$*b) zdiv b = intify(a)"
   by (simp add: zdiv_zmult1_eq)
 
 lemma zdiv_zmult_self2 [simp]: "intify(b) \<noteq> #0 \<Longrightarrow> (b$*a) zdiv b = intify(a)"
   by (simp add: zmult_commute) 
 
 lemma zmod_zmult_self1 [simp]: "(a$*b) zmod b = #0"
   by (simp add: zmod_zmult1_eq)
 
 lemma zmod_zmult_self2 [simp]: "(b$*a) zmod b = #0"
   by (simp add: zmult_commute zmod_zmult1_eq)
 
 
 (** proving (a$+b) zdiv c =
             a zdiv c $+ b zdiv c $+ ((a zmod c $+ b zmod c) zdiv c) **)
 
 lemma zadd1_lemma:
      "\<lbrakk>quorem(\<langle>a,c\<rangle>, \<langle>aq,ar\<rangle>);  quorem(\<langle>b,c\<rangle>, \<langle>bq,br\<rangle>);
          c \<in> int;  c \<noteq> #0\<rbrakk>
       \<Longrightarrow> quorem (<a$+b, c>, <aq $+ bq $+ (ar$+br) zdiv c, (ar$+br) zmod c>)"
 apply (auto simp add: split_ifs quorem_def neq_iff_zless zadd_zmult_distrib2
                       pos_mod_sign pos_mod_bound neg_mod_sign neg_mod_bound)
 apply (auto intro: raw_zmod_zdiv_equality)
 done
 
 (*NOT suitable for rewriting: the RHS has an instance of the LHS*)
 lemma zdiv_zadd1_eq_raw:
      "\<lbrakk>a \<in> int; b \<in> int; c \<in> int\<rbrakk> \<Longrightarrow>
       (a$+b) zdiv c = a zdiv c $+ b zdiv c $+ ((a zmod c $+ b zmod c) zdiv c)"
 apply (case_tac "c = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (blast intro: zadd1_lemma [OF quorem_div_mod quorem_div_mod,
                                  THEN quorem_div])
 done
 
 lemma zdiv_zadd1_eq:
      "(a$+b) zdiv c = a zdiv c $+ b zdiv c $+ ((a zmod c $+ b zmod c) zdiv c)"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" and c = "intify (c)"
        in zdiv_zadd1_eq_raw)
 apply auto
 done
 
 lemma zmod_zadd1_eq_raw:
      "\<lbrakk>a \<in> int; b \<in> int; c \<in> int\<rbrakk>
       \<Longrightarrow> (a$+b) zmod c = (a zmod c $+ b zmod c) zmod c"
 apply (case_tac "c = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (blast intro: zadd1_lemma [OF quorem_div_mod quorem_div_mod,
                                  THEN quorem_mod])
 done
 
 lemma zmod_zadd1_eq: "(a$+b) zmod c = (a zmod c $+ b zmod c) zmod c"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" and c = "intify (c)"
        in zmod_zadd1_eq_raw)
 apply auto
 done
 
 lemma zmod_div_trivial_raw:
      "\<lbrakk>a \<in> int; b \<in> int\<rbrakk> \<Longrightarrow> (a zmod b) zdiv b = #0"
 apply (case_tac "b = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (auto simp add: neq_iff_zless pos_mod_sign pos_mod_bound
          zdiv_pos_pos_trivial neg_mod_sign neg_mod_bound zdiv_neg_neg_trivial)
 done
 
 lemma zmod_div_trivial [simp]: "(a zmod b) zdiv b = #0"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" in zmod_div_trivial_raw)
 apply auto
 done
 
 lemma zmod_mod_trivial_raw:
      "\<lbrakk>a \<in> int; b \<in> int\<rbrakk> \<Longrightarrow> (a zmod b) zmod b = a zmod b"
 apply (case_tac "b = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (auto simp add: neq_iff_zless pos_mod_sign pos_mod_bound
        zmod_pos_pos_trivial neg_mod_sign neg_mod_bound zmod_neg_neg_trivial)
 done
 
 lemma zmod_mod_trivial [simp]: "(a zmod b) zmod b = a zmod b"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" in zmod_mod_trivial_raw)
 apply auto
 done
 
 lemma zmod_zadd_left_eq: "(a$+b) zmod c = ((a zmod c) $+ b) zmod c"
 apply (rule trans [symmetric])
 apply (rule zmod_zadd1_eq)
 apply (simp (no_asm))
 apply (rule zmod_zadd1_eq [symmetric])
 done
 
 lemma zmod_zadd_right_eq: "(a$+b) zmod c = (a $+ (b zmod c)) zmod c"
 apply (rule trans [symmetric])
 apply (rule zmod_zadd1_eq)
 apply (simp (no_asm))
 apply (rule zmod_zadd1_eq [symmetric])
 done
 
 
 lemma zdiv_zadd_self1 [simp]:
      "intify(a) \<noteq> #0 \<Longrightarrow> (a$+b) zdiv a = b zdiv a $+ #1"
 by (simp (no_asm_simp) add: zdiv_zadd1_eq)
 
 lemma zdiv_zadd_self2 [simp]:
      "intify(a) \<noteq> #0 \<Longrightarrow> (b$+a) zdiv a = b zdiv a $+ #1"
 by (simp (no_asm_simp) add: zdiv_zadd1_eq)
 
 lemma zmod_zadd_self1 [simp]: "(a$+b) zmod a = b zmod a"
 apply (case_tac "a = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (simp (no_asm_simp) add: zmod_zadd1_eq)
 done
 
 lemma zmod_zadd_self2 [simp]: "(b$+a) zmod a = b zmod a"
 apply (case_tac "a = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (simp (no_asm_simp) add: zmod_zadd1_eq)
 done
 
 
 subsection\<open>proving  a zdiv (b*c) = (a zdiv b) zdiv c\<close>
 
 (*The condition c>0 seems necessary.  Consider that 7 zdiv \<not>6 = \<not>2 but
   7 zdiv 2 zdiv \<not>3 = 3 zdiv \<not>3 = \<not>1.  The subcase (a zdiv b) zmod c = 0 seems
   to cause particular problems.*)
 
 (** first, four lemmas to bound the remainder for the cases b<0 and b>0 **)
 
 lemma zdiv_zmult2_aux1:
      "\<lbrakk>#0 $< c;  b $< r;  r $\<le> #0\<rbrakk> \<Longrightarrow> b$*c $< b$*(q zmod c) $+ r"
 apply (subgoal_tac "b $* (c $- q zmod c) $< r $* #1")
 apply (simp add: zdiff_zmult_distrib2 zadd_commute zcompare_rls)
 apply (rule zle_zless_trans)
 apply (erule_tac [2] zmult_zless_mono1)
 apply (rule zmult_zle_mono2_neg)
 apply (auto simp add: zcompare_rls zadd_commute add1_zle_iff pos_mod_bound)
 apply (blast intro: zless_imp_zle dest: zless_zle_trans)
 done
 
 lemma zdiv_zmult2_aux2:
      "\<lbrakk>#0 $< c;   b $< r;  r $\<le> #0\<rbrakk> \<Longrightarrow> b $* (q zmod c) $+ r $\<le> #0"
 apply (subgoal_tac "b $* (q zmod c) $\<le> #0")
  prefer 2
  apply (simp add: zmult_le_0_iff pos_mod_sign)
  apply (blast intro: zless_imp_zle dest: zless_zle_trans)
 (*arithmetic*)
 apply (drule zadd_zle_mono)
 apply assumption
 apply (simp add: zadd_commute)
 done
 
 lemma zdiv_zmult2_aux3:
      "\<lbrakk>#0 $< c;  #0 $\<le> r;  r $< b\<rbrakk> \<Longrightarrow> #0 $\<le> b $* (q zmod c) $+ r"
 apply (subgoal_tac "#0 $\<le> b $* (q zmod c)")
  prefer 2
  apply (simp add: int_0_le_mult_iff pos_mod_sign)
  apply (blast intro: zless_imp_zle dest: zle_zless_trans)
 (*arithmetic*)
 apply (drule zadd_zle_mono)
 apply assumption
 apply (simp add: zadd_commute)
 done
 
 lemma zdiv_zmult2_aux4:
      "\<lbrakk>#0 $< c; #0 $\<le> r; r $< b\<rbrakk> \<Longrightarrow> b $* (q zmod c) $+ r $< b $* c"
 apply (subgoal_tac "r $* #1 $< b $* (c $- q zmod c)")
 apply (simp add: zdiff_zmult_distrib2 zadd_commute zcompare_rls)
 apply (rule zless_zle_trans)
 apply (erule zmult_zless_mono1)
 apply (rule_tac [2] zmult_zle_mono2)
 apply (auto simp add: zcompare_rls zadd_commute add1_zle_iff pos_mod_bound)
 apply (blast intro: zless_imp_zle dest: zle_zless_trans)
 done
 
 lemma zdiv_zmult2_lemma:
      "\<lbrakk>quorem (\<langle>a,b\<rangle>, \<langle>q,r\<rangle>);  a \<in> int;  b \<in> int;  b \<noteq> #0;  #0 $< c\<rbrakk>
       \<Longrightarrow> quorem (<a,b$*c>, <q zdiv c, b$*(q zmod c) $+ r>)"
 apply (auto simp add: zmult_ac zmod_zdiv_equality [symmetric] quorem_def
                neq_iff_zless int_0_less_mult_iff
                zadd_zmult_distrib2 [symmetric] zdiv_zmult2_aux1 zdiv_zmult2_aux2
                zdiv_zmult2_aux3 zdiv_zmult2_aux4)
 apply (blast dest: zless_trans)+
 done
 
 lemma zdiv_zmult2_eq_raw:
      "\<lbrakk>#0 $< c;  a \<in> int;  b \<in> int\<rbrakk> \<Longrightarrow> a zdiv (b$*c) = (a zdiv b) zdiv c"
 apply (case_tac "b = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (rule quorem_div_mod [THEN zdiv_zmult2_lemma, THEN quorem_div])
 apply (auto simp add: intify_eq_0_iff_zle)
 apply (blast dest: zle_zless_trans)
 done
 
 lemma zdiv_zmult2_eq: "#0 $< c \<Longrightarrow> a zdiv (b$*c) = (a zdiv b) zdiv c"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" in zdiv_zmult2_eq_raw)
 apply auto
 done
 
 lemma zmod_zmult2_eq_raw:
      "\<lbrakk>#0 $< c;  a \<in> int;  b \<in> int\<rbrakk>
       \<Longrightarrow> a zmod (b$*c) = b$*(a zdiv b zmod c) $+ a zmod b"
 apply (case_tac "b = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (rule quorem_div_mod [THEN zdiv_zmult2_lemma, THEN quorem_mod])
 apply (auto simp add: intify_eq_0_iff_zle)
 apply (blast dest: zle_zless_trans)
 done
 
 lemma zmod_zmult2_eq:
      "#0 $< c \<Longrightarrow> a zmod (b$*c) = b$*(a zdiv b zmod c) $+ a zmod b"
 apply (cut_tac a = "intify (a)" and b = "intify (b)" in zmod_zmult2_eq_raw)
 apply auto
 done
 
 subsection\<open>Cancellation of common factors in "zdiv"\<close>
 
 lemma zdiv_zmult_zmult1_aux1:
      "\<lbrakk>#0 $< b;  intify(c) \<noteq> #0\<rbrakk> \<Longrightarrow> (c$*a) zdiv (c$*b) = a zdiv b"
 apply (subst zdiv_zmult2_eq)
 apply auto
 done
 
 lemma zdiv_zmult_zmult1_aux2:
      "\<lbrakk>b $< #0;  intify(c) \<noteq> #0\<rbrakk> \<Longrightarrow> (c$*a) zdiv (c$*b) = a zdiv b"
 apply (subgoal_tac " (c $* ($-a)) zdiv (c $* ($-b)) = ($-a) zdiv ($-b)")
 apply (rule_tac [2] zdiv_zmult_zmult1_aux1)
 apply auto
 done
 
 lemma zdiv_zmult_zmult1_raw:
      "\<lbrakk>intify(c) \<noteq> #0; b \<in> int\<rbrakk> \<Longrightarrow> (c$*a) zdiv (c$*b) = a zdiv b"
 apply (case_tac "b = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (auto simp add: neq_iff_zless [of b]
   zdiv_zmult_zmult1_aux1 zdiv_zmult_zmult1_aux2)
 done
 
 lemma zdiv_zmult_zmult1: "intify(c) \<noteq> #0 \<Longrightarrow> (c$*a) zdiv (c$*b) = a zdiv b"
 apply (cut_tac b = "intify (b)" in zdiv_zmult_zmult1_raw)
 apply auto
 done
 
 lemma zdiv_zmult_zmult2: "intify(c) \<noteq> #0 \<Longrightarrow> (a$*c) zdiv (b$*c) = a zdiv b"
 apply (drule zdiv_zmult_zmult1)
 apply (auto simp add: zmult_commute)
 done
 
 
 subsection\<open>Distribution of factors over "zmod"\<close>
 
 lemma zmod_zmult_zmult1_aux1:
      "\<lbrakk>#0 $< b;  intify(c) \<noteq> #0\<rbrakk>
       \<Longrightarrow> (c$*a) zmod (c$*b) = c $* (a zmod b)"
 apply (subst zmod_zmult2_eq)
 apply auto
 done
 
 lemma zmod_zmult_zmult1_aux2:
      "\<lbrakk>b $< #0;  intify(c) \<noteq> #0\<rbrakk>
       \<Longrightarrow> (c$*a) zmod (c$*b) = c $* (a zmod b)"
 apply (subgoal_tac " (c $* ($-a)) zmod (c $* ($-b)) = c $* (($-a) zmod ($-b))")
 apply (rule_tac [2] zmod_zmult_zmult1_aux1)
 apply auto
 done
 
 lemma zmod_zmult_zmult1_raw:
      "\<lbrakk>b \<in> int; c \<in> int\<rbrakk> \<Longrightarrow> (c$*a) zmod (c$*b) = c $* (a zmod b)"
 apply (case_tac "b = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (case_tac "c = #0")
  apply (simp add: DIVISION_BY_ZERO_ZDIV DIVISION_BY_ZERO_ZMOD)
 apply (auto simp add: neq_iff_zless [of b]
   zmod_zmult_zmult1_aux1 zmod_zmult_zmult1_aux2)
 done
 
 lemma zmod_zmult_zmult1: "(c$*a) zmod (c$*b) = c $* (a zmod b)"
 apply (cut_tac b = "intify (b)" and c = "intify (c)" in zmod_zmult_zmult1_raw)
 apply auto
 done
 
 lemma zmod_zmult_zmult2: "(a$*c) zmod (b$*c) = (a zmod b) $* c"
 apply (cut_tac c = "c" in zmod_zmult_zmult1)
 apply (auto simp add: zmult_commute)
 done
 
 
 (** Quotients of signs **)
 
 lemma zdiv_neg_pos_less0: "\<lbrakk>a $< #0;  #0 $< b\<rbrakk> \<Longrightarrow> a zdiv b $< #0"
 apply (subgoal_tac "a zdiv b $\<le> #-1")
 apply (erule zle_zless_trans)
 apply (simp (no_asm))
 apply (rule zle_trans)
 apply (rule_tac a' = "#-1" in zdiv_mono1)
 apply (rule zless_add1_iff_zle [THEN iffD1])
 apply (simp (no_asm))
 apply (auto simp add: zdiv_minus1)
 done
 
 lemma zdiv_nonneg_neg_le0: "\<lbrakk>#0 $\<le> a;  b $< #0\<rbrakk> \<Longrightarrow> a zdiv b $\<le> #0"
 apply (drule zdiv_mono1_neg)
 apply auto
 done
 
 lemma pos_imp_zdiv_nonneg_iff: "#0 $< b \<Longrightarrow> (#0 $\<le> a zdiv b) \<longleftrightarrow> (#0 $\<le> a)"
 apply auto
 apply (drule_tac [2] zdiv_mono1)
 apply (auto simp add: neq_iff_zless)
 apply (simp (no_asm_use) add: not_zless_iff_zle [THEN iff_sym])
 apply (blast intro: zdiv_neg_pos_less0)
 done
 
 lemma neg_imp_zdiv_nonneg_iff: "b $< #0 \<Longrightarrow> (#0 $\<le> a zdiv b) \<longleftrightarrow> (a $\<le> #0)"
 apply (subst zdiv_zminus_zminus [symmetric])
 apply (rule iff_trans)
 apply (rule pos_imp_zdiv_nonneg_iff)
 apply auto
 done
 
 (*But not (a zdiv b $\<le> 0 iff a$\<le>0); consider a=1, b=2 when a zdiv b = 0.*)
 lemma pos_imp_zdiv_neg_iff: "#0 $< b \<Longrightarrow> (a zdiv b $< #0) \<longleftrightarrow> (a $< #0)"
 apply (simp (no_asm_simp) add: not_zle_iff_zless [THEN iff_sym])
 apply (erule pos_imp_zdiv_nonneg_iff)
 done
 
 (*Again the law fails for $\<le>: consider a = -1, b = -2 when a zdiv b = 0*)
 lemma neg_imp_zdiv_neg_iff: "b $< #0 \<Longrightarrow> (a zdiv b $< #0) \<longleftrightarrow> (#0 $< a)"
 apply (simp (no_asm_simp) add: not_zle_iff_zless [THEN iff_sym])
 apply (erule neg_imp_zdiv_nonneg_iff)
 done
 
 (*
  THESE REMAIN TO BE CONVERTED -- but aren't that useful!
 
  subsection{* Speeding up the division algorithm with shifting *}
 
  (** computing "zdiv" by shifting **)
 
  lemma pos_zdiv_mult_2: "#0 $\<le> a \<Longrightarrow> (#1 $+ #2$*b) zdiv (#2$*a) = b zdiv a"
  apply (case_tac "a = #0")
  apply (subgoal_tac "#1 $\<le> a")
   apply (arith_tac 2)
  apply (subgoal_tac "#1 $< a $* #2")
   apply (arith_tac 2)
  apply (subgoal_tac "#2$* (#1 $+ b zmod a) $\<le> #2$*a")
   apply (rule_tac [2] zmult_zle_mono2)
  apply (auto simp add: zadd_commute zmult_commute add1_zle_iff pos_mod_bound)
  apply (subst zdiv_zadd1_eq)
  apply (simp (no_asm_simp) add: zdiv_zmult_zmult2 zmod_zmult_zmult2 zdiv_pos_pos_trivial)
  apply (subst zdiv_pos_pos_trivial)
  apply (simp (no_asm_simp) add: [zmod_pos_pos_trivial pos_mod_sign [THEN zadd_zle_mono1] RSN (2,zle_trans) ])
  apply (auto simp add: zmod_pos_pos_trivial)
  apply (subgoal_tac "#0 $\<le> b zmod a")
   apply (asm_simp_tac (simpset () add: pos_mod_sign) 2)
  apply arith
  done
 
 
  lemma neg_zdiv_mult_2: "a $\<le> #0 \<Longrightarrow> (#1 $+ #2$*b) zdiv (#2$*a) \<longleftrightarrow> (b$+#1) zdiv a"
  apply (subgoal_tac " (#1 $+ #2$* ($-b-#1)) zdiv (#2 $* ($-a)) \<longleftrightarrow> ($-b-#1) zdiv ($-a)")
  apply (rule_tac [2] pos_zdiv_mult_2)
  apply (auto simp add: zmult_zminus_right)
  apply (subgoal_tac " (#-1 - (#2 $* b)) = - (#1 $+ (#2 $* b))")
  apply (Simp_tac 2)
  apply (asm_full_simp_tac (HOL_ss add: zdiv_zminus_zminus zdiff_def zminus_zadd_distrib [symmetric])
  done
 
 
  (*Not clear why this must be proved separately; probably integ_of causes
    simplification problems*)
  lemma lemma: "\<not> #0 $\<le> x \<Longrightarrow> x $\<le> #0"
  apply auto
  done
 
  lemma zdiv_integ_of_BIT: "integ_of (v BIT b) zdiv integ_of (w BIT False) =
            (if \<not>b | #0 $\<le> integ_of w
             then integ_of v zdiv (integ_of w)
             else (integ_of v $+ #1) zdiv (integ_of w))"
  apply (simp_tac (simpset_of @{theory_context Int} add: zadd_assoc integ_of_BIT)
  apply (simp (no_asm_simp) del: bin_arith_extra_simps@bin_rel_simps add: zdiv_zmult_zmult1 pos_zdiv_mult_2 lemma neg_zdiv_mult_2)
  done
 
  declare zdiv_integ_of_BIT [simp]
 
 
  (** computing "zmod" by shifting (proofs resemble those for "zdiv") **)
 
  lemma pos_zmod_mult_2: "#0 $\<le> a \<Longrightarrow> (#1 $+ #2$*b) zmod (#2$*a) = #1 $+ #2 $* (b zmod a)"
  apply (case_tac "a = #0")
  apply (subgoal_tac "#1 $\<le> a")
   apply (arith_tac 2)
  apply (subgoal_tac "#1 $< a $* #2")
   apply (arith_tac 2)
  apply (subgoal_tac "#2$* (#1 $+ b zmod a) $\<le> #2$*a")
   apply (rule_tac [2] zmult_zle_mono2)
  apply (auto simp add: zadd_commute zmult_commute add1_zle_iff pos_mod_bound)
  apply (subst zmod_zadd1_eq)
  apply (simp (no_asm_simp) add: zmod_zmult_zmult2 zmod_pos_pos_trivial)
  apply (rule zmod_pos_pos_trivial)
  apply (simp (no_asm_simp) # add: [zmod_pos_pos_trivial pos_mod_sign [THEN zadd_zle_mono1] RSN (2,zle_trans) ])
  apply (auto simp add: zmod_pos_pos_trivial)
  apply (subgoal_tac "#0 $\<le> b zmod a")
   apply (asm_simp_tac (simpset () add: pos_mod_sign) 2)
  apply arith
  done
 
 
  lemma neg_zmod_mult_2: "a $\<le> #0 \<Longrightarrow> (#1 $+ #2$*b) zmod (#2$*a) = #2 $* ((b$+#1) zmod a) - #1"
  apply (subgoal_tac " (#1 $+ #2$* ($-b-#1)) zmod (#2$* ($-a)) = #1 $+ #2$* (($-b-#1) zmod ($-a))")
  apply (rule_tac [2] pos_zmod_mult_2)
  apply (auto simp add: zmult_zminus_right)
  apply (subgoal_tac " (#-1 - (#2 $* b)) = - (#1 $+ (#2 $* b))")
  apply (Simp_tac 2)
  apply (asm_full_simp_tac (HOL_ss add: zmod_zminus_zminus zdiff_def zminus_zadd_distrib [symmetric])
  apply (dtac (zminus_equation [THEN iffD1, symmetric])
  apply auto
  done
 
  lemma zmod_integ_of_BIT: "integ_of (v BIT b) zmod integ_of (w BIT False) =
            (if b then
                  if #0 $\<le> integ_of w
                  then #2 $* (integ_of v zmod integ_of w) $+ #1
                  else #2 $* ((integ_of v $+ #1) zmod integ_of w) - #1
             else #2 $* (integ_of v zmod integ_of w))"
  apply (simp_tac (simpset_of @{theory_context Int} add: zadd_assoc integ_of_BIT)
  apply (simp (no_asm_simp) del: bin_arith_extra_simps@bin_rel_simps add: zmod_zmult_zmult1 pos_zmod_mult_2 lemma neg_zmod_mult_2)
  done
 
  declare zmod_integ_of_BIT [simp]
 *)
 
 end
 
diff --git a/src/ZF/List.thy b/src/ZF/List.thy
--- a/src/ZF/List.thy
+++ b/src/ZF/List.thy
@@ -1,1270 +1,1270 @@
 (*  Title:      ZF/List.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section\<open>Lists in Zermelo-Fraenkel Set Theory\<close>
 
 theory List imports Datatype ArithSimp begin
 
 consts
   list       :: "i\<Rightarrow>i"
 
 datatype
   "list(A)" = Nil | Cons ("a \<in> A", "l \<in> list(A)")
 
 
 syntax
  "_Nil" :: i  (\<open>[]\<close>)
  "_List" :: "is \<Rightarrow> i"  (\<open>[(_)]\<close>)
 
 translations
   "[x, xs]"     == "CONST Cons(x, [xs])"
   "[x]"         == "CONST Cons(x, [])"
   "[]"          == "CONST Nil"
 
 
 consts
   length :: "i\<Rightarrow>i"
   hd     :: "i\<Rightarrow>i"
   tl     :: "i\<Rightarrow>i"
 
 primrec
   "length([]) = 0"
   "length(Cons(a,l)) = succ(length(l))"
 
 primrec
   "hd([]) = 0"
   "hd(Cons(a,l)) = a"
 
 primrec
   "tl([]) = []"
   "tl(Cons(a,l)) = l"
 
 
 consts
   map         :: "[i\<Rightarrow>i, i] \<Rightarrow> i"
   set_of_list :: "i\<Rightarrow>i"
   app         :: "[i,i]\<Rightarrow>i"                        (infixr \<open>@\<close> 60)
 
 (*map is a binding operator -- it applies to meta-level functions, not
 object-level functions.  This simplifies the final form of term_rec_conv,
 although complicating its derivation.*)
 primrec
   "map(f,[]) = []"
   "map(f,Cons(a,l)) = Cons(f(a), map(f,l))"
 
 primrec
   "set_of_list([]) = 0"
   "set_of_list(Cons(a,l)) = cons(a, set_of_list(l))"
 
 primrec
   app_Nil:  "[] @ ys = ys"
   app_Cons: "(Cons(a,l)) @ ys = Cons(a, l @ ys)"
 
 
 consts
   rev :: "i\<Rightarrow>i"
   flat       :: "i\<Rightarrow>i"
   list_add   :: "i\<Rightarrow>i"
 
 primrec
   "rev([]) = []"
   "rev(Cons(a,l)) = rev(l) @ [a]"
 
 primrec
   "flat([]) = []"
   "flat(Cons(l,ls)) = l @ flat(ls)"
 
 primrec
   "list_add([]) = 0"
   "list_add(Cons(a,l)) = a #+ list_add(l)"
 
 consts
   drop       :: "[i,i]\<Rightarrow>i"
 
 primrec
   drop_0:    "drop(0,l) = l"
   drop_succ: "drop(succ(i), l) = tl (drop(i,l))"
 
 
 (*** Thanks to Sidi Ehmety for the following ***)
 
 definition
 (* Function `take' returns the first n elements of a list *)
   take     :: "[i,i]\<Rightarrow>i"  where
   "take(n, as) \<equiv> list_rec(\<lambda>n\<in>nat. [],
                 \<lambda>a l r. \<lambda>n\<in>nat. nat_case([], \<lambda>m. Cons(a, r`m), n), as)`n"
 
 definition
   nth :: "[i, i]\<Rightarrow>i"  where
   \<comment> \<open>returns the (n+1)th element of a list, or 0 if the
    list is too short.\<close>
   "nth(n, as) \<equiv> list_rec(\<lambda>n\<in>nat. 0,
                           \<lambda>a l r. \<lambda>n\<in>nat. nat_case(a, \<lambda>m. r`m, n), as) ` n"
 
 definition
   list_update :: "[i, i, i]\<Rightarrow>i"  where
   "list_update(xs, i, v) \<equiv> list_rec(\<lambda>n\<in>nat. Nil,
       \<lambda>u us vs. \<lambda>n\<in>nat. nat_case(Cons(v, us), \<lambda>m. Cons(u, vs`m), n), xs)`i"
 
 consts
   filter :: "[i\<Rightarrow>o, i] \<Rightarrow> i"
   upt :: "[i, i] \<Rightarrow>i"
 
 primrec
   "filter(P, Nil) = Nil"
   "filter(P, Cons(x, xs)) =
      (if P(x) then Cons(x, filter(P, xs)) else filter(P, xs))"
 
 primrec
   "upt(i, 0) = Nil"
   "upt(i, succ(j)) = (if i \<le> j then upt(i, j)@[j] else Nil)"
 
 definition
   min :: "[i,i] \<Rightarrow>i"  where
     "min(x, y) \<equiv> (if x \<le> y then x else y)"
 
 definition
   max :: "[i, i] \<Rightarrow>i"  where
     "max(x, y) \<equiv> (if x \<le> y then y else x)"
 
 (*** Aspects of the datatype definition ***)
 
 declare list.intros [simp,TC]
 
 (*An elimination rule, for type-checking*)
 inductive_cases ConsE: "Cons(a,l) \<in> list(A)"
 
 lemma Cons_type_iff [simp]: "Cons(a,l) \<in> list(A) \<longleftrightarrow> a \<in> A \<and> l \<in> list(A)"
 by (blast elim: ConsE)
 
 (*Proving freeness results*)
 lemma Cons_iff: "Cons(a,l)=Cons(a',l') \<longleftrightarrow> a=a' \<and> l=l'"
 by auto
 
 lemma Nil_Cons_iff: "\<not> Nil=Cons(a,l)"
 by auto
 
 lemma list_unfold: "list(A) = {0} + (A * list(A))"
 by (blast intro!: list.intros [unfolded list.con_defs]
           elim: list.cases [unfolded list.con_defs])
 
 
 (**  Lemmas to justify using "list" in other recursive type definitions **)
 
 lemma list_mono: "A<=B \<Longrightarrow> list(A) \<subseteq> list(B)"
 apply (unfold list.defs )
 apply (rule lfp_mono)
 apply (simp_all add: list.bnd_mono)
 apply (assumption | rule univ_mono basic_monos)+
 done
 
 (*There is a similar proof by list induction.*)
 lemma list_univ: "list(univ(A)) \<subseteq> univ(A)"
 apply (unfold list.defs list.con_defs)
 apply (rule lfp_lowerbound)
 apply (rule_tac [2] A_subset_univ [THEN univ_mono])
 apply (blast intro!: zero_in_univ Inl_in_univ Inr_in_univ Pair_in_univ)
 done
 
 (*These two theorems justify datatypes involving list(nat), list(A), ...*)
 lemmas list_subset_univ = subset_trans [OF list_mono list_univ]
 
 lemma list_into_univ: "\<lbrakk>l \<in> list(A);  A \<subseteq> univ(B)\<rbrakk> \<Longrightarrow> l \<in> univ(B)"
 by (blast intro: list_subset_univ [THEN subsetD])
 
 lemma list_case_type:
     "\<lbrakk>l \<in> list(A);
         c \<in> C(Nil);
         \<And>x y. \<lbrakk>x \<in> A;  y \<in> list(A)\<rbrakk> \<Longrightarrow> h(x,y): C(Cons(x,y))
 \<rbrakk> \<Longrightarrow> list_case(c,h,l) \<in> C(l)"
 by (erule list.induct, auto)
 
 lemma list_0_triv: "list(0) = {Nil}"
 apply (rule equalityI, auto)
 apply (induct_tac x, auto)
 done
 
 
 (*** List functions ***)
 
 lemma tl_type: "l \<in> list(A) \<Longrightarrow> tl(l) \<in> list(A)"
 apply (induct_tac "l")
 apply (simp_all (no_asm_simp) add: list.intros)
 done
 
 (** drop **)
 
 lemma drop_Nil [simp]: "i \<in> nat \<Longrightarrow> drop(i, Nil) = Nil"
 apply (induct_tac "i")
 apply (simp_all (no_asm_simp))
 done
 
 lemma drop_succ_Cons [simp]: "i \<in> nat \<Longrightarrow> drop(succ(i), Cons(a,l)) = drop(i,l)"
 apply (rule sym)
 apply (induct_tac "i")
 apply (simp (no_asm))
 apply (simp (no_asm_simp))
 done
 
 lemma drop_type [simp,TC]: "\<lbrakk>i \<in> nat; l \<in> list(A)\<rbrakk> \<Longrightarrow> drop(i,l) \<in> list(A)"
 apply (induct_tac "i")
 apply (simp_all (no_asm_simp) add: tl_type)
 done
 
 declare drop_succ [simp del]
 
 
 (** Type checking -- proved by induction, as usual **)
 
 lemma list_rec_type [TC]:
     "\<lbrakk>l \<in> list(A);
         c \<in> C(Nil);
         \<And>x y r. \<lbrakk>x \<in> A;  y \<in> list(A);  r \<in> C(y)\<rbrakk> \<Longrightarrow> h(x,y,r): C(Cons(x,y))
 \<rbrakk> \<Longrightarrow> list_rec(c,h,l) \<in> C(l)"
 by (induct_tac "l", auto)
 
 (** map **)
 
 lemma map_type [TC]:
     "\<lbrakk>l \<in> list(A);  \<And>x. x \<in> A \<Longrightarrow> h(x): B\<rbrakk> \<Longrightarrow> map(h,l) \<in> list(B)"
 apply (simp add: map_list_def)
 apply (typecheck add: list.intros list_rec_type, blast)
 done
 
 lemma map_type2 [TC]: "l \<in> list(A) \<Longrightarrow> map(h,l) \<in> list({h(u). u \<in> A})"
 apply (erule map_type)
 apply (erule RepFunI)
 done
 
 (** length **)
 
 lemma length_type [TC]: "l \<in> list(A) \<Longrightarrow> length(l) \<in> nat"
 by (simp add: length_list_def)
 
 lemma lt_length_in_nat:
    "\<lbrakk>x < length(xs); xs \<in> list(A)\<rbrakk> \<Longrightarrow> x \<in> nat"
 by (frule lt_nat_in_nat, typecheck)
 
 (** app **)
 
 lemma app_type [TC]: "\<lbrakk>xs: list(A);  ys: list(A)\<rbrakk> \<Longrightarrow> xs@ys \<in> list(A)"
 by (simp add: app_list_def)
 
 (** rev **)
 
 lemma rev_type [TC]: "xs: list(A) \<Longrightarrow> rev(xs) \<in> list(A)"
 by (simp add: rev_list_def)
 
 
 (** flat **)
 
 lemma flat_type [TC]: "ls: list(list(A)) \<Longrightarrow> flat(ls) \<in> list(A)"
 by (simp add: flat_list_def)
 
 
 (** set_of_list **)
 
 lemma set_of_list_type [TC]: "l \<in> list(A) \<Longrightarrow> set_of_list(l) \<in> Pow(A)"
-apply (unfold set_of_list_list_def)
+  unfolding set_of_list_list_def
 apply (erule list_rec_type, auto)
 done
 
 lemma set_of_list_append:
      "xs: list(A) \<Longrightarrow> set_of_list (xs@ys) = set_of_list(xs) \<union> set_of_list(ys)"
 apply (erule list.induct)
 apply (simp_all (no_asm_simp) add: Un_cons)
 done
 
 
 (** list_add **)
 
 lemma list_add_type [TC]: "xs: list(nat) \<Longrightarrow> list_add(xs) \<in> nat"
 by (simp add: list_add_list_def)
 
 
 (*** theorems about map ***)
 
 lemma map_ident [simp]: "l \<in> list(A) \<Longrightarrow> map(\<lambda>u. u, l) = l"
 apply (induct_tac "l")
 apply (simp_all (no_asm_simp))
 done
 
 lemma map_compose: "l \<in> list(A) \<Longrightarrow> map(h, map(j,l)) = map(\<lambda>u. h(j(u)), l)"
 apply (induct_tac "l")
 apply (simp_all (no_asm_simp))
 done
 
 lemma map_app_distrib: "xs: list(A) \<Longrightarrow> map(h, xs@ys) = map(h,xs) @ map(h,ys)"
 apply (induct_tac "xs")
 apply (simp_all (no_asm_simp))
 done
 
 lemma map_flat: "ls: list(list(A)) \<Longrightarrow> map(h, flat(ls)) = flat(map(map(h),ls))"
 apply (induct_tac "ls")
 apply (simp_all (no_asm_simp) add: map_app_distrib)
 done
 
 lemma list_rec_map:
      "l \<in> list(A) \<Longrightarrow>
       list_rec(c, d, map(h,l)) =
       list_rec(c, \<lambda>x xs r. d(h(x), map(h,xs), r), l)"
 apply (induct_tac "l")
 apply (simp_all (no_asm_simp))
 done
 
 (** theorems about list(Collect(A,P)) -- used in Induct/Term.thy **)
 
 (* @{term"c \<in> list(Collect(B,P)) \<Longrightarrow> c \<in> list"} *)
 lemmas list_CollectD = Collect_subset [THEN list_mono, THEN subsetD]
 
 lemma map_list_Collect: "l \<in> list({x \<in> A. h(x)=j(x)}) \<Longrightarrow> map(h,l) = map(j,l)"
 apply (induct_tac "l")
 apply (simp_all (no_asm_simp))
 done
 
 (*** theorems about length ***)
 
 lemma length_map [simp]: "xs: list(A) \<Longrightarrow> length(map(h,xs)) = length(xs)"
 by (induct_tac "xs", simp_all)
 
 lemma length_app [simp]:
      "\<lbrakk>xs: list(A); ys: list(A)\<rbrakk>
       \<Longrightarrow> length(xs@ys) = length(xs) #+ length(ys)"
 by (induct_tac "xs", simp_all)
 
 lemma length_rev [simp]: "xs: list(A) \<Longrightarrow> length(rev(xs)) = length(xs)"
 apply (induct_tac "xs")
 apply (simp_all (no_asm_simp) add: length_app)
 done
 
 lemma length_flat:
      "ls: list(list(A)) \<Longrightarrow> length(flat(ls)) = list_add(map(length,ls))"
 apply (induct_tac "ls")
 apply (simp_all (no_asm_simp) add: length_app)
 done
 
 (** Length and drop **)
 
 (*Lemma for the inductive step of drop_length*)
 lemma drop_length_Cons [rule_format]:
      "xs: list(A) \<Longrightarrow>
            \<forall>x.  \<exists>z zs. drop(length(xs), Cons(x,xs)) = Cons(z,zs)"
 by (erule list.induct, simp_all)
 
 lemma drop_length [rule_format]:
      "l \<in> list(A) \<Longrightarrow> \<forall>i \<in> length(l). (\<exists>z zs. drop(i,l) = Cons(z,zs))"
 apply (erule list.induct, simp_all, safe)
 apply (erule drop_length_Cons)
 apply (rule natE)
 apply (erule Ord_trans [OF asm_rl length_type Ord_nat], assumption, simp_all)
 apply (blast intro: succ_in_naturalD length_type)
 done
 
 
 (*** theorems about app ***)
 
 lemma app_right_Nil [simp]: "xs: list(A) \<Longrightarrow> xs@Nil=xs"
 by (erule list.induct, simp_all)
 
 lemma app_assoc: "xs: list(A) \<Longrightarrow> (xs@ys)@zs = xs@(ys@zs)"
 by (induct_tac "xs", simp_all)
 
 lemma flat_app_distrib: "ls: list(list(A)) \<Longrightarrow> flat(ls@ms) = flat(ls)@flat(ms)"
 apply (induct_tac "ls")
 apply (simp_all (no_asm_simp) add: app_assoc)
 done
 
 (*** theorems about rev ***)
 
 lemma rev_map_distrib: "l \<in> list(A) \<Longrightarrow> rev(map(h,l)) = map(h,rev(l))"
 apply (induct_tac "l")
 apply (simp_all (no_asm_simp) add: map_app_distrib)
 done
 
 (*Simplifier needs the premises as assumptions because rewriting will not
   instantiate the variable ?A in the rules' typing conditions; note that
   rev_type does not instantiate ?A.  Only the premises do.
 *)
 lemma rev_app_distrib:
      "\<lbrakk>xs: list(A);  ys: list(A)\<rbrakk> \<Longrightarrow> rev(xs@ys) = rev(ys)@rev(xs)"
 apply (erule list.induct)
 apply (simp_all add: app_assoc)
 done
 
 lemma rev_rev_ident [simp]: "l \<in> list(A) \<Longrightarrow> rev(rev(l))=l"
 apply (induct_tac "l")
 apply (simp_all (no_asm_simp) add: rev_app_distrib)
 done
 
 lemma rev_flat: "ls: list(list(A)) \<Longrightarrow> rev(flat(ls)) = flat(map(rev,rev(ls)))"
 apply (induct_tac "ls")
 apply (simp_all add: map_app_distrib flat_app_distrib rev_app_distrib)
 done
 
 
 (*** theorems about list_add ***)
 
 lemma list_add_app:
      "\<lbrakk>xs: list(nat);  ys: list(nat)\<rbrakk>
       \<Longrightarrow> list_add(xs@ys) = list_add(ys) #+ list_add(xs)"
 apply (induct_tac "xs", simp_all)
 done
 
 lemma list_add_rev: "l \<in> list(nat) \<Longrightarrow> list_add(rev(l)) = list_add(l)"
 apply (induct_tac "l")
 apply (simp_all (no_asm_simp) add: list_add_app)
 done
 
 lemma list_add_flat:
      "ls: list(list(nat)) \<Longrightarrow> list_add(flat(ls)) = list_add(map(list_add,ls))"
 apply (induct_tac "ls")
 apply (simp_all (no_asm_simp) add: list_add_app)
 done
 
 (** New induction rules **)
 
 lemma list_append_induct [case_names Nil snoc, consumes 1]:
     "\<lbrakk>l \<in> list(A);
         P(Nil);
         \<And>x y. \<lbrakk>x \<in> A;  y \<in> list(A);  P(y)\<rbrakk> \<Longrightarrow> P(y @ [x])
 \<rbrakk> \<Longrightarrow> P(l)"
 apply (subgoal_tac "P(rev(rev(l)))", simp)
 apply (erule rev_type [THEN list.induct], simp_all)
 done
 
 lemma list_complete_induct_lemma [rule_format]:
  assumes ih:
     "\<And>l. \<lbrakk>l \<in> list(A);
              \<forall>l' \<in> list(A). length(l') < length(l) \<longrightarrow> P(l')\<rbrakk>
           \<Longrightarrow> P(l)"
   shows "n \<in> nat \<Longrightarrow> \<forall>l \<in> list(A). length(l) < n \<longrightarrow> P(l)"
 apply (induct_tac n, simp)
 apply (blast intro: ih elim!: leE)
 done
 
 theorem list_complete_induct:
       "\<lbrakk>l \<in> list(A);
           \<And>l. \<lbrakk>l \<in> list(A);
                   \<forall>l' \<in> list(A). length(l') < length(l) \<longrightarrow> P(l')\<rbrakk>
                \<Longrightarrow> P(l)
 \<rbrakk> \<Longrightarrow> P(l)"
 apply (rule list_complete_induct_lemma [of A])
    prefer 4 apply (rule le_refl, simp)
   apply blast
  apply simp
 apply assumption
 done
 
 
 (*** Thanks to Sidi Ehmety for these results about min, take, etc. ***)
 
 (** min FIXME: replace by Int! **)
 (* Min theorems are also true for i, j ordinals *)
 lemma min_sym: "\<lbrakk>i \<in> nat; j \<in> nat\<rbrakk> \<Longrightarrow> min(i,j)=min(j,i)"
-apply (unfold min_def)
+  unfolding min_def
 apply (auto dest!: not_lt_imp_le dest: lt_not_sym intro: le_anti_sym)
 done
 
 lemma min_type [simp,TC]: "\<lbrakk>i \<in> nat; j \<in> nat\<rbrakk> \<Longrightarrow> min(i,j):nat"
 by (unfold min_def, auto)
 
 lemma min_0 [simp]: "i \<in> nat \<Longrightarrow> min(0,i) = 0"
-apply (unfold min_def)
+  unfolding min_def
 apply (auto dest: not_lt_imp_le)
 done
 
 lemma min_02 [simp]: "i \<in> nat \<Longrightarrow> min(i, 0) = 0"
-apply (unfold min_def)
+  unfolding min_def
 apply (auto dest: not_lt_imp_le)
 done
 
 lemma lt_min_iff: "\<lbrakk>i \<in> nat; j \<in> nat; k \<in> nat\<rbrakk> \<Longrightarrow> i<min(j,k) \<longleftrightarrow> i<j \<and> i<k"
-apply (unfold min_def)
+  unfolding min_def
 apply (auto dest!: not_lt_imp_le intro: lt_trans2 lt_trans)
 done
 
 lemma min_succ_succ [simp]:
      "\<lbrakk>i \<in> nat; j \<in> nat\<rbrakk> \<Longrightarrow>  min(succ(i), succ(j))= succ(min(i, j))"
 apply (unfold min_def, auto)
 done
 
 (*** more theorems about lists ***)
 
 (** filter **)
 
 lemma filter_append [simp]:
      "xs:list(A) \<Longrightarrow> filter(P, xs@ys) = filter(P, xs) @ filter(P, ys)"
 by (induct_tac "xs", auto)
 
 lemma filter_type [simp,TC]: "xs:list(A) \<Longrightarrow> filter(P, xs):list(A)"
 by (induct_tac "xs", auto)
 
 lemma length_filter: "xs:list(A) \<Longrightarrow> length(filter(P, xs)) \<le> length(xs)"
 apply (induct_tac "xs", auto)
 apply (rule_tac j = "length (l) " in le_trans)
 apply (auto simp add: le_iff)
 done
 
 lemma filter_is_subset: "xs:list(A) \<Longrightarrow> set_of_list(filter(P,xs)) \<subseteq> set_of_list(xs)"
 by (induct_tac "xs", auto)
 
 lemma filter_False [simp]: "xs:list(A) \<Longrightarrow> filter(\<lambda>p. False, xs) = Nil"
 by (induct_tac "xs", auto)
 
 lemma filter_True [simp]: "xs:list(A) \<Longrightarrow> filter(\<lambda>p. True, xs) = xs"
 by (induct_tac "xs", auto)
 
 (** length **)
 
 lemma length_is_0_iff [simp]: "xs:list(A) \<Longrightarrow> length(xs)=0 \<longleftrightarrow> xs=Nil"
 by (erule list.induct, auto)
 
 lemma length_is_0_iff2 [simp]: "xs:list(A) \<Longrightarrow> 0 = length(xs) \<longleftrightarrow> xs=Nil"
 by (erule list.induct, auto)
 
 lemma length_tl [simp]: "xs:list(A) \<Longrightarrow> length(tl(xs)) = length(xs) #- 1"
 by (erule list.induct, auto)
 
 lemma length_greater_0_iff: "xs:list(A) \<Longrightarrow> 0<length(xs) \<longleftrightarrow> xs \<noteq> Nil"
 by (erule list.induct, auto)
 
 lemma length_succ_iff: "xs:list(A) \<Longrightarrow> length(xs)=succ(n) \<longleftrightarrow> (\<exists>y ys. xs=Cons(y, ys) \<and> length(ys)=n)"
 by (erule list.induct, auto)
 
 (** more theorems about append **)
 
 lemma append_is_Nil_iff [simp]:
      "xs:list(A) \<Longrightarrow> (xs@ys = Nil) \<longleftrightarrow> (xs=Nil \<and> ys = Nil)"
 by (erule list.induct, auto)
 
 lemma append_is_Nil_iff2 [simp]:
      "xs:list(A) \<Longrightarrow> (Nil = xs@ys) \<longleftrightarrow> (xs=Nil \<and> ys = Nil)"
 by (erule list.induct, auto)
 
 lemma append_left_is_self_iff [simp]:
      "xs:list(A) \<Longrightarrow> (xs@ys = xs) \<longleftrightarrow> (ys = Nil)"
 by (erule list.induct, auto)
 
 lemma append_left_is_self_iff2 [simp]:
      "xs:list(A) \<Longrightarrow> (xs = xs@ys) \<longleftrightarrow> (ys = Nil)"
 by (erule list.induct, auto)
 
 (*TOO SLOW as a default simprule!*)
 lemma append_left_is_Nil_iff [rule_format]:
      "\<lbrakk>xs:list(A); ys:list(A); zs:list(A)\<rbrakk> \<Longrightarrow>
    length(ys)=length(zs) \<longrightarrow> (xs@ys=zs \<longleftrightarrow> (xs=Nil \<and> ys=zs))"
 apply (erule list.induct)
 apply (auto simp add: length_app)
 done
 
 (*TOO SLOW as a default simprule!*)
 lemma append_left_is_Nil_iff2 [rule_format]:
      "\<lbrakk>xs:list(A); ys:list(A); zs:list(A)\<rbrakk> \<Longrightarrow>
    length(ys)=length(zs) \<longrightarrow> (zs=ys@xs \<longleftrightarrow> (xs=Nil \<and> ys=zs))"
 apply (erule list.induct)
 apply (auto simp add: length_app)
 done
 
 lemma append_eq_append_iff [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>ys \<in> list(A).
       length(xs)=length(ys) \<longrightarrow> (xs@us = ys@vs) \<longleftrightarrow> (xs=ys \<and> us=vs)"
 apply (erule list.induct)
 apply (simp (no_asm_simp))
 apply clarify
 apply (erule_tac a = ys in list.cases, auto)
 done
 declare append_eq_append_iff [simp]
 
 lemma append_eq_append [rule_format]:
   "xs:list(A) \<Longrightarrow>
    \<forall>ys \<in> list(A). \<forall>us \<in> list(A). \<forall>vs \<in> list(A).
    length(us) = length(vs) \<longrightarrow> (xs@us = ys@vs) \<longrightarrow> (xs=ys \<and> us=vs)"
 apply (induct_tac "xs")
 apply (force simp add: length_app, clarify)
 apply (erule_tac a = ys in list.cases, simp)
 apply (subgoal_tac "Cons (a, l) @ us =vs")
  apply (drule rev_iffD1 [OF _ append_left_is_Nil_iff], simp_all, blast)
 done
 
 lemma append_eq_append_iff2 [simp]:
  "\<lbrakk>xs:list(A); ys:list(A); us:list(A); vs:list(A); length(us)=length(vs)\<rbrakk>
   \<Longrightarrow>  xs@us = ys@vs \<longleftrightarrow> (xs=ys \<and> us=vs)"
 apply (rule iffI)
 apply (rule append_eq_append, auto)
 done
 
 lemma append_self_iff [simp]:
      "\<lbrakk>xs:list(A); ys:list(A); zs:list(A)\<rbrakk> \<Longrightarrow> xs@ys=xs@zs \<longleftrightarrow> ys=zs"
 by simp
 
 lemma append_self_iff2 [simp]:
      "\<lbrakk>xs:list(A); ys:list(A); zs:list(A)\<rbrakk> \<Longrightarrow> ys@xs=zs@xs \<longleftrightarrow> ys=zs"
 by simp
 
 (* Can also be proved from append_eq_append_iff2,
 but the proof requires two more hypotheses: x \<in> A and y \<in> A *)
 lemma append1_eq_iff [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>ys \<in> list(A). xs@[x] = ys@[y] \<longleftrightarrow> (xs = ys \<and> x=y)"
 apply (erule list.induct)
  apply clarify
  apply (erule list.cases)
  apply simp_all
 txt\<open>Inductive step\<close>
 apply clarify
 apply (erule_tac a=ys in list.cases, simp_all)
 done
 declare append1_eq_iff [simp]
 
 lemma append_right_is_self_iff [simp]:
      "\<lbrakk>xs:list(A); ys:list(A)\<rbrakk> \<Longrightarrow> (xs@ys = ys) \<longleftrightarrow> (xs=Nil)"
 by (simp (no_asm_simp) add: append_left_is_Nil_iff)
 
 lemma append_right_is_self_iff2 [simp]:
      "\<lbrakk>xs:list(A); ys:list(A)\<rbrakk> \<Longrightarrow> (ys = xs@ys) \<longleftrightarrow> (xs=Nil)"
 apply (rule iffI)
 apply (drule sym, auto)
 done
 
 lemma hd_append [rule_format]:
      "xs:list(A) \<Longrightarrow> xs \<noteq> Nil \<longrightarrow> hd(xs @ ys) = hd(xs)"
 by (induct_tac "xs", auto)
 declare hd_append [simp]
 
 lemma tl_append [rule_format]:
      "xs:list(A) \<Longrightarrow> xs\<noteq>Nil \<longrightarrow> tl(xs @ ys) = tl(xs)@ys"
 by (induct_tac "xs", auto)
 declare tl_append [simp]
 
 (** rev **)
 lemma rev_is_Nil_iff [simp]: "xs:list(A) \<Longrightarrow> (rev(xs) = Nil \<longleftrightarrow> xs = Nil)"
 by (erule list.induct, auto)
 
 lemma Nil_is_rev_iff [simp]: "xs:list(A) \<Longrightarrow> (Nil = rev(xs) \<longleftrightarrow> xs = Nil)"
 by (erule list.induct, auto)
 
 lemma rev_is_rev_iff [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>ys \<in> list(A). rev(xs)=rev(ys) \<longleftrightarrow> xs=ys"
 apply (erule list.induct, force, clarify)
 apply (erule_tac a = ys in list.cases, auto)
 done
 declare rev_is_rev_iff [simp]
 
 lemma rev_list_elim [rule_format]:
      "xs:list(A) \<Longrightarrow>
       (xs=Nil \<longrightarrow> P) \<longrightarrow> (\<forall>ys \<in> list(A). \<forall>y \<in> A. xs =ys@[y] \<longrightarrow>P)\<longrightarrow>P"
 by (erule list_append_induct, auto)
 
 
 (** more theorems about drop **)
 
 lemma length_drop [rule_format]:
      "n \<in> nat \<Longrightarrow> \<forall>xs \<in> list(A). length(drop(n, xs)) = length(xs) #- n"
 apply (erule nat_induct)
 apply (auto elim: list.cases)
 done
 declare length_drop [simp]
 
 lemma drop_all [rule_format]:
      "n \<in> nat \<Longrightarrow> \<forall>xs \<in> list(A). length(xs) \<le> n \<longrightarrow> drop(n, xs)=Nil"
 apply (erule nat_induct)
 apply (auto elim: list.cases)
 done
 declare drop_all [simp]
 
 lemma drop_append [rule_format]:
      "n \<in> nat \<Longrightarrow>
       \<forall>xs \<in> list(A). drop(n, xs@ys) = drop(n,xs) @ drop(n #- length(xs), ys)"
 apply (induct_tac "n")
 apply (auto elim: list.cases)
 done
 
 lemma drop_drop:
     "m \<in> nat \<Longrightarrow> \<forall>xs \<in> list(A). \<forall>n \<in> nat. drop(n, drop(m, xs))=drop(n #+ m, xs)"
 apply (induct_tac "m")
 apply (auto elim: list.cases)
 done
 
 (** take **)
 
 lemma take_0 [simp]: "xs:list(A) \<Longrightarrow> take(0, xs) =  Nil"
-apply (unfold take_def)
+  unfolding take_def
 apply (erule list.induct, auto)
 done
 
 lemma take_succ_Cons [simp]:
     "n \<in> nat \<Longrightarrow> take(succ(n), Cons(a, xs)) = Cons(a, take(n, xs))"
 by (simp add: take_def)
 
 (* Needed for proving take_all *)
 lemma take_Nil [simp]: "n \<in> nat \<Longrightarrow> take(n, Nil) = Nil"
 by (unfold take_def, auto)
 
 lemma take_all [rule_format]:
      "n \<in> nat \<Longrightarrow> \<forall>xs \<in> list(A). length(xs) \<le> n  \<longrightarrow> take(n, xs) = xs"
 apply (erule nat_induct)
 apply (auto elim: list.cases)
 done
 declare take_all [simp]
 
 lemma take_type [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>n \<in> nat. take(n, xs):list(A)"
 apply (erule list.induct, simp, clarify)
 apply (erule natE, auto)
 done
 declare take_type [simp,TC]
 
 lemma take_append [rule_format]:
  "xs:list(A) \<Longrightarrow>
   \<forall>ys \<in> list(A). \<forall>n \<in> nat. take(n, xs @ ys) =
                             take(n, xs) @ take(n #- length(xs), ys)"
 apply (erule list.induct, simp, clarify)
 apply (erule natE, auto)
 done
 declare take_append [simp]
 
 lemma take_take [rule_format]:
    "m \<in> nat \<Longrightarrow>
     \<forall>xs \<in> list(A). \<forall>n \<in> nat. take(n, take(m,xs))= take(min(n, m), xs)"
 apply (induct_tac "m", auto)
 apply (erule_tac a = xs in list.cases)
 apply (auto simp add: take_Nil)
 apply (erule_tac n=n in natE)
 apply (auto intro: take_0 take_type)
 done
 
 (** nth **)
 
 lemma nth_0 [simp]: "nth(0, Cons(a, l)) = a"
 by (simp add: nth_def)
 
 lemma nth_Cons [simp]: "n \<in> nat \<Longrightarrow> nth(succ(n), Cons(a,l)) = nth(n,l)"
 by (simp add: nth_def)
 
 lemma nth_empty [simp]: "nth(n, Nil) = 0"
 by (simp add: nth_def)
 
 lemma nth_type [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>n. n < length(xs) \<longrightarrow> nth(n,xs) \<in> A"
 apply (erule list.induct, simp, clarify)
 apply (subgoal_tac "n \<in> nat")
  apply (erule natE, auto dest!: le_in_nat)
 done
 declare nth_type [simp,TC]
 
 lemma nth_eq_0 [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>n \<in> nat. length(xs) \<le> n \<longrightarrow> nth(n,xs) = 0"
 apply (erule list.induct, simp, clarify)
 apply (erule natE, auto)
 done
 
 lemma nth_append [rule_format]:
   "xs:list(A) \<Longrightarrow>
    \<forall>n \<in> nat. nth(n, xs @ ys) = (if n < length(xs) then nth(n,xs)
                                 else nth(n #- length(xs), ys))"
 apply (induct_tac "xs", simp, clarify)
 apply (erule natE, auto)
 done
 
 lemma set_of_list_conv_nth:
     "xs:list(A)
      \<Longrightarrow> set_of_list(xs) = {x \<in> A. \<exists>i\<in>nat. i<length(xs) \<and> x = nth(i,xs)}"
 apply (induct_tac "xs", simp_all)
 apply (rule equalityI, auto)
 apply (rule_tac x = 0 in bexI, auto)
 apply (erule natE, auto)
 done
 
 (* Other theorems about lists *)
 
 lemma nth_take_lemma [rule_format]:
  "k \<in> nat \<Longrightarrow>
   \<forall>xs \<in> list(A). (\<forall>ys \<in> list(A). k \<le> length(xs) \<longrightarrow> k \<le> length(ys) \<longrightarrow>
       (\<forall>i \<in> nat. i<k \<longrightarrow> nth(i,xs) = nth(i,ys))\<longrightarrow> take(k,xs) = take(k,ys))"
 apply (induct_tac "k")
 apply (simp_all (no_asm_simp) add: lt_succ_eq_0_disj all_conj_distrib)
 apply clarify
 (*Both lists are non-empty*)
 apply (erule_tac a=xs in list.cases, simp)
 apply (erule_tac a=ys in list.cases, clarify)
 apply (simp (no_asm_use) )
 apply clarify
 apply (simp (no_asm_simp))
 apply (rule conjI, force)
 apply (rename_tac y ys z zs)
 apply (drule_tac x = zs and x1 = ys in bspec [THEN bspec], auto)
 done
 
 lemma nth_equalityI [rule_format]:
      "\<lbrakk>xs:list(A); ys:list(A); length(xs) = length(ys);
          \<forall>i \<in> nat. i < length(xs) \<longrightarrow> nth(i,xs) = nth(i,ys)\<rbrakk>
       \<Longrightarrow> xs = ys"
 apply (subgoal_tac "length (xs) \<le> length (ys) ")
 apply (cut_tac k="length(xs)" and xs=xs and ys=ys in nth_take_lemma)
 apply (simp_all add: take_all)
 done
 
 (*The famous take-lemma*)
 
 lemma take_equalityI [rule_format]:
     "\<lbrakk>xs:list(A); ys:list(A); (\<forall>i \<in> nat. take(i, xs) = take(i,ys))\<rbrakk>
      \<Longrightarrow> xs = ys"
 apply (case_tac "length (xs) \<le> length (ys) ")
 apply (drule_tac x = "length (ys) " in bspec)
 apply (drule_tac [3] not_lt_imp_le)
 apply (subgoal_tac [5] "length (ys) \<le> length (xs) ")
 apply (rule_tac [6] j = "succ (length (ys))" in le_trans)
 apply (rule_tac [6] leI)
 apply (drule_tac [5] x = "length (xs) " in bspec)
 apply (simp_all add: take_all)
 done
 
 lemma nth_drop [rule_format]:
   "n \<in> nat \<Longrightarrow> \<forall>i \<in> nat. \<forall>xs \<in> list(A). nth(i, drop(n, xs)) = nth(n #+ i, xs)"
 apply (induct_tac "n", simp_all, clarify)
 apply (erule list.cases, auto)
 done
 
 lemma take_succ [rule_format]:
   "xs\<in>list(A)
    \<Longrightarrow> \<forall>i. i < length(xs) \<longrightarrow> take(succ(i), xs) = take(i,xs) @ [nth(i, xs)]"
 apply (induct_tac "xs", auto)
 apply (subgoal_tac "i\<in>nat")
 apply (erule natE)
 apply (auto simp add: le_in_nat)
 done
 
 lemma take_add [rule_format]:
      "\<lbrakk>xs\<in>list(A); j\<in>nat\<rbrakk>
       \<Longrightarrow> \<forall>i\<in>nat. take(i #+ j, xs) = take(i,xs) @ take(j, drop(i,xs))"
 apply (induct_tac "xs", simp_all, clarify)
 apply (erule_tac n = i in natE, simp_all)
 done
 
 lemma length_take:
      "l\<in>list(A) \<Longrightarrow> \<forall>n\<in>nat. length(take(n,l)) = min(n, length(l))"
 apply (induct_tac "l", safe, simp_all)
 apply (erule natE, simp_all)
 done
 
 subsection\<open>The function zip\<close>
 
 text\<open>Crafty definition to eliminate a type argument\<close>
 
 consts
   zip_aux        :: "[i,i]\<Rightarrow>i"
 
 primrec (*explicit lambda is required because both arguments of "un" vary*)
   "zip_aux(B,[]) =
      (\<lambda>ys \<in> list(B). list_case([], \<lambda>y l. [], ys))"
 
   "zip_aux(B,Cons(x,l)) =
      (\<lambda>ys \<in> list(B).
         list_case(Nil, \<lambda>y zs. Cons(\<langle>x,y\<rangle>, zip_aux(B,l)`zs), ys))"
 
 definition
   zip :: "[i, i]\<Rightarrow>i"  where
    "zip(xs, ys) \<equiv> zip_aux(set_of_list(ys),xs)`ys"
 
 
 (* zip equations *)
 
 lemma list_on_set_of_list: "xs \<in> list(A) \<Longrightarrow> xs \<in> list(set_of_list(xs))"
 apply (induct_tac xs, simp_all)
 apply (blast intro: list_mono [THEN subsetD])
 done
 
 lemma zip_Nil [simp]: "ys:list(A) \<Longrightarrow> zip(Nil, ys)=Nil"
 apply (simp add: zip_def list_on_set_of_list [of _ A])
 apply (erule list.cases, simp_all)
 done
 
 lemma zip_Nil2 [simp]: "xs:list(A) \<Longrightarrow> zip(xs, Nil)=Nil"
 apply (simp add: zip_def list_on_set_of_list [of _ A])
 apply (erule list.cases, simp_all)
 done
 
 lemma zip_aux_unique [rule_format]:
      "\<lbrakk>B<=C;  xs \<in> list(A)\<rbrakk>
       \<Longrightarrow> \<forall>ys \<in> list(B). zip_aux(C,xs) ` ys = zip_aux(B,xs) ` ys"
 apply (induct_tac xs)
  apply simp_all
  apply (blast intro: list_mono [THEN subsetD], clarify)
 apply (erule_tac a=ys in list.cases, auto)
 apply (blast intro: list_mono [THEN subsetD])
 done
 
 lemma zip_Cons_Cons [simp]:
      "\<lbrakk>xs:list(A); ys:list(B); x \<in> A; y \<in> B\<rbrakk> \<Longrightarrow>
       zip(Cons(x,xs), Cons(y, ys)) = Cons(\<langle>x,y\<rangle>, zip(xs, ys))"
 apply (simp add: zip_def, auto)
 apply (rule zip_aux_unique, auto)
 apply (simp add: list_on_set_of_list [of _ B])
 apply (blast intro: list_on_set_of_list list_mono [THEN subsetD])
 done
 
 lemma zip_type [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>ys \<in> list(B). zip(xs, ys):list(A*B)"
 apply (induct_tac "xs")
 apply (simp (no_asm))
 apply clarify
 apply (erule_tac a = ys in list.cases, auto)
 done
 declare zip_type [simp,TC]
 
 (* zip length *)
 lemma length_zip [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>ys \<in> list(B). length(zip(xs,ys)) =
                                      min(length(xs), length(ys))"
-apply (unfold min_def)
+  unfolding min_def
 apply (induct_tac "xs", simp_all, clarify)
 apply (erule_tac a = ys in list.cases, auto)
 done
 declare length_zip [simp]
 
 lemma zip_append1 [rule_format]:
  "\<lbrakk>ys:list(A); zs:list(B)\<rbrakk> \<Longrightarrow>
   \<forall>xs \<in> list(A). zip(xs @ ys, zs) =
                  zip(xs, take(length(xs), zs)) @ zip(ys, drop(length(xs),zs))"
 apply (induct_tac "zs", force, clarify)
 apply (erule_tac a = xs in list.cases, simp_all)
 done
 
 lemma zip_append2 [rule_format]:
  "\<lbrakk>xs:list(A); zs:list(B)\<rbrakk> \<Longrightarrow> \<forall>ys \<in> list(B). zip(xs, ys@zs) =
        zip(take(length(ys), xs), ys) @ zip(drop(length(ys), xs), zs)"
 apply (induct_tac "xs", force, clarify)
 apply (erule_tac a = ys in list.cases, auto)
 done
 
 lemma zip_append [simp]:
  "\<lbrakk>length(xs) = length(us); length(ys) = length(vs);
      xs:list(A); us:list(B); ys:list(A); vs:list(B)\<rbrakk>
   \<Longrightarrow> zip(xs@ys,us@vs) = zip(xs, us) @ zip(ys, vs)"
 by (simp (no_asm_simp) add: zip_append1 drop_append diff_self_eq_0)
 
 
 lemma zip_rev [rule_format]:
  "ys:list(B) \<Longrightarrow> \<forall>xs \<in> list(A).
     length(xs) = length(ys) \<longrightarrow> zip(rev(xs), rev(ys)) = rev(zip(xs, ys))"
 apply (induct_tac "ys", force, clarify)
 apply (erule_tac a = xs in list.cases)
 apply (auto simp add: length_rev)
 done
 declare zip_rev [simp]
 
 lemma nth_zip [rule_format]:
    "ys:list(B) \<Longrightarrow> \<forall>i \<in> nat. \<forall>xs \<in> list(A).
                     i < length(xs) \<longrightarrow> i < length(ys) \<longrightarrow>
                     nth(i,zip(xs, ys)) = <nth(i,xs),nth(i, ys)>"
 apply (induct_tac "ys", force, clarify)
 apply (erule_tac a = xs in list.cases, simp)
 apply (auto elim: natE)
 done
 declare nth_zip [simp]
 
 lemma set_of_list_zip [rule_format]:
      "\<lbrakk>xs:list(A); ys:list(B); i \<in> nat\<rbrakk>
       \<Longrightarrow> set_of_list(zip(xs, ys)) =
           {\<langle>x, y\<rangle>:A*B. \<exists>i\<in>nat. i < min(length(xs), length(ys))
           \<and> x = nth(i, xs) \<and> y = nth(i, ys)}"
 by (force intro!: Collect_cong simp add: lt_min_iff set_of_list_conv_nth)
 
 (** list_update **)
 
 lemma list_update_Nil [simp]: "i \<in> nat \<Longrightarrow>list_update(Nil, i, v) = Nil"
 by (unfold list_update_def, auto)
 
 lemma list_update_Cons_0 [simp]: "list_update(Cons(x, xs), 0, v)= Cons(v, xs)"
 by (unfold list_update_def, auto)
 
 lemma list_update_Cons_succ [simp]:
   "n \<in> nat \<Longrightarrow>
     list_update(Cons(x, xs), succ(n), v)= Cons(x, list_update(xs, n, v))"
 apply (unfold list_update_def, auto)
 done
 
 lemma list_update_type [rule_format]:
      "\<lbrakk>xs:list(A); v \<in> A\<rbrakk> \<Longrightarrow> \<forall>n \<in> nat. list_update(xs, n, v):list(A)"
 apply (induct_tac "xs")
 apply (simp (no_asm))
 apply clarify
 apply (erule natE, auto)
 done
 declare list_update_type [simp,TC]
 
 lemma length_list_update [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>i \<in> nat. length(list_update(xs, i, v))=length(xs)"
 apply (induct_tac "xs")
 apply (simp (no_asm))
 apply clarify
 apply (erule natE, auto)
 done
 declare length_list_update [simp]
 
 lemma nth_list_update [rule_format]:
      "\<lbrakk>xs:list(A)\<rbrakk> \<Longrightarrow> \<forall>i \<in> nat. \<forall>j \<in> nat. i < length(xs)  \<longrightarrow>
          nth(j, list_update(xs, i, x)) = (if i=j then x else nth(j, xs))"
 apply (induct_tac "xs")
  apply simp_all
 apply clarify
 apply (rename_tac i j)
 apply (erule_tac n=i in natE)
 apply (erule_tac [2] n=j in natE)
 apply (erule_tac n=j in natE, simp_all, force)
 done
 
 lemma nth_list_update_eq [simp]:
      "\<lbrakk>i < length(xs); xs:list(A)\<rbrakk> \<Longrightarrow> nth(i, list_update(xs, i,x)) = x"
 by (simp (no_asm_simp) add: lt_length_in_nat nth_list_update)
 
 
 lemma nth_list_update_neq [rule_format]:
   "xs:list(A) \<Longrightarrow>
      \<forall>i \<in> nat. \<forall>j \<in> nat. i \<noteq> j \<longrightarrow> nth(j, list_update(xs,i,x)) = nth(j,xs)"
 apply (induct_tac "xs")
  apply (simp (no_asm))
 apply clarify
 apply (erule natE)
 apply (erule_tac [2] natE, simp_all)
 apply (erule natE, simp_all)
 done
 declare nth_list_update_neq [simp]
 
 lemma list_update_overwrite [rule_format]:
      "xs:list(A) \<Longrightarrow> \<forall>i \<in> nat. i < length(xs)
    \<longrightarrow> list_update(list_update(xs, i, x), i, y) = list_update(xs, i,y)"
 apply (induct_tac "xs")
  apply (simp (no_asm))
 apply clarify
 apply (erule natE, auto)
 done
 declare list_update_overwrite [simp]
 
 lemma list_update_same_conv [rule_format]:
      "xs:list(A) \<Longrightarrow>
       \<forall>i \<in> nat. i < length(xs) \<longrightarrow>
                  (list_update(xs, i, x) = xs) \<longleftrightarrow> (nth(i, xs) = x)"
 apply (induct_tac "xs")
  apply (simp (no_asm))
 apply clarify
 apply (erule natE, auto)
 done
 
 lemma update_zip [rule_format]:
      "ys:list(B) \<Longrightarrow>
       \<forall>i \<in> nat. \<forall>xy \<in> A*B. \<forall>xs \<in> list(A).
         length(xs) = length(ys) \<longrightarrow>
         list_update(zip(xs, ys), i, xy) = zip(list_update(xs, i, fst(xy)),
                                               list_update(ys, i, snd(xy)))"
 apply (induct_tac "ys")
  apply auto
 apply (erule_tac a = xs in list.cases)
 apply (auto elim: natE)
 done
 
 lemma set_update_subset_cons [rule_format]:
   "xs:list(A) \<Longrightarrow>
    \<forall>i \<in> nat. set_of_list(list_update(xs, i, x)) \<subseteq> cons(x, set_of_list(xs))"
 apply (induct_tac "xs")
  apply simp
 apply (rule ballI)
 apply (erule natE, simp_all, auto)
 done
 
 lemma set_of_list_update_subsetI:
      "\<lbrakk>set_of_list(xs) \<subseteq> A; xs:list(A); x \<in> A; i \<in> nat\<rbrakk>
    \<Longrightarrow> set_of_list(list_update(xs, i,x)) \<subseteq> A"
 apply (rule subset_trans)
 apply (rule set_update_subset_cons, auto)
 done
 
 (** upt **)
 
 lemma upt_rec:
      "j \<in> nat \<Longrightarrow> upt(i,j) = (if i<j then Cons(i, upt(succ(i), j)) else Nil)"
 apply (induct_tac "j", auto)
 apply (drule not_lt_imp_le)
 apply (auto simp: lt_Ord intro: le_anti_sym)
 done
 
 lemma upt_conv_Nil [simp]: "\<lbrakk>j \<le> i; j \<in> nat\<rbrakk> \<Longrightarrow> upt(i,j) = Nil"
 apply (subst upt_rec, auto)
 apply (auto simp add: le_iff)
 apply (drule lt_asym [THEN notE], auto)
 done
 
 (*Only needed if upt_Suc is deleted from the simpset*)
 lemma upt_succ_append:
      "\<lbrakk>i \<le> j; j \<in> nat\<rbrakk> \<Longrightarrow> upt(i,succ(j)) = upt(i, j)@[j]"
 by simp
 
 lemma upt_conv_Cons:
      "\<lbrakk>i<j; j \<in> nat\<rbrakk>  \<Longrightarrow> upt(i,j) = Cons(i,upt(succ(i),j))"
 apply (rule trans)
 apply (rule upt_rec, auto)
 done
 
 lemma upt_type [simp,TC]: "j \<in> nat \<Longrightarrow> upt(i,j):list(nat)"
 by (induct_tac "j", auto)
 
 (*LOOPS as a simprule, since j<=j*)
 lemma upt_add_eq_append:
      "\<lbrakk>i \<le> j; j \<in> nat; k \<in> nat\<rbrakk> \<Longrightarrow> upt(i, j #+k) = upt(i,j)@upt(j,j#+k)"
 apply (induct_tac "k")
 apply (auto simp add: app_assoc app_type)
 apply (rule_tac j = j in le_trans, auto)
 done
 
 lemma length_upt [simp]: "\<lbrakk>i \<in> nat; j \<in> nat\<rbrakk> \<Longrightarrow>length(upt(i,j)) = j #- i"
 apply (induct_tac "j")
 apply (rule_tac [2] sym)
 apply (auto dest!: not_lt_imp_le simp add: diff_succ diff_is_0_iff)
 done
 
 lemma nth_upt [simp]:
      "\<lbrakk>i \<in> nat; j \<in> nat; k \<in> nat; i #+ k < j\<rbrakk> \<Longrightarrow> nth(k, upt(i,j)) = i #+ k"
 apply (rotate_tac -1, erule rev_mp)
 apply (induct_tac "j", simp)
 apply (auto dest!: not_lt_imp_le
             simp add: nth_append le_iff less_diff_conv add_commute)
 done
 
 lemma take_upt [rule_format]:
      "\<lbrakk>m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow>
          \<forall>i \<in> nat. i #+ m \<le> n \<longrightarrow> take(m, upt(i,n)) = upt(i,i#+m)"
 apply (induct_tac "m")
 apply (simp (no_asm_simp) add: take_0)
 apply clarify
 apply (subst upt_rec, simp)
 apply (rule sym)
 apply (subst upt_rec, simp)
 apply (simp_all del: upt.simps)
 apply (rule_tac j = "succ (i #+ x) " in lt_trans2)
 apply auto
 done
 declare take_upt [simp]
 
 lemma map_succ_upt:
      "\<lbrakk>m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> map(succ, upt(m,n))= upt(succ(m), succ(n))"
 apply (induct_tac "n")
 apply (auto simp add: map_app_distrib)
 done
 
 lemma nth_map [rule_format]:
      "xs:list(A) \<Longrightarrow>
       \<forall>n \<in> nat. n < length(xs) \<longrightarrow> nth(n, map(f, xs)) = f(nth(n, xs))"
 apply (induct_tac "xs", simp)
 apply (rule ballI)
 apply (induct_tac "n", auto)
 done
 declare nth_map [simp]
 
 lemma nth_map_upt [rule_format]:
      "\<lbrakk>m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow>
       \<forall>i \<in> nat. i < n #- m \<longrightarrow> nth(i, map(f, upt(m,n))) = f(m #+ i)"
 apply (rule_tac n = m and m = n in diff_induct, typecheck, simp, simp)
 apply (subst map_succ_upt [symmetric], simp_all, clarify)
 apply (subgoal_tac "i < length (upt (0, x))")
  prefer 2
  apply (simp add: less_diff_conv)
  apply (rule_tac j = "succ (i #+ y) " in lt_trans2)
   apply simp
  apply simp
 apply (subgoal_tac "i < length (upt (y, x))")
  apply (simp_all add: add_commute less_diff_conv)
 done
 
 (** sublist (a generalization of nth to sets) **)
 
 definition
   sublist :: "[i, i] \<Rightarrow> i"  where
     "sublist(xs, A)\<equiv>
      map(fst, (filter(\<lambda>p. snd(p): A, zip(xs, upt(0,length(xs))))))"
 
 lemma sublist_0 [simp]: "xs:list(A) \<Longrightarrow>sublist(xs, 0) =Nil"
 by (unfold sublist_def, auto)
 
 lemma sublist_Nil [simp]: "sublist(Nil, A) = Nil"
 by (unfold sublist_def, auto)
 
 lemma sublist_shift_lemma:
  "\<lbrakk>xs:list(B); i \<in> nat\<rbrakk> \<Longrightarrow>
   map(fst, filter(\<lambda>p. snd(p):A, zip(xs, upt(i,i #+ length(xs))))) =
   map(fst, filter(\<lambda>p. snd(p):nat \<and> snd(p) #+ i \<in> A, zip(xs,upt(0,length(xs)))))"
 apply (erule list_append_induct)
 apply (simp (no_asm_simp))
 apply (auto simp add: add_commute length_app filter_append map_app_distrib)
 done
 
 lemma sublist_type [simp,TC]:
      "xs:list(B) \<Longrightarrow> sublist(xs, A):list(B)"
-apply (unfold sublist_def)
+  unfolding sublist_def
 apply (induct_tac "xs")
 apply (auto simp add: filter_append map_app_distrib)
 done
 
 lemma upt_add_eq_append2:
      "\<lbrakk>i \<in> nat; j \<in> nat\<rbrakk> \<Longrightarrow> upt(0, i #+ j) = upt(0, i) @ upt(i, i #+ j)"
 by (simp add: upt_add_eq_append [of 0] nat_0_le)
 
 lemma sublist_append:
  "\<lbrakk>xs:list(B); ys:list(B)\<rbrakk> \<Longrightarrow>
   sublist(xs@ys, A) = sublist(xs, A) @ sublist(ys, {j \<in> nat. j #+ length(xs): A})"
-apply (unfold sublist_def)
+  unfolding sublist_def
 apply (erule_tac l = ys in list_append_induct, simp)
 apply (simp (no_asm_simp) add: upt_add_eq_append2 app_assoc [symmetric])
 apply (auto simp add: sublist_shift_lemma length_type map_app_distrib app_assoc)
 apply (simp_all add: add_commute)
 done
 
 
 lemma sublist_Cons:
      "\<lbrakk>xs:list(B); x \<in> B\<rbrakk> \<Longrightarrow>
       sublist(Cons(x, xs), A) =
       (if 0 \<in> A then [x] else []) @ sublist(xs, {j \<in> nat. succ(j) \<in> A})"
 apply (erule_tac l = xs in list_append_induct)
 apply (simp (no_asm_simp) add: sublist_def)
 apply (simp del: app_Cons add: app_Cons [symmetric] sublist_append, simp)
 done
 
 lemma sublist_singleton [simp]:
      "sublist([x], A) = (if 0 \<in> A then [x] else [])"
 by (simp add: sublist_Cons)
 
 lemma sublist_upt_eq_take [rule_format]:
     "xs:list(A) \<Longrightarrow> \<forall>n\<in>nat. sublist(xs,n) = take(n,xs)"
 apply (erule list.induct, simp)
 apply (clarify )
 apply (erule natE)
 apply (simp_all add: nat_eq_Collect_lt Ord_mem_iff_lt sublist_Cons)
 done
 declare sublist_upt_eq_take [simp]
 
 lemma sublist_Int_eq:
      "xs \<in> list(B) \<Longrightarrow> sublist(xs, A \<inter> nat) = sublist(xs, A)"
 apply (erule list.induct)
 apply (simp_all add: sublist_Cons)
 done
 
 text\<open>Repetition of a List Element\<close>
 
 consts   repeat :: "[i,i]\<Rightarrow>i"
 primrec
   "repeat(a,0) = []"
 
   "repeat(a,succ(n)) = Cons(a,repeat(a,n))"
 
 lemma length_repeat: "n \<in> nat \<Longrightarrow> length(repeat(a,n)) = n"
 by (induct_tac n, auto)
 
 lemma repeat_succ_app: "n \<in> nat \<Longrightarrow> repeat(a,succ(n)) = repeat(a,n) @ [a]"
 apply (induct_tac n)
 apply (simp_all del: app_Cons add: app_Cons [symmetric])
 done
 
 lemma repeat_type [TC]: "\<lbrakk>a \<in> A; n \<in> nat\<rbrakk> \<Longrightarrow> repeat(a,n) \<in> list(A)"
 by (induct_tac n, auto)
 
 end
diff --git a/src/ZF/Nat.thy b/src/ZF/Nat.thy
--- a/src/ZF/Nat.thy
+++ b/src/ZF/Nat.thy
@@ -1,297 +1,297 @@
 (*  Title:      ZF/Nat.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section\<open>The Natural numbers As a Least Fixed Point\<close>
 
 theory Nat imports OrdQuant Bool begin
 
 definition
   nat :: i  where
     "nat \<equiv> lfp(Inf, \<lambda>X. {0} \<union> {succ(i). i \<in> X})"
 
 definition
   quasinat :: "i \<Rightarrow> o"  where
     "quasinat(n) \<equiv> n=0 | (\<exists>m. n = succ(m))"
 
 definition
   (*Has an unconditional succ case, which is used in "recursor" below.*)
   nat_case :: "[i, i\<Rightarrow>i, i]\<Rightarrow>i"  where
     "nat_case(a,b,k) \<equiv> THE y. k=0 \<and> y=a | (\<exists>x. k=succ(x) \<and> y=b(x))"
 
 definition
   nat_rec :: "[i, i, [i,i]\<Rightarrow>i]\<Rightarrow>i"  where
     "nat_rec(k,a,b) \<equiv>
           wfrec(Memrel(nat), k, \<lambda>n f. nat_case(a, \<lambda>m. b(m, f`m), n))"
 
   (*Internalized relations on the naturals*)
 
 definition
   Le :: i  where
     "Le \<equiv> {\<langle>x,y\<rangle>:nat*nat. x \<le> y}"
 
 definition
   Lt :: i  where
     "Lt \<equiv> {\<langle>x, y\<rangle>:nat*nat. x < y}"
 
 definition
   Ge :: i  where
     "Ge \<equiv> {\<langle>x,y\<rangle>:nat*nat. y \<le> x}"
 
 definition
   Gt :: i  where
     "Gt \<equiv> {\<langle>x,y\<rangle>:nat*nat. y < x}"
 
 definition
   greater_than :: "i\<Rightarrow>i"  where
     "greater_than(n) \<equiv> {i \<in> nat. n < i}"
 
 text\<open>No need for a less-than operator: a natural number is its list of
 predecessors!\<close>
 
 
 lemma nat_bnd_mono: "bnd_mono(Inf, \<lambda>X. {0} \<union> {succ(i). i \<in> X})"
 apply (rule bnd_monoI)
 apply (cut_tac infinity, blast, blast)
 done
 
 (* @{term"nat = {0} \<union> {succ(x). x \<in> nat}"} *)
 lemmas nat_unfold = nat_bnd_mono [THEN nat_def [THEN def_lfp_unfold]]
 
 (** Type checking of 0 and successor **)
 
 lemma nat_0I [iff,TC]: "0 \<in> nat"
 apply (subst nat_unfold)
 apply (rule singletonI [THEN UnI1])
 done
 
 lemma nat_succI [intro!,TC]: "n \<in> nat \<Longrightarrow> succ(n) \<in> nat"
 apply (subst nat_unfold)
 apply (erule RepFunI [THEN UnI2])
 done
 
 lemma nat_1I [iff,TC]: "1 \<in> nat"
 by (rule nat_0I [THEN nat_succI])
 
 lemma nat_2I [iff,TC]: "2 \<in> nat"
 by (rule nat_1I [THEN nat_succI])
 
 lemma bool_subset_nat: "bool \<subseteq> nat"
 by (blast elim!: boolE)
 
 lemmas bool_into_nat = bool_subset_nat [THEN subsetD]
 
 
 subsection\<open>Injectivity Properties and Induction\<close>
 
 (*Mathematical induction*)
 lemma nat_induct [case_names 0 succ, induct set: nat]:
     "\<lbrakk>n \<in> nat;  P(0);  \<And>x. \<lbrakk>x \<in> nat;  P(x)\<rbrakk> \<Longrightarrow> P(succ(x))\<rbrakk> \<Longrightarrow> P(n)"
 by (erule def_induct [OF nat_def nat_bnd_mono], blast)
 
 lemma natE:
  assumes "n \<in> nat"
  obtains ("0") "n=0" | (succ) x where "x \<in> nat" "n=succ(x)"
 using assms
 by (rule nat_unfold [THEN equalityD1, THEN subsetD, THEN UnE]) auto
 
 lemma nat_into_Ord [simp]: "n \<in> nat \<Longrightarrow> Ord(n)"
 by (erule nat_induct, auto)
 
 (* @{term"i \<in> nat \<Longrightarrow> 0 \<le> i"}; same thing as @{term"0<succ(i)"}  *)
 lemmas nat_0_le = nat_into_Ord [THEN Ord_0_le]
 
 (* @{term"i \<in> nat \<Longrightarrow> i \<le> i"}; same thing as @{term"i<succ(i)"}  *)
 lemmas nat_le_refl = nat_into_Ord [THEN le_refl]
 
 lemma Ord_nat [iff]: "Ord(nat)"
 apply (rule OrdI)
 apply (erule_tac [2] nat_into_Ord [THEN Ord_is_Transset])
-apply (unfold Transset_def)
+  unfolding Transset_def
 apply (rule ballI)
 apply (erule nat_induct, auto)
 done
 
 lemma Limit_nat [iff]: "Limit(nat)"
-apply (unfold Limit_def)
+  unfolding Limit_def
 apply (safe intro!: ltI Ord_nat)
 apply (erule ltD)
 done
 
 lemma naturals_not_limit: "a \<in> nat \<Longrightarrow> \<not> Limit(a)"
 by (induct a rule: nat_induct, auto)
 
 lemma succ_natD: "succ(i): nat \<Longrightarrow> i \<in> nat"
 by (rule Ord_trans [OF succI1], auto)
 
 lemma nat_succ_iff [iff]: "succ(n): nat \<longleftrightarrow> n \<in> nat"
 by (blast dest!: succ_natD)
 
 lemma nat_le_Limit: "Limit(i) \<Longrightarrow> nat \<le> i"
 apply (rule subset_imp_le)
 apply (simp_all add: Limit_is_Ord)
 apply (rule subsetI)
 apply (erule nat_induct)
  apply (erule Limit_has_0 [THEN ltD])
 apply (blast intro: Limit_has_succ [THEN ltD] ltI Limit_is_Ord)
 done
 
 (* \<lbrakk>succ(i): k;  k \<in> nat\<rbrakk> \<Longrightarrow> i \<in> k *)
 lemmas succ_in_naturalD = Ord_trans [OF succI1 _ nat_into_Ord]
 
 lemma lt_nat_in_nat: "\<lbrakk>m<n;  n \<in> nat\<rbrakk> \<Longrightarrow> m \<in> nat"
 apply (erule ltE)
 apply (erule Ord_trans, assumption, simp)
 done
 
 lemma le_in_nat: "\<lbrakk>m \<le> n; n \<in> nat\<rbrakk> \<Longrightarrow> m \<in> nat"
 by (blast dest!: lt_nat_in_nat)
 
 
 subsection\<open>Variations on Mathematical Induction\<close>
 
 (*complete induction*)
 
 lemmas complete_induct = Ord_induct [OF _ Ord_nat, case_names less, consumes 1]
 
 lemma complete_induct_rule [case_names less, consumes 1]:
   "i \<in> nat \<Longrightarrow> (\<And>x. x \<in> nat \<Longrightarrow> (\<And>y. y \<in> x \<Longrightarrow> P(y)) \<Longrightarrow> P(x)) \<Longrightarrow> P(i)"
   using complete_induct [of i P] by simp
 
 (*Induction starting from m rather than 0*)
 lemma nat_induct_from:
   assumes "m \<le> n" "m \<in> nat" "n \<in> nat"
     and "P(m)"
     and "\<And>x. \<lbrakk>x \<in> nat;  m \<le> x;  P(x)\<rbrakk> \<Longrightarrow> P(succ(x))"
   shows "P(n)"
 proof -
   from assms(3) have "m \<le> n \<longrightarrow> P(m) \<longrightarrow> P(n)"
     by (rule nat_induct) (use assms(5) in \<open>simp_all add: distrib_simps le_succ_iff\<close>)
   with assms(1,2,4) show ?thesis by blast
 qed
 
 (*Induction suitable for subtraction and less-than*)
 lemma diff_induct [case_names 0 0_succ succ_succ, consumes 2]:
     "\<lbrakk>m \<in> nat;  n \<in> nat;
         \<And>x. x \<in> nat \<Longrightarrow> P(x,0);
         \<And>y. y \<in> nat \<Longrightarrow> P(0,succ(y));
         \<And>x y. \<lbrakk>x \<in> nat;  y \<in> nat;  P(x,y)\<rbrakk> \<Longrightarrow> P(succ(x),succ(y))\<rbrakk>
      \<Longrightarrow> P(m,n)"
 apply (erule_tac x = m in rev_bspec)
 apply (erule nat_induct, simp)
 apply (rule ballI)
 apply (rename_tac i j)
 apply (erule_tac n=j in nat_induct, auto)
 done
 
 
 (** Induction principle analogous to trancl_induct **)
 
 lemma succ_lt_induct_lemma [rule_format]:
      "m \<in> nat \<Longrightarrow> P(m,succ(m)) \<longrightarrow> (\<forall>x\<in>nat. P(m,x) \<longrightarrow> P(m,succ(x))) \<longrightarrow>
                  (\<forall>n\<in>nat. m<n \<longrightarrow> P(m,n))"
 apply (erule nat_induct)
  apply (intro impI, rule nat_induct [THEN ballI])
    prefer 4 apply (intro impI, rule nat_induct [THEN ballI])
 apply (auto simp add: le_iff)
 done
 
 lemma succ_lt_induct:
     "\<lbrakk>m<n;  n \<in> nat;
         P(m,succ(m));
         \<And>x. \<lbrakk>x \<in> nat;  P(m,x)\<rbrakk> \<Longrightarrow> P(m,succ(x))\<rbrakk>
      \<Longrightarrow> P(m,n)"
 by (blast intro: succ_lt_induct_lemma lt_nat_in_nat)
 
 subsection\<open>quasinat: to allow a case-split rule for \<^term>\<open>nat_case\<close>\<close>
 
 text\<open>True if the argument is zero or any successor\<close>
 lemma [iff]: "quasinat(0)"
 by (simp add: quasinat_def)
 
 lemma [iff]: "quasinat(succ(x))"
 by (simp add: quasinat_def)
 
 lemma nat_imp_quasinat: "n \<in> nat \<Longrightarrow> quasinat(n)"
 by (erule natE, simp_all)
 
 lemma non_nat_case: "\<not> quasinat(x) \<Longrightarrow> nat_case(a,b,x) = 0"
 by (simp add: quasinat_def nat_case_def)
 
 lemma nat_cases_disj: "k=0 | (\<exists>y. k = succ(y)) | \<not> quasinat(k)"
 apply (case_tac "k=0", simp)
 apply (case_tac "\<exists>m. k = succ(m)")
 apply (simp_all add: quasinat_def)
 done
 
 lemma nat_cases:
      "\<lbrakk>k=0 \<Longrightarrow> P;  \<And>y. k = succ(y) \<Longrightarrow> P; \<not> quasinat(k) \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (insert nat_cases_disj [of k], blast)
 
 (** nat_case **)
 
 lemma nat_case_0 [simp]: "nat_case(a,b,0) = a"
 by (simp add: nat_case_def)
 
 lemma nat_case_succ [simp]: "nat_case(a,b,succ(n)) = b(n)"
 by (simp add: nat_case_def)
 
 lemma nat_case_type [TC]:
     "\<lbrakk>n \<in> nat;  a \<in> C(0);  \<And>m. m \<in> nat \<Longrightarrow> b(m): C(succ(m))\<rbrakk>
      \<Longrightarrow> nat_case(a,b,n) \<in> C(n)"
 by (erule nat_induct, auto)
 
 lemma split_nat_case:
   "P(nat_case(a,b,k)) \<longleftrightarrow>
    ((k=0 \<longrightarrow> P(a)) \<and> (\<forall>x. k=succ(x) \<longrightarrow> P(b(x))) \<and> (\<not> quasinat(k) \<longrightarrow> P(0)))"
 apply (rule nat_cases [of k])
 apply (auto simp add: non_nat_case)
 done
 
 
 subsection\<open>Recursion on the Natural Numbers\<close>
 
 (** nat_rec is used to define eclose and transrec, then becomes obsolete.
     The operator rec, from arith.thy, has fewer typing conditions **)
 
 lemma nat_rec_0: "nat_rec(0,a,b) = a"
 apply (rule nat_rec_def [THEN def_wfrec, THEN trans])
  apply (rule wf_Memrel)
 apply (rule nat_case_0)
 done
 
 lemma nat_rec_succ: "m \<in> nat \<Longrightarrow> nat_rec(succ(m),a,b) = b(m, nat_rec(m,a,b))"
 apply (rule nat_rec_def [THEN def_wfrec, THEN trans])
  apply (rule wf_Memrel)
 apply (simp add: vimage_singleton_iff)
 done
 
 (** The union of two natural numbers is a natural number -- their maximum **)
 
 lemma Un_nat_type [TC]: "\<lbrakk>i \<in> nat; j \<in> nat\<rbrakk> \<Longrightarrow> i \<union> j \<in> nat"
 apply (rule Un_least_lt [THEN ltD])
 apply (simp_all add: lt_def)
 done
 
 lemma Int_nat_type [TC]: "\<lbrakk>i \<in> nat; j \<in> nat\<rbrakk> \<Longrightarrow> i \<inter> j \<in> nat"
 apply (rule Int_greatest_lt [THEN ltD])
 apply (simp_all add: lt_def)
 done
 
 (*needed to simplify unions over nat*)
 lemma nat_nonempty [simp]: "nat \<noteq> 0"
 by blast
 
 text\<open>A natural number is the set of its predecessors\<close>
 lemma nat_eq_Collect_lt: "i \<in> nat \<Longrightarrow> {j\<in>nat. j<i} = i"
 apply (rule equalityI)
 apply (blast dest: ltD)
 apply (auto simp add: Ord_mem_iff_lt)
 apply (blast intro: lt_trans)
 done
 
 lemma Le_iff [iff]: "\<langle>x,y\<rangle> \<in> Le \<longleftrightarrow> x \<le> y \<and> x \<in> nat \<and> y \<in> nat"
 by (force simp add: Le_def)
 
 end
diff --git a/src/ZF/Order.thy b/src/ZF/Order.thy
--- a/src/ZF/Order.thy
+++ b/src/ZF/Order.thy
@@ -1,714 +1,714 @@
 (*  Title:      ZF/Order.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 
 Results from the book "Set Theory: an Introduction to Independence Proofs"
         by Kenneth Kunen.  Chapter 1, section 6.
 Additional definitions and lemmas for reflexive orders.
 *)
 
 section\<open>Partial and Total Orderings: Basic Definitions and Properties\<close>
 
 theory Order imports WF Perm begin
 
 text \<open>We adopt the following convention: \<open>ord\<close> is used for
   strict orders and \<open>order\<close> is used for their reflexive
   counterparts.\<close>
 
 definition
   part_ord :: "[i,i]\<Rightarrow>o"                (*Strict partial ordering*)  where
    "part_ord(A,r) \<equiv> irrefl(A,r) \<and> trans[A](r)"
 
 definition
   linear   :: "[i,i]\<Rightarrow>o"                (*Strict total ordering*)  where
    "linear(A,r) \<equiv> (\<forall>x\<in>A. \<forall>y\<in>A. \<langle>x,y\<rangle>:r | x=y | \<langle>y,x\<rangle>:r)"
 
 definition
   tot_ord  :: "[i,i]\<Rightarrow>o"                (*Strict total ordering*)  where
    "tot_ord(A,r) \<equiv> part_ord(A,r) \<and> linear(A,r)"
 
 definition
   "preorder_on(A, r) \<equiv> refl(A, r) \<and> trans[A](r)"
 
 definition                              (*Partial ordering*)
   "partial_order_on(A, r) \<equiv> preorder_on(A, r) \<and> antisym(r)"
 
 abbreviation
   "Preorder(r) \<equiv> preorder_on(field(r), r)"
 
 abbreviation
   "Partial_order(r) \<equiv> partial_order_on(field(r), r)"
 
 definition
   well_ord :: "[i,i]\<Rightarrow>o"                (*Well-ordering*)  where
    "well_ord(A,r) \<equiv> tot_ord(A,r) \<and> wf[A](r)"
 
 definition
   mono_map :: "[i,i,i,i]\<Rightarrow>i"            (*Order-preserving maps*)  where
    "mono_map(A,r,B,s) \<equiv>
               {f \<in> A->B. \<forall>x\<in>A. \<forall>y\<in>A. \<langle>x,y\<rangle>:r \<longrightarrow> <f`x,f`y>:s}"
 
 definition
   ord_iso  :: "[i,i,i,i]\<Rightarrow>i"  (\<open>(\<langle>_, _\<rangle> \<cong>/ \<langle>_, _\<rangle>)\<close> 51)  (*Order isomorphisms*)  where
    "\<langle>A,r\<rangle> \<cong> \<langle>B,s\<rangle> \<equiv>
               {f \<in> bij(A,B). \<forall>x\<in>A. \<forall>y\<in>A. \<langle>x,y\<rangle>:r \<longleftrightarrow> <f`x,f`y>:s}"
 
 definition
   pred     :: "[i,i,i]\<Rightarrow>i"              (*Set of predecessors*)  where
    "pred(A,x,r) \<equiv> {y \<in> A. \<langle>y,x\<rangle>:r}"
 
 definition
   ord_iso_map :: "[i,i,i,i]\<Rightarrow>i"         (*Construction for linearity theorem*)  where
    "ord_iso_map(A,r,B,s) \<equiv>
      \<Union>x\<in>A. \<Union>y\<in>B. \<Union>f \<in> ord_iso(pred(A,x,r), r, pred(B,y,s), s). {\<langle>x,y\<rangle>}"
 
 definition
   first :: "[i, i, i] \<Rightarrow> o"  where
     "first(u, X, R) \<equiv> u \<in> X \<and> (\<forall>v\<in>X. v\<noteq>u \<longrightarrow> \<langle>u,v\<rangle> \<in> R)"
 
 subsection\<open>Immediate Consequences of the Definitions\<close>
 
 lemma part_ord_Imp_asym:
     "part_ord(A,r) \<Longrightarrow> asym(r \<inter> A*A)"
 by (unfold part_ord_def irrefl_def trans_on_def asym_def, blast)
 
 lemma linearE:
     "\<lbrakk>linear(A,r);  x \<in> A;  y \<in> A;
         \<langle>x,y\<rangle>:r \<Longrightarrow> P;  x=y \<Longrightarrow> P;  \<langle>y,x\<rangle>:r \<Longrightarrow> P\<rbrakk>
      \<Longrightarrow> P"
 by (simp add: linear_def, blast)
 
 
 (** General properties of well_ord **)
 
 lemma well_ordI:
     "\<lbrakk>wf[A](r); linear(A,r)\<rbrakk> \<Longrightarrow> well_ord(A,r)"
 apply (simp add: irrefl_def part_ord_def tot_ord_def
                  trans_on_def well_ord_def wf_on_not_refl)
 apply (fast elim: linearE wf_on_asym wf_on_chain3)
 done
 
 lemma well_ord_is_wf:
     "well_ord(A,r) \<Longrightarrow> wf[A](r)"
 by (unfold well_ord_def, safe)
 
 lemma well_ord_is_trans_on:
     "well_ord(A,r) \<Longrightarrow> trans[A](r)"
 by (unfold well_ord_def tot_ord_def part_ord_def, safe)
 
 lemma well_ord_is_linear: "well_ord(A,r) \<Longrightarrow> linear(A,r)"
 by (unfold well_ord_def tot_ord_def, blast)
 
 
 (** Derived rules for pred(A,x,r) **)
 
 lemma pred_iff: "y \<in> pred(A,x,r) \<longleftrightarrow> \<langle>y,x\<rangle>:r \<and> y \<in> A"
 by (unfold pred_def, blast)
 
 lemmas predI = conjI [THEN pred_iff [THEN iffD2]]
 
 lemma predE: "\<lbrakk>y \<in> pred(A,x,r);  \<lbrakk>y \<in> A; \<langle>y,x\<rangle>:r\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (simp add: pred_def)
 
 lemma pred_subset_under: "pred(A,x,r) \<subseteq> r -`` {x}"
 by (simp add: pred_def, blast)
 
 lemma pred_subset: "pred(A,x,r) \<subseteq> A"
 by (simp add: pred_def, blast)
 
 lemma pred_pred_eq:
     "pred(pred(A,x,r), y, r) = pred(A,x,r) \<inter> pred(A,y,r)"
 by (simp add: pred_def, blast)
 
 lemma trans_pred_pred_eq:
     "\<lbrakk>trans[A](r);  \<langle>y,x\<rangle>:r;  x \<in> A;  y \<in> A\<rbrakk>
      \<Longrightarrow> pred(pred(A,x,r), y, r) = pred(A,y,r)"
 by (unfold trans_on_def pred_def, blast)
 
 
 subsection\<open>Restricting an Ordering's Domain\<close>
 
 (** The ordering's properties hold over all subsets of its domain
     [including initial segments of the form pred(A,x,r) **)
 
 (*Note: a relation s such that s<=r need not be a partial ordering*)
 lemma part_ord_subset:
     "\<lbrakk>part_ord(A,r);  B<=A\<rbrakk> \<Longrightarrow> part_ord(B,r)"
 by (unfold part_ord_def irrefl_def trans_on_def, blast)
 
 lemma linear_subset:
     "\<lbrakk>linear(A,r);  B<=A\<rbrakk> \<Longrightarrow> linear(B,r)"
 by (unfold linear_def, blast)
 
 lemma tot_ord_subset:
     "\<lbrakk>tot_ord(A,r);  B<=A\<rbrakk> \<Longrightarrow> tot_ord(B,r)"
-apply (unfold tot_ord_def)
+  unfolding tot_ord_def
 apply (fast elim!: part_ord_subset linear_subset)
 done
 
 lemma well_ord_subset:
     "\<lbrakk>well_ord(A,r);  B<=A\<rbrakk> \<Longrightarrow> well_ord(B,r)"
-apply (unfold well_ord_def)
+  unfolding well_ord_def
 apply (fast elim!: tot_ord_subset wf_on_subset_A)
 done
 
 
 (** Relations restricted to a smaller domain, by Krzysztof Grabczewski **)
 
 lemma irrefl_Int_iff: "irrefl(A,r \<inter> A*A) \<longleftrightarrow> irrefl(A,r)"
 by (unfold irrefl_def, blast)
 
 lemma trans_on_Int_iff: "trans[A](r \<inter> A*A) \<longleftrightarrow> trans[A](r)"
 by (unfold trans_on_def, blast)
 
 lemma part_ord_Int_iff: "part_ord(A,r \<inter> A*A) \<longleftrightarrow> part_ord(A,r)"
-apply (unfold part_ord_def)
+  unfolding part_ord_def
 apply (simp add: irrefl_Int_iff trans_on_Int_iff)
 done
 
 lemma linear_Int_iff: "linear(A,r \<inter> A*A) \<longleftrightarrow> linear(A,r)"
 by (unfold linear_def, blast)
 
 lemma tot_ord_Int_iff: "tot_ord(A,r \<inter> A*A) \<longleftrightarrow> tot_ord(A,r)"
-apply (unfold tot_ord_def)
+  unfolding tot_ord_def
 apply (simp add: part_ord_Int_iff linear_Int_iff)
 done
 
 lemma wf_on_Int_iff: "wf[A](r \<inter> A*A) \<longleftrightarrow> wf[A](r)"
 apply (unfold wf_on_def wf_def, fast) (*10 times faster than blast!*)
 done
 
 lemma well_ord_Int_iff: "well_ord(A,r \<inter> A*A) \<longleftrightarrow> well_ord(A,r)"
-apply (unfold well_ord_def)
+  unfolding well_ord_def
 apply (simp add: tot_ord_Int_iff wf_on_Int_iff)
 done
 
 
 subsection\<open>Empty and Unit Domains\<close>
 
 (*The empty relation is well-founded*)
 lemma wf_on_any_0: "wf[A](0)"
 by (simp add: wf_on_def wf_def, fast)
 
 subsubsection\<open>Relations over the Empty Set\<close>
 
 lemma irrefl_0: "irrefl(0,r)"
 by (unfold irrefl_def, blast)
 
 lemma trans_on_0: "trans[0](r)"
 by (unfold trans_on_def, blast)
 
 lemma part_ord_0: "part_ord(0,r)"
-apply (unfold part_ord_def)
+  unfolding part_ord_def
 apply (simp add: irrefl_0 trans_on_0)
 done
 
 lemma linear_0: "linear(0,r)"
 by (unfold linear_def, blast)
 
 lemma tot_ord_0: "tot_ord(0,r)"
-apply (unfold tot_ord_def)
+  unfolding tot_ord_def
 apply (simp add: part_ord_0 linear_0)
 done
 
 lemma wf_on_0: "wf[0](r)"
 by (unfold wf_on_def wf_def, blast)
 
 lemma well_ord_0: "well_ord(0,r)"
-apply (unfold well_ord_def)
+  unfolding well_ord_def
 apply (simp add: tot_ord_0 wf_on_0)
 done
 
 
 subsubsection\<open>The Empty Relation Well-Orders the Unit Set\<close>
 
 text\<open>by Grabczewski\<close>
 
 lemma tot_ord_unit: "tot_ord({a},0)"
 by (simp add: irrefl_def trans_on_def part_ord_def linear_def tot_ord_def)
 
 lemma well_ord_unit: "well_ord({a},0)"
-apply (unfold well_ord_def)
+  unfolding well_ord_def
 apply (simp add: tot_ord_unit wf_on_any_0)
 done
 
 
 subsection\<open>Order-Isomorphisms\<close>
 
 text\<open>Suppes calls them "similarities"\<close>
 
 (** Order-preserving (monotone) maps **)
 
 lemma mono_map_is_fun: "f \<in> mono_map(A,r,B,s) \<Longrightarrow> f \<in> A->B"
 by (simp add: mono_map_def)
 
 lemma mono_map_is_inj:
     "\<lbrakk>linear(A,r);  wf[B](s);  f \<in> mono_map(A,r,B,s)\<rbrakk> \<Longrightarrow> f \<in> inj(A,B)"
 apply (unfold mono_map_def inj_def, clarify)
 apply (erule_tac x=w and y=x in linearE, assumption+)
 apply (force intro: apply_type dest: wf_on_not_refl)+
 done
 
 lemma ord_isoI:
     "\<lbrakk>f \<in> bij(A, B);
         \<And>x y. \<lbrakk>x \<in> A; y \<in> A\<rbrakk> \<Longrightarrow> \<langle>x, y\<rangle> \<in> r \<longleftrightarrow> <f`x, f`y> \<in> s\<rbrakk>
      \<Longrightarrow> f \<in> ord_iso(A,r,B,s)"
 by (simp add: ord_iso_def)
 
 lemma ord_iso_is_mono_map:
     "f \<in> ord_iso(A,r,B,s) \<Longrightarrow> f \<in> mono_map(A,r,B,s)"
 apply (simp add: ord_iso_def mono_map_def)
 apply (blast dest!: bij_is_fun)
 done
 
 lemma ord_iso_is_bij:
     "f \<in> ord_iso(A,r,B,s) \<Longrightarrow> f \<in> bij(A,B)"
 by (simp add: ord_iso_def)
 
 (*Needed?  But ord_iso_converse is!*)
 lemma ord_iso_apply:
     "\<lbrakk>f \<in> ord_iso(A,r,B,s);  \<langle>x,y\<rangle>: r;  x \<in> A;  y \<in> A\<rbrakk> \<Longrightarrow> <f`x, f`y> \<in> s"
 by (simp add: ord_iso_def)
 
 lemma ord_iso_converse:
     "\<lbrakk>f \<in> ord_iso(A,r,B,s);  \<langle>x,y\<rangle>: s;  x \<in> B;  y \<in> B\<rbrakk>
      \<Longrightarrow> <converse(f) ` x, converse(f) ` y> \<in> r"
 apply (simp add: ord_iso_def, clarify)
 apply (erule bspec [THEN bspec, THEN iffD2])
 apply (erule asm_rl bij_converse_bij [THEN bij_is_fun, THEN apply_type])+
 apply (auto simp add: right_inverse_bij)
 done
 
 
 (** Symmetry and Transitivity Rules **)
 
 (*Reflexivity of similarity*)
 lemma ord_iso_refl: "id(A): ord_iso(A,r,A,r)"
 by (rule id_bij [THEN ord_isoI], simp)
 
 (*Symmetry of similarity*)
 lemma ord_iso_sym: "f \<in> ord_iso(A,r,B,s) \<Longrightarrow> converse(f): ord_iso(B,s,A,r)"
 apply (simp add: ord_iso_def)
 apply (auto simp add: right_inverse_bij bij_converse_bij
                       bij_is_fun [THEN apply_funtype])
 done
 
 (*Transitivity of similarity*)
 lemma mono_map_trans:
     "\<lbrakk>g \<in> mono_map(A,r,B,s);  f \<in> mono_map(B,s,C,t)\<rbrakk>
      \<Longrightarrow> (f O g): mono_map(A,r,C,t)"
-apply (unfold mono_map_def)
+  unfolding mono_map_def
 apply (auto simp add: comp_fun)
 done
 
 (*Transitivity of similarity: the order-isomorphism relation*)
 lemma ord_iso_trans:
     "\<lbrakk>g \<in> ord_iso(A,r,B,s);  f \<in> ord_iso(B,s,C,t)\<rbrakk>
      \<Longrightarrow> (f O g): ord_iso(A,r,C,t)"
 apply (unfold ord_iso_def, clarify)
 apply (frule bij_is_fun [of f])
 apply (frule bij_is_fun [of g])
 apply (auto simp add: comp_bij)
 done
 
 (** Two monotone maps can make an order-isomorphism **)
 
 lemma mono_ord_isoI:
     "\<lbrakk>f \<in> mono_map(A,r,B,s);  g \<in> mono_map(B,s,A,r);
         f O g = id(B);  g O f = id(A)\<rbrakk> \<Longrightarrow> f \<in> ord_iso(A,r,B,s)"
 apply (simp add: ord_iso_def mono_map_def, safe)
 apply (intro fg_imp_bijective, auto)
 apply (subgoal_tac "<g` (f`x), g` (f`y) > \<in> r")
 apply (simp add: comp_eq_id_iff [THEN iffD1])
 apply (blast intro: apply_funtype)
 done
 
 lemma well_ord_mono_ord_isoI:
      "\<lbrakk>well_ord(A,r);  well_ord(B,s);
          f \<in> mono_map(A,r,B,s);  converse(f): mono_map(B,s,A,r)\<rbrakk>
       \<Longrightarrow> f \<in> ord_iso(A,r,B,s)"
 apply (intro mono_ord_isoI, auto)
 apply (frule mono_map_is_fun [THEN fun_is_rel])
 apply (erule converse_converse [THEN subst], rule left_comp_inverse)
 apply (blast intro: left_comp_inverse mono_map_is_inj well_ord_is_linear
                     well_ord_is_wf)+
 done
 
 
 (** Order-isomorphisms preserve the ordering's properties **)
 
 lemma part_ord_ord_iso:
     "\<lbrakk>part_ord(B,s);  f \<in> ord_iso(A,r,B,s)\<rbrakk> \<Longrightarrow> part_ord(A,r)"
 apply (simp add: part_ord_def irrefl_def trans_on_def ord_iso_def)
 apply (fast intro: bij_is_fun [THEN apply_type])
 done
 
 lemma linear_ord_iso:
     "\<lbrakk>linear(B,s);  f \<in> ord_iso(A,r,B,s)\<rbrakk> \<Longrightarrow> linear(A,r)"
 apply (simp add: linear_def ord_iso_def, safe)
 apply (drule_tac x1 = "f`x" and x = "f`y" in bspec [THEN bspec])
 apply (safe elim!: bij_is_fun [THEN apply_type])
 apply (drule_tac t = "(`) (converse (f))" in subst_context)
 apply (simp add: left_inverse_bij)
 done
 
 lemma wf_on_ord_iso:
     "\<lbrakk>wf[B](s);  f \<in> ord_iso(A,r,B,s)\<rbrakk> \<Longrightarrow> wf[A](r)"
 apply (simp add: wf_on_def wf_def ord_iso_def, safe)
 apply (drule_tac x = "{f`z. z \<in> Z \<inter> A}" in spec)
 apply (safe intro!: equalityI)
 apply (blast dest!: equalityD1 intro: bij_is_fun [THEN apply_type])+
 done
 
 lemma well_ord_ord_iso:
     "\<lbrakk>well_ord(B,s);  f \<in> ord_iso(A,r,B,s)\<rbrakk> \<Longrightarrow> well_ord(A,r)"
 apply (unfold well_ord_def tot_ord_def)
 apply (fast elim!: part_ord_ord_iso linear_ord_iso wf_on_ord_iso)
 done
 
 
 subsection\<open>Main results of Kunen, Chapter 1 section 6\<close>
 
 (*Inductive argument for Kunen's Lemma 6.1, etc.
   Simple proof from Halmos, page 72*)
 lemma well_ord_iso_subset_lemma:
      "\<lbrakk>well_ord(A,r);  f \<in> ord_iso(A,r, A',r);  A'<= A;  y \<in> A\<rbrakk>
       \<Longrightarrow> \<not> <f`y, y>: r"
 apply (simp add: well_ord_def ord_iso_def)
 apply (elim conjE CollectE)
 apply (rule_tac a=y in wf_on_induct, assumption+)
 apply (blast dest: bij_is_fun [THEN apply_type])
 done
 
 (*Kunen's Lemma 6.1 \<in> there's no order-isomorphism to an initial segment
                      of a well-ordering*)
 lemma well_ord_iso_predE:
      "\<lbrakk>well_ord(A,r);  f \<in> ord_iso(A, r, pred(A,x,r), r);  x \<in> A\<rbrakk> \<Longrightarrow> P"
 apply (insert well_ord_iso_subset_lemma [of A r f "pred(A,x,r)" x])
 apply (simp add: pred_subset)
 (*Now we know  f`x < x *)
 apply (drule ord_iso_is_bij [THEN bij_is_fun, THEN apply_type], assumption)
 (*Now we also know @{term"f`x \<in> pred(A,x,r)"}: contradiction! *)
 apply (simp add: well_ord_def pred_def)
 done
 
 (*Simple consequence of Lemma 6.1*)
 lemma well_ord_iso_pred_eq:
      "\<lbrakk>well_ord(A,r);  f \<in> ord_iso(pred(A,a,r), r, pred(A,c,r), r);
          a \<in> A;  c \<in> A\<rbrakk> \<Longrightarrow> a=c"
 apply (frule well_ord_is_trans_on)
 apply (frule well_ord_is_linear)
 apply (erule_tac x=a and y=c in linearE, assumption+)
 apply (drule ord_iso_sym)
 (*two symmetric cases*)
 apply (auto elim!: well_ord_subset [OF _ pred_subset, THEN well_ord_iso_predE]
             intro!: predI
             simp add: trans_pred_pred_eq)
 done
 
 (*Does not assume r is a wellordering!*)
 lemma ord_iso_image_pred:
      "\<lbrakk>f \<in> ord_iso(A,r,B,s);  a \<in> A\<rbrakk> \<Longrightarrow> f `` pred(A,a,r) = pred(B, f`a, s)"
 apply (unfold ord_iso_def pred_def)
 apply (erule CollectE)
 apply (simp (no_asm_simp) add: image_fun [OF bij_is_fun Collect_subset])
 apply (rule equalityI)
 apply (safe elim!: bij_is_fun [THEN apply_type])
 apply (rule RepFun_eqI)
 apply (blast intro!: right_inverse_bij [symmetric])
 apply (auto simp add: right_inverse_bij  bij_is_fun [THEN apply_funtype])
 done
 
 lemma ord_iso_restrict_image:
      "\<lbrakk>f \<in> ord_iso(A,r,B,s);  C<=A\<rbrakk>
       \<Longrightarrow> restrict(f,C) \<in> ord_iso(C, r, f``C, s)"
 apply (simp add: ord_iso_def)
 apply (blast intro: bij_is_inj restrict_bij)
 done
 
 (*But in use, A and B may themselves be initial segments.  Then use
   trans_pred_pred_eq to simplify the pred(pred...) terms.  See just below.*)
 lemma ord_iso_restrict_pred:
    "\<lbrakk>f \<in> ord_iso(A,r,B,s);   a \<in> A\<rbrakk>
     \<Longrightarrow> restrict(f, pred(A,a,r)) \<in> ord_iso(pred(A,a,r), r, pred(B, f`a, s), s)"
 apply (simp add: ord_iso_image_pred [symmetric])
 apply (blast intro: ord_iso_restrict_image elim: predE)
 done
 
 (*Tricky; a lot of forward proof!*)
 lemma well_ord_iso_preserving:
      "\<lbrakk>well_ord(A,r);  well_ord(B,s);  \<langle>a,c\<rangle>: r;
          f \<in> ord_iso(pred(A,a,r), r, pred(B,b,s), s);
          g \<in> ord_iso(pred(A,c,r), r, pred(B,d,s), s);
          a \<in> A;  c \<in> A;  b \<in> B;  d \<in> B\<rbrakk> \<Longrightarrow> \<langle>b,d\<rangle>: s"
 apply (frule ord_iso_is_bij [THEN bij_is_fun, THEN apply_type], (erule asm_rl predI predE)+)
 apply (subgoal_tac "b = g`a")
 apply (simp (no_asm_simp))
 apply (rule well_ord_iso_pred_eq, auto)
 apply (frule ord_iso_restrict_pred, (erule asm_rl predI)+)
 apply (simp add: well_ord_is_trans_on trans_pred_pred_eq)
 apply (erule ord_iso_sym [THEN ord_iso_trans], assumption)
 done
 
 (*See Halmos, page 72*)
 lemma well_ord_iso_unique_lemma:
      "\<lbrakk>well_ord(A,r);
          f \<in> ord_iso(A,r, B,s);  g \<in> ord_iso(A,r, B,s);  y \<in> A\<rbrakk>
       \<Longrightarrow> \<not> <g`y, f`y> \<in> s"
 apply (frule well_ord_iso_subset_lemma)
 apply (rule_tac f = "converse (f) " and g = g in ord_iso_trans)
 apply auto
 apply (blast intro: ord_iso_sym)
 apply (frule ord_iso_is_bij [of f])
 apply (frule ord_iso_is_bij [of g])
 apply (frule ord_iso_converse)
 apply (blast intro!: bij_converse_bij
              intro: bij_is_fun apply_funtype)+
 apply (erule notE)
 apply (simp add: left_inverse_bij bij_is_fun comp_fun_apply [of _ A B])
 done
 
 
 (*Kunen's Lemma 6.2: Order-isomorphisms between well-orderings are unique*)
 lemma well_ord_iso_unique: "\<lbrakk>well_ord(A,r);
          f \<in> ord_iso(A,r, B,s);  g \<in> ord_iso(A,r, B,s)\<rbrakk> \<Longrightarrow> f = g"
 apply (rule fun_extension)
 apply (erule ord_iso_is_bij [THEN bij_is_fun])+
 apply (subgoal_tac "f`x \<in> B \<and> g`x \<in> B \<and> linear(B,s)")
  apply (simp add: linear_def)
  apply (blast dest: well_ord_iso_unique_lemma)
 apply (blast intro: ord_iso_is_bij bij_is_fun apply_funtype
                     well_ord_is_linear well_ord_ord_iso ord_iso_sym)
 done
 
 subsection\<open>Towards Kunen's Theorem 6.3: Linearity of the Similarity Relation\<close>
 
 lemma ord_iso_map_subset: "ord_iso_map(A,r,B,s) \<subseteq> A*B"
 by (unfold ord_iso_map_def, blast)
 
 lemma domain_ord_iso_map: "domain(ord_iso_map(A,r,B,s)) \<subseteq> A"
 by (unfold ord_iso_map_def, blast)
 
 lemma range_ord_iso_map: "range(ord_iso_map(A,r,B,s)) \<subseteq> B"
 by (unfold ord_iso_map_def, blast)
 
 lemma converse_ord_iso_map:
     "converse(ord_iso_map(A,r,B,s)) = ord_iso_map(B,s,A,r)"
-apply (unfold ord_iso_map_def)
+  unfolding ord_iso_map_def
 apply (blast intro: ord_iso_sym)
 done
 
 lemma function_ord_iso_map:
     "well_ord(B,s) \<Longrightarrow> function(ord_iso_map(A,r,B,s))"
 apply (unfold ord_iso_map_def function_def)
 apply (blast intro: well_ord_iso_pred_eq ord_iso_sym ord_iso_trans)
 done
 
 lemma ord_iso_map_fun: "well_ord(B,s) \<Longrightarrow> ord_iso_map(A,r,B,s)
            \<in> domain(ord_iso_map(A,r,B,s)) -> range(ord_iso_map(A,r,B,s))"
 by (simp add: Pi_iff function_ord_iso_map
                  ord_iso_map_subset [THEN domain_times_range])
 
 lemma ord_iso_map_mono_map:
     "\<lbrakk>well_ord(A,r);  well_ord(B,s)\<rbrakk>
      \<Longrightarrow> ord_iso_map(A,r,B,s)
            \<in> mono_map(domain(ord_iso_map(A,r,B,s)), r,
                       range(ord_iso_map(A,r,B,s)), s)"
-apply (unfold mono_map_def)
+  unfolding mono_map_def
 apply (simp (no_asm_simp) add: ord_iso_map_fun)
 apply safe
 apply (subgoal_tac "x \<in> A \<and> ya:A \<and> y \<in> B \<and> yb:B")
  apply (simp add: apply_equality [OF _  ord_iso_map_fun])
- apply (unfold ord_iso_map_def)
+   unfolding ord_iso_map_def
  apply (blast intro: well_ord_iso_preserving, blast)
 done
 
 lemma ord_iso_map_ord_iso:
     "\<lbrakk>well_ord(A,r);  well_ord(B,s)\<rbrakk> \<Longrightarrow> ord_iso_map(A,r,B,s)
            \<in> ord_iso(domain(ord_iso_map(A,r,B,s)), r,
                       range(ord_iso_map(A,r,B,s)), s)"
 apply (rule well_ord_mono_ord_isoI)
    prefer 4
    apply (rule converse_ord_iso_map [THEN subst])
    apply (simp add: ord_iso_map_mono_map
                     ord_iso_map_subset [THEN converse_converse])
 apply (blast intro!: domain_ord_iso_map range_ord_iso_map
              intro: well_ord_subset ord_iso_map_mono_map)+
 done
 
 
 (*One way of saying that domain(ord_iso_map(A,r,B,s)) is downwards-closed*)
 lemma domain_ord_iso_map_subset:
      "\<lbrakk>well_ord(A,r);  well_ord(B,s);
          a \<in> A;  a \<notin> domain(ord_iso_map(A,r,B,s))\<rbrakk>
       \<Longrightarrow>  domain(ord_iso_map(A,r,B,s)) \<subseteq> pred(A, a, r)"
-apply (unfold ord_iso_map_def)
+  unfolding ord_iso_map_def
 apply (safe intro!: predI)
 (*Case analysis on  xa vs a in r *)
 apply (simp (no_asm_simp))
 apply (frule_tac A = A in well_ord_is_linear)
 apply (rename_tac b y f)
 apply (erule_tac x=b and y=a in linearE, assumption+)
 (*Trivial case: b=a*)
 apply clarify
 apply blast
 (*Harder case: \<langle>a, xa\<rangle>: r*)
 apply (frule ord_iso_is_bij [THEN bij_is_fun, THEN apply_type],
        (erule asm_rl predI predE)+)
 apply (frule ord_iso_restrict_pred)
  apply (simp add: pred_iff)
 apply (simp split: split_if_asm
           add: well_ord_is_trans_on trans_pred_pred_eq domain_UN domain_Union, blast)
 done
 
 (*For the 4-way case analysis in the main result*)
 lemma domain_ord_iso_map_cases:
      "\<lbrakk>well_ord(A,r);  well_ord(B,s)\<rbrakk>
       \<Longrightarrow> domain(ord_iso_map(A,r,B,s)) = A |
           (\<exists>x\<in>A. domain(ord_iso_map(A,r,B,s)) = pred(A,x,r))"
 apply (frule well_ord_is_wf)
 apply (unfold wf_on_def wf_def)
 apply (drule_tac x = "A-domain (ord_iso_map (A,r,B,s))" in spec)
 apply safe
 (*The first case: the domain equals A*)
 apply (rule domain_ord_iso_map [THEN equalityI])
 apply (erule Diff_eq_0_iff [THEN iffD1])
 (*The other case: the domain equals an initial segment*)
 apply (blast del: domainI subsetI
              elim!: predE
              intro!: domain_ord_iso_map_subset
              intro: subsetI)+
 done
 
 (*As above, by duality*)
 lemma range_ord_iso_map_cases:
     "\<lbrakk>well_ord(A,r);  well_ord(B,s)\<rbrakk>
      \<Longrightarrow> range(ord_iso_map(A,r,B,s)) = B |
          (\<exists>y\<in>B. range(ord_iso_map(A,r,B,s)) = pred(B,y,s))"
 apply (rule converse_ord_iso_map [THEN subst])
 apply (simp add: domain_ord_iso_map_cases)
 done
 
 text\<open>Kunen's Theorem 6.3: Fundamental Theorem for Well-Ordered Sets\<close>
 theorem well_ord_trichotomy:
    "\<lbrakk>well_ord(A,r);  well_ord(B,s)\<rbrakk>
     \<Longrightarrow> ord_iso_map(A,r,B,s) \<in> ord_iso(A, r, B, s) |
         (\<exists>x\<in>A. ord_iso_map(A,r,B,s) \<in> ord_iso(pred(A,x,r), r, B, s)) |
         (\<exists>y\<in>B. ord_iso_map(A,r,B,s) \<in> ord_iso(A, r, pred(B,y,s), s))"
 apply (frule_tac B = B in domain_ord_iso_map_cases, assumption)
 apply (frule_tac B = B in range_ord_iso_map_cases, assumption)
 apply (drule ord_iso_map_ord_iso, assumption)
 apply (elim disjE bexE)
    apply (simp_all add: bexI)
 apply (rule wf_on_not_refl [THEN notE])
   apply (erule well_ord_is_wf)
  apply assumption
 apply (subgoal_tac "\<langle>x,y\<rangle>: ord_iso_map (A,r,B,s) ")
  apply (drule rangeI)
  apply (simp add: pred_def)
 apply (unfold ord_iso_map_def, blast)
 done
 
 
 subsection\<open>Miscellaneous Results by Krzysztof Grabczewski\<close>
 
 (** Properties of converse(r) **)
 
 lemma irrefl_converse: "irrefl(A,r) \<Longrightarrow> irrefl(A,converse(r))"
 by (unfold irrefl_def, blast)
 
 lemma trans_on_converse: "trans[A](r) \<Longrightarrow> trans[A](converse(r))"
 by (unfold trans_on_def, blast)
 
 lemma part_ord_converse: "part_ord(A,r) \<Longrightarrow> part_ord(A,converse(r))"
-apply (unfold part_ord_def)
+  unfolding part_ord_def
 apply (blast intro!: irrefl_converse trans_on_converse)
 done
 
 lemma linear_converse: "linear(A,r) \<Longrightarrow> linear(A,converse(r))"
 by (unfold linear_def, blast)
 
 lemma tot_ord_converse: "tot_ord(A,r) \<Longrightarrow> tot_ord(A,converse(r))"
-apply (unfold tot_ord_def)
+  unfolding tot_ord_def
 apply (blast intro!: part_ord_converse linear_converse)
 done
 
 
 (** By Krzysztof Grabczewski.
     Lemmas involving the first element of a well ordered set **)
 
 lemma first_is_elem: "first(b,B,r) \<Longrightarrow> b \<in> B"
 by (unfold first_def, blast)
 
 lemma well_ord_imp_ex1_first:
         "\<lbrakk>well_ord(A,r); B<=A; B\<noteq>0\<rbrakk> \<Longrightarrow> (\<exists>!b. first(b,B,r))"
 apply (unfold well_ord_def wf_on_def wf_def first_def)
 apply (elim conjE allE disjE, blast)
 apply (erule bexE)
 apply (rule_tac a = x in ex1I, auto)
 apply (unfold tot_ord_def linear_def, blast)
 done
 
 lemma the_first_in:
      "\<lbrakk>well_ord(A,r); B<=A; B\<noteq>0\<rbrakk> \<Longrightarrow> (THE b. first(b,B,r)) \<in> B"
 apply (drule well_ord_imp_ex1_first, assumption+)
 apply (rule first_is_elem)
 apply (erule theI)
 done
 
 
 subsection \<open>Lemmas for the Reflexive Orders\<close>
 
 lemma subset_vimage_vimage_iff:
   "\<lbrakk>Preorder(r); A \<subseteq> field(r); B \<subseteq> field(r)\<rbrakk> \<Longrightarrow>
   r -`` A \<subseteq> r -`` B \<longleftrightarrow> (\<forall>a\<in>A. \<exists>b\<in>B. \<langle>a, b\<rangle> \<in> r)"
   apply (auto simp: subset_def preorder_on_def refl_def vimage_def image_def)
    apply blast
   unfolding trans_on_def
   apply (erule_tac P = "(\<lambda>x. \<forall>y\<in>field(r).
           \<forall>z\<in>field(r). \<langle>x, y\<rangle> \<in> r \<longrightarrow> \<langle>y, z\<rangle> \<in> r \<longrightarrow> \<langle>x, z\<rangle> \<in> r)" for r in rev_ballE)
     (* instance obtained from proof term generated by best *)
    apply best
   apply blast
   done
 
 lemma subset_vimage1_vimage1_iff:
   "\<lbrakk>Preorder(r); a \<in> field(r); b \<in> field(r)\<rbrakk> \<Longrightarrow>
   r -`` {a} \<subseteq> r -`` {b} \<longleftrightarrow> \<langle>a, b\<rangle> \<in> r"
   by (simp add: subset_vimage_vimage_iff)
 
 lemma Refl_antisym_eq_Image1_Image1_iff:
   "\<lbrakk>refl(field(r), r); antisym(r); a \<in> field(r); b \<in> field(r)\<rbrakk> \<Longrightarrow>
   r `` {a} = r `` {b} \<longleftrightarrow> a = b"
   apply rule
    apply (frule equality_iffD)
    apply (drule equality_iffD)
    apply (simp add: antisym_def refl_def)
    apply best
   apply (simp add: antisym_def refl_def)
   done
 
 lemma Partial_order_eq_Image1_Image1_iff:
   "\<lbrakk>Partial_order(r); a \<in> field(r); b \<in> field(r)\<rbrakk> \<Longrightarrow>
   r `` {a} = r `` {b} \<longleftrightarrow> a = b"
   by (simp add: partial_order_on_def preorder_on_def
     Refl_antisym_eq_Image1_Image1_iff)
 
 lemma Refl_antisym_eq_vimage1_vimage1_iff:
   "\<lbrakk>refl(field(r), r); antisym(r); a \<in> field(r); b \<in> field(r)\<rbrakk> \<Longrightarrow>
   r -`` {a} = r -`` {b} \<longleftrightarrow> a = b"
   apply rule
    apply (frule equality_iffD)
    apply (drule equality_iffD)
    apply (simp add: antisym_def refl_def)
    apply best
   apply (simp add: antisym_def refl_def)
   done
 
 lemma Partial_order_eq_vimage1_vimage1_iff:
   "\<lbrakk>Partial_order(r); a \<in> field(r); b \<in> field(r)\<rbrakk> \<Longrightarrow>
   r -`` {a} = r -`` {b} \<longleftrightarrow> a = b"
   by (simp add: partial_order_on_def preorder_on_def
     Refl_antisym_eq_vimage1_vimage1_iff)
 
 end
diff --git a/src/ZF/OrderArith.thy b/src/ZF/OrderArith.thy
--- a/src/ZF/OrderArith.thy
+++ b/src/ZF/OrderArith.thy
@@ -1,568 +1,568 @@
 (*  Title:      ZF/OrderArith.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section\<open>Combining Orderings: Foundations of Ordinal Arithmetic\<close>
 
 theory OrderArith imports Order Sum Ordinal begin
 
 definition
   (*disjoint sum of two relations; underlies ordinal addition*)
   radd    :: "[i,i,i,i]\<Rightarrow>i"  where
     "radd(A,r,B,s) \<equiv>
                 {z: (A+B) * (A+B).
                     (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>)   |
                     (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x',x\<rangle>:r)   |
                     (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y',y\<rangle>:s)}"
 
 definition
   (*lexicographic product of two relations; underlies ordinal multiplication*)
   rmult   :: "[i,i,i,i]\<Rightarrow>i"  where
     "rmult(A,r,B,s) \<equiv>
                 {z: (A*B) * (A*B).
                     \<exists>x' y' x y. z = \<langle>\<langle>x',y'\<rangle>, \<langle>x,y\<rangle>\<rangle> \<and>
                        (\<langle>x',x\<rangle>: r | (x'=x \<and> \<langle>y',y\<rangle>: s))}"
 
 definition
   (*inverse image of a relation*)
   rvimage :: "[i,i,i]\<Rightarrow>i"  where
     "rvimage(A,f,r) \<equiv> {z \<in> A*A. \<exists>x y. z = \<langle>x,y\<rangle> \<and> \<langle>f`x,f`y\<rangle>: r}"
 
 definition
   measure :: "[i, i\<Rightarrow>i] \<Rightarrow> i"  where
     "measure(A,f) \<equiv> {\<langle>x,y\<rangle>: A*A. f(x) < f(y)}"
 
 
 subsection\<open>Addition of Relations -- Disjoint Sum\<close>
 
 subsubsection\<open>Rewrite rules.  Can be used to obtain introduction rules\<close>
 
 lemma radd_Inl_Inr_iff [iff]:
     "\<langle>Inl(a), Inr(b)\<rangle> \<in> radd(A,r,B,s)  \<longleftrightarrow>  a \<in> A \<and> b \<in> B"
 by (unfold radd_def, blast)
 
 lemma radd_Inl_iff [iff]:
     "\<langle>Inl(a'), Inl(a)\<rangle> \<in> radd(A,r,B,s)  \<longleftrightarrow>  a':A \<and> a \<in> A \<and> \<langle>a',a\<rangle>:r"
 by (unfold radd_def, blast)
 
 lemma radd_Inr_iff [iff]:
     "\<langle>Inr(b'), Inr(b)\<rangle> \<in> radd(A,r,B,s) \<longleftrightarrow>  b':B \<and> b \<in> B \<and> \<langle>b',b\<rangle>:s"
 by (unfold radd_def, blast)
 
 lemma radd_Inr_Inl_iff [simp]:
     "\<langle>Inr(b), Inl(a)\<rangle> \<in> radd(A,r,B,s) \<longleftrightarrow> False"
 by (unfold radd_def, blast)
 
 declare radd_Inr_Inl_iff [THEN iffD1, dest!]
 
 subsubsection\<open>Elimination Rule\<close>
 
 lemma raddE:
     "\<lbrakk>\<langle>p',p\<rangle> \<in> radd(A,r,B,s);
         \<And>x y. \<lbrakk>p'=Inl(x); x \<in> A; p=Inr(y); y \<in> B\<rbrakk> \<Longrightarrow> Q;
         \<And>x' x. \<lbrakk>p'=Inl(x'); p=Inl(x); \<langle>x',x\<rangle>: r; x':A; x \<in> A\<rbrakk> \<Longrightarrow> Q;
         \<And>y' y. \<lbrakk>p'=Inr(y'); p=Inr(y); \<langle>y',y\<rangle>: s; y':B; y \<in> B\<rbrakk> \<Longrightarrow> Q
 \<rbrakk> \<Longrightarrow> Q"
 by (unfold radd_def, blast)
 
 subsubsection\<open>Type checking\<close>
 
 lemma radd_type: "radd(A,r,B,s) \<subseteq> (A+B) * (A+B)"
-apply (unfold radd_def)
+  unfolding radd_def
 apply (rule Collect_subset)
 done
 
 lemmas field_radd = radd_type [THEN field_rel_subset]
 
 subsubsection\<open>Linearity\<close>
 
 lemma linear_radd:
     "\<lbrakk>linear(A,r);  linear(B,s)\<rbrakk> \<Longrightarrow> linear(A+B,radd(A,r,B,s))"
 by (unfold linear_def, blast)
 
 
 subsubsection\<open>Well-foundedness\<close>
 
 lemma wf_on_radd: "\<lbrakk>wf[A](r);  wf[B](s)\<rbrakk> \<Longrightarrow> wf[A+B](radd(A,r,B,s))"
 apply (rule wf_onI2)
 apply (subgoal_tac "\<forall>x\<in>A. Inl (x) \<in> Ba")
  \<comment> \<open>Proving the lemma, which is needed twice!\<close>
  prefer 2
  apply (erule_tac V = "y \<in> A + B" in thin_rl)
  apply (rule_tac ballI)
  apply (erule_tac r = r and a = x in wf_on_induct, assumption)
  apply blast
 txt\<open>Returning to main part of proof\<close>
 apply safe
 apply blast
 apply (erule_tac r = s and a = ya in wf_on_induct, assumption, blast)
 done
 
 lemma wf_radd: "\<lbrakk>wf(r);  wf(s)\<rbrakk> \<Longrightarrow> wf(radd(field(r),r,field(s),s))"
 apply (simp add: wf_iff_wf_on_field)
 apply (rule wf_on_subset_A [OF _ field_radd])
 apply (blast intro: wf_on_radd)
 done
 
 lemma well_ord_radd:
      "\<lbrakk>well_ord(A,r);  well_ord(B,s)\<rbrakk> \<Longrightarrow> well_ord(A+B, radd(A,r,B,s))"
 apply (rule well_ordI)
 apply (simp add: well_ord_def wf_on_radd)
 apply (simp add: well_ord_def tot_ord_def linear_radd)
 done
 
 subsubsection\<open>An \<^term>\<open>ord_iso\<close> congruence law\<close>
 
 lemma sum_bij:
      "\<lbrakk>f \<in> bij(A,C);  g \<in> bij(B,D)\<rbrakk>
       \<Longrightarrow> (\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z)) \<in> bij(A+B, C+D)"
 apply (rule_tac d = "case (\<lambda>x. Inl (converse(f)`x), \<lambda>y. Inr(converse(g)`y))"
        in lam_bijective)
 apply (typecheck add: bij_is_inj inj_is_fun)
 apply (auto simp add: left_inverse_bij right_inverse_bij)
 done
 
 lemma sum_ord_iso_cong:
     "\<lbrakk>f \<in> ord_iso(A,r,A',r');  g \<in> ord_iso(B,s,B',s')\<rbrakk> \<Longrightarrow>
             (\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z))
             \<in> ord_iso(A+B, radd(A,r,B,s), A'+B', radd(A',r',B',s'))"
-apply (unfold ord_iso_def)
+  unfolding ord_iso_def
 apply (safe intro!: sum_bij)
 (*Do the beta-reductions now*)
 apply (auto cong add: conj_cong simp add: bij_is_fun [THEN apply_type])
 done
 
 (*Could we prove an ord_iso result?  Perhaps
      ord_iso(A+B, radd(A,r,B,s), A \<union> B, r \<union> s) *)
 lemma sum_disjoint_bij: "A \<inter> B = 0 \<Longrightarrow>
             (\<lambda>z\<in>A+B. case(\<lambda>x. x, \<lambda>y. y, z)) \<in> bij(A+B, A \<union> B)"
 apply (rule_tac d = "\<lambda>z. if z \<in> A then Inl (z) else Inr (z) " in lam_bijective)
 apply auto
 done
 
 subsubsection\<open>Associativity\<close>
 
 lemma sum_assoc_bij:
      "(\<lambda>z\<in>(A+B)+C. case(case(Inl, \<lambda>y. Inr(Inl(y))), \<lambda>y. Inr(Inr(y)), z))
       \<in> bij((A+B)+C, A+(B+C))"
 apply (rule_tac d = "case (\<lambda>x. Inl (Inl (x)), case (\<lambda>x. Inl (Inr (x)), Inr))"
        in lam_bijective)
 apply auto
 done
 
 lemma sum_assoc_ord_iso:
      "(\<lambda>z\<in>(A+B)+C. case(case(Inl, \<lambda>y. Inr(Inl(y))), \<lambda>y. Inr(Inr(y)), z))
       \<in> ord_iso((A+B)+C, radd(A+B, radd(A,r,B,s), C, t),
                 A+(B+C), radd(A, r, B+C, radd(B,s,C,t)))"
 by (rule sum_assoc_bij [THEN ord_isoI], auto)
 
 
 subsection\<open>Multiplication of Relations -- Lexicographic Product\<close>
 
 subsubsection\<open>Rewrite rule.  Can be used to obtain introduction rules\<close>
 
 lemma  rmult_iff [iff]:
     "\<langle>\<langle>a',b'\<rangle>, \<langle>a,b\<rangle>\<rangle> \<in> rmult(A,r,B,s) \<longleftrightarrow>
             (\<langle>a',a\<rangle>: r  \<and> a':A \<and> a \<in> A \<and> b': B \<and> b \<in> B) |
             (\<langle>b',b\<rangle>: s  \<and> a'=a \<and> a \<in> A \<and> b': B \<and> b \<in> B)"
 
 by (unfold rmult_def, blast)
 
 lemma rmultE:
     "\<lbrakk>\<langle>\<langle>a',b'\<rangle>, \<langle>a,b\<rangle>\<rangle> \<in> rmult(A,r,B,s);
         \<lbrakk>\<langle>a',a\<rangle>: r;  a':A;  a \<in> A;  b':B;  b \<in> B\<rbrakk> \<Longrightarrow> Q;
         \<lbrakk>\<langle>b',b\<rangle>: s;  a \<in> A;  a'=a;  b':B;  b \<in> B\<rbrakk> \<Longrightarrow> Q
 \<rbrakk> \<Longrightarrow> Q"
 by blast
 
 subsubsection\<open>Type checking\<close>
 
 lemma rmult_type: "rmult(A,r,B,s) \<subseteq> (A*B) * (A*B)"
 by (unfold rmult_def, rule Collect_subset)
 
 lemmas field_rmult = rmult_type [THEN field_rel_subset]
 
 subsubsection\<open>Linearity\<close>
 
 lemma linear_rmult:
     "\<lbrakk>linear(A,r);  linear(B,s)\<rbrakk> \<Longrightarrow> linear(A*B,rmult(A,r,B,s))"
 by (simp add: linear_def, blast)
 
 subsubsection\<open>Well-foundedness\<close>
 
 lemma wf_on_rmult: "\<lbrakk>wf[A](r);  wf[B](s)\<rbrakk> \<Longrightarrow> wf[A*B](rmult(A,r,B,s))"
 apply (rule wf_onI2)
 apply (erule SigmaE)
 apply (erule ssubst)
 apply (subgoal_tac "\<forall>b\<in>B. \<langle>x,b\<rangle>: Ba", blast)
 apply (erule_tac a = x in wf_on_induct, assumption)
 apply (rule ballI)
 apply (erule_tac a = b in wf_on_induct, assumption)
 apply (best elim!: rmultE bspec [THEN mp])
 done
 
 
 lemma wf_rmult: "\<lbrakk>wf(r);  wf(s)\<rbrakk> \<Longrightarrow> wf(rmult(field(r),r,field(s),s))"
 apply (simp add: wf_iff_wf_on_field)
 apply (rule wf_on_subset_A [OF _ field_rmult])
 apply (blast intro: wf_on_rmult)
 done
 
 lemma well_ord_rmult:
      "\<lbrakk>well_ord(A,r);  well_ord(B,s)\<rbrakk> \<Longrightarrow> well_ord(A*B, rmult(A,r,B,s))"
 apply (rule well_ordI)
 apply (simp add: well_ord_def wf_on_rmult)
 apply (simp add: well_ord_def tot_ord_def linear_rmult)
 done
 
 
 subsubsection\<open>An \<^term>\<open>ord_iso\<close> congruence law\<close>
 
 lemma prod_bij:
      "\<lbrakk>f \<in> bij(A,C);  g \<in> bij(B,D)\<rbrakk>
       \<Longrightarrow> (lam \<langle>x,y\<rangle>:A*B. \<langle>f`x, g`y\<rangle>) \<in> bij(A*B, C*D)"
 apply (rule_tac d = "\<lambda>\<langle>x,y\<rangle>. \<langle>converse (f) `x, converse (g) `y\<rangle>"
        in lam_bijective)
 apply (typecheck add: bij_is_inj inj_is_fun)
 apply (auto simp add: left_inverse_bij right_inverse_bij)
 done
 
 lemma prod_ord_iso_cong:
     "\<lbrakk>f \<in> ord_iso(A,r,A',r');  g \<in> ord_iso(B,s,B',s')\<rbrakk>
      \<Longrightarrow> (lam \<langle>x,y\<rangle>:A*B. \<langle>f`x, g`y\<rangle>)
          \<in> ord_iso(A*B, rmult(A,r,B,s), A'*B', rmult(A',r',B',s'))"
-apply (unfold ord_iso_def)
+  unfolding ord_iso_def
 apply (safe intro!: prod_bij)
 apply (simp_all add: bij_is_fun [THEN apply_type])
 apply (blast intro: bij_is_inj [THEN inj_apply_equality])
 done
 
 lemma singleton_prod_bij: "(\<lambda>z\<in>A. \<langle>x,z\<rangle>) \<in> bij(A, {x}*A)"
 by (rule_tac d = snd in lam_bijective, auto)
 
 (*Used??*)
 lemma singleton_prod_ord_iso:
      "well_ord({x},xr) \<Longrightarrow>
           (\<lambda>z\<in>A. \<langle>x,z\<rangle>) \<in> ord_iso(A, r, {x}*A, rmult({x}, xr, A, r))"
 apply (rule singleton_prod_bij [THEN ord_isoI])
 apply (simp (no_asm_simp))
 apply (blast dest: well_ord_is_wf [THEN wf_on_not_refl])
 done
 
 (*Here we build a complicated function term, then simplify it using
   case_cong, id_conv, comp_lam, case_case.*)
 lemma prod_sum_singleton_bij:
      "a\<notin>C \<Longrightarrow>
        (\<lambda>x\<in>C*B + D. case(\<lambda>x. x, \<lambda>y.\<langle>a,y\<rangle>, x))
        \<in> bij(C*B + D, C*B \<union> {a}*D)"
 apply (rule subst_elem)
 apply (rule id_bij [THEN sum_bij, THEN comp_bij])
 apply (rule singleton_prod_bij)
 apply (rule sum_disjoint_bij, blast)
 apply (simp (no_asm_simp) cong add: case_cong)
 apply (rule comp_lam [THEN trans, symmetric])
 apply (fast elim!: case_type)
 apply (simp (no_asm_simp) add: case_case)
 done
 
 lemma prod_sum_singleton_ord_iso:
  "\<lbrakk>a \<in> A;  well_ord(A,r)\<rbrakk> \<Longrightarrow>
     (\<lambda>x\<in>pred(A,a,r)*B + pred(B,b,s). case(\<lambda>x. x, \<lambda>y.\<langle>a,y\<rangle>, x))
     \<in> ord_iso(pred(A,a,r)*B + pred(B,b,s),
                   radd(A*B, rmult(A,r,B,s), B, s),
               pred(A,a,r)*B \<union> {a}*pred(B,b,s), rmult(A,r,B,s))"
 apply (rule prod_sum_singleton_bij [THEN ord_isoI])
 apply (simp (no_asm_simp) add: pred_iff well_ord_is_wf [THEN wf_on_not_refl])
 apply (auto elim!: well_ord_is_wf [THEN wf_on_asym] predE)
 done
 
 subsubsection\<open>Distributive law\<close>
 
 lemma sum_prod_distrib_bij:
      "(lam \<langle>x,z\<rangle>:(A+B)*C. case(\<lambda>y. Inl(\<langle>y,z\<rangle>), \<lambda>y. Inr(\<langle>y,z\<rangle>), x))
       \<in> bij((A+B)*C, (A*C)+(B*C))"
 by (rule_tac d = "case (\<lambda>\<langle>x,y\<rangle>.\<langle>Inl (x),y\<rangle>, \<lambda>\<langle>x,y\<rangle>.\<langle>Inr (x),y\<rangle>) "
     in lam_bijective, auto)
 
 lemma sum_prod_distrib_ord_iso:
  "(lam \<langle>x,z\<rangle>:(A+B)*C. case(\<lambda>y. Inl(\<langle>y,z\<rangle>), \<lambda>y. Inr(\<langle>y,z\<rangle>), x))
   \<in> ord_iso((A+B)*C, rmult(A+B, radd(A,r,B,s), C, t),
             (A*C)+(B*C), radd(A*C, rmult(A,r,C,t), B*C, rmult(B,s,C,t)))"
 by (rule sum_prod_distrib_bij [THEN ord_isoI], auto)
 
 subsubsection\<open>Associativity\<close>
 
 lemma prod_assoc_bij:
      "(lam \<langle>\<langle>x,y\<rangle>, z\<rangle>:(A*B)*C. \<langle>x,\<langle>y,z\<rangle>\<rangle>) \<in> bij((A*B)*C, A*(B*C))"
 by (rule_tac d = "\<lambda>\<langle>x, \<langle>y,z\<rangle>\<rangle>. \<langle>\<langle>x,y\<rangle>, z\<rangle>" in lam_bijective, auto)
 
 lemma prod_assoc_ord_iso:
  "(lam \<langle>\<langle>x,y\<rangle>, z\<rangle>:(A*B)*C. \<langle>x,\<langle>y,z\<rangle>\<rangle>)
   \<in> ord_iso((A*B)*C, rmult(A*B, rmult(A,r,B,s), C, t),
             A*(B*C), rmult(A, r, B*C, rmult(B,s,C,t)))"
 by (rule prod_assoc_bij [THEN ord_isoI], auto)
 
 subsection\<open>Inverse Image of a Relation\<close>
 
 subsubsection\<open>Rewrite rule\<close>
 
 lemma rvimage_iff: "\<langle>a,b\<rangle> \<in> rvimage(A,f,r)  \<longleftrightarrow>  \<langle>f`a,f`b\<rangle>: r \<and> a \<in> A \<and> b \<in> A"
 by (unfold rvimage_def, blast)
 
 subsubsection\<open>Type checking\<close>
 
 lemma rvimage_type: "rvimage(A,f,r) \<subseteq> A*A"
 by (unfold rvimage_def, rule Collect_subset)
 
 lemmas field_rvimage = rvimage_type [THEN field_rel_subset]
 
 lemma rvimage_converse: "rvimage(A,f, converse(r)) = converse(rvimage(A,f,r))"
 by (unfold rvimage_def, blast)
 
 
 subsubsection\<open>Partial Ordering Properties\<close>
 
 lemma irrefl_rvimage:
     "\<lbrakk>f \<in> inj(A,B);  irrefl(B,r)\<rbrakk> \<Longrightarrow> irrefl(A, rvimage(A,f,r))"
 apply (unfold irrefl_def rvimage_def)
 apply (blast intro: inj_is_fun [THEN apply_type])
 done
 
 lemma trans_on_rvimage:
     "\<lbrakk>f \<in> inj(A,B);  trans[B](r)\<rbrakk> \<Longrightarrow> trans[A](rvimage(A,f,r))"
 apply (unfold trans_on_def rvimage_def)
 apply (blast intro: inj_is_fun [THEN apply_type])
 done
 
 lemma part_ord_rvimage:
     "\<lbrakk>f \<in> inj(A,B);  part_ord(B,r)\<rbrakk> \<Longrightarrow> part_ord(A, rvimage(A,f,r))"
-apply (unfold part_ord_def)
+  unfolding part_ord_def
 apply (blast intro!: irrefl_rvimage trans_on_rvimage)
 done
 
 subsubsection\<open>Linearity\<close>
 
 lemma linear_rvimage:
     "\<lbrakk>f \<in> inj(A,B);  linear(B,r)\<rbrakk> \<Longrightarrow> linear(A,rvimage(A,f,r))"
 apply (simp add: inj_def linear_def rvimage_iff)
 apply (blast intro: apply_funtype)
 done
 
 lemma tot_ord_rvimage:
     "\<lbrakk>f \<in> inj(A,B);  tot_ord(B,r)\<rbrakk> \<Longrightarrow> tot_ord(A, rvimage(A,f,r))"
-apply (unfold tot_ord_def)
+  unfolding tot_ord_def
 apply (blast intro!: part_ord_rvimage linear_rvimage)
 done
 
 
 subsubsection\<open>Well-foundedness\<close>
 
 lemma wf_rvimage [intro!]: "wf(r) \<Longrightarrow> wf(rvimage(A,f,r))"
 apply (simp (no_asm_use) add: rvimage_def wf_eq_minimal)
 apply clarify
 apply (subgoal_tac "\<exists>w. w \<in> {w: {f`x. x \<in> Q}. \<exists>x. x \<in> Q \<and> (f`x = w) }")
  apply (erule allE)
  apply (erule impE)
  apply assumption
  apply blast
 apply blast
 done
 
 text\<open>But note that the combination of \<open>wf_imp_wf_on\<close> and
  \<open>wf_rvimage\<close> gives \<^prop>\<open>wf(r) \<Longrightarrow> wf[C](rvimage(A,f,r))\<close>\<close>
 lemma wf_on_rvimage: "\<lbrakk>f \<in> A\<rightarrow>B;  wf[B](r)\<rbrakk> \<Longrightarrow> wf[A](rvimage(A,f,r))"
 apply (rule wf_onI2)
 apply (subgoal_tac "\<forall>z\<in>A. f`z=f`y \<longrightarrow> z \<in> Ba")
  apply blast
 apply (erule_tac a = "f`y" in wf_on_induct)
  apply (blast intro!: apply_funtype)
 apply (blast intro!: apply_funtype dest!: rvimage_iff [THEN iffD1])
 done
 
 (*Note that we need only wf[A](...) and linear(A,...) to get the result!*)
 lemma well_ord_rvimage:
      "\<lbrakk>f \<in> inj(A,B);  well_ord(B,r)\<rbrakk> \<Longrightarrow> well_ord(A, rvimage(A,f,r))"
 apply (rule well_ordI)
 apply (unfold well_ord_def tot_ord_def)
 apply (blast intro!: wf_on_rvimage inj_is_fun)
 apply (blast intro!: linear_rvimage)
 done
 
 lemma ord_iso_rvimage:
     "f \<in> bij(A,B) \<Longrightarrow> f \<in> ord_iso(A, rvimage(A,f,s), B, s)"
-apply (unfold ord_iso_def)
+  unfolding ord_iso_def
 apply (simp add: rvimage_iff)
 done
 
 lemma ord_iso_rvimage_eq:
     "f \<in> ord_iso(A,r, B,s) \<Longrightarrow> rvimage(A,f,s) = r \<inter> A*A"
 by (unfold ord_iso_def rvimage_def, blast)
 
 
 subsection\<open>Every well-founded relation is a subset of some inverse image of
       an ordinal\<close>
 
 lemma wf_rvimage_Ord: "Ord(i) \<Longrightarrow> wf(rvimage(A, f, Memrel(i)))"
 by (blast intro: wf_rvimage wf_Memrel)
 
 
 definition
   wfrank :: "[i,i]\<Rightarrow>i"  where
     "wfrank(r,a) \<equiv> wfrec(r, a, \<lambda>x f. \<Union>y \<in> r-``{x}. succ(f`y))"
 
 definition
   wftype :: "i\<Rightarrow>i"  where
     "wftype(r) \<equiv> \<Union>y \<in> range(r). succ(wfrank(r,y))"
 
 lemma wfrank: "wf(r) \<Longrightarrow> wfrank(r,a) = (\<Union>y \<in> r-``{a}. succ(wfrank(r,y)))"
 by (subst wfrank_def [THEN def_wfrec], simp_all)
 
 lemma Ord_wfrank: "wf(r) \<Longrightarrow> Ord(wfrank(r,a))"
 apply (rule_tac a=a in wf_induct, assumption)
 apply (subst wfrank, assumption)
 apply (rule Ord_succ [THEN Ord_UN], blast)
 done
 
 lemma wfrank_lt: "\<lbrakk>wf(r); \<langle>a,b\<rangle> \<in> r\<rbrakk> \<Longrightarrow> wfrank(r,a) < wfrank(r,b)"
 apply (rule_tac a1 = b in wfrank [THEN ssubst], assumption)
 apply (rule UN_I [THEN ltI])
 apply (simp add: Ord_wfrank vimage_iff)+
 done
 
 lemma Ord_wftype: "wf(r) \<Longrightarrow> Ord(wftype(r))"
 by (simp add: wftype_def Ord_wfrank)
 
 lemma wftypeI: "\<lbrakk>wf(r);  x \<in> field(r)\<rbrakk> \<Longrightarrow> wfrank(r,x) \<in> wftype(r)"
 apply (simp add: wftype_def)
 apply (blast intro: wfrank_lt [THEN ltD])
 done
 
 
 lemma wf_imp_subset_rvimage:
      "\<lbrakk>wf(r); r \<subseteq> A*A\<rbrakk> \<Longrightarrow> \<exists>i f. Ord(i) \<and> r \<subseteq> rvimage(A, f, Memrel(i))"
 apply (rule_tac x="wftype(r)" in exI)
 apply (rule_tac x="\<lambda>x\<in>A. wfrank(r,x)" in exI)
 apply (simp add: Ord_wftype, clarify)
 apply (frule subsetD, assumption, clarify)
 apply (simp add: rvimage_iff wfrank_lt [THEN ltD])
 apply (blast intro: wftypeI)
 done
 
 theorem wf_iff_subset_rvimage:
   "relation(r) \<Longrightarrow> wf(r) \<longleftrightarrow> (\<exists>i f A. Ord(i) \<and> r \<subseteq> rvimage(A, f, Memrel(i)))"
 by (blast dest!: relation_field_times_field wf_imp_subset_rvimage
           intro: wf_rvimage_Ord [THEN wf_subset])
 
 
 subsection\<open>Other Results\<close>
 
 lemma wf_times: "A \<inter> B = 0 \<Longrightarrow> wf(A*B)"
 by (simp add: wf_def, blast)
 
 text\<open>Could also be used to prove \<open>wf_radd\<close>\<close>
 lemma wf_Un:
      "\<lbrakk>range(r) \<inter> domain(s) = 0; wf(r);  wf(s)\<rbrakk> \<Longrightarrow> wf(r \<union> s)"
 apply (simp add: wf_def, clarify)
 apply (rule equalityI)
  prefer 2 apply blast
 apply clarify
 apply (drule_tac x=Z in spec)
 apply (drule_tac x="Z \<inter> domain(s)" in spec)
 apply simp
 apply (blast intro: elim: equalityE)
 done
 
 subsubsection\<open>The Empty Relation\<close>
 
 lemma wf0: "wf(0)"
 by (simp add: wf_def, blast)
 
 lemma linear0: "linear(0,0)"
 by (simp add: linear_def)
 
 lemma well_ord0: "well_ord(0,0)"
 by (blast intro: wf_imp_wf_on well_ordI wf0 linear0)
 
 subsubsection\<open>The "measure" relation is useful with wfrec\<close>
 
 lemma measure_eq_rvimage_Memrel:
      "measure(A,f) = rvimage(A,Lambda(A,f),Memrel(Collect(RepFun(A,f),Ord)))"
 apply (simp (no_asm) add: measure_def rvimage_def Memrel_iff)
 apply (rule equalityI, auto)
 apply (auto intro: Ord_in_Ord simp add: lt_def)
 done
 
 lemma wf_measure [iff]: "wf(measure(A,f))"
 by (simp (no_asm) add: measure_eq_rvimage_Memrel wf_Memrel wf_rvimage)
 
 lemma measure_iff [iff]: "\<langle>x,y\<rangle> \<in> measure(A,f) \<longleftrightarrow> x \<in> A \<and> y \<in> A \<and> f(x)<f(y)"
 by (simp (no_asm) add: measure_def)
 
 lemma linear_measure:
  assumes Ordf: "\<And>x. x \<in> A \<Longrightarrow> Ord(f(x))"
      and inj:  "\<And>x y. \<lbrakk>x \<in> A; y \<in> A; f(x) = f(y)\<rbrakk> \<Longrightarrow> x=y"
  shows "linear(A, measure(A,f))"
 apply (auto simp add: linear_def)
 apply (rule_tac i="f(x)" and j="f(y)" in Ord_linear_lt)
     apply (simp_all add: Ordf)
 apply (blast intro: inj)
 done
 
 lemma wf_on_measure: "wf[B](measure(A,f))"
 by (rule wf_imp_wf_on [OF wf_measure])
 
 lemma well_ord_measure:
  assumes Ordf: "\<And>x. x \<in> A \<Longrightarrow> Ord(f(x))"
      and inj:  "\<And>x y. \<lbrakk>x \<in> A; y \<in> A; f(x) = f(y)\<rbrakk> \<Longrightarrow> x=y"
  shows "well_ord(A, measure(A,f))"
 apply (rule well_ordI)
 apply (rule wf_on_measure)
 apply (blast intro: linear_measure Ordf inj)
 done
 
 lemma measure_type: "measure(A,f) \<subseteq> A*A"
 by (auto simp add: measure_def)
 
 subsubsection\<open>Well-foundedness of Unions\<close>
 
 lemma wf_on_Union:
  assumes wfA: "wf[A](r)"
      and wfB: "\<And>a. a\<in>A \<Longrightarrow> wf[B(a)](s)"
      and ok: "\<And>a u v. \<lbrakk>\<langle>u,v\<rangle> \<in> s; v \<in> B(a); a \<in> A\<rbrakk>
                        \<Longrightarrow> (\<exists>a'\<in>A. \<langle>a',a\<rangle> \<in> r \<and> u \<in> B(a')) | u \<in> B(a)"
  shows "wf[\<Union>a\<in>A. B(a)](s)"
 apply (rule wf_onI2)
 apply (erule UN_E)
 apply (subgoal_tac "\<forall>z \<in> B(a). z \<in> Ba", blast)
 apply (rule_tac a = a in wf_on_induct [OF wfA], assumption)
 apply (rule ballI)
 apply (rule_tac a = z in wf_on_induct [OF wfB], assumption, assumption)
 apply (rename_tac u)
 apply (drule_tac x=u in bspec, blast)
 apply (erule mp, clarify)
 apply (frule ok, assumption+, blast)
 done
 
 subsubsection\<open>Bijections involving Powersets\<close>
 
 lemma Pow_sum_bij:
     "(\<lambda>Z \<in> Pow(A+B). \<langle>{x \<in> A. Inl(x) \<in> Z}, {y \<in> B. Inr(y) \<in> Z}\<rangle>)
      \<in> bij(Pow(A+B), Pow(A)*Pow(B))"
 apply (rule_tac d = "\<lambda>\<langle>X,Y\<rangle>. {Inl (x). x \<in> X} \<union> {Inr (y). y \<in> Y}"
        in lam_bijective)
 apply force+
 done
 
 text\<open>As a special case, we have \<^term>\<open>bij(Pow(A*B), A \<rightarrow> Pow(B))\<close>\<close>
 lemma Pow_Sigma_bij:
     "(\<lambda>r \<in> Pow(Sigma(A,B)). \<lambda>x \<in> A. r``{x})
      \<in> bij(Pow(Sigma(A,B)), \<Prod>x \<in> A. Pow(B(x)))"
 apply (rule_tac d = "\<lambda>f. \<Union>x \<in> A. \<Union>y \<in> f`x. {\<langle>x,y\<rangle>}" in lam_bijective)
 apply (blast intro: lam_type)
 apply (blast dest: apply_type, simp_all)
 apply fast (*strange, but blast can't do it*)
 apply (rule fun_extension, auto)
 by blast
 
 end
diff --git a/src/ZF/OrderType.thy b/src/ZF/OrderType.thy
--- a/src/ZF/OrderType.thy
+++ b/src/ZF/OrderType.thy
@@ -1,1028 +1,1028 @@
 (*  Title:      ZF/OrderType.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section\<open>Order Types and Ordinal Arithmetic\<close>
 
 theory OrderType imports OrderArith OrdQuant Nat begin
 
 text\<open>The order type of a well-ordering is the least ordinal isomorphic to it.
 Ordinal arithmetic is traditionally defined in terms of order types, as it is
 here.  But a definition by transfinite recursion would be much simpler!\<close>
 
 definition
   ordermap  :: "[i,i]\<Rightarrow>i"  where
    "ordermap(A,r) \<equiv> \<lambda>x\<in>A. wfrec[A](r, x, \<lambda>x f. f `` pred(A,x,r))"
 
 definition
   ordertype :: "[i,i]\<Rightarrow>i"  where
    "ordertype(A,r) \<equiv> ordermap(A,r)``A"
 
 definition
   (*alternative definition of ordinal numbers*)
   Ord_alt   :: "i \<Rightarrow> o"  where
    "Ord_alt(X) \<equiv> well_ord(X, Memrel(X)) \<and> (\<forall>u\<in>X. u=pred(X, u, Memrel(X)))"
 
 definition
   (*coercion to ordinal: if not, just 0*)
   ordify    :: "i\<Rightarrow>i"  where
     "ordify(x) \<equiv> if Ord(x) then x else 0"
 
 definition
   (*ordinal multiplication*)
   omult      :: "[i,i]\<Rightarrow>i"           (infixl \<open>**\<close> 70)  where
    "i ** j \<equiv> ordertype(j*i, rmult(j,Memrel(j),i,Memrel(i)))"
 
 definition
   (*ordinal addition*)
   raw_oadd   :: "[i,i]\<Rightarrow>i"  where
     "raw_oadd(i,j) \<equiv> ordertype(i+j, radd(i,Memrel(i),j,Memrel(j)))"
 
 definition
   oadd      :: "[i,i]\<Rightarrow>i"           (infixl \<open>++\<close> 65)  where
     "i ++ j \<equiv> raw_oadd(ordify(i),ordify(j))"
 
 definition
   (*ordinal subtraction*)
   odiff      :: "[i,i]\<Rightarrow>i"           (infixl \<open>--\<close> 65)  where
     "i -- j \<equiv> ordertype(i-j, Memrel(i))"
 
 
 subsection\<open>Proofs needing the combination of Ordinal.thy and Order.thy\<close>
 
 lemma le_well_ord_Memrel: "j \<le> i \<Longrightarrow> well_ord(j, Memrel(i))"
 apply (rule well_ordI)
 apply (rule wf_Memrel [THEN wf_imp_wf_on])
 apply (simp add: ltD lt_Ord linear_def
                  ltI [THEN lt_trans2 [of _ j i]])
 apply (intro ballI Ord_linear)
 apply (blast intro: Ord_in_Ord lt_Ord)+
 done
 
 (*"Ord(i) \<Longrightarrow> well_ord(i, Memrel(i))"*)
 lemmas well_ord_Memrel = le_refl [THEN le_well_ord_Memrel]
 
 (*Kunen's Theorem 7.3 (i), page 16;  see also Ordinal/Ord_in_Ord
   The smaller ordinal is an initial segment of the larger *)
 lemma lt_pred_Memrel:
     "j<i \<Longrightarrow> pred(i, j, Memrel(i)) = j"
 apply (simp add: pred_def lt_def)
 apply (blast intro: Ord_trans)
 done
 
 lemma pred_Memrel:
       "x \<in> A \<Longrightarrow> pred(A, x, Memrel(A)) = A \<inter> x"
 by (unfold pred_def Memrel_def, blast)
 
 lemma Ord_iso_implies_eq_lemma:
      "\<lbrakk>j<i;  f \<in> ord_iso(i,Memrel(i),j,Memrel(j))\<rbrakk> \<Longrightarrow> R"
 apply (frule lt_pred_Memrel)
 apply (erule ltE)
 apply (rule well_ord_Memrel [THEN well_ord_iso_predE, of i f j], auto)
-apply (unfold ord_iso_def)
+  unfolding ord_iso_def
 (*Combining the two simplifications causes looping*)
 apply (simp (no_asm_simp))
 apply (blast intro: bij_is_fun [THEN apply_type] Ord_trans)
 done
 
 (*Kunen's Theorem 7.3 (ii), page 16.  Isomorphic ordinals are equal*)
 lemma Ord_iso_implies_eq:
      "\<lbrakk>Ord(i);  Ord(j);  f \<in> ord_iso(i,Memrel(i),j,Memrel(j))\<rbrakk>
       \<Longrightarrow> i=j"
 apply (rule_tac i = i and j = j in Ord_linear_lt)
 apply (blast intro: ord_iso_sym Ord_iso_implies_eq_lemma)+
 done
 
 
 subsection\<open>Ordermap and ordertype\<close>
 
 lemma ordermap_type:
     "ordermap(A,r) \<in> A -> ordertype(A,r)"
 apply (unfold ordermap_def ordertype_def)
 apply (rule lam_type)
 apply (rule lamI [THEN imageI], assumption+)
 done
 
 subsubsection\<open>Unfolding of ordermap\<close>
 
 (*Useful for cardinality reasoning; see CardinalArith.ML*)
 lemma ordermap_eq_image:
     "\<lbrakk>wf[A](r);  x \<in> A\<rbrakk>
      \<Longrightarrow> ordermap(A,r) ` x = ordermap(A,r) `` pred(A,x,r)"
 apply (unfold ordermap_def pred_def)
 apply (simp (no_asm_simp))
 apply (erule wfrec_on [THEN trans], assumption)
 apply (simp (no_asm_simp) add: subset_iff image_lam vimage_singleton_iff)
 done
 
 (*Useful for rewriting PROVIDED pred is not unfolded until later!*)
 lemma ordermap_pred_unfold:
      "\<lbrakk>wf[A](r);  x \<in> A\<rbrakk>
       \<Longrightarrow> ordermap(A,r) ` x = {ordermap(A,r)`y . y \<in> pred(A,x,r)}"
 by (simp add: ordermap_eq_image pred_subset ordermap_type [THEN image_fun])
 
 (*pred-unfolded version.  NOT suitable for rewriting -- loops!*)
 lemmas ordermap_unfold = ordermap_pred_unfold [simplified pred_def]
 
 (*The theorem above is
 
 \<lbrakk>wf[A](r); x \<in> A\<rbrakk>
 \<Longrightarrow> ordermap(A,r) ` x = {ordermap(A,r) ` y . y: {y \<in> A . \<langle>y,x\<rangle> \<in> r}}
 
 NOTE: the definition of ordermap used here delivers ordinals only if r is
 transitive.  If r is the predecessor relation on the naturals then
 ordermap(nat,predr) ` n equals {n-1} and not n.  A more complicated definition,
 like
 
   ordermap(A,r) ` x = Union{succ(ordermap(A,r) ` y) . y: {y \<in> A . \<langle>y,x\<rangle> \<in> r}},
 
 might eliminate the need for r to be transitive.
 *)
 
 
 subsubsection\<open>Showing that ordermap, ordertype yield ordinals\<close>
 
 lemma Ord_ordermap:
     "\<lbrakk>well_ord(A,r);  x \<in> A\<rbrakk> \<Longrightarrow> Ord(ordermap(A,r) ` x)"
 apply (unfold well_ord_def tot_ord_def part_ord_def, safe)
 apply (rule_tac a=x in wf_on_induct, assumption+)
 apply (simp (no_asm_simp) add: ordermap_pred_unfold)
 apply (rule OrdI [OF _ Ord_is_Transset])
 apply (unfold pred_def Transset_def)
 apply (blast intro: trans_onD
              dest!: ordermap_unfold [THEN equalityD1])+
 done
 
 lemma Ord_ordertype:
     "well_ord(A,r) \<Longrightarrow> Ord(ordertype(A,r))"
-apply (unfold ordertype_def)
+  unfolding ordertype_def
 apply (subst image_fun [OF ordermap_type subset_refl])
 apply (rule OrdI [OF _ Ord_is_Transset])
 prefer 2 apply (blast intro: Ord_ordermap)
 apply (unfold Transset_def well_ord_def)
 apply (blast intro: trans_onD
              dest!: ordermap_unfold [THEN equalityD1])
 done
 
 
 subsubsection\<open>ordermap preserves the orderings in both directions\<close>
 
 lemma ordermap_mono:
      "\<lbrakk>\<langle>w,x\<rangle>: r;  wf[A](r);  w \<in> A; x \<in> A\<rbrakk>
       \<Longrightarrow> ordermap(A,r)`w \<in> ordermap(A,r)`x"
 apply (erule_tac x1 = x in ordermap_unfold [THEN ssubst], assumption, blast)
 done
 
 (*linearity of r is crucial here*)
 lemma converse_ordermap_mono:
     "\<lbrakk>ordermap(A,r)`w \<in> ordermap(A,r)`x;  well_ord(A,r); w \<in> A; x \<in> A\<rbrakk>
      \<Longrightarrow> \<langle>w,x\<rangle>: r"
 apply (unfold well_ord_def tot_ord_def, safe)
 apply (erule_tac x=w and y=x in linearE, assumption+)
 apply (blast elim!: mem_not_refl [THEN notE])
 apply (blast dest: ordermap_mono intro: mem_asym)
 done
 
 lemma ordermap_surj: "ordermap(A, r) \<in> surj(A, ordertype(A, r))"
   unfolding ordertype_def
   by (rule surj_image) (rule ordermap_type)
 
 lemma ordermap_bij:
     "well_ord(A,r) \<Longrightarrow> ordermap(A,r) \<in> bij(A, ordertype(A,r))"
 apply (unfold well_ord_def tot_ord_def bij_def inj_def)
 apply (force intro!: ordermap_type ordermap_surj
              elim: linearE dest: ordermap_mono
              simp add: mem_not_refl)
 done
 
 subsubsection\<open>Isomorphisms involving ordertype\<close>
 
 lemma ordertype_ord_iso:
  "well_ord(A,r)
   \<Longrightarrow> ordermap(A,r) \<in> ord_iso(A,r, ordertype(A,r), Memrel(ordertype(A,r)))"
-apply (unfold ord_iso_def)
+  unfolding ord_iso_def
 apply (safe elim!: well_ord_is_wf
             intro!: ordermap_type [THEN apply_type] ordermap_mono ordermap_bij)
 apply (blast dest!: converse_ordermap_mono)
 done
 
 lemma ordertype_eq:
      "\<lbrakk>f \<in> ord_iso(A,r,B,s);  well_ord(B,s)\<rbrakk>
       \<Longrightarrow> ordertype(A,r) = ordertype(B,s)"
 apply (frule well_ord_ord_iso, assumption)
 apply (rule Ord_iso_implies_eq, (erule Ord_ordertype)+)
 apply (blast intro: ord_iso_trans ord_iso_sym ordertype_ord_iso)
 done
 
 lemma ordertype_eq_imp_ord_iso:
      "\<lbrakk>ordertype(A,r) = ordertype(B,s); well_ord(A,r);  well_ord(B,s)\<rbrakk>
       \<Longrightarrow> \<exists>f. f \<in> ord_iso(A,r,B,s)"
 apply (rule exI)
 apply (rule ordertype_ord_iso [THEN ord_iso_trans], assumption)
 apply (erule ssubst)
 apply (erule ordertype_ord_iso [THEN ord_iso_sym])
 done
 
 subsubsection\<open>Basic equalities for ordertype\<close>
 
 (*Ordertype of Memrel*)
 lemma le_ordertype_Memrel: "j \<le> i \<Longrightarrow> ordertype(j,Memrel(i)) = j"
 apply (rule Ord_iso_implies_eq [symmetric])
 apply (erule ltE, assumption)
 apply (blast intro: le_well_ord_Memrel Ord_ordertype)
 apply (rule ord_iso_trans)
 apply (erule_tac [2] le_well_ord_Memrel [THEN ordertype_ord_iso])
 apply (rule id_bij [THEN ord_isoI])
 apply (simp (no_asm_simp))
 apply (fast elim: ltE Ord_in_Ord Ord_trans)
 done
 
 (*"Ord(i) \<Longrightarrow> ordertype(i, Memrel(i)) = i"*)
 lemmas ordertype_Memrel = le_refl [THEN le_ordertype_Memrel]
 
 lemma ordertype_0 [simp]: "ordertype(0,r) = 0"
 apply (rule id_bij [THEN ord_isoI, THEN ordertype_eq, THEN trans])
 apply (erule emptyE)
 apply (rule well_ord_0)
 apply (rule Ord_0 [THEN ordertype_Memrel])
 done
 
 (*Ordertype of rvimage:  \<lbrakk>f \<in> bij(A,B);  well_ord(B,s)\<rbrakk> \<Longrightarrow>
                          ordertype(A, rvimage(A,f,s)) = ordertype(B,s) *)
 lemmas bij_ordertype_vimage = ord_iso_rvimage [THEN ordertype_eq]
 
 subsubsection\<open>A fundamental unfolding law for ordertype.\<close>
 
 (*Ordermap returns the same result if applied to an initial segment*)
 lemma ordermap_pred_eq_ordermap:
      "\<lbrakk>well_ord(A,r);  y \<in> A;  z \<in> pred(A,y,r)\<rbrakk>
       \<Longrightarrow> ordermap(pred(A,y,r), r) ` z = ordermap(A, r) ` z"
 apply (frule wf_on_subset_A [OF well_ord_is_wf pred_subset])
 apply (rule_tac a=z in wf_on_induct, assumption+)
 apply (safe elim!: predE)
 apply (simp (no_asm_simp) add: ordermap_pred_unfold well_ord_is_wf pred_iff)
 (*combining these two simplifications LOOPS! *)
 apply (simp (no_asm_simp) add: pred_pred_eq)
 apply (simp add: pred_def)
 apply (rule RepFun_cong [OF _ refl])
 apply (drule well_ord_is_trans_on)
 apply (fast elim!: trans_onD)
 done
 
 lemma ordertype_unfold:
     "ordertype(A,r) = {ordermap(A,r)`y . y \<in> A}"
-apply (unfold ordertype_def)
+  unfolding ordertype_def
 apply (rule image_fun [OF ordermap_type subset_refl])
 done
 
 text\<open>Theorems by Krzysztof Grabczewski; proofs simplified by lcp\<close>
 
 lemma ordertype_pred_subset: "\<lbrakk>well_ord(A,r);  x \<in> A\<rbrakk> \<Longrightarrow>
           ordertype(pred(A,x,r),r) \<subseteq> ordertype(A,r)"
 apply (simp add: ordertype_unfold well_ord_subset [OF _ pred_subset])
 apply (fast intro: ordermap_pred_eq_ordermap elim: predE)
 done
 
 lemma ordertype_pred_lt:
      "\<lbrakk>well_ord(A,r);  x \<in> A\<rbrakk>
       \<Longrightarrow> ordertype(pred(A,x,r),r) < ordertype(A,r)"
 apply (rule ordertype_pred_subset [THEN subset_imp_le, THEN leE])
 apply (simp_all add: Ord_ordertype well_ord_subset [OF _ pred_subset])
 apply (erule sym [THEN ordertype_eq_imp_ord_iso, THEN exE])
 apply (erule_tac [3] well_ord_iso_predE)
 apply (simp_all add: well_ord_subset [OF _ pred_subset])
 done
 
 (*May rewrite with this -- provided no rules are supplied for proving that
         well_ord(pred(A,x,r), r) *)
 lemma ordertype_pred_unfold:
      "well_ord(A,r)
       \<Longrightarrow> ordertype(A,r) = {ordertype(pred(A,x,r),r). x \<in> A}"
 apply (rule equalityI)
 apply (safe intro!: ordertype_pred_lt [THEN ltD])
 apply (auto simp add: ordertype_def well_ord_is_wf [THEN ordermap_eq_image]
                       ordermap_type [THEN image_fun]
                       ordermap_pred_eq_ordermap pred_subset)
 done
 
 
 subsection\<open>Alternative definition of ordinal\<close>
 
 (*proof by Krzysztof Grabczewski*)
 lemma Ord_is_Ord_alt: "Ord(i) \<Longrightarrow> Ord_alt(i)"
-apply (unfold Ord_alt_def)
+  unfolding Ord_alt_def
 apply (rule conjI)
 apply (erule well_ord_Memrel)
 apply (unfold Ord_def Transset_def pred_def Memrel_def, blast)
 done
 
 (*proof by lcp*)
 lemma Ord_alt_is_Ord:
     "Ord_alt(i) \<Longrightarrow> Ord(i)"
 apply (unfold Ord_alt_def Ord_def Transset_def well_ord_def
                      tot_ord_def part_ord_def trans_on_def)
 apply (simp add: pred_Memrel)
 apply (blast elim!: equalityE)
 done
 
 
 subsection\<open>Ordinal Addition\<close>
 
 subsubsection\<open>Order Type calculations for radd\<close>
 
 text\<open>Addition with 0\<close>
 
 lemma bij_sum_0: "(\<lambda>z\<in>A+0. case(\<lambda>x. x, \<lambda>y. y, z)) \<in> bij(A+0, A)"
 apply (rule_tac d = Inl in lam_bijective, safe)
 apply (simp_all (no_asm_simp))
 done
 
 lemma ordertype_sum_0_eq:
      "well_ord(A,r) \<Longrightarrow> ordertype(A+0, radd(A,r,0,s)) = ordertype(A,r)"
 apply (rule bij_sum_0 [THEN ord_isoI, THEN ordertype_eq])
 prefer 2 apply assumption
 apply force
 done
 
 lemma bij_0_sum: "(\<lambda>z\<in>0+A. case(\<lambda>x. x, \<lambda>y. y, z)) \<in> bij(0+A, A)"
 apply (rule_tac d = Inr in lam_bijective, safe)
 apply (simp_all (no_asm_simp))
 done
 
 lemma ordertype_0_sum_eq:
      "well_ord(A,r) \<Longrightarrow> ordertype(0+A, radd(0,s,A,r)) = ordertype(A,r)"
 apply (rule bij_0_sum [THEN ord_isoI, THEN ordertype_eq])
 prefer 2 apply assumption
 apply force
 done
 
 text\<open>Initial segments of radd.  Statements by Grabczewski\<close>
 
 (*In fact, pred(A+B, Inl(a), radd(A,r,B,s)) = pred(A,a,r)+0 *)
 lemma pred_Inl_bij:
  "a \<in> A \<Longrightarrow> (\<lambda>x\<in>pred(A,a,r). Inl(x))
           \<in> bij(pred(A,a,r), pred(A+B, Inl(a), radd(A,r,B,s)))"
-apply (unfold pred_def)
+  unfolding pred_def
 apply (rule_tac d = "case (\<lambda>x. x, \<lambda>y. y) " in lam_bijective)
 apply auto
 done
 
 lemma ordertype_pred_Inl_eq:
      "\<lbrakk>a \<in> A;  well_ord(A,r)\<rbrakk>
       \<Longrightarrow> ordertype(pred(A+B, Inl(a), radd(A,r,B,s)), radd(A,r,B,s)) =
           ordertype(pred(A,a,r), r)"
 apply (rule pred_Inl_bij [THEN ord_isoI, THEN ord_iso_sym, THEN ordertype_eq])
 apply (simp_all add: well_ord_subset [OF _ pred_subset])
 apply (simp add: pred_def)
 done
 
 lemma pred_Inr_bij:
  "b \<in> B \<Longrightarrow>
          id(A+pred(B,b,s))
          \<in> bij(A+pred(B,b,s), pred(A+B, Inr(b), radd(A,r,B,s)))"
 apply (unfold pred_def id_def)
 apply (rule_tac d = "\<lambda>z. z" in lam_bijective, auto)
 done
 
 lemma ordertype_pred_Inr_eq:
      "\<lbrakk>b \<in> B;  well_ord(A,r);  well_ord(B,s)\<rbrakk>
       \<Longrightarrow> ordertype(pred(A+B, Inr(b), radd(A,r,B,s)), radd(A,r,B,s)) =
           ordertype(A+pred(B,b,s), radd(A,r,pred(B,b,s),s))"
 apply (rule pred_Inr_bij [THEN ord_isoI, THEN ord_iso_sym, THEN ordertype_eq])
 prefer 2 apply (force simp add: pred_def id_def, assumption)
 apply (blast intro: well_ord_radd well_ord_subset [OF _ pred_subset])
 done
 
 
 subsubsection\<open>ordify: trivial coercion to an ordinal\<close>
 
 lemma Ord_ordify [iff, TC]: "Ord(ordify(x))"
 by (simp add: ordify_def)
 
 (*Collapsing*)
 lemma ordify_idem [simp]: "ordify(ordify(x)) = ordify(x)"
 by (simp add: ordify_def)
 
 
 subsubsection\<open>Basic laws for ordinal addition\<close>
 
 lemma Ord_raw_oadd: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> Ord(raw_oadd(i,j))"
 by (simp add: raw_oadd_def ordify_def Ord_ordertype well_ord_radd
               well_ord_Memrel)
 
 lemma Ord_oadd [iff,TC]: "Ord(i++j)"
 by (simp add: oadd_def Ord_raw_oadd)
 
 
 text\<open>Ordinal addition with zero\<close>
 
 lemma raw_oadd_0: "Ord(i) \<Longrightarrow> raw_oadd(i,0) = i"
 by (simp add: raw_oadd_def ordify_def ordertype_sum_0_eq
               ordertype_Memrel well_ord_Memrel)
 
 lemma oadd_0 [simp]: "Ord(i) \<Longrightarrow> i++0 = i"
 apply (simp (no_asm_simp) add: oadd_def raw_oadd_0 ordify_def)
 done
 
 lemma raw_oadd_0_left: "Ord(i) \<Longrightarrow> raw_oadd(0,i) = i"
 by (simp add: raw_oadd_def ordify_def ordertype_0_sum_eq ordertype_Memrel
               well_ord_Memrel)
 
 lemma oadd_0_left [simp]: "Ord(i) \<Longrightarrow> 0++i = i"
 by (simp add: oadd_def raw_oadd_0_left ordify_def)
 
 
 lemma oadd_eq_if_raw_oadd:
      "i++j = (if Ord(i) then (if Ord(j) then raw_oadd(i,j) else i)
               else (if Ord(j) then j else 0))"
 by (simp add: oadd_def ordify_def raw_oadd_0_left raw_oadd_0)
 
 lemma raw_oadd_eq_oadd: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> raw_oadd(i,j) = i++j"
 by (simp add: oadd_def ordify_def)
 
 (*** Further properties of ordinal addition.  Statements by Grabczewski,
     proofs by lcp. ***)
 
 (*Surely also provable by transfinite induction on j?*)
 lemma lt_oadd1: "k<i \<Longrightarrow> k < i++j"
 apply (simp add: oadd_def ordify_def lt_Ord2 raw_oadd_0, clarify)
 apply (simp add: raw_oadd_def)
 apply (rule ltE, assumption)
 apply (rule ltI)
 apply (force simp add: ordertype_pred_unfold well_ord_radd well_ord_Memrel
           ordertype_pred_Inl_eq lt_pred_Memrel leI [THEN le_ordertype_Memrel])
 apply (blast intro: Ord_ordertype well_ord_radd well_ord_Memrel)
 done
 
 (*Thus also we obtain the rule  @{term"i++j = k \<Longrightarrow> i \<le> k"} *)
 lemma oadd_le_self: "Ord(i) \<Longrightarrow> i \<le> i++j"
 apply (rule all_lt_imp_le)
 apply (auto simp add: Ord_oadd lt_oadd1)
 done
 
 text\<open>Various other results\<close>
 
 lemma id_ord_iso_Memrel: "A<=B \<Longrightarrow> id(A) \<in> ord_iso(A, Memrel(A), A, Memrel(B))"
 apply (rule id_bij [THEN ord_isoI])
 apply (simp (no_asm_simp))
 apply blast
 done
 
 lemma subset_ord_iso_Memrel:
      "\<lbrakk>f \<in> ord_iso(A,Memrel(B),C,r); A<=B\<rbrakk> \<Longrightarrow> f \<in> ord_iso(A,Memrel(A),C,r)"
 apply (frule ord_iso_is_bij [THEN bij_is_fun, THEN fun_is_rel])
 apply (frule ord_iso_trans [OF id_ord_iso_Memrel], assumption)
 apply (simp add: right_comp_id)
 done
 
 lemma restrict_ord_iso:
      "\<lbrakk>f \<in> ord_iso(i, Memrel(i), Order.pred(A,a,r), r);  a \<in> A; j < i;
        trans[A](r)\<rbrakk>
       \<Longrightarrow> restrict(f,j) \<in> ord_iso(j, Memrel(j), Order.pred(A,f`j,r), r)"
 apply (frule ltD)
 apply (frule ord_iso_is_bij [THEN bij_is_fun, THEN apply_type], assumption)
 apply (frule ord_iso_restrict_pred, assumption)
 apply (simp add: pred_iff trans_pred_pred_eq lt_pred_Memrel)
 apply (blast intro!: subset_ord_iso_Memrel le_imp_subset [OF leI])
 done
 
 lemma restrict_ord_iso2:
      "\<lbrakk>f \<in> ord_iso(Order.pred(A,a,r), r, i, Memrel(i));  a \<in> A;
        j < i; trans[A](r)\<rbrakk>
       \<Longrightarrow> converse(restrict(converse(f), j))
           \<in> ord_iso(Order.pred(A, converse(f)`j, r), r, j, Memrel(j))"
 by (blast intro: restrict_ord_iso ord_iso_sym ltI)
 
 lemma ordertype_sum_Memrel:
      "\<lbrakk>well_ord(A,r);  k<j\<rbrakk>
       \<Longrightarrow> ordertype(A+k, radd(A, r, k, Memrel(j))) =
           ordertype(A+k, radd(A, r, k, Memrel(k)))"
 apply (erule ltE)
 apply (rule ord_iso_refl [THEN sum_ord_iso_cong, THEN ordertype_eq])
 apply (erule OrdmemD [THEN id_ord_iso_Memrel, THEN ord_iso_sym])
 apply (simp_all add: well_ord_radd well_ord_Memrel)
 done
 
 lemma oadd_lt_mono2: "k<j \<Longrightarrow> i++k < i++j"
 apply (simp add: oadd_def ordify_def raw_oadd_0_left lt_Ord lt_Ord2, clarify)
 apply (simp add: raw_oadd_def)
 apply (rule ltE, assumption)
 apply (rule ordertype_pred_unfold [THEN equalityD2, THEN subsetD, THEN ltI])
 apply (simp_all add: Ord_ordertype well_ord_radd well_ord_Memrel)
 apply (rule bexI)
 apply (erule_tac [2] InrI)
 apply (simp add: ordertype_pred_Inr_eq well_ord_Memrel lt_pred_Memrel
                  leI [THEN le_ordertype_Memrel] ordertype_sum_Memrel)
 done
 
 lemma oadd_lt_cancel2: "\<lbrakk>i++j < i++k;  Ord(j)\<rbrakk> \<Longrightarrow> j<k"
 apply (simp (asm_lr) add: oadd_eq_if_raw_oadd split: split_if_asm)
  prefer 2
  apply (frule_tac i = i and j = j in oadd_le_self)
  apply (simp (asm_lr) add: oadd_def ordify_def lt_Ord not_lt_iff_le [THEN iff_sym])
 apply (rule Ord_linear_lt, auto)
 apply (simp_all add: raw_oadd_eq_oadd)
 apply (blast dest: oadd_lt_mono2 elim: lt_irrefl lt_asym)+
 done
 
 lemma oadd_lt_iff2: "Ord(j) \<Longrightarrow> i++j < i++k \<longleftrightarrow> j<k"
 by (blast intro!: oadd_lt_mono2 dest!: oadd_lt_cancel2)
 
 lemma oadd_inject: "\<lbrakk>i++j = i++k;  Ord(j); Ord(k)\<rbrakk> \<Longrightarrow> j=k"
 apply (simp add: oadd_eq_if_raw_oadd split: split_if_asm)
 apply (simp add: raw_oadd_eq_oadd)
 apply (rule Ord_linear_lt, auto)
 apply (force dest: oadd_lt_mono2 [of concl: i] simp add: lt_not_refl)+
 done
 
 lemma lt_oadd_disj: "k < i++j \<Longrightarrow> k<i | (\<exists>l\<in>j. k = i++l )"
 apply (simp add: Ord_in_Ord' [of _ j] oadd_eq_if_raw_oadd
             split: split_if_asm)
  prefer 2
  apply (simp add: Ord_in_Ord' [of _ j] lt_def)
 apply (simp add: ordertype_pred_unfold well_ord_radd well_ord_Memrel raw_oadd_def)
 apply (erule ltD [THEN RepFunE])
 apply (force simp add: ordertype_pred_Inl_eq well_ord_Memrel ltI
                        lt_pred_Memrel le_ordertype_Memrel leI
                        ordertype_pred_Inr_eq ordertype_sum_Memrel)
 done
 
 
 subsubsection\<open>Ordinal addition with successor -- via associativity!\<close>
 
 lemma oadd_assoc: "(i++j)++k = i++(j++k)"
 apply (simp add: oadd_eq_if_raw_oadd Ord_raw_oadd raw_oadd_0 raw_oadd_0_left, clarify)
 apply (simp add: raw_oadd_def)
 apply (rule ordertype_eq [THEN trans])
 apply (rule sum_ord_iso_cong [OF ordertype_ord_iso [THEN ord_iso_sym]
                                  ord_iso_refl])
 apply (simp_all add: Ord_ordertype well_ord_radd well_ord_Memrel)
 apply (rule sum_assoc_ord_iso [THEN ordertype_eq, THEN trans])
 apply (rule_tac [2] ordertype_eq)
 apply (rule_tac [2] sum_ord_iso_cong [OF ord_iso_refl ordertype_ord_iso])
 apply (blast intro: Ord_ordertype well_ord_radd well_ord_Memrel)+
 done
 
 lemma oadd_unfold: "\<lbrakk>Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> i++j = i \<union> (\<Union>k\<in>j. {i++k})"
 apply (rule subsetI [THEN equalityI])
 apply (erule ltI [THEN lt_oadd_disj, THEN disjE])
 apply (blast intro: Ord_oadd)
 apply (blast elim!: ltE, blast)
 apply (force intro: lt_oadd1 oadd_lt_mono2 simp add: Ord_mem_iff_lt)
 done
 
 lemma oadd_1: "Ord(i) \<Longrightarrow> i++1 = succ(i)"
 apply (simp (no_asm_simp) add: oadd_unfold Ord_1 oadd_0)
 apply blast
 done
 
 lemma oadd_succ [simp]: "Ord(j) \<Longrightarrow> i++succ(j) = succ(i++j)"
 apply (simp add: oadd_eq_if_raw_oadd, clarify)
 apply (simp add: raw_oadd_eq_oadd)
 apply (simp add: oadd_1 [of j, symmetric] oadd_1 [of "i++j", symmetric]
                  oadd_assoc)
 done
 
 
 text\<open>Ordinal addition with limit ordinals\<close>
 
 lemma oadd_UN:
      "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> Ord(j(x));  a \<in> A\<rbrakk>
       \<Longrightarrow> i ++ (\<Union>x\<in>A. j(x)) = (\<Union>x\<in>A. i++j(x))"
 by (blast intro: ltI Ord_UN Ord_oadd lt_oadd1 [THEN ltD]
                  oadd_lt_mono2 [THEN ltD]
           elim!: ltE dest!: ltI [THEN lt_oadd_disj])
 
 lemma oadd_Limit: "Limit(j) \<Longrightarrow> i++j = (\<Union>k\<in>j. i++k)"
 apply (frule Limit_has_0 [THEN ltD])
 apply (simp add: Limit_is_Ord [THEN Ord_in_Ord] oadd_UN [symmetric]
                  Union_eq_UN [symmetric] Limit_Union_eq)
 done
 
 lemma oadd_eq_0_iff: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> (i ++ j) = 0 \<longleftrightarrow> i=0 \<and> j=0"
 apply (erule trans_induct3 [of j])
 apply (simp_all add: oadd_Limit)
 apply (simp add: Union_empty_iff Limit_def lt_def, blast)
 done
 
 lemma oadd_eq_lt_iff: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> 0 < (i ++ j) \<longleftrightarrow> 0<i | 0<j"
 by (simp add: Ord_0_lt_iff [symmetric] oadd_eq_0_iff)
 
 lemma oadd_LimitI: "\<lbrakk>Ord(i); Limit(j)\<rbrakk> \<Longrightarrow> Limit(i ++ j)"
 apply (simp add: oadd_Limit)
 apply (frule Limit_has_1 [THEN ltD])
 apply (rule increasing_LimitI)
  apply (rule Ord_0_lt)
   apply (blast intro: Ord_in_Ord [OF Limit_is_Ord])
  apply (force simp add: Union_empty_iff oadd_eq_0_iff
                         Limit_is_Ord [of j, THEN Ord_in_Ord], auto)
 apply (rule_tac x="succ(y)" in bexI)
  apply (simp add: ltI Limit_is_Ord [of j, THEN Ord_in_Ord])
 apply (simp add: Limit_def lt_def)
 done
 
 text\<open>Order/monotonicity properties of ordinal addition\<close>
 
 lemma oadd_le_self2: "Ord(i) \<Longrightarrow> i \<le> j++i"
 proof (induct i rule: trans_induct3)
   case 0 thus ?case by (simp add: Ord_0_le)
 next
   case (succ i) thus ?case by (simp add: oadd_succ succ_leI)
 next
   case (limit l)
   hence "l = (\<Union>x\<in>l. x)"
     by (simp add: Union_eq_UN [symmetric] Limit_Union_eq)
   also have "... \<le> (\<Union>x\<in>l. j++x)"
     by (rule le_implies_UN_le_UN) (rule limit.hyps)
   finally have "l \<le> (\<Union>x\<in>l. j++x)" .
   thus ?case using limit.hyps by (simp add: oadd_Limit)
 qed
 
 lemma oadd_le_mono1: "k \<le> j \<Longrightarrow> k++i \<le> j++i"
 apply (frule lt_Ord)
 apply (frule le_Ord2)
 apply (simp add: oadd_eq_if_raw_oadd, clarify)
 apply (simp add: raw_oadd_eq_oadd)
 apply (erule_tac i = i in trans_induct3)
 apply (simp (no_asm_simp))
 apply (simp (no_asm_simp) add: oadd_succ succ_le_iff)
 apply (simp (no_asm_simp) add: oadd_Limit)
 apply (rule le_implies_UN_le_UN, blast)
 done
 
 lemma oadd_lt_mono: "\<lbrakk>i' \<le> i;  j'<j\<rbrakk> \<Longrightarrow> i'++j' < i++j"
 by (blast intro: lt_trans1 oadd_le_mono1 oadd_lt_mono2 Ord_succD elim: ltE)
 
 lemma oadd_le_mono: "\<lbrakk>i' \<le> i;  j' \<le> j\<rbrakk> \<Longrightarrow> i'++j' \<le> i++j"
 by (simp del: oadd_succ add: oadd_succ [symmetric] le_Ord2 oadd_lt_mono)
 
 lemma oadd_le_iff2: "\<lbrakk>Ord(j); Ord(k)\<rbrakk> \<Longrightarrow> i++j \<le> i++k \<longleftrightarrow> j \<le> k"
 by (simp del: oadd_succ add: oadd_lt_iff2 oadd_succ [symmetric] Ord_succ)
 
 lemma oadd_lt_self: "\<lbrakk>Ord(i);  0<j\<rbrakk> \<Longrightarrow> i < i++j"
 apply (rule lt_trans2)
 apply (erule le_refl)
 apply (simp only: lt_Ord2  oadd_1 [of i, symmetric])
 apply (blast intro: succ_leI oadd_le_mono)
 done
 
 text\<open>Every ordinal is exceeded by some limit ordinal.\<close>
 lemma Ord_imp_greater_Limit: "Ord(i) \<Longrightarrow> \<exists>k. i<k \<and> Limit(k)"
 apply (rule_tac x="i ++ nat" in exI)
 apply (blast intro: oadd_LimitI  oadd_lt_self  Limit_nat [THEN Limit_has_0])
 done
 
 lemma Ord2_imp_greater_Limit: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> \<exists>k. i<k \<and> j<k \<and> Limit(k)"
 apply (insert Ord_Un [of i j, THEN Ord_imp_greater_Limit])
 apply (simp add: Un_least_lt_iff)
 done
 
 
 subsection\<open>Ordinal Subtraction\<close>
 
 text\<open>The difference is \<^term>\<open>ordertype(j-i, Memrel(j))\<close>.
     It's probably simpler to define the difference recursively!\<close>
 
 lemma bij_sum_Diff:
      "A<=B \<Longrightarrow> (\<lambda>y\<in>B. if(y \<in> A, Inl(y), Inr(y))) \<in> bij(B, A+(B-A))"
 apply (rule_tac d = "case (\<lambda>x. x, \<lambda>y. y) " in lam_bijective)
 apply (blast intro!: if_type)
 apply (fast intro!: case_type)
 apply (erule_tac [2] sumE)
 apply (simp_all (no_asm_simp))
 done
 
 lemma ordertype_sum_Diff:
      "i \<le> j \<Longrightarrow>
             ordertype(i+(j-i), radd(i,Memrel(j),j-i,Memrel(j))) =
             ordertype(j, Memrel(j))"
 apply (safe dest!: le_subset_iff [THEN iffD1])
 apply (rule bij_sum_Diff [THEN ord_isoI, THEN ord_iso_sym, THEN ordertype_eq])
 apply (erule_tac [3] well_ord_Memrel, assumption)
 apply (simp (no_asm_simp))
 apply (frule_tac j = y in Ord_in_Ord, assumption)
 apply (frule_tac j = x in Ord_in_Ord, assumption)
 apply (simp (no_asm_simp) add: Ord_mem_iff_lt lt_Ord not_lt_iff_le)
 apply (blast intro: lt_trans2 lt_trans)
 done
 
 lemma Ord_odiff [simp,TC]:
     "\<lbrakk>Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> Ord(i--j)"
-apply (unfold odiff_def)
+  unfolding odiff_def
 apply (blast intro: Ord_ordertype Diff_subset well_ord_subset well_ord_Memrel)
 done
 
 
 lemma raw_oadd_ordertype_Diff:
    "i \<le> j
     \<Longrightarrow> raw_oadd(i,j--i) = ordertype(i+(j-i), radd(i,Memrel(j),j-i,Memrel(j)))"
 apply (simp add: raw_oadd_def odiff_def)
 apply (safe dest!: le_subset_iff [THEN iffD1])
 apply (rule sum_ord_iso_cong [THEN ordertype_eq])
 apply (erule id_ord_iso_Memrel)
 apply (rule ordertype_ord_iso [THEN ord_iso_sym])
 apply (blast intro: well_ord_radd Diff_subset well_ord_subset well_ord_Memrel)+
 done
 
 lemma oadd_odiff_inverse: "i \<le> j \<Longrightarrow> i ++ (j--i) = j"
 by (simp add: lt_Ord le_Ord2 oadd_def ordify_def raw_oadd_ordertype_Diff
               ordertype_sum_Diff ordertype_Memrel lt_Ord2 [THEN Ord_succD])
 
 (*By oadd_inject, the difference between i and j is unique.  Note that we get
   i++j = k  \<Longrightarrow>  j = k--i.  *)
 lemma odiff_oadd_inverse: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> (i++j) -- i = j"
 apply (rule oadd_inject)
 apply (blast intro: oadd_odiff_inverse oadd_le_self)
 apply (blast intro: Ord_ordertype Ord_oadd Ord_odiff)+
 done
 
 lemma odiff_lt_mono2: "\<lbrakk>i<j;  k \<le> i\<rbrakk> \<Longrightarrow> i--k < j--k"
 apply (rule_tac i = k in oadd_lt_cancel2)
 apply (simp add: oadd_odiff_inverse)
 apply (subst oadd_odiff_inverse)
 apply (blast intro: le_trans leI, assumption)
 apply (simp (no_asm_simp) add: lt_Ord le_Ord2)
 done
 
 
 subsection\<open>Ordinal Multiplication\<close>
 
 lemma Ord_omult [simp,TC]:
     "\<lbrakk>Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> Ord(i**j)"
-apply (unfold omult_def)
+  unfolding omult_def
 apply (blast intro: Ord_ordertype well_ord_rmult well_ord_Memrel)
 done
 
 subsubsection\<open>A useful unfolding law\<close>
 
 lemma pred_Pair_eq:
  "\<lbrakk>a \<in> A;  b \<in> B\<rbrakk> \<Longrightarrow> pred(A*B, \<langle>a,b\<rangle>, rmult(A,r,B,s)) =
                       pred(A,a,r)*B \<union> ({a} * pred(B,b,s))"
 apply (unfold pred_def, blast)
 done
 
 lemma ordertype_pred_Pair_eq:
      "\<lbrakk>a \<in> A;  b \<in> B;  well_ord(A,r);  well_ord(B,s)\<rbrakk> \<Longrightarrow>
          ordertype(pred(A*B, \<langle>a,b\<rangle>, rmult(A,r,B,s)), rmult(A,r,B,s)) =
          ordertype(pred(A,a,r)*B + pred(B,b,s),
                   radd(A*B, rmult(A,r,B,s), B, s))"
 apply (simp (no_asm_simp) add: pred_Pair_eq)
 apply (rule ordertype_eq [symmetric])
 apply (rule prod_sum_singleton_ord_iso)
 apply (simp_all add: pred_subset well_ord_rmult [THEN well_ord_subset])
 apply (blast intro: pred_subset well_ord_rmult [THEN well_ord_subset]
              elim!: predE)
 done
 
 lemma ordertype_pred_Pair_lemma:
     "\<lbrakk>i'<i;  j'<j\<rbrakk>
      \<Longrightarrow> ordertype(pred(i*j, <i',j'>, rmult(i,Memrel(i),j,Memrel(j))),
                    rmult(i,Memrel(i),j,Memrel(j))) =
          raw_oadd (j**i', j')"
 apply (unfold raw_oadd_def omult_def)
 apply (simp add: ordertype_pred_Pair_eq lt_pred_Memrel ltD lt_Ord2
                  well_ord_Memrel)
 apply (rule trans)
  apply (rule_tac [2] ordertype_ord_iso
                       [THEN sum_ord_iso_cong, THEN ordertype_eq])
   apply (rule_tac [3] ord_iso_refl)
 apply (rule id_bij [THEN ord_isoI, THEN ordertype_eq])
 apply (elim SigmaE sumE ltE ssubst)
 apply (simp_all add: well_ord_rmult well_ord_radd well_ord_Memrel
                      Ord_ordertype lt_Ord lt_Ord2)
 apply (blast intro: Ord_trans)+
 done
 
 lemma lt_omult:
  "\<lbrakk>Ord(i);  Ord(j);  k<j**i\<rbrakk>
   \<Longrightarrow> \<exists>j' i'. k = j**i' ++ j' \<and> j'<j \<and> i'<i"
-apply (unfold omult_def)
+  unfolding omult_def
 apply (simp add: ordertype_pred_unfold well_ord_rmult well_ord_Memrel)
 apply (safe elim!: ltE)
 apply (simp add: ordertype_pred_Pair_lemma ltI raw_oadd_eq_oadd
             omult_def [symmetric] Ord_in_Ord' [of _ i] Ord_in_Ord' [of _ j])
 apply (blast intro: ltI)
 done
 
 lemma omult_oadd_lt:
      "\<lbrakk>j'<j;  i'<i\<rbrakk> \<Longrightarrow> j**i' ++ j'  <  j**i"
-apply (unfold omult_def)
+  unfolding omult_def
 apply (rule ltI)
  prefer 2
  apply (simp add: Ord_ordertype well_ord_rmult well_ord_Memrel lt_Ord2)
 apply (simp add: ordertype_pred_unfold well_ord_rmult well_ord_Memrel lt_Ord2)
 apply (rule bexI [of _ i'])
 apply (rule bexI [of _ j'])
 apply (simp add: ordertype_pred_Pair_lemma ltI omult_def [symmetric])
 apply (simp add: lt_Ord lt_Ord2 raw_oadd_eq_oadd)
 apply (simp_all add: lt_def)
 done
 
 lemma omult_unfold:
      "\<lbrakk>Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> j**i = (\<Union>j'\<in>j. \<Union>i'\<in>i. {j**i' ++ j'})"
 apply (rule subsetI [THEN equalityI])
 apply (rule lt_omult [THEN exE])
 apply (erule_tac [3] ltI)
 apply (simp_all add: Ord_omult)
 apply (blast elim!: ltE)
 apply (blast intro: omult_oadd_lt [THEN ltD] ltI)
 done
 
 subsubsection\<open>Basic laws for ordinal multiplication\<close>
 
 text\<open>Ordinal multiplication by zero\<close>
 
 lemma omult_0 [simp]: "i**0 = 0"
-apply (unfold omult_def)
+  unfolding omult_def
 apply (simp (no_asm_simp))
 done
 
 lemma omult_0_left [simp]: "0**i = 0"
-apply (unfold omult_def)
+  unfolding omult_def
 apply (simp (no_asm_simp))
 done
 
 text\<open>Ordinal multiplication by 1\<close>
 
 lemma omult_1 [simp]: "Ord(i) \<Longrightarrow> i**1 = i"
-apply (unfold omult_def)
+  unfolding omult_def
 apply (rule_tac s1="Memrel(i)"
        in ord_isoI [THEN ordertype_eq, THEN trans])
 apply (rule_tac c = snd and d = "\<lambda>z.\<langle>0,z\<rangle>"  in lam_bijective)
 apply (auto elim!: snd_type well_ord_Memrel ordertype_Memrel)
 done
 
 lemma omult_1_left [simp]: "Ord(i) \<Longrightarrow> 1**i = i"
-apply (unfold omult_def)
+  unfolding omult_def
 apply (rule_tac s1="Memrel(i)"
        in ord_isoI [THEN ordertype_eq, THEN trans])
 apply (rule_tac c = fst and d = "\<lambda>z.\<langle>z,0\<rangle>" in lam_bijective)
 apply (auto elim!: fst_type well_ord_Memrel ordertype_Memrel)
 done
 
 text\<open>Distributive law for ordinal multiplication and addition\<close>
 
 lemma oadd_omult_distrib:
      "\<lbrakk>Ord(i);  Ord(j);  Ord(k)\<rbrakk> \<Longrightarrow> i**(j++k) = (i**j)++(i**k)"
 apply (simp add: oadd_eq_if_raw_oadd)
 apply (simp add: omult_def raw_oadd_def)
 apply (rule ordertype_eq [THEN trans])
 apply (rule prod_ord_iso_cong [OF ordertype_ord_iso [THEN ord_iso_sym]
                                   ord_iso_refl])
 apply (simp_all add: well_ord_rmult well_ord_radd well_ord_Memrel
                      Ord_ordertype)
 apply (rule sum_prod_distrib_ord_iso [THEN ordertype_eq, THEN trans])
 apply (rule_tac [2] ordertype_eq)
 apply (rule_tac [2] sum_ord_iso_cong [OF ordertype_ord_iso ordertype_ord_iso])
 apply (simp_all add: well_ord_rmult well_ord_radd well_ord_Memrel
                      Ord_ordertype)
 done
 
 lemma omult_succ: "\<lbrakk>Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> i**succ(j) = (i**j)++i"
 by (simp del: oadd_succ add: oadd_1 [of j, symmetric] oadd_omult_distrib)
 
 text\<open>Associative law\<close>
 
 lemma omult_assoc:
     "\<lbrakk>Ord(i);  Ord(j);  Ord(k)\<rbrakk> \<Longrightarrow> (i**j)**k = i**(j**k)"
-apply (unfold omult_def)
+  unfolding omult_def
 apply (rule ordertype_eq [THEN trans])
 apply (rule prod_ord_iso_cong [OF ord_iso_refl
                                   ordertype_ord_iso [THEN ord_iso_sym]])
 apply (blast intro: well_ord_rmult well_ord_Memrel)+
 apply (rule prod_assoc_ord_iso
              [THEN ord_iso_sym, THEN ordertype_eq, THEN trans])
 apply (rule_tac [2] ordertype_eq)
 apply (rule_tac [2] prod_ord_iso_cong [OF ordertype_ord_iso ord_iso_refl])
 apply (blast intro: well_ord_rmult well_ord_Memrel Ord_ordertype)+
 done
 
 
 text\<open>Ordinal multiplication with limit ordinals\<close>
 
 lemma omult_UN:
      "\<lbrakk>Ord(i);  \<And>x. x \<in> A \<Longrightarrow> Ord(j(x))\<rbrakk>
       \<Longrightarrow> i ** (\<Union>x\<in>A. j(x)) = (\<Union>x\<in>A. i**j(x))"
 by (simp (no_asm_simp) add: Ord_UN omult_unfold, blast)
 
 lemma omult_Limit: "\<lbrakk>Ord(i);  Limit(j)\<rbrakk> \<Longrightarrow> i**j = (\<Union>k\<in>j. i**k)"
 by (simp add: Limit_is_Ord [THEN Ord_in_Ord] omult_UN [symmetric]
               Union_eq_UN [symmetric] Limit_Union_eq)
 
 
 subsubsection\<open>Ordering/monotonicity properties of ordinal multiplication\<close>
 
 (*As a special case we have "\<lbrakk>0<i;  0<j\<rbrakk> \<Longrightarrow> 0 < i**j" *)
 lemma lt_omult1: "\<lbrakk>k<i;  0<j\<rbrakk> \<Longrightarrow> k < i**j"
 apply (safe elim!: ltE intro!: ltI Ord_omult)
 apply (force simp add: omult_unfold)
 done
 
 lemma omult_le_self: "\<lbrakk>Ord(i);  0<j\<rbrakk> \<Longrightarrow> i \<le> i**j"
 by (blast intro: all_lt_imp_le Ord_omult lt_omult1 lt_Ord2)
 
 lemma omult_le_mono1:
   assumes kj: "k \<le> j" and i: "Ord(i)" shows "k**i \<le> j**i"
 proof -
   have o: "Ord(k)" "Ord(j)" by (rule lt_Ord [OF kj] le_Ord2 [OF kj])+
   show ?thesis using i
   proof (induct i rule: trans_induct3)
     case 0 thus ?case
       by simp
   next
     case (succ i) thus ?case
       by (simp add: o kj omult_succ oadd_le_mono)
   next
     case (limit l)
     thus ?case
       by (auto simp add: o kj omult_Limit le_implies_UN_le_UN)
   qed
 qed
 
 lemma omult_lt_mono2: "\<lbrakk>k<j;  0<i\<rbrakk> \<Longrightarrow> i**k < i**j"
 apply (rule ltI)
 apply (simp (no_asm_simp) add: omult_unfold lt_Ord2)
 apply (safe elim!: ltE intro!: Ord_omult)
 apply (force simp add: Ord_omult)
 done
 
 lemma omult_le_mono2: "\<lbrakk>k \<le> j;  Ord(i)\<rbrakk> \<Longrightarrow> i**k \<le> i**j"
 apply (rule subset_imp_le)
 apply (safe elim!: ltE dest!: Ord_succD intro!: Ord_omult)
 apply (simp add: omult_unfold)
 apply (blast intro: Ord_trans)
 done
 
 lemma omult_le_mono: "\<lbrakk>i' \<le> i;  j' \<le> j\<rbrakk> \<Longrightarrow> i'**j' \<le> i**j"
 by (blast intro: le_trans omult_le_mono1 omult_le_mono2 Ord_succD elim: ltE)
 
 lemma omult_lt_mono: "\<lbrakk>i' \<le> i;  j'<j;  0<i\<rbrakk> \<Longrightarrow> i'**j' < i**j"
 by (blast intro: lt_trans1 omult_le_mono1 omult_lt_mono2 Ord_succD elim: ltE)
 
 lemma omult_le_self2:
   assumes i: "Ord(i)" and j: "0<j" shows "i \<le> j**i"
 proof -
   have oj: "Ord(j)" by (rule lt_Ord2 [OF j])
   show ?thesis using i
   proof (induct i rule: trans_induct3)
     case 0 thus ?case
       by simp
   next
     case (succ i)
     have "j ** i ++ 0 < j ** i ++ j"
       by (rule oadd_lt_mono2 [OF j])
     with succ.hyps show ?case
       by (simp add: oj j omult_succ ) (rule lt_trans1)
   next
     case (limit l)
     hence "l = (\<Union>x\<in>l. x)"
       by (simp add: Union_eq_UN [symmetric] Limit_Union_eq)
     also have "... \<le> (\<Union>x\<in>l. j**x)"
       by (rule le_implies_UN_le_UN) (rule limit.hyps)
     finally have "l \<le> (\<Union>x\<in>l. j**x)" .
     thus ?case using limit.hyps by (simp add: oj omult_Limit)
   qed
 qed
 
 
 text\<open>Further properties of ordinal multiplication\<close>
 
 lemma omult_inject: "\<lbrakk>i**j = i**k;  0<i;  Ord(j);  Ord(k)\<rbrakk> \<Longrightarrow> j=k"
 apply (rule Ord_linear_lt)
 prefer 4 apply assumption
 apply auto
 apply (force dest: omult_lt_mono2 simp add: lt_not_refl)+
 done
 
 subsection\<open>The Relation \<^term>\<open>Lt\<close>\<close>
 
 lemma wf_Lt: "wf(Lt)"
 apply (rule wf_subset)
 apply (rule wf_Memrel)
 apply (auto simp add: Lt_def Memrel_def lt_def)
 done
 
 lemma irrefl_Lt: "irrefl(A,Lt)"
 by (auto simp add: Lt_def irrefl_def)
 
 lemma trans_Lt: "trans[A](Lt)"
 apply (simp add: Lt_def trans_on_def)
 apply (blast intro: lt_trans)
 done
 
 lemma part_ord_Lt: "part_ord(A,Lt)"
 by (simp add: part_ord_def irrefl_Lt trans_Lt)
 
 lemma linear_Lt: "linear(nat,Lt)"
 apply (auto dest!: not_lt_imp_le simp add: Lt_def linear_def le_iff)
 apply (drule lt_asym, auto)
 done
 
 lemma tot_ord_Lt: "tot_ord(nat,Lt)"
 by (simp add: tot_ord_def linear_Lt part_ord_Lt)
 
 lemma well_ord_Lt: "well_ord(nat,Lt)"
 by (simp add: well_ord_def wf_Lt wf_imp_wf_on tot_ord_Lt)
 
 end
diff --git a/src/ZF/Ordinal.thy b/src/ZF/Ordinal.thy
--- a/src/ZF/Ordinal.thy
+++ b/src/ZF/Ordinal.thy
@@ -1,765 +1,765 @@
 (*  Title:      ZF/Ordinal.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section\<open>Transitive Sets and Ordinals\<close>
 
 theory Ordinal imports WF Bool equalities begin
 
 definition
   Memrel        :: "i\<Rightarrow>i"  where
     "Memrel(A)   \<equiv> {z\<in>A*A . \<exists>x y. z=\<langle>x,y\<rangle> \<and> x\<in>y }"
 
 definition
   Transset  :: "i\<Rightarrow>o"  where
     "Transset(i) \<equiv> \<forall>x\<in>i. x<=i"
 
 definition
   Ord  :: "i\<Rightarrow>o"  where
     "Ord(i)      \<equiv> Transset(i) \<and> (\<forall>x\<in>i. Transset(x))"
 
 definition
   lt        :: "[i,i] \<Rightarrow> o"  (infixl \<open><\<close> 50)   (*less-than on ordinals*)  where
     "i<j         \<equiv> i\<in>j \<and> Ord(j)"
 
 definition
   Limit         :: "i\<Rightarrow>o"  where
     "Limit(i)    \<equiv> Ord(i) \<and> 0<i \<and> (\<forall>y. y<i \<longrightarrow> succ(y)<i)"
 
 abbreviation
   le  (infixl \<open>\<le>\<close> 50) where
   "x \<le> y \<equiv> x < succ(y)"
 
 
 subsection\<open>Rules for Transset\<close>
 
 subsubsection\<open>Three Neat Characterisations of Transset\<close>
 
 lemma Transset_iff_Pow: "Transset(A) <-> A<=Pow(A)"
 by (unfold Transset_def, blast)
 
 lemma Transset_iff_Union_succ: "Transset(A) <-> \<Union>(succ(A)) = A"
-apply (unfold Transset_def)
+  unfolding Transset_def
 apply (blast elim!: equalityE)
 done
 
 lemma Transset_iff_Union_subset: "Transset(A) <-> \<Union>(A) \<subseteq> A"
 by (unfold Transset_def, blast)
 
 subsubsection\<open>Consequences of Downwards Closure\<close>
 
 lemma Transset_doubleton_D:
     "\<lbrakk>Transset(C); {a,b}: C\<rbrakk> \<Longrightarrow> a\<in>C \<and> b\<in>C"
 by (unfold Transset_def, blast)
 
 lemma Transset_Pair_D:
     "\<lbrakk>Transset(C); \<langle>a,b\<rangle>\<in>C\<rbrakk> \<Longrightarrow> a\<in>C \<and> b\<in>C"
 apply (simp add: Pair_def)
 apply (blast dest: Transset_doubleton_D)
 done
 
 lemma Transset_includes_domain:
     "\<lbrakk>Transset(C); A*B \<subseteq> C; b \<in> B\<rbrakk> \<Longrightarrow> A \<subseteq> C"
 by (blast dest: Transset_Pair_D)
 
 lemma Transset_includes_range:
     "\<lbrakk>Transset(C); A*B \<subseteq> C; a \<in> A\<rbrakk> \<Longrightarrow> B \<subseteq> C"
 by (blast dest: Transset_Pair_D)
 
 subsubsection\<open>Closure Properties\<close>
 
 lemma Transset_0: "Transset(0)"
 by (unfold Transset_def, blast)
 
 lemma Transset_Un:
     "\<lbrakk>Transset(i);  Transset(j)\<rbrakk> \<Longrightarrow> Transset(i \<union> j)"
 by (unfold Transset_def, blast)
 
 lemma Transset_Int:
     "\<lbrakk>Transset(i);  Transset(j)\<rbrakk> \<Longrightarrow> Transset(i \<inter> j)"
 by (unfold Transset_def, blast)
 
 lemma Transset_succ: "Transset(i) \<Longrightarrow> Transset(succ(i))"
 by (unfold Transset_def, blast)
 
 lemma Transset_Pow: "Transset(i) \<Longrightarrow> Transset(Pow(i))"
 by (unfold Transset_def, blast)
 
 lemma Transset_Union: "Transset(A) \<Longrightarrow> Transset(\<Union>(A))"
 by (unfold Transset_def, blast)
 
 lemma Transset_Union_family:
     "\<lbrakk>\<And>i. i\<in>A \<Longrightarrow> Transset(i)\<rbrakk> \<Longrightarrow> Transset(\<Union>(A))"
 by (unfold Transset_def, blast)
 
 lemma Transset_Inter_family:
     "\<lbrakk>\<And>i. i\<in>A \<Longrightarrow> Transset(i)\<rbrakk> \<Longrightarrow> Transset(\<Inter>(A))"
 by (unfold Inter_def Transset_def, blast)
 
 lemma Transset_UN:
      "(\<And>x. x \<in> A \<Longrightarrow> Transset(B(x))) \<Longrightarrow> Transset (\<Union>x\<in>A. B(x))"
 by (rule Transset_Union_family, auto)
 
 lemma Transset_INT:
      "(\<And>x. x \<in> A \<Longrightarrow> Transset(B(x))) \<Longrightarrow> Transset (\<Inter>x\<in>A. B(x))"
 by (rule Transset_Inter_family, auto)
 
 
 subsection\<open>Lemmas for Ordinals\<close>
 
 lemma OrdI:
     "\<lbrakk>Transset(i);  \<And>x. x\<in>i \<Longrightarrow> Transset(x)\<rbrakk>  \<Longrightarrow>  Ord(i)"
 by (simp add: Ord_def)
 
 lemma Ord_is_Transset: "Ord(i) \<Longrightarrow> Transset(i)"
 by (simp add: Ord_def)
 
 lemma Ord_contains_Transset:
     "\<lbrakk>Ord(i);  j\<in>i\<rbrakk> \<Longrightarrow> Transset(j) "
 by (unfold Ord_def, blast)
 
 
 lemma Ord_in_Ord: "\<lbrakk>Ord(i);  j\<in>i\<rbrakk> \<Longrightarrow> Ord(j)"
 by (unfold Ord_def Transset_def, blast)
 
 (*suitable for rewriting PROVIDED i has been fixed*)
 lemma Ord_in_Ord': "\<lbrakk>j\<in>i; Ord(i)\<rbrakk> \<Longrightarrow> Ord(j)"
 by (blast intro: Ord_in_Ord)
 
 (* Ord(succ(j)) \<Longrightarrow> Ord(j) *)
 lemmas Ord_succD = Ord_in_Ord [OF _ succI1]
 
 lemma Ord_subset_Ord: "\<lbrakk>Ord(i);  Transset(j);  j<=i\<rbrakk> \<Longrightarrow> Ord(j)"
 by (simp add: Ord_def Transset_def, blast)
 
 lemma OrdmemD: "\<lbrakk>j\<in>i;  Ord(i)\<rbrakk> \<Longrightarrow> j<=i"
 by (unfold Ord_def Transset_def, blast)
 
 lemma Ord_trans: "\<lbrakk>i\<in>j;  j\<in>k;  Ord(k)\<rbrakk> \<Longrightarrow> i\<in>k"
 by (blast dest: OrdmemD)
 
 lemma Ord_succ_subsetI: "\<lbrakk>i\<in>j;  Ord(j)\<rbrakk> \<Longrightarrow> succ(i) \<subseteq> j"
 by (blast dest: OrdmemD)
 
 
 subsection\<open>The Construction of Ordinals: 0, succ, Union\<close>
 
 lemma Ord_0 [iff,TC]: "Ord(0)"
 by (blast intro: OrdI Transset_0)
 
 lemma Ord_succ [TC]: "Ord(i) \<Longrightarrow> Ord(succ(i))"
 by (blast intro: OrdI Transset_succ Ord_is_Transset Ord_contains_Transset)
 
 lemmas Ord_1 = Ord_0 [THEN Ord_succ]
 
 lemma Ord_succ_iff [iff]: "Ord(succ(i)) <-> Ord(i)"
 by (blast intro: Ord_succ dest!: Ord_succD)
 
 lemma Ord_Un [intro,simp,TC]: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> Ord(i \<union> j)"
-apply (unfold Ord_def)
+  unfolding Ord_def
 apply (blast intro!: Transset_Un)
 done
 
 lemma Ord_Int [TC]: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> Ord(i \<inter> j)"
-apply (unfold Ord_def)
+  unfolding Ord_def
 apply (blast intro!: Transset_Int)
 done
 
 text\<open>There is no set of all ordinals, for then it would contain itself\<close>
 lemma ON_class: "\<not> (\<forall>i. i\<in>X <-> Ord(i))"
 proof (rule notI)
   assume X: "\<forall>i. i \<in> X \<longleftrightarrow> Ord(i)"
   have "\<forall>x y. x\<in>X \<longrightarrow> y\<in>x \<longrightarrow> y\<in>X"
     by (simp add: X, blast intro: Ord_in_Ord)
   hence "Transset(X)"
      by (auto simp add: Transset_def)
   moreover have "\<And>x. x \<in> X \<Longrightarrow> Transset(x)"
      by (simp add: X Ord_def)
   ultimately have "Ord(X)" by (rule OrdI)
   hence "X \<in> X" by (simp add: X)
   thus "False" by (rule mem_irrefl)
 qed
 
 subsection\<open>< is 'less Than' for Ordinals\<close>
 
 lemma ltI: "\<lbrakk>i\<in>j;  Ord(j)\<rbrakk> \<Longrightarrow> i<j"
 by (unfold lt_def, blast)
 
 lemma ltE:
     "\<lbrakk>i<j;  \<lbrakk>i\<in>j;  Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
-apply (unfold lt_def)
+  unfolding lt_def
 apply (blast intro: Ord_in_Ord)
 done
 
 lemma ltD: "i<j \<Longrightarrow> i\<in>j"
 by (erule ltE, assumption)
 
 lemma not_lt0 [simp]: "\<not> i<0"
 by (unfold lt_def, blast)
 
 lemma lt_Ord: "j<i \<Longrightarrow> Ord(j)"
 by (erule ltE, assumption)
 
 lemma lt_Ord2: "j<i \<Longrightarrow> Ord(i)"
 by (erule ltE, assumption)
 
 (* @{term"ja \<le> j \<Longrightarrow> Ord(j)"} *)
 lemmas le_Ord2 = lt_Ord2 [THEN Ord_succD]
 
 (* i<0 \<Longrightarrow> R *)
 lemmas lt0E = not_lt0 [THEN notE, elim!]
 
 lemma lt_trans [trans]: "\<lbrakk>i<j;  j<k\<rbrakk> \<Longrightarrow> i<k"
 by (blast intro!: ltI elim!: ltE intro: Ord_trans)
 
 lemma lt_not_sym: "i<j \<Longrightarrow> \<not> (j<i)"
-apply (unfold lt_def)
+  unfolding lt_def
 apply (blast elim: mem_asym)
 done
 
 (* \<lbrakk>i<j;  \<not>P \<Longrightarrow> j<i\<rbrakk> \<Longrightarrow> P *)
 lemmas lt_asym = lt_not_sym [THEN swap]
 
 lemma lt_irrefl [elim!]: "i<i \<Longrightarrow> P"
 by (blast intro: lt_asym)
 
 lemma lt_not_refl: "\<not> i<i"
 apply (rule notI)
 apply (erule lt_irrefl)
 done
 
 
 text\<open>Recall that  \<^term>\<open>i \<le> j\<close>  abbreviates  \<^term>\<open>i<succ(j)\<close>!\<close>
 
 lemma le_iff: "i \<le> j <-> i<j | (i=j \<and> Ord(j))"
 by (unfold lt_def, blast)
 
 (*Equivalently, i<j \<Longrightarrow> i < succ(j)*)
 lemma leI: "i<j \<Longrightarrow> i \<le> j"
 by (simp add: le_iff)
 
 lemma le_eqI: "\<lbrakk>i=j;  Ord(j)\<rbrakk> \<Longrightarrow> i \<le> j"
 by (simp add: le_iff)
 
 lemmas le_refl = refl [THEN le_eqI]
 
 lemma le_refl_iff [iff]: "i \<le> i <-> Ord(i)"
 by (simp (no_asm_simp) add: lt_not_refl le_iff)
 
 lemma leCI: "(\<not> (i=j \<and> Ord(j)) \<Longrightarrow> i<j) \<Longrightarrow> i \<le> j"
 by (simp add: le_iff, blast)
 
 lemma leE:
     "\<lbrakk>i \<le> j;  i<j \<Longrightarrow> P;  \<lbrakk>i=j;  Ord(j)\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (simp add: le_iff, blast)
 
 lemma le_anti_sym: "\<lbrakk>i \<le> j;  j \<le> i\<rbrakk> \<Longrightarrow> i=j"
 apply (simp add: le_iff)
 apply (blast elim: lt_asym)
 done
 
 lemma le0_iff [simp]: "i \<le> 0 <-> i=0"
 by (blast elim!: leE)
 
 lemmas le0D = le0_iff [THEN iffD1, dest!]
 
 subsection\<open>Natural Deduction Rules for Memrel\<close>
 
 (*The lemmas MemrelI/E give better speed than [iff] here*)
 lemma Memrel_iff [simp]: "\<langle>a,b\<rangle> \<in> Memrel(A) <-> a\<in>b \<and> a\<in>A \<and> b\<in>A"
 by (unfold Memrel_def, blast)
 
 lemma MemrelI [intro!]: "\<lbrakk>a \<in> b;  a \<in> A;  b \<in> A\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle> \<in> Memrel(A)"
 by auto
 
 lemma MemrelE [elim!]:
     "\<lbrakk>\<langle>a,b\<rangle> \<in> Memrel(A);
         \<lbrakk>a \<in> A;  b \<in> A;  a\<in>b\<rbrakk>  \<Longrightarrow> P\<rbrakk>
      \<Longrightarrow> P"
 by auto
 
 lemma Memrel_type: "Memrel(A) \<subseteq> A*A"
 by (unfold Memrel_def, blast)
 
 lemma Memrel_mono: "A<=B \<Longrightarrow> Memrel(A) \<subseteq> Memrel(B)"
 by (unfold Memrel_def, blast)
 
 lemma Memrel_0 [simp]: "Memrel(0) = 0"
 by (unfold Memrel_def, blast)
 
 lemma Memrel_1 [simp]: "Memrel(1) = 0"
 by (unfold Memrel_def, blast)
 
 lemma relation_Memrel: "relation(Memrel(A))"
 by (simp add: relation_def Memrel_def)
 
 (*The membership relation (as a set) is well-founded.
   Proof idea: show A<=B by applying the foundation axiom to A-B *)
 lemma wf_Memrel: "wf(Memrel(A))"
-apply (unfold wf_def)
+  unfolding wf_def
 apply (rule foundation [THEN disjE, THEN allI], erule disjI1, blast)
 done
 
 text\<open>The premise \<^term>\<open>Ord(i)\<close> does not suffice.\<close>
 lemma trans_Memrel:
     "Ord(i) \<Longrightarrow> trans(Memrel(i))"
 by (unfold Ord_def Transset_def trans_def, blast)
 
 text\<open>However, the following premise is strong enough.\<close>
 lemma Transset_trans_Memrel:
     "\<forall>j\<in>i. Transset(j) \<Longrightarrow> trans(Memrel(i))"
 by (unfold Transset_def trans_def, blast)
 
 (*If Transset(A) then Memrel(A) internalizes the membership relation below A*)
 lemma Transset_Memrel_iff:
     "Transset(A) \<Longrightarrow> \<langle>a,b\<rangle> \<in> Memrel(A) <-> a\<in>b \<and> b\<in>A"
 by (unfold Transset_def, blast)
 
 
 subsection\<open>Transfinite Induction\<close>
 
 (*Epsilon induction over a transitive set*)
 lemma Transset_induct:
     "\<lbrakk>i \<in> k;  Transset(k);
         \<And>x.\<lbrakk>x \<in> k;  \<forall>y\<in>x. P(y)\<rbrakk> \<Longrightarrow> P(x)\<rbrakk>
      \<Longrightarrow>  P(i)"
 apply (simp add: Transset_def)
 apply (erule wf_Memrel [THEN wf_induct2], blast+)
 done
 
 (*Induction over an ordinal*)
 lemma Ord_induct [consumes 2]:
   "i \<in> k \<Longrightarrow> Ord(k) \<Longrightarrow> (\<And>x. x \<in> k \<Longrightarrow> (\<And>y. y \<in> x \<Longrightarrow> P(y)) \<Longrightarrow> P(x)) \<Longrightarrow> P(i)"
   using Transset_induct [OF _ Ord_is_Transset, of i k P] by simp
 
 (*Induction over the class of ordinals -- a useful corollary of Ord_induct*)
 lemma trans_induct [consumes 1, case_names step]:
   "Ord(i) \<Longrightarrow> (\<And>x. Ord(x) \<Longrightarrow> (\<And>y. y \<in> x \<Longrightarrow> P(y)) \<Longrightarrow> P(x)) \<Longrightarrow> P(i)"
   apply (rule Ord_succ [THEN succI1 [THEN Ord_induct]], assumption)
   apply (blast intro: Ord_succ [THEN Ord_in_Ord])
   done
 
 
 section\<open>Fundamental properties of the epsilon ordering (< on ordinals)\<close>
 
 
 subsubsection\<open>Proving That < is a Linear Ordering on the Ordinals\<close>
 
 lemma Ord_linear:
      "Ord(i) \<Longrightarrow> Ord(j) \<Longrightarrow> i\<in>j | i=j | j\<in>i"
 proof (induct i arbitrary: j rule: trans_induct)
   case (step i)
   note step_i = step
   show ?case using \<open>Ord(j)\<close>
     proof (induct j rule: trans_induct)
       case (step j)
       thus ?case using step_i
         by (blast dest: Ord_trans)
     qed
 qed
 
 text\<open>The trichotomy law for ordinals\<close>
 lemma Ord_linear_lt:
  assumes o: "Ord(i)" "Ord(j)"
  obtains (lt) "i<j" | (eq) "i=j" | (gt) "j<i"
 apply (simp add: lt_def)
 apply (rule_tac i1=i and j1=j in Ord_linear [THEN disjE])
 apply (blast intro: o)+
 done
 
 lemma Ord_linear2:
  assumes o: "Ord(i)" "Ord(j)"
  obtains (lt) "i<j" | (ge) "j \<le> i"
 apply (rule_tac i = i and j = j in Ord_linear_lt)
 apply (blast intro: leI le_eqI sym o) +
 done
 
 lemma Ord_linear_le:
  assumes o: "Ord(i)" "Ord(j)"
  obtains (le) "i \<le> j" | (ge) "j \<le> i"
 apply (rule_tac i = i and j = j in Ord_linear_lt)
 apply (blast intro: leI le_eqI o) +
 done
 
 lemma le_imp_not_lt: "j \<le> i \<Longrightarrow> \<not> i<j"
 by (blast elim!: leE elim: lt_asym)
 
 lemma not_lt_imp_le: "\<lbrakk>\<not> i<j;  Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> j \<le> i"
 by (rule_tac i = i and j = j in Ord_linear2, auto)
 
 
 subsubsection \<open>Some Rewrite Rules for \<open><\<close>, \<open>\<le>\<close>\<close>
 
 lemma Ord_mem_iff_lt: "Ord(j) \<Longrightarrow> i\<in>j <-> i<j"
 by (unfold lt_def, blast)
 
 lemma not_lt_iff_le: "\<lbrakk>Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> \<not> i<j <-> j \<le> i"
 by (blast dest: le_imp_not_lt not_lt_imp_le)
 
 lemma not_le_iff_lt: "\<lbrakk>Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> \<not> i \<le> j <-> j<i"
 by (simp (no_asm_simp) add: not_lt_iff_le [THEN iff_sym])
 
 (*This is identical to 0<succ(i) *)
 lemma Ord_0_le: "Ord(i) \<Longrightarrow> 0 \<le> i"
 by (erule not_lt_iff_le [THEN iffD1], auto)
 
 lemma Ord_0_lt: "\<lbrakk>Ord(i);  i\<noteq>0\<rbrakk> \<Longrightarrow> 0<i"
 apply (erule not_le_iff_lt [THEN iffD1])
 apply (rule Ord_0, blast)
 done
 
 lemma Ord_0_lt_iff: "Ord(i) \<Longrightarrow> i\<noteq>0 <-> 0<i"
 by (blast intro: Ord_0_lt)
 
 
 subsection\<open>Results about Less-Than or Equals\<close>
 
 (** For ordinals, @{term"j\<subseteq>i"} implies @{term"j \<le> i"} (less-than or equals) **)
 
 lemma zero_le_succ_iff [iff]: "0 \<le> succ(x) <-> Ord(x)"
 by (blast intro: Ord_0_le elim: ltE)
 
 lemma subset_imp_le: "\<lbrakk>j<=i;  Ord(i);  Ord(j)\<rbrakk> \<Longrightarrow> j \<le> i"
 apply (rule not_lt_iff_le [THEN iffD1], assumption+)
 apply (blast elim: ltE mem_irrefl)
 done
 
 lemma le_imp_subset: "i \<le> j \<Longrightarrow> i<=j"
 by (blast dest: OrdmemD elim: ltE leE)
 
 lemma le_subset_iff: "j \<le> i <-> j<=i \<and> Ord(i) \<and> Ord(j)"
 by (blast dest: subset_imp_le le_imp_subset elim: ltE)
 
 lemma le_succ_iff: "i \<le> succ(j) <-> i \<le> j | i=succ(j) \<and> Ord(i)"
 apply (simp (no_asm) add: le_iff)
 apply blast
 done
 
 (*Just a variant of subset_imp_le*)
 lemma all_lt_imp_le: "\<lbrakk>Ord(i);  Ord(j);  \<And>x. x<j \<Longrightarrow> x<i\<rbrakk> \<Longrightarrow> j \<le> i"
 by (blast intro: not_lt_imp_le dest: lt_irrefl)
 
 subsubsection\<open>Transitivity Laws\<close>
 
 lemma lt_trans1: "\<lbrakk>i \<le> j;  j<k\<rbrakk> \<Longrightarrow> i<k"
 by (blast elim!: leE intro: lt_trans)
 
 lemma lt_trans2: "\<lbrakk>i<j;  j \<le> k\<rbrakk> \<Longrightarrow> i<k"
 by (blast elim!: leE intro: lt_trans)
 
 lemma le_trans: "\<lbrakk>i \<le> j;  j \<le> k\<rbrakk> \<Longrightarrow> i \<le> k"
 by (blast intro: lt_trans1)
 
 lemma succ_leI: "i<j \<Longrightarrow> succ(i) \<le> j"
 apply (rule not_lt_iff_le [THEN iffD1])
 apply (blast elim: ltE leE lt_asym)+
 done
 
 (*Identical to  succ(i) < succ(j) \<Longrightarrow> i<j  *)
 lemma succ_leE: "succ(i) \<le> j \<Longrightarrow> i<j"
 apply (rule not_le_iff_lt [THEN iffD1])
 apply (blast elim: ltE leE lt_asym)+
 done
 
 lemma succ_le_iff [iff]: "succ(i) \<le> j <-> i<j"
 by (blast intro: succ_leI succ_leE)
 
 lemma succ_le_imp_le: "succ(i) \<le> succ(j) \<Longrightarrow> i \<le> j"
 by (blast dest!: succ_leE)
 
 lemma lt_subset_trans: "\<lbrakk>i \<subseteq> j;  j<k;  Ord(i)\<rbrakk> \<Longrightarrow> i<k"
 apply (rule subset_imp_le [THEN lt_trans1])
 apply (blast intro: elim: ltE) +
 done
 
 lemma lt_imp_0_lt: "j<i \<Longrightarrow> 0<i"
 by (blast intro: lt_trans1 Ord_0_le [OF lt_Ord])
 
 lemma succ_lt_iff: "succ(i) < j <-> i<j \<and> succ(i) \<noteq> j"
 apply auto
 apply (blast intro: lt_trans le_refl dest: lt_Ord)
 apply (frule lt_Ord)
 apply (rule not_le_iff_lt [THEN iffD1])
   apply (blast intro: lt_Ord2)
  apply blast
 apply (simp add: lt_Ord lt_Ord2 le_iff)
 apply (blast dest: lt_asym)
 done
 
 lemma Ord_succ_mem_iff: "Ord(j) \<Longrightarrow> succ(i) \<in> succ(j) <-> i\<in>j"
 apply (insert succ_le_iff [of i j])
 apply (simp add: lt_def)
 done
 
 subsubsection\<open>Union and Intersection\<close>
 
 lemma Un_upper1_le: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> i \<le> i \<union> j"
 by (rule Un_upper1 [THEN subset_imp_le], auto)
 
 lemma Un_upper2_le: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> j \<le> i \<union> j"
 by (rule Un_upper2 [THEN subset_imp_le], auto)
 
 (*Replacing k by succ(k') yields the similar rule for le!*)
 lemma Un_least_lt: "\<lbrakk>i<k;  j<k\<rbrakk> \<Longrightarrow> i \<union> j < k"
 apply (rule_tac i = i and j = j in Ord_linear_le)
 apply (auto simp add: Un_commute le_subset_iff subset_Un_iff lt_Ord)
 done
 
 lemma Un_least_lt_iff: "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> i \<union> j < k  <->  i<k \<and> j<k"
 apply (safe intro!: Un_least_lt)
 apply (rule_tac [2] Un_upper2_le [THEN lt_trans1])
 apply (rule Un_upper1_le [THEN lt_trans1], auto)
 done
 
 lemma Un_least_mem_iff:
     "\<lbrakk>Ord(i); Ord(j); Ord(k)\<rbrakk> \<Longrightarrow> i \<union> j \<in> k  <->  i\<in>k \<and> j\<in>k"
 apply (insert Un_least_lt_iff [of i j k])
 apply (simp add: lt_def)
 done
 
 (*Replacing k by succ(k') yields the similar rule for le!*)
 lemma Int_greatest_lt: "\<lbrakk>i<k;  j<k\<rbrakk> \<Longrightarrow> i \<inter> j < k"
 apply (rule_tac i = i and j = j in Ord_linear_le)
 apply (auto simp add: Int_commute le_subset_iff subset_Int_iff lt_Ord)
 done
 
 lemma Ord_Un_if:
      "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> i \<union> j = (if j<i then i else j)"
 by (simp add: not_lt_iff_le le_imp_subset leI
               subset_Un_iff [symmetric]  subset_Un_iff2 [symmetric])
 
 lemma succ_Un_distrib:
      "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> succ(i \<union> j) = succ(i) \<union> succ(j)"
 by (simp add: Ord_Un_if lt_Ord le_Ord2)
 
 lemma lt_Un_iff:
      "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> k < i \<union> j <-> k < i | k < j"
 apply (simp add: Ord_Un_if not_lt_iff_le)
 apply (blast intro: leI lt_trans2)+
 done
 
 lemma le_Un_iff:
      "\<lbrakk>Ord(i); Ord(j)\<rbrakk> \<Longrightarrow> k \<le> i \<union> j <-> k \<le> i | k \<le> j"
 by (simp add: succ_Un_distrib lt_Un_iff [symmetric])
 
 lemma Un_upper1_lt: "\<lbrakk>k < i; Ord(j)\<rbrakk> \<Longrightarrow> k < i \<union> j"
 by (simp add: lt_Un_iff lt_Ord2)
 
 lemma Un_upper2_lt: "\<lbrakk>k < j; Ord(i)\<rbrakk> \<Longrightarrow> k < i \<union> j"
 by (simp add: lt_Un_iff lt_Ord2)
 
 (*See also Transset_iff_Union_succ*)
 lemma Ord_Union_succ_eq: "Ord(i) \<Longrightarrow> \<Union>(succ(i)) = i"
 by (blast intro: Ord_trans)
 
 
 subsection\<open>Results about Limits\<close>
 
 lemma Ord_Union [intro,simp,TC]: "\<lbrakk>\<And>i. i\<in>A \<Longrightarrow> Ord(i)\<rbrakk> \<Longrightarrow> Ord(\<Union>(A))"
 apply (rule Ord_is_Transset [THEN Transset_Union_family, THEN OrdI])
 apply (blast intro: Ord_contains_Transset)+
 done
 
 lemma Ord_UN [intro,simp,TC]:
      "\<lbrakk>\<And>x. x\<in>A \<Longrightarrow> Ord(B(x))\<rbrakk> \<Longrightarrow> Ord(\<Union>x\<in>A. B(x))"
 by (rule Ord_Union, blast)
 
 lemma Ord_Inter [intro,simp,TC]:
     "\<lbrakk>\<And>i. i\<in>A \<Longrightarrow> Ord(i)\<rbrakk> \<Longrightarrow> Ord(\<Inter>(A))"
 apply (rule Transset_Inter_family [THEN OrdI])
 apply (blast intro: Ord_is_Transset)
 apply (simp add: Inter_def)
 apply (blast intro: Ord_contains_Transset)
 done
 
 lemma Ord_INT [intro,simp,TC]:
     "\<lbrakk>\<And>x. x\<in>A \<Longrightarrow> Ord(B(x))\<rbrakk> \<Longrightarrow> Ord(\<Inter>x\<in>A. B(x))"
 by (rule Ord_Inter, blast)
 
 
 (* No < version of this theorem: consider that @{term"(\<Union>i\<in>nat.i)=nat"}! *)
 lemma UN_least_le:
     "\<lbrakk>Ord(i);  \<And>x. x\<in>A \<Longrightarrow> b(x) \<le> i\<rbrakk> \<Longrightarrow> (\<Union>x\<in>A. b(x)) \<le> i"
 apply (rule le_imp_subset [THEN UN_least, THEN subset_imp_le])
 apply (blast intro: Ord_UN elim: ltE)+
 done
 
 lemma UN_succ_least_lt:
     "\<lbrakk>j<i;  \<And>x. x\<in>A \<Longrightarrow> b(x)<j\<rbrakk> \<Longrightarrow> (\<Union>x\<in>A. succ(b(x))) < i"
 apply (rule ltE, assumption)
 apply (rule UN_least_le [THEN lt_trans2])
 apply (blast intro: succ_leI)+
 done
 
 lemma UN_upper_lt:
      "\<lbrakk>a\<in>A;  i < b(a);  Ord(\<Union>x\<in>A. b(x))\<rbrakk> \<Longrightarrow> i < (\<Union>x\<in>A. b(x))"
 by (unfold lt_def, blast)
 
 lemma UN_upper_le:
      "\<lbrakk>a \<in> A;  i \<le> b(a);  Ord(\<Union>x\<in>A. b(x))\<rbrakk> \<Longrightarrow> i \<le> (\<Union>x\<in>A. b(x))"
 apply (frule ltD)
 apply (rule le_imp_subset [THEN subset_trans, THEN subset_imp_le])
 apply (blast intro: lt_Ord UN_upper)+
 done
 
 lemma lt_Union_iff: "\<forall>i\<in>A. Ord(i) \<Longrightarrow> (j < \<Union>(A)) <-> (\<exists>i\<in>A. j<i)"
 by (auto simp: lt_def Ord_Union)
 
 lemma Union_upper_le:
      "\<lbrakk>j \<in> J;  i\<le>j;  Ord(\<Union>(J))\<rbrakk> \<Longrightarrow> i \<le> \<Union>J"
 apply (subst Union_eq_UN)
 apply (rule UN_upper_le, auto)
 done
 
 lemma le_implies_UN_le_UN:
     "\<lbrakk>\<And>x. x\<in>A \<Longrightarrow> c(x) \<le> d(x)\<rbrakk> \<Longrightarrow> (\<Union>x\<in>A. c(x)) \<le> (\<Union>x\<in>A. d(x))"
 apply (rule UN_least_le)
 apply (rule_tac [2] UN_upper_le)
 apply (blast intro: Ord_UN le_Ord2)+
 done
 
 lemma Ord_equality: "Ord(i) \<Longrightarrow> (\<Union>y\<in>i. succ(y)) = i"
 by (blast intro: Ord_trans)
 
 (*Holds for all transitive sets, not just ordinals*)
 lemma Ord_Union_subset: "Ord(i) \<Longrightarrow> \<Union>(i) \<subseteq> i"
 by (blast intro: Ord_trans)
 
 
 subsection\<open>Limit Ordinals -- General Properties\<close>
 
 lemma Limit_Union_eq: "Limit(i) \<Longrightarrow> \<Union>(i) = i"
-apply (unfold Limit_def)
+  unfolding Limit_def
 apply (fast intro!: ltI elim!: ltE elim: Ord_trans)
 done
 
 lemma Limit_is_Ord: "Limit(i) \<Longrightarrow> Ord(i)"
-apply (unfold Limit_def)
+  unfolding Limit_def
 apply (erule conjunct1)
 done
 
 lemma Limit_has_0: "Limit(i) \<Longrightarrow> 0 < i"
-apply (unfold Limit_def)
+  unfolding Limit_def
 apply (erule conjunct2 [THEN conjunct1])
 done
 
 lemma Limit_nonzero: "Limit(i) \<Longrightarrow> i \<noteq> 0"
 by (drule Limit_has_0, blast)
 
 lemma Limit_has_succ: "\<lbrakk>Limit(i);  j<i\<rbrakk> \<Longrightarrow> succ(j) < i"
 by (unfold Limit_def, blast)
 
 lemma Limit_succ_lt_iff [simp]: "Limit(i) \<Longrightarrow> succ(j) < i <-> (j<i)"
 apply (safe intro!: Limit_has_succ)
 apply (frule lt_Ord)
 apply (blast intro: lt_trans)
 done
 
 lemma zero_not_Limit [iff]: "\<not> Limit(0)"
 by (simp add: Limit_def)
 
 lemma Limit_has_1: "Limit(i) \<Longrightarrow> 1 < i"
 by (blast intro: Limit_has_0 Limit_has_succ)
 
 lemma increasing_LimitI: "\<lbrakk>0<l; \<forall>x\<in>l. \<exists>y\<in>l. x<y\<rbrakk> \<Longrightarrow> Limit(l)"
 apply (unfold Limit_def, simp add: lt_Ord2, clarify)
 apply (drule_tac i=y in ltD)
 apply (blast intro: lt_trans1 [OF _ ltI] lt_Ord2)
 done
 
 lemma non_succ_LimitI:
   assumes i: "0<i" and nsucc: "\<And>y. succ(y) \<noteq> i"
   shows "Limit(i)"
 proof -
   have Oi: "Ord(i)" using i by (simp add: lt_def)
   { fix y
     assume yi: "y<i"
     hence Osy: "Ord(succ(y))" by (simp add: lt_Ord Ord_succ)
     have "\<not> i \<le> y" using yi by (blast dest: le_imp_not_lt)
     hence "succ(y) < i" using nsucc [of y]
       by (blast intro: Ord_linear_lt [OF Osy Oi]) }
   thus ?thesis using i Oi by (auto simp add: Limit_def)
 qed
 
 lemma succ_LimitE [elim!]: "Limit(succ(i)) \<Longrightarrow> P"
 apply (rule lt_irrefl)
 apply (rule Limit_has_succ, assumption)
 apply (erule Limit_is_Ord [THEN Ord_succD, THEN le_refl])
 done
 
 lemma not_succ_Limit [simp]: "\<not> Limit(succ(i))"
 by blast
 
 lemma Limit_le_succD: "\<lbrakk>Limit(i);  i \<le> succ(j)\<rbrakk> \<Longrightarrow> i \<le> j"
 by (blast elim!: leE)
 
 
 subsubsection\<open>Traditional 3-Way Case Analysis on Ordinals\<close>
 
 lemma Ord_cases_disj: "Ord(i) \<Longrightarrow> i=0 | (\<exists>j. Ord(j) \<and> i=succ(j)) | Limit(i)"
 by (blast intro!: non_succ_LimitI Ord_0_lt)
 
 lemma Ord_cases:
  assumes i: "Ord(i)"
  obtains ("0") "i=0" | (succ) j where "Ord(j)" "i=succ(j)" | (limit) "Limit(i)"
 by (insert Ord_cases_disj [OF i], auto)
 
 lemma trans_induct3_raw:
      "\<lbrakk>Ord(i);
          P(0);
          \<And>x. \<lbrakk>Ord(x);  P(x)\<rbrakk> \<Longrightarrow> P(succ(x));
          \<And>x. \<lbrakk>Limit(x);  \<forall>y\<in>x. P(y)\<rbrakk> \<Longrightarrow> P(x)
 \<rbrakk> \<Longrightarrow> P(i)"
 apply (erule trans_induct)
 apply (erule Ord_cases, blast+)
 done
 
 lemma trans_induct3 [case_names 0 succ limit, consumes 1]:
   "Ord(i) \<Longrightarrow> P(0) \<Longrightarrow> (\<And>x. Ord(x) \<Longrightarrow> P(x) \<Longrightarrow> P(succ(x))) \<Longrightarrow> (\<And>x. Limit(x) \<Longrightarrow> (\<And>y. y \<in> x \<Longrightarrow> P(y)) \<Longrightarrow> P(x)) \<Longrightarrow> P(i)"
   using trans_induct3_raw [of i P] by simp
 
 text\<open>A set of ordinals is either empty, contains its own union, or its
 union is a limit ordinal.\<close>
 
 lemma Union_le: "\<lbrakk>\<And>x. x\<in>I \<Longrightarrow> x\<le>j; Ord(j)\<rbrakk> \<Longrightarrow> \<Union>(I) \<le> j"
   by (auto simp add: le_subset_iff Union_least)
 
 lemma Ord_set_cases:
   assumes I: "\<forall>i\<in>I. Ord(i)"
   shows "I=0 \<or> \<Union>(I) \<in> I \<or> (\<Union>(I) \<notin> I \<and> Limit(\<Union>(I)))"
 proof (cases "\<Union>(I)" rule: Ord_cases)
   show "Ord(\<Union>I)" using I by (blast intro: Ord_Union)
 next
   assume "\<Union>I = 0" thus ?thesis by (simp, blast intro: subst_elem)
 next
   fix j
   assume j: "Ord(j)" and UIj:"\<Union>(I) = succ(j)"
   { assume "\<forall>i\<in>I. i\<le>j"
     hence "\<Union>(I) \<le> j"
       by (simp add: Union_le j)
     hence False
       by (simp add: UIj lt_not_refl) }
   then obtain i where i: "i \<in> I" "succ(j) \<le> i" using I j
     by (atomize, auto simp add: not_le_iff_lt)
   have "\<Union>(I) \<le> succ(j)" using UIj j by auto
   hence "i \<le> succ(j)" using i
     by (simp add: le_subset_iff Union_subset_iff)
   hence "succ(j) = i" using i
     by (blast intro: le_anti_sym)
   hence "succ(j) \<in> I" by (simp add: i)
   thus ?thesis by (simp add: UIj)
 next
   assume "Limit(\<Union>I)" thus ?thesis by auto
 qed
 
 text\<open>If the union of a set of ordinals is a successor, then it is an element of that set.\<close>
 lemma Ord_Union_eq_succD: "\<lbrakk>\<forall>x\<in>X. Ord(x);  \<Union>X = succ(j)\<rbrakk> \<Longrightarrow> succ(j) \<in> X"
   by (drule Ord_set_cases, auto)
 
 lemma Limit_Union [rule_format]: "\<lbrakk>I \<noteq> 0;  (\<And>i. i\<in>I \<Longrightarrow> Limit(i))\<rbrakk> \<Longrightarrow> Limit(\<Union>I)"
 apply (simp add: Limit_def lt_def)
 apply (blast intro!: equalityI)
 done
 
 end
diff --git a/src/ZF/Perm.thy b/src/ZF/Perm.thy
--- a/src/ZF/Perm.thy
+++ b/src/ZF/Perm.thy
@@ -1,554 +1,554 @@
 (*  Title:      ZF/Perm.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1991  University of Cambridge
 
 The theory underlying permutation groups
   -- Composition of relations, the identity relation
   -- Injections, surjections, bijections
   -- Lemmas for the Schroeder-Bernstein Theorem
 *)
 
 section\<open>Injections, Surjections, Bijections, Composition\<close>
 
 theory Perm imports func begin
 
 definition
   (*composition of relations and functions; NOT Suppes's relative product*)
   comp     :: "[i,i]\<Rightarrow>i"      (infixr \<open>O\<close> 60)  where
     "r O s \<equiv> {xz \<in> domain(s)*range(r) .
                \<exists>x y z. xz=\<langle>x,z\<rangle> \<and> \<langle>x,y\<rangle>:s \<and> \<langle>y,z\<rangle>:r}"
 
 definition
   (*the identity function for A*)
   id    :: "i\<Rightarrow>i"  where
     "id(A) \<equiv> (\<lambda>x\<in>A. x)"
 
 definition
   (*one-to-one functions from A to B*)
   inj   :: "[i,i]\<Rightarrow>i"  where
     "inj(A,B) \<equiv> { f \<in> A->B. \<forall>w\<in>A. \<forall>x\<in>A. f`w=f`x \<longrightarrow> w=x}"
 
 definition
   (*onto functions from A to B*)
   surj  :: "[i,i]\<Rightarrow>i"  where
     "surj(A,B) \<equiv> { f \<in> A->B . \<forall>y\<in>B. \<exists>x\<in>A. f`x=y}"
 
 definition
   (*one-to-one and onto functions*)
   bij   :: "[i,i]\<Rightarrow>i"  where
     "bij(A,B) \<equiv> inj(A,B) \<inter> surj(A,B)"
 
 
 subsection\<open>Surjective Function Space\<close>
 
 lemma surj_is_fun: "f \<in> surj(A,B) \<Longrightarrow> f \<in> A->B"
-apply (unfold surj_def)
+  unfolding surj_def
 apply (erule CollectD1)
 done
 
 lemma fun_is_surj: "f \<in> Pi(A,B) \<Longrightarrow> f \<in> surj(A,range(f))"
-apply (unfold surj_def)
+  unfolding surj_def
 apply (blast intro: apply_equality range_of_fun domain_type)
 done
 
 lemma surj_range: "f \<in> surj(A,B) \<Longrightarrow> range(f)=B"
-apply (unfold surj_def)
+  unfolding surj_def
 apply (best intro: apply_Pair elim: range_type)
 done
 
 text\<open>A function with a right inverse is a surjection\<close>
 
 lemma f_imp_surjective:
     "\<lbrakk>f \<in> A->B;  \<And>y. y \<in> B \<Longrightarrow> d(y): A;  \<And>y. y \<in> B \<Longrightarrow> f`d(y) = y\<rbrakk>
      \<Longrightarrow> f \<in> surj(A,B)"
   by (simp add: surj_def, blast)
 
 lemma lam_surjective:
     "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> c(x): B;
         \<And>y. y \<in> B \<Longrightarrow> d(y): A;
         \<And>y. y \<in> B \<Longrightarrow> c(d(y)) = y
 \<rbrakk> \<Longrightarrow> (\<lambda>x\<in>A. c(x)) \<in> surj(A,B)"
 apply (rule_tac d = d in f_imp_surjective)
 apply (simp_all add: lam_type)
 done
 
 text\<open>Cantor's theorem revisited\<close>
 lemma cantor_surj: "f \<notin> surj(A,Pow(A))"
 apply (unfold surj_def, safe)
 apply (cut_tac cantor)
 apply (best del: subsetI)
 done
 
 
 subsection\<open>Injective Function Space\<close>
 
 lemma inj_is_fun: "f \<in> inj(A,B) \<Longrightarrow> f \<in> A->B"
-apply (unfold inj_def)
+  unfolding inj_def
 apply (erule CollectD1)
 done
 
 text\<open>Good for dealing with sets of pairs, but a bit ugly in use [used in AC]\<close>
 lemma inj_equality:
     "\<lbrakk>\<langle>a,b\<rangle>:f;  \<langle>c,b\<rangle>:f;  f \<in> inj(A,B)\<rbrakk> \<Longrightarrow> a=c"
-apply (unfold inj_def)
+  unfolding inj_def
 apply (blast dest: Pair_mem_PiD)
 done
 
 lemma inj_apply_equality: "\<lbrakk>f \<in> inj(A,B);  f`a=f`b;  a \<in> A;  b \<in> A\<rbrakk> \<Longrightarrow> a=b"
 by (unfold inj_def, blast)
 
 text\<open>A function with a left inverse is an injection\<close>
 
 lemma f_imp_injective: "\<lbrakk>f \<in> A->B;  \<forall>x\<in>A. d(f`x)=x\<rbrakk> \<Longrightarrow> f \<in> inj(A,B)"
 apply (simp (no_asm_simp) add: inj_def)
 apply (blast intro: subst_context [THEN box_equals])
 done
 
 lemma lam_injective:
     "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> c(x): B;
         \<And>x. x \<in> A \<Longrightarrow> d(c(x)) = x\<rbrakk>
      \<Longrightarrow> (\<lambda>x\<in>A. c(x)) \<in> inj(A,B)"
 apply (rule_tac d = d in f_imp_injective)
 apply (simp_all add: lam_type)
 done
 
 subsection\<open>Bijections\<close>
 
 lemma bij_is_inj: "f \<in> bij(A,B) \<Longrightarrow> f \<in> inj(A,B)"
-apply (unfold bij_def)
+  unfolding bij_def
 apply (erule IntD1)
 done
 
 lemma bij_is_surj: "f \<in> bij(A,B) \<Longrightarrow> f \<in> surj(A,B)"
-apply (unfold bij_def)
+  unfolding bij_def
 apply (erule IntD2)
 done
 
 lemma bij_is_fun: "f \<in> bij(A,B) \<Longrightarrow> f \<in> A->B"
   by (rule bij_is_inj [THEN inj_is_fun])
 
 lemma lam_bijective:
     "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> c(x): B;
         \<And>y. y \<in> B \<Longrightarrow> d(y): A;
         \<And>x. x \<in> A \<Longrightarrow> d(c(x)) = x;
         \<And>y. y \<in> B \<Longrightarrow> c(d(y)) = y
 \<rbrakk> \<Longrightarrow> (\<lambda>x\<in>A. c(x)) \<in> bij(A,B)"
-apply (unfold bij_def)
+  unfolding bij_def
 apply (blast intro!: lam_injective lam_surjective)
 done
 
 lemma RepFun_bijective: "(\<forall>y\<in>x. \<exists>!y'. f(y') = f(y))
       \<Longrightarrow> (\<lambda>z\<in>{f(y). y \<in> x}. THE y. f(y) = z) \<in> bij({f(y). y \<in> x}, x)"
 apply (rule_tac d = f in lam_bijective)
 apply (auto simp add: the_equality2)
 done
 
 
 subsection\<open>Identity Function\<close>
 
 lemma idI [intro!]: "a \<in> A \<Longrightarrow> \<langle>a,a\<rangle> \<in> id(A)"
-apply (unfold id_def)
+  unfolding id_def
 apply (erule lamI)
 done
 
 lemma idE [elim!]: "\<lbrakk>p \<in> id(A);  \<And>x.\<lbrakk>x \<in> A; p=\<langle>x,x\<rangle>\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow>  P"
 by (simp add: id_def lam_def, blast)
 
 lemma id_type: "id(A) \<in> A->A"
-apply (unfold id_def)
+  unfolding id_def
 apply (rule lam_type, assumption)
 done
 
 lemma id_conv [simp]: "x \<in> A \<Longrightarrow> id(A)`x = x"
-apply (unfold id_def)
+  unfolding id_def
 apply (simp (no_asm_simp))
 done
 
 lemma id_mono: "A<=B \<Longrightarrow> id(A) \<subseteq> id(B)"
-apply (unfold id_def)
+  unfolding id_def
 apply (erule lam_mono)
 done
 
 lemma id_subset_inj: "A<=B \<Longrightarrow> id(A): inj(A,B)"
 apply (simp add: inj_def id_def)
 apply (blast intro: lam_type)
 done
 
 lemmas id_inj = subset_refl [THEN id_subset_inj]
 
 lemma id_surj: "id(A): surj(A,A)"
 apply (unfold id_def surj_def)
 apply (simp (no_asm_simp))
 done
 
 lemma id_bij: "id(A): bij(A,A)"
-apply (unfold bij_def)
+  unfolding bij_def
 apply (blast intro: id_inj id_surj)
 done
 
 lemma subset_iff_id: "A \<subseteq> B \<longleftrightarrow> id(A) \<in> A->B"
-apply (unfold id_def)
+  unfolding id_def
 apply (force intro!: lam_type dest: apply_type)
 done
 
 text\<open>\<^term>\<open>id\<close> as the identity relation\<close>
 lemma id_iff [simp]: "\<langle>x,y\<rangle> \<in> id(A) \<longleftrightarrow> x=y \<and> y \<in> A"
 by auto
 
 
 subsection\<open>Converse of a Function\<close>
 
 lemma inj_converse_fun: "f \<in> inj(A,B) \<Longrightarrow> converse(f) \<in> range(f)->A"
-apply (unfold inj_def)
+  unfolding inj_def
 apply (simp (no_asm_simp) add: Pi_iff function_def)
 apply (erule CollectE)
 apply (simp (no_asm_simp) add: apply_iff)
 apply (blast dest: fun_is_rel)
 done
 
 text\<open>Equations for converse(f)\<close>
 
 text\<open>The premises are equivalent to saying that f is injective...\<close>
 lemma left_inverse_lemma:
      "\<lbrakk>f \<in> A->B;  converse(f): C->A;  a \<in> A\<rbrakk> \<Longrightarrow> converse(f)`(f`a) = a"
 by (blast intro: apply_Pair apply_equality converseI)
 
 lemma left_inverse [simp]: "\<lbrakk>f \<in> inj(A,B);  a \<in> A\<rbrakk> \<Longrightarrow> converse(f)`(f`a) = a"
 by (blast intro: left_inverse_lemma inj_converse_fun inj_is_fun)
 
 lemma left_inverse_eq:
      "\<lbrakk>f \<in> inj(A,B); f ` x = y; x \<in> A\<rbrakk> \<Longrightarrow> converse(f) ` y = x"
 by auto
 
 lemmas left_inverse_bij = bij_is_inj [THEN left_inverse]
 
 lemma right_inverse_lemma:
      "\<lbrakk>f \<in> A->B;  converse(f): C->A;  b \<in> C\<rbrakk> \<Longrightarrow> f`(converse(f)`b) = b"
 by (rule apply_Pair [THEN converseD [THEN apply_equality]], auto)
 
 (*Should the premises be f \<in> surj(A,B), b \<in> B for symmetry with left_inverse?
   No: they would not imply that converse(f) was a function! *)
 lemma right_inverse [simp]:
      "\<lbrakk>f \<in> inj(A,B);  b \<in> range(f)\<rbrakk> \<Longrightarrow> f`(converse(f)`b) = b"
 by (blast intro: right_inverse_lemma inj_converse_fun inj_is_fun)
 
 lemma right_inverse_bij: "\<lbrakk>f \<in> bij(A,B);  b \<in> B\<rbrakk> \<Longrightarrow> f`(converse(f)`b) = b"
 by (force simp add: bij_def surj_range)
 
 subsection\<open>Converses of Injections, Surjections, Bijections\<close>
 
 lemma inj_converse_inj: "f \<in> inj(A,B) \<Longrightarrow> converse(f): inj(range(f), A)"
 apply (rule f_imp_injective)
 apply (erule inj_converse_fun, clarify)
 apply (rule right_inverse)
  apply assumption
 apply blast
 done
 
 lemma inj_converse_surj: "f \<in> inj(A,B) \<Longrightarrow> converse(f): surj(range(f), A)"
 by (blast intro: f_imp_surjective inj_converse_fun left_inverse inj_is_fun
                  range_of_fun [THEN apply_type])
 
 text\<open>Adding this as an intro! rule seems to cause looping\<close>
 lemma bij_converse_bij [TC]: "f \<in> bij(A,B) \<Longrightarrow> converse(f): bij(B,A)"
-apply (unfold bij_def)
+  unfolding bij_def
 apply (fast elim: surj_range [THEN subst] inj_converse_inj inj_converse_surj)
 done
 
 
 
 subsection\<open>Composition of Two Relations\<close>
 
 text\<open>The inductive definition package could derive these theorems for \<^term>\<open>r O s\<close>\<close>
 
 lemma compI [intro]: "\<lbrakk>\<langle>a,b\<rangle>:s; \<langle>b,c\<rangle>:r\<rbrakk> \<Longrightarrow> \<langle>a,c\<rangle> \<in> r O s"
 by (unfold comp_def, blast)
 
 lemma compE [elim!]:
     "\<lbrakk>xz \<in> r O s;
         \<And>x y z. \<lbrakk>xz=\<langle>x,z\<rangle>;  \<langle>x,y\<rangle>:s;  \<langle>y,z\<rangle>:r\<rbrakk> \<Longrightarrow> P\<rbrakk>
      \<Longrightarrow> P"
 by (unfold comp_def, blast)
 
 lemma compEpair:
     "\<lbrakk>\<langle>a,c\<rangle> \<in> r O s;
         \<And>y. \<lbrakk>\<langle>a,y\<rangle>:s;  \<langle>y,c\<rangle>:r\<rbrakk> \<Longrightarrow> P\<rbrakk>
      \<Longrightarrow> P"
 by (erule compE, simp)
 
 lemma converse_comp: "converse(R O S) = converse(S) O converse(R)"
 by blast
 
 
 subsection\<open>Domain and Range -- see Suppes, Section 3.1\<close>
 
 text\<open>Boyer et al., Set Theory in First-Order Logic, JAR 2 (1986), 287-327\<close>
 lemma range_comp: "range(r O s) \<subseteq> range(r)"
 by blast
 
 lemma range_comp_eq: "domain(r) \<subseteq> range(s) \<Longrightarrow> range(r O s) = range(r)"
 by (rule range_comp [THEN equalityI], blast)
 
 lemma domain_comp: "domain(r O s) \<subseteq> domain(s)"
 by blast
 
 lemma domain_comp_eq: "range(s) \<subseteq> domain(r) \<Longrightarrow> domain(r O s) = domain(s)"
 by (rule domain_comp [THEN equalityI], blast)
 
 lemma image_comp: "(r O s)``A = r``(s``A)"
 by blast
 
 lemma inj_inj_range: "f \<in> inj(A,B) \<Longrightarrow> f \<in> inj(A,range(f))"
   by (auto simp add: inj_def Pi_iff function_def)
 
 lemma inj_bij_range: "f \<in> inj(A,B) \<Longrightarrow> f \<in> bij(A,range(f))"
   by (auto simp add: bij_def intro: inj_inj_range inj_is_fun fun_is_surj)
 
 
 subsection\<open>Other Results\<close>
 
 lemma comp_mono: "\<lbrakk>r'<=r; s'<=s\<rbrakk> \<Longrightarrow> (r' O s') \<subseteq> (r O s)"
 by blast
 
 text\<open>composition preserves relations\<close>
 lemma comp_rel: "\<lbrakk>s<=A*B;  r<=B*C\<rbrakk> \<Longrightarrow> (r O s) \<subseteq> A*C"
 by blast
 
 text\<open>associative law for composition\<close>
 lemma comp_assoc: "(r O s) O t = r O (s O t)"
 by blast
 
 (*left identity of composition; provable inclusions are
         id(A) O r \<subseteq> r
   and   \<lbrakk>r<=A*B; B<=C\<rbrakk> \<Longrightarrow> r \<subseteq> id(C) O r *)
 lemma left_comp_id: "r<=A*B \<Longrightarrow> id(B) O r = r"
 by blast
 
 (*right identity of composition; provable inclusions are
         r O id(A) \<subseteq> r
   and   \<lbrakk>r<=A*B; A<=C\<rbrakk> \<Longrightarrow> r \<subseteq> r O id(C) *)
 lemma right_comp_id: "r<=A*B \<Longrightarrow> r O id(A) = r"
 by blast
 
 
 subsection\<open>Composition Preserves Functions, Injections, and Surjections\<close>
 
 lemma comp_function: "\<lbrakk>function(g);  function(f)\<rbrakk> \<Longrightarrow> function(f O g)"
 by (unfold function_def, blast)
 
 text\<open>Don't think the premises can be weakened much\<close>
 lemma comp_fun: "\<lbrakk>g \<in> A->B;  f \<in> B->C\<rbrakk> \<Longrightarrow> (f O g) \<in> A->C"
 apply (auto simp add: Pi_def comp_function Pow_iff comp_rel)
 apply (subst range_rel_subset [THEN domain_comp_eq], auto)
 done
 
 (*Thanks to the new definition of "apply", the premise f \<in> B->C is gone!*)
 lemma comp_fun_apply [simp]:
      "\<lbrakk>g \<in> A->B;  a \<in> A\<rbrakk> \<Longrightarrow> (f O g)`a = f`(g`a)"
 apply (frule apply_Pair, assumption)
 apply (simp add: apply_def image_comp)
 apply (blast dest: apply_equality)
 done
 
 text\<open>Simplifies compositions of lambda-abstractions\<close>
 lemma comp_lam:
     "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> b(x): B\<rbrakk>
      \<Longrightarrow> (\<lambda>y\<in>B. c(y)) O (\<lambda>x\<in>A. b(x)) = (\<lambda>x\<in>A. c(b(x)))"
 apply (subgoal_tac "(\<lambda>x\<in>A. b(x)) \<in> A -> B")
  apply (rule fun_extension)
    apply (blast intro: comp_fun lam_funtype)
   apply (rule lam_funtype)
  apply simp
 apply (simp add: lam_type)
 done
 
 lemma comp_inj:
      "\<lbrakk>g \<in> inj(A,B);  f \<in> inj(B,C)\<rbrakk> \<Longrightarrow> (f O g) \<in> inj(A,C)"
 apply (frule inj_is_fun [of g])
 apply (frule inj_is_fun [of f])
 apply (rule_tac d = "\<lambda>y. converse (g) ` (converse (f) ` y)" in f_imp_injective)
  apply (blast intro: comp_fun, simp)
 done
 
 lemma comp_surj:
     "\<lbrakk>g \<in> surj(A,B);  f \<in> surj(B,C)\<rbrakk> \<Longrightarrow> (f O g) \<in> surj(A,C)"
-apply (unfold surj_def)
+  unfolding surj_def
 apply (blast intro!: comp_fun comp_fun_apply)
 done
 
 lemma comp_bij:
     "\<lbrakk>g \<in> bij(A,B);  f \<in> bij(B,C)\<rbrakk> \<Longrightarrow> (f O g) \<in> bij(A,C)"
-apply (unfold bij_def)
+  unfolding bij_def
 apply (blast intro: comp_inj comp_surj)
 done
 
 
 subsection\<open>Dual Properties of \<^term>\<open>inj\<close> and \<^term>\<open>surj\<close>\<close>
 
 text\<open>Useful for proofs from
     D Pastre.  Automatic theorem proving in set theory.
     Artificial Intelligence, 10:1--27, 1978.\<close>
 
 lemma comp_mem_injD1:
     "\<lbrakk>(f O g): inj(A,C);  g \<in> A->B;  f \<in> B->C\<rbrakk> \<Longrightarrow> g \<in> inj(A,B)"
 by (unfold inj_def, force)
 
 lemma comp_mem_injD2:
     "\<lbrakk>(f O g): inj(A,C);  g \<in> surj(A,B);  f \<in> B->C\<rbrakk> \<Longrightarrow> f \<in> inj(B,C)"
 apply (unfold inj_def surj_def, safe)
 apply (rule_tac x1 = x in bspec [THEN bexE])
 apply (erule_tac [3] x1 = w in bspec [THEN bexE], assumption+, safe)
 apply (rule_tac t = "(`) (g) " in subst_context)
 apply (erule asm_rl bspec [THEN bspec, THEN mp])+
 apply (simp (no_asm_simp))
 done
 
 lemma comp_mem_surjD1:
     "\<lbrakk>(f O g): surj(A,C);  g \<in> A->B;  f \<in> B->C\<rbrakk> \<Longrightarrow> f \<in> surj(B,C)"
-apply (unfold surj_def)
+  unfolding surj_def
 apply (blast intro!: comp_fun_apply [symmetric] apply_funtype)
 done
 
 
 lemma comp_mem_surjD2:
     "\<lbrakk>(f O g): surj(A,C);  g \<in> A->B;  f \<in> inj(B,C)\<rbrakk> \<Longrightarrow> g \<in> surj(A,B)"
 apply (unfold inj_def surj_def, safe)
 apply (drule_tac x = "f`y" in bspec, auto)
 apply (blast intro: apply_funtype)
 done
 
 subsubsection\<open>Inverses of Composition\<close>
 
 text\<open>left inverse of composition; one inclusion is
         \<^term>\<open>f \<in> A->B \<Longrightarrow> id(A) \<subseteq> converse(f) O f\<close>\<close>
 lemma left_comp_inverse: "f \<in> inj(A,B) \<Longrightarrow> converse(f) O f = id(A)"
 apply (unfold inj_def, clarify)
 apply (rule equalityI)
  apply (auto simp add: apply_iff, blast)
 done
 
 text\<open>right inverse of composition; one inclusion is
                 \<^term>\<open>f \<in> A->B \<Longrightarrow> f O converse(f) \<subseteq> id(B)\<close>\<close>
 lemma right_comp_inverse:
     "f \<in> surj(A,B) \<Longrightarrow> f O converse(f) = id(B)"
 apply (simp add: surj_def, clarify)
 apply (rule equalityI)
 apply (best elim: domain_type range_type dest: apply_equality2)
 apply (blast intro: apply_Pair)
 done
 
 
 subsubsection\<open>Proving that a Function is a Bijection\<close>
 
 lemma comp_eq_id_iff:
     "\<lbrakk>f \<in> A->B;  g \<in> B->A\<rbrakk> \<Longrightarrow> f O g = id(B) \<longleftrightarrow> (\<forall>y\<in>B. f`(g`y)=y)"
 apply (unfold id_def, safe)
  apply (drule_tac t = "\<lambda>h. h`y " in subst_context)
  apply simp
 apply (rule fun_extension)
   apply (blast intro: comp_fun lam_type)
  apply auto
 done
 
 lemma fg_imp_bijective:
     "\<lbrakk>f \<in> A->B;  g \<in> B->A;  f O g = id(B);  g O f = id(A)\<rbrakk> \<Longrightarrow> f \<in> bij(A,B)"
-apply (unfold bij_def)
+  unfolding bij_def
 apply (simp add: comp_eq_id_iff)
 apply (blast intro: f_imp_injective f_imp_surjective apply_funtype)
 done
 
 lemma nilpotent_imp_bijective: "\<lbrakk>f \<in> A->A;  f O f = id(A)\<rbrakk> \<Longrightarrow> f \<in> bij(A,A)"
 by (blast intro: fg_imp_bijective)
 
 lemma invertible_imp_bijective:
      "\<lbrakk>converse(f): B->A;  f \<in> A->B\<rbrakk> \<Longrightarrow> f \<in> bij(A,B)"
 by (simp add: fg_imp_bijective comp_eq_id_iff
               left_inverse_lemma right_inverse_lemma)
 
 subsubsection\<open>Unions of Functions\<close>
 
 text\<open>See similar theorems in func.thy\<close>
 
 text\<open>Theorem by KG, proof by LCP\<close>
 lemma inj_disjoint_Un:
      "\<lbrakk>f \<in> inj(A,B);  g \<in> inj(C,D);  B \<inter> D = 0\<rbrakk>
       \<Longrightarrow> (\<lambda>a\<in>A \<union> C. if a \<in> A then f`a else g`a) \<in> inj(A \<union> C, B \<union> D)"
 apply (rule_tac d = "\<lambda>z. if z \<in> B then converse (f) `z else converse (g) `z"
        in lam_injective)
 apply (auto simp add: inj_is_fun [THEN apply_type])
 done
 
 lemma surj_disjoint_Un:
     "\<lbrakk>f \<in> surj(A,B);  g \<in> surj(C,D);  A \<inter> C = 0\<rbrakk>
      \<Longrightarrow> (f \<union> g) \<in> surj(A \<union> C, B \<union> D)"
 apply (simp add: surj_def fun_disjoint_Un)
 apply (blast dest!: domain_of_fun
              intro!: fun_disjoint_apply1 fun_disjoint_apply2)
 done
 
 text\<open>A simple, high-level proof; the version for injections follows from it,
   using  \<^term>\<open>f \<in> inj(A,B) \<longleftrightarrow> f \<in> bij(A,range(f))\<close>\<close>
 lemma bij_disjoint_Un:
      "\<lbrakk>f \<in> bij(A,B);  g \<in> bij(C,D);  A \<inter> C = 0;  B \<inter> D = 0\<rbrakk>
       \<Longrightarrow> (f \<union> g) \<in> bij(A \<union> C, B \<union> D)"
 apply (rule invertible_imp_bijective)
 apply (subst converse_Un)
 apply (auto intro: fun_disjoint_Un bij_is_fun bij_converse_bij)
 done
 
 
 subsubsection\<open>Restrictions as Surjections and Bijections\<close>
 
 lemma surj_image:
     "f \<in> Pi(A,B) \<Longrightarrow> f \<in> surj(A, f``A)"
 apply (simp add: surj_def)
 apply (blast intro: apply_equality apply_Pair Pi_type)
 done
 
 lemma surj_image_eq: "f \<in> surj(A, B) \<Longrightarrow> f``A = B"
   by (auto simp add: surj_def image_fun) (blast dest: apply_type) 
 
 lemma restrict_image [simp]: "restrict(f,A) `` B = f `` (A \<inter> B)"
 by (auto simp add: restrict_def)
 
 lemma restrict_inj:
     "\<lbrakk>f \<in> inj(A,B);  C<=A\<rbrakk> \<Longrightarrow> restrict(f,C): inj(C,B)"
-apply (unfold inj_def)
+  unfolding inj_def
 apply (safe elim!: restrict_type2, auto)
 done
 
 lemma restrict_surj: "\<lbrakk>f \<in> Pi(A,B);  C<=A\<rbrakk> \<Longrightarrow> restrict(f,C): surj(C, f``C)"
 apply (insert restrict_type2 [THEN surj_image])
 apply (simp add: restrict_image)
 done
 
 lemma restrict_bij:
     "\<lbrakk>f \<in> inj(A,B);  C<=A\<rbrakk> \<Longrightarrow> restrict(f,C): bij(C, f``C)"
 apply (simp add: inj_def bij_def)
 apply (blast intro: restrict_surj surj_is_fun)
 done
 
 
 subsubsection\<open>Lemmas for Ramsey's Theorem\<close>
 
 lemma inj_weaken_type: "\<lbrakk>f \<in> inj(A,B);  B<=D\<rbrakk> \<Longrightarrow> f \<in> inj(A,D)"
-apply (unfold inj_def)
+  unfolding inj_def
 apply (blast intro: fun_weaken_type)
 done
 
 lemma inj_succ_restrict:
      "\<lbrakk>f \<in> inj(succ(m), A)\<rbrakk> \<Longrightarrow> restrict(f,m) \<in> inj(m, A-{f`m})"
 apply (rule restrict_bij [THEN bij_is_inj, THEN inj_weaken_type], assumption, blast)
-apply (unfold inj_def)
+  unfolding inj_def
 apply (fast elim: range_type mem_irrefl dest: apply_equality)
 done
 
 
 lemma inj_extend:
     "\<lbrakk>f \<in> inj(A,B);  a\<notin>A;  b\<notin>B\<rbrakk>
      \<Longrightarrow> cons(\<langle>a,b\<rangle>,f) \<in> inj(cons(a,A), cons(b,B))"
-apply (unfold inj_def)
+  unfolding inj_def
 apply (force intro: apply_type  simp add: fun_extend)
 done
 
 end
diff --git a/src/ZF/QUniv.thy b/src/ZF/QUniv.thy
--- a/src/ZF/QUniv.thy
+++ b/src/ZF/QUniv.thy
@@ -1,203 +1,203 @@
 (*  Title:      ZF/QUniv.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1993  University of Cambridge
 *)
 
 section\<open>A Small Universe for Lazy Recursive Types\<close>
 
 theory QUniv imports Univ QPair begin
 
 (*Disjoint sums as a datatype*)
 rep_datatype
   elimination   sumE
   induction     TrueI
   case_eqns     case_Inl case_Inr
 
 (*Variant disjoint sums as a datatype*)
 rep_datatype
   elimination   qsumE
   induction     TrueI
   case_eqns     qcase_QInl qcase_QInr
 
 definition
   quniv :: "i \<Rightarrow> i"  where
    "quniv(A) \<equiv> Pow(univ(eclose(A)))"
 
 
 subsection\<open>Properties involving Transset and Sum\<close>
 
 lemma Transset_includes_summands:
      "\<lbrakk>Transset(C); A+B \<subseteq> C\<rbrakk> \<Longrightarrow> A \<subseteq> C \<and> B \<subseteq> C"
 apply (simp add: sum_def Un_subset_iff)
 apply (blast dest: Transset_includes_range)
 done
 
 lemma Transset_sum_Int_subset:
      "Transset(C) \<Longrightarrow> (A+B) \<inter> C \<subseteq> (A \<inter> C) + (B \<inter> C)"
 apply (simp add: sum_def Int_Un_distrib2)
 apply (blast dest: Transset_Pair_D)
 done
 
 subsection\<open>Introduction and Elimination Rules\<close>
 
 lemma qunivI: "X \<subseteq> univ(eclose(A)) \<Longrightarrow> X \<in> quniv(A)"
 by (simp add: quniv_def)
 
 lemma qunivD: "X \<in> quniv(A) \<Longrightarrow> X \<subseteq> univ(eclose(A))"
 by (simp add: quniv_def)
 
 lemma quniv_mono: "A<=B \<Longrightarrow> quniv(A) \<subseteq> quniv(B)"
-apply (unfold quniv_def)
+  unfolding quniv_def
 apply (erule eclose_mono [THEN univ_mono, THEN Pow_mono])
 done
 
 subsection\<open>Closure Properties\<close>
 
 lemma univ_eclose_subset_quniv: "univ(eclose(A)) \<subseteq> quniv(A)"
 apply (simp add: quniv_def Transset_iff_Pow [symmetric])
 apply (rule Transset_eclose [THEN Transset_univ])
 done
 
 (*Key property for proving A_subset_quniv; requires eclose in definition of quniv*)
 lemma univ_subset_quniv: "univ(A) \<subseteq> quniv(A)"
 apply (rule arg_subset_eclose [THEN univ_mono, THEN subset_trans])
 apply (rule univ_eclose_subset_quniv)
 done
 
 lemmas univ_into_quniv = univ_subset_quniv [THEN subsetD]
 
 lemma Pow_univ_subset_quniv: "Pow(univ(A)) \<subseteq> quniv(A)"
-apply (unfold quniv_def)
+  unfolding quniv_def
 apply (rule arg_subset_eclose [THEN univ_mono, THEN Pow_mono])
 done
 
 lemmas univ_subset_into_quniv =
     PowI [THEN Pow_univ_subset_quniv [THEN subsetD]]
 
 lemmas zero_in_quniv = zero_in_univ [THEN univ_into_quniv]
 lemmas one_in_quniv = one_in_univ [THEN univ_into_quniv]
 lemmas two_in_quniv = two_in_univ [THEN univ_into_quniv]
 
 lemmas A_subset_quniv =  subset_trans [OF A_subset_univ univ_subset_quniv]
 
 lemmas A_into_quniv = A_subset_quniv [THEN subsetD]
 
 (*** univ(A) closure for Quine-inspired pairs and injections ***)
 
 (*Quine ordered pairs*)
 lemma QPair_subset_univ:
     "\<lbrakk>a \<subseteq> univ(A);  b \<subseteq> univ(A)\<rbrakk> \<Longrightarrow> <a;b> \<subseteq> univ(A)"
 by (simp add: QPair_def sum_subset_univ)
 
 subsection\<open>Quine Disjoint Sum\<close>
 
 lemma QInl_subset_univ: "a \<subseteq> univ(A) \<Longrightarrow> QInl(a) \<subseteq> univ(A)"
-apply (unfold QInl_def)
+  unfolding QInl_def
 apply (erule empty_subsetI [THEN QPair_subset_univ])
 done
 
 lemmas naturals_subset_nat =
     Ord_nat [THEN Ord_is_Transset, unfolded Transset_def, THEN bspec]
 
 lemmas naturals_subset_univ =
     subset_trans [OF naturals_subset_nat nat_subset_univ]
 
 lemma QInr_subset_univ: "a \<subseteq> univ(A) \<Longrightarrow> QInr(a) \<subseteq> univ(A)"
-apply (unfold QInr_def)
+  unfolding QInr_def
 apply (erule nat_1I [THEN naturals_subset_univ, THEN QPair_subset_univ])
 done
 
 subsection\<open>Closure for Quine-Inspired Products and Sums\<close>
 
 (*Quine ordered pairs*)
 lemma QPair_in_quniv:
     "\<lbrakk>a: quniv(A);  b: quniv(A)\<rbrakk> \<Longrightarrow> <a;b> \<in> quniv(A)"
 by (simp add: quniv_def QPair_def sum_subset_univ)
 
 lemma QSigma_quniv: "quniv(A) <*> quniv(A) \<subseteq> quniv(A)"
 by (blast intro: QPair_in_quniv)
 
 lemmas QSigma_subset_quniv =  subset_trans [OF QSigma_mono QSigma_quniv]
 
 (*The opposite inclusion*)
 lemma quniv_QPair_D:
     "<a;b> \<in> quniv(A) \<Longrightarrow> a: quniv(A) \<and> b: quniv(A)"
 apply (unfold quniv_def QPair_def)
 apply (rule Transset_includes_summands [THEN conjE])
 apply (rule Transset_eclose [THEN Transset_univ])
 apply (erule PowD, blast)
 done
 
 lemmas quniv_QPair_E = quniv_QPair_D [THEN conjE]
 
 lemma quniv_QPair_iff: "<a;b> \<in> quniv(A) \<longleftrightarrow> a: quniv(A) \<and> b: quniv(A)"
 by (blast intro: QPair_in_quniv dest: quniv_QPair_D)
 
 
 subsection\<open>Quine Disjoint Sum\<close>
 
 lemma QInl_in_quniv: "a: quniv(A) \<Longrightarrow> QInl(a) \<in> quniv(A)"
 by (simp add: QInl_def zero_in_quniv QPair_in_quniv)
 
 lemma QInr_in_quniv: "b: quniv(A) \<Longrightarrow> QInr(b) \<in> quniv(A)"
 by (simp add: QInr_def one_in_quniv QPair_in_quniv)
 
 lemma qsum_quniv: "quniv(C) <+> quniv(C) \<subseteq> quniv(C)"
 by (blast intro: QInl_in_quniv QInr_in_quniv)
 
 lemmas qsum_subset_quniv = subset_trans [OF qsum_mono qsum_quniv]
 
 
 subsection\<open>The Natural Numbers\<close>
 
 lemmas nat_subset_quniv =  subset_trans [OF nat_subset_univ univ_subset_quniv]
 
 (* n:nat \<Longrightarrow> n:quniv(A) *)
 lemmas nat_into_quniv = nat_subset_quniv [THEN subsetD]
 
 lemmas bool_subset_quniv = subset_trans [OF bool_subset_univ univ_subset_quniv]
 
 lemmas bool_into_quniv = bool_subset_quniv [THEN subsetD]
 
 
 (*Intersecting <a;b> with Vfrom...*)
 
 lemma QPair_Int_Vfrom_succ_subset:
  "Transset(X) \<Longrightarrow>
        <a;b> \<inter> Vfrom(X, succ(i))  \<subseteq>  <a \<inter> Vfrom(X,i);  b \<inter> Vfrom(X,i)>"
 by (simp add: QPair_def sum_def Int_Un_distrib2 Un_mono
               product_Int_Vfrom_subset [THEN subset_trans]
               Sigma_mono [OF Int_lower1 subset_refl])
 
 subsection\<open>"Take-Lemma" Rules\<close>
 
 (*for proving a=b by coinduction and c: quniv(A)*)
 
 (*Rule for level i -- preserving the level, not decreasing it*)
 
 lemma QPair_Int_Vfrom_subset:
  "Transset(X) \<Longrightarrow>
        <a;b> \<inter> Vfrom(X,i)  \<subseteq>  <a \<inter> Vfrom(X,i);  b \<inter> Vfrom(X,i)>"
-apply (unfold QPair_def)
+  unfolding QPair_def
 apply (erule Transset_Vfrom [THEN Transset_sum_Int_subset])
 done
 
 (*@{term"\<lbrakk>a \<inter> Vset(i) \<subseteq> c; b \<inter> Vset(i) \<subseteq> d\<rbrakk> \<Longrightarrow> <a;b> \<inter> Vset(i) \<subseteq> <c;d>"}*)
 lemmas QPair_Int_Vset_subset_trans =
      subset_trans [OF Transset_0 [THEN QPair_Int_Vfrom_subset] QPair_mono]
 
 lemma QPair_Int_Vset_subset_UN:
      "Ord(i) \<Longrightarrow> <a;b> \<inter> Vset(i) \<subseteq> (\<Union>j\<in>i. <a \<inter> Vset(j); b \<inter> Vset(j)>)"
 apply (erule Ord_cases)
 (*0 case*)
 apply (simp add: Vfrom_0)
 (*succ(j) case*)
 apply (erule ssubst)
 apply (rule Transset_0 [THEN QPair_Int_Vfrom_succ_subset, THEN subset_trans])
 apply (rule succI1 [THEN UN_upper])
 (*Limit(i) case*)
 apply (simp del: UN_simps
         add: Limit_Vfrom_eq Int_UN_distrib UN_mono QPair_Int_Vset_subset_trans)
 done
 
 end
diff --git a/src/ZF/Resid/Confluence.thy b/src/ZF/Resid/Confluence.thy
--- a/src/ZF/Resid/Confluence.thy
+++ b/src/ZF/Resid/Confluence.thy
@@ -1,118 +1,118 @@
 (*  Title:      ZF/Resid/Confluence.thy
     Author:     Ole Rasmussen
     Copyright   1995  University of Cambridge
 *)
 
 theory Confluence imports Reduction begin
 
 definition
   confluence    :: "i\<Rightarrow>o"  where
     "confluence(R) \<equiv>   
        \<forall>x y. \<langle>x,y\<rangle> \<in> R \<longrightarrow> (\<forall>z.\<langle>x,z\<rangle> \<in> R \<longrightarrow> (\<exists>u.\<langle>y,u\<rangle> \<in> R \<and> \<langle>z,u\<rangle> \<in> R))"
 
 definition
   strip         :: "o"  where
     "strip \<equiv> \<forall>x y. (x =\<Longrightarrow> y) \<longrightarrow> 
                     (\<forall>z.(x =1\<Rightarrow> z) \<longrightarrow> (\<exists>u.(y =1\<Rightarrow> u) \<and> (z=\<Longrightarrow>u)))" 
 
 
 (* ------------------------------------------------------------------------- *)
 (*        strip lemmas                                                       *)
 (* ------------------------------------------------------------------------- *)
 
 lemma strip_lemma_r: 
     "\<lbrakk>confluence(Spar_red1)\<rbrakk>\<Longrightarrow> strip"
 apply (unfold confluence_def strip_def)
 apply (rule impI [THEN allI, THEN allI])
 apply (erule Spar_red.induct, fast)
 apply (fast intro: Spar_red.trans)
 done
 
 
 lemma strip_lemma_l: 
     "strip\<Longrightarrow> confluence(Spar_red)"
 apply (unfold confluence_def strip_def)
 apply (rule impI [THEN allI, THEN allI])
 apply (erule Spar_red.induct, blast)
 apply clarify
 apply (blast intro: Spar_red.trans)
 done
 
 (* ------------------------------------------------------------------------- *)
 (*      Confluence                                                           *)
 (* ------------------------------------------------------------------------- *)
 
 
 lemma parallel_moves: "confluence(Spar_red1)"
 apply (unfold confluence_def, clarify)
 apply (frule simulation)
 apply (frule_tac n = z in simulation, clarify)
 apply (frule_tac v = va in paving)
 apply (force intro: completeness)+
 done
 
 lemmas confluence_parallel_reduction =
       parallel_moves [THEN strip_lemma_r, THEN strip_lemma_l]
 
 lemma lemma1: "\<lbrakk>confluence(Spar_red)\<rbrakk>\<Longrightarrow> confluence(Sred)"
 by (unfold confluence_def, blast intro: par_red_red red_par_red)
 
 lemmas confluence_beta_reduction =
        confluence_parallel_reduction [THEN lemma1]
 
 
 (**** Conversion ****)
 
 consts
   Sconv1        :: "i"
   Sconv         :: "i"
 
 abbreviation
   Sconv1_rel (infixl \<open><-1->\<close> 50) where
   "a<-1->b \<equiv> \<langle>a,b\<rangle> \<in> Sconv1"
 
 abbreviation
   Sconv_rel (infixl \<open><-\<longrightarrow>\<close> 50) where
   "a<-\<longrightarrow>b \<equiv> \<langle>a,b\<rangle> \<in> Sconv"
   
 inductive
   domains       "Sconv1" \<subseteq> "lambda*lambda"
   intros
     red1:        "m -1-> n \<Longrightarrow> m<-1->n"
     expl:        "n -1-> m \<Longrightarrow> m<-1->n"
   type_intros    red1D1 red1D2 lambda.intros bool_typechecks
 
 declare Sconv1.intros [intro]
 
 inductive
   domains       "Sconv" \<subseteq> "lambda*lambda"
   intros
     one_step:    "m<-1->n  \<Longrightarrow> m<-\<longrightarrow>n"
     refl:        "m \<in> lambda \<Longrightarrow> m<-\<longrightarrow>m"
     trans:       "\<lbrakk>m<-\<longrightarrow>n; n<-\<longrightarrow>p\<rbrakk> \<Longrightarrow> m<-\<longrightarrow>p"
   type_intros    Sconv1.dom_subset [THEN subsetD] lambda.intros bool_typechecks
 
 declare Sconv.intros [intro]
 
 lemma conv_sym: "m<-\<longrightarrow>n \<Longrightarrow> n<-\<longrightarrow>m"
 apply (erule Sconv.induct)
 apply (erule Sconv1.induct, blast+)
 done
 
 (* ------------------------------------------------------------------------- *)
 (*      Church_Rosser Theorem                                                *)
 (* ------------------------------------------------------------------------- *)
 
 lemma Church_Rosser: "m<-\<longrightarrow>n \<Longrightarrow> \<exists>p.(m -\<longrightarrow>p) \<and> (n -\<longrightarrow> p)"
 apply (erule Sconv.induct)
 apply (erule Sconv1.induct)
 apply (blast intro: red1D1 redD2)
 apply (blast intro: red1D1 redD2)
 apply (blast intro: red1D1 redD2)
 apply (cut_tac confluence_beta_reduction)
-apply (unfold confluence_def)
+  unfolding confluence_def
 apply (blast intro: Sred.trans)
 done
 
 end
 
diff --git a/src/ZF/Resid/Residuals.thy b/src/ZF/Resid/Residuals.thy
--- a/src/ZF/Resid/Residuals.thy
+++ b/src/ZF/Resid/Residuals.thy
@@ -1,213 +1,213 @@
 (*  Title:      ZF/Resid/Residuals.thy
     Author:     Ole Rasmussen
     Copyright   1995  University of Cambridge
 *)
 
 theory Residuals imports Substitution begin
 
 consts
   Sres          :: "i"
 
 abbreviation
   "residuals(u,v,w) \<equiv> <u,v,w> \<in> Sres"
 
 inductive
   domains       "Sres" \<subseteq> "redexes*redexes*redexes"
   intros
     Res_Var:    "n \<in> nat \<Longrightarrow> residuals(Var(n),Var(n),Var(n))"
     Res_Fun:    "\<lbrakk>residuals(u,v,w)\<rbrakk>\<Longrightarrow>   
                      residuals(Fun(u),Fun(v),Fun(w))"
     Res_App:    "\<lbrakk>residuals(u1,v1,w1);   
                    residuals(u2,v2,w2); b \<in> bool\<rbrakk>\<Longrightarrow>   
                  residuals(App(b,u1,u2),App(0,v1,v2),App(b,w1,w2))"
     Res_redex:  "\<lbrakk>residuals(u1,v1,w1);   
                    residuals(u2,v2,w2); b \<in> bool\<rbrakk>\<Longrightarrow>   
                  residuals(App(b,Fun(u1),u2),App(1,Fun(v1),v2),w2/w1)"
   type_intros    subst_type nat_typechecks redexes.intros bool_typechecks
 
 definition
   res_func      :: "[i,i]\<Rightarrow>i"     (infixl \<open>|>\<close> 70)  where
   "u |> v \<equiv> THE w. residuals(u,v,w)"
 
 
 subsection\<open>Setting up rule lists\<close>
 
 declare Sres.intros [intro]
 declare Sreg.intros [intro]
 declare subst_type [intro]
 
 inductive_cases [elim!]:
   "residuals(Var(n),Var(n),v)"
   "residuals(Fun(t),Fun(u),v)"
   "residuals(App(b, u1, u2), App(0, v1, v2),v)"
   "residuals(App(b, u1, u2), App(1, Fun(v1), v2),v)"
   "residuals(Var(n),u,v)"
   "residuals(Fun(t),u,v)"
   "residuals(App(b, u1, u2), w,v)"
   "residuals(u,Var(n),v)"
   "residuals(u,Fun(t),v)"
   "residuals(w,App(b, u1, u2),v)"
 
 
 inductive_cases [elim!]:
   "Var(n) \<Longleftarrow> u"
   "Fun(n) \<Longleftarrow> u"
   "u \<Longleftarrow> Fun(n)"
   "App(1,Fun(t),a) \<Longleftarrow> u"
   "App(0,t,a) \<Longleftarrow> u"
 
 inductive_cases [elim!]:
   "Fun(t) \<in> redexes"
 
 declare Sres.intros [simp]
 
 subsection\<open>residuals is a  partial function\<close>
 
 lemma residuals_function [rule_format]:
      "residuals(u,v,w) \<Longrightarrow> \<forall>w1. residuals(u,v,w1) \<longrightarrow> w1 = w"
 by (erule Sres.induct, force+)
 
 lemma residuals_intro [rule_format]:
      "u \<sim> v \<Longrightarrow> regular(v) \<longrightarrow> (\<exists>w. residuals(u,v,w))"
 by (erule Scomp.induct, force+)
 
 lemma comp_resfuncD:
      "\<lbrakk>u \<sim> v;  regular(v)\<rbrakk> \<Longrightarrow> residuals(u, v, THE w. residuals(u, v, w))"
 apply (frule residuals_intro, assumption, clarify)
 apply (subst the_equality)
 apply (blast intro: residuals_function)+
 done
 
 subsection\<open>Residual function\<close>
 
 lemma res_Var [simp]: "n \<in> nat \<Longrightarrow> Var(n) |> Var(n) = Var(n)"
 by (unfold res_func_def, blast)
 
 lemma res_Fun [simp]: 
     "\<lbrakk>s \<sim> t; regular(t)\<rbrakk>\<Longrightarrow> Fun(s) |> Fun(t) = Fun(s |> t)"
-apply (unfold res_func_def)
+  unfolding res_func_def
 apply (blast intro: comp_resfuncD residuals_function) 
 done
 
 lemma res_App [simp]: 
     "\<lbrakk>s \<sim> u; regular(u); t \<sim> v; regular(v); b \<in> bool\<rbrakk>
      \<Longrightarrow> App(b,s,t) |> App(0,u,v) = App(b, s |> u, t |> v)"
-apply (unfold res_func_def) 
+  unfolding res_func_def 
 apply (blast dest!: comp_resfuncD intro: residuals_function)
 done
 
 lemma res_redex [simp]: 
     "\<lbrakk>s \<sim> u; regular(u); t \<sim> v; regular(v); b \<in> bool\<rbrakk>
      \<Longrightarrow> App(b,Fun(s),t) |> App(1,Fun(u),v) = (t |> v)/ (s |> u)"
-apply (unfold res_func_def)
+  unfolding res_func_def
 apply (blast elim!: redexes.free_elims dest!: comp_resfuncD 
              intro: residuals_function)
 done
 
 lemma resfunc_type [simp]:
      "\<lbrakk>s \<sim> t; regular(t)\<rbrakk>\<Longrightarrow> regular(t) \<longrightarrow> s |> t \<in> redexes"
   by (erule Scomp.induct, auto)
 
 subsection\<open>Commutation theorem\<close>
 
 lemma sub_comp [simp]: "u \<Longleftarrow> v \<Longrightarrow> u \<sim> v"
 by (erule Ssub.induct, simp_all)
 
 lemma sub_preserve_reg [rule_format, simp]:
      "u \<Longleftarrow> v \<Longrightarrow> regular(v) \<longrightarrow> regular(u)"
 by (erule Ssub.induct, auto)
 
 lemma residuals_lift_rec: "\<lbrakk>u \<sim> v; k \<in> nat\<rbrakk>\<Longrightarrow> regular(v)\<longrightarrow> (\<forall>n \<in> nat.   
          lift_rec(u,n) |> lift_rec(v,n) = lift_rec(u |> v,n))"
 apply (erule Scomp.induct, safe)
 apply (simp_all add: lift_rec_Var subst_Var lift_subst)
 done
 
 lemma residuals_subst_rec:
      "u1 \<sim> u2 \<Longrightarrow>  \<forall>v1 v2. v1 \<sim> v2 \<longrightarrow> regular(v2) \<longrightarrow> regular(u2) \<longrightarrow> 
                   (\<forall>n \<in> nat. subst_rec(v1,u1,n) |> subst_rec(v2,u2,n) =  
                     subst_rec(v1 |> v2, u1 |> u2,n))"
 apply (erule Scomp.induct, safe)
 apply (simp_all add: lift_rec_Var subst_Var residuals_lift_rec)
 apply (drule_tac psi = "\<forall>x. P(x)" for P in asm_rl)
 apply (simp add: substitution)
 done
 
 
 lemma commutation [simp]:
      "\<lbrakk>u1 \<sim> u2; v1 \<sim> v2; regular(u2); regular(v2)\<rbrakk>
       \<Longrightarrow> (v1/u1) |> (v2/u2) = (v1 |> v2)/(u1 |> u2)"
 by (simp add: residuals_subst_rec)
 
 
 subsection\<open>Residuals are comp and regular\<close>
 
 lemma residuals_preserve_comp [rule_format, simp]:
      "u \<sim> v \<Longrightarrow> \<forall>w. u \<sim> w \<longrightarrow> v \<sim> w \<longrightarrow> regular(w) \<longrightarrow> (u|>w) \<sim> (v|>w)"
 by (erule Scomp.induct, force+)
 
 lemma residuals_preserve_reg [rule_format, simp]:
      "u \<sim> v \<Longrightarrow> regular(u) \<longrightarrow> regular(v) \<longrightarrow> regular(u|>v)"
 apply (erule Scomp.induct, auto)
 done
 
 subsection\<open>Preservation lemma\<close>
 
 lemma union_preserve_comp: "u \<sim> v \<Longrightarrow> v \<sim> (u \<squnion> v)"
 by (erule Scomp.induct, simp_all)
 
 lemma preservation [rule_format]:
      "u \<sim> v \<Longrightarrow> regular(v) \<longrightarrow> u|>v = (u \<squnion> v)|>v"
 apply (erule Scomp.induct, safe)
 apply (drule_tac [3] psi = "Fun (u) |> v = w" for u v w in asm_rl)
 apply (auto simp add: union_preserve_comp comp_sym_iff)
 done
 
 
 declare sub_comp [THEN comp_sym, simp]
 
 subsection\<open>Prism theorem\<close>
 
 (* Having more assumptions than needed -- removed below  *)
 lemma prism_l [rule_format]:
      "v \<Longleftarrow> u \<Longrightarrow>  
        regular(u) \<longrightarrow> (\<forall>w. w \<sim> v \<longrightarrow> w \<sim> u \<longrightarrow>   
                             w |> u = (w|>v) |> (u|>v))"
 by (erule Ssub.induct, force+)
 
 lemma prism: "\<lbrakk>v \<Longleftarrow> u; regular(u); w \<sim> v\<rbrakk> \<Longrightarrow> w |> u = (w|>v) |> (u|>v)"
 apply (rule prism_l)
 apply (rule_tac [4] comp_trans, auto)
 done
 
 
 subsection\<open>Levy's Cube Lemma\<close>
 
 lemma cube: "\<lbrakk>u \<sim> v; regular(v); regular(u); w \<sim> u\<rbrakk>\<Longrightarrow>   
            (w|>u) |> (v|>u) = (w|>v) |> (u|>v)"
 apply (subst preservation [of u], assumption, assumption)
 apply (subst preservation [of v], erule comp_sym, assumption)
 apply (subst prism [symmetric, of v])
 apply (simp add: union_r comp_sym_iff)
 apply (simp add: union_preserve_regular comp_sym_iff)
 apply (erule comp_trans, assumption)
 apply (simp add: prism [symmetric] union_l union_preserve_regular 
                  comp_sym_iff union_sym)
 done
 
 
 subsection\<open>paving theorem\<close>
 
 lemma paving: "\<lbrakk>w \<sim> u; w \<sim> v; regular(u); regular(v)\<rbrakk>\<Longrightarrow>  
            \<exists>uv vu. (w|>u) |> vu = (w|>v) |> uv \<and> (w|>u) \<sim> vu \<and>
              regular(vu) \<and> (w|>v) \<sim> uv \<and> regular(uv)"
 apply (subgoal_tac "u \<sim> v")
 apply (safe intro!: exI)
 apply (rule cube)
 apply (simp_all add: comp_sym_iff)
 apply (blast intro: residuals_preserve_comp comp_trans comp_sym)+
 done
 
 
 end
 
diff --git a/src/ZF/Sum.thy b/src/ZF/Sum.thy
--- a/src/ZF/Sum.thy
+++ b/src/ZF/Sum.thy
@@ -1,191 +1,191 @@
 (*  Title:      ZF/Sum.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1993  University of Cambridge
 *)
 
 section\<open>Disjoint Sums\<close>
 
 theory Sum imports Bool equalities begin
 
 text\<open>And the "Part" primitive for simultaneous recursive type definitions\<close>
 
 definition sum :: "[i,i]\<Rightarrow>i" (infixr \<open>+\<close> 65) where
      "A+B \<equiv> {0}*A \<union> {1}*B"
 
 definition Inl :: "i\<Rightarrow>i" where
      "Inl(a) \<equiv> \<langle>0,a\<rangle>"
 
 definition Inr :: "i\<Rightarrow>i" where
      "Inr(b) \<equiv> \<langle>1,b\<rangle>"
 
 definition "case" :: "[i\<Rightarrow>i, i\<Rightarrow>i, i]\<Rightarrow>i" where
      "case(c,d) \<equiv> (\<lambda>\<langle>y,z\<rangle>. cond(y, d(z), c(z)))"
 
   (*operator for selecting out the various summands*)
 definition Part :: "[i,i\<Rightarrow>i] \<Rightarrow> i" where
      "Part(A,h) \<equiv> {x \<in> A. \<exists>z. x = h(z)}"
 
 subsection\<open>Rules for the \<^term>\<open>Part\<close> Primitive\<close>
 
 lemma Part_iff:
     "a \<in> Part(A,h) \<longleftrightarrow> a \<in> A \<and> (\<exists>y. a=h(y))"
-apply (unfold Part_def)
+  unfolding Part_def
 apply (rule separation)
 done
 
 lemma Part_eqI [intro]:
     "\<lbrakk>a \<in> A;  a=h(b)\<rbrakk> \<Longrightarrow> a \<in> Part(A,h)"
 by (unfold Part_def, blast)
 
 lemmas PartI = refl [THEN [2] Part_eqI]
 
 lemma PartE [elim!]:
     "\<lbrakk>a \<in> Part(A,h);  \<And>z. \<lbrakk>a \<in> A;  a=h(z)\<rbrakk> \<Longrightarrow> P
 \<rbrakk> \<Longrightarrow> P"
 apply (unfold Part_def, blast)
 done
 
 lemma Part_subset: "Part(A,h) \<subseteq> A"
-apply (unfold Part_def)
+  unfolding Part_def
 apply (rule Collect_subset)
 done
 
 
 subsection\<open>Rules for Disjoint Sums\<close>
 
 lemmas sum_defs = sum_def Inl_def Inr_def case_def
 
 lemma Sigma_bool: "Sigma(bool,C) = C(0) + C(1)"
 by (unfold bool_def sum_def, blast)
 
 (** Introduction rules for the injections **)
 
 lemma InlI [intro!,simp,TC]: "a \<in> A \<Longrightarrow> Inl(a) \<in> A+B"
 by (unfold sum_defs, blast)
 
 lemma InrI [intro!,simp,TC]: "b \<in> B \<Longrightarrow> Inr(b) \<in> A+B"
 by (unfold sum_defs, blast)
 
 (** Elimination rules **)
 
 lemma sumE [elim!]:
     "\<lbrakk>u \<in> A+B;
         \<And>x. \<lbrakk>x \<in> A;  u=Inl(x)\<rbrakk> \<Longrightarrow> P;
         \<And>y. \<lbrakk>y \<in> B;  u=Inr(y)\<rbrakk> \<Longrightarrow> P
 \<rbrakk> \<Longrightarrow> P"
 by (unfold sum_defs, blast)
 
 (** Injection and freeness equivalences, for rewriting **)
 
 lemma Inl_iff [iff]: "Inl(a)=Inl(b) \<longleftrightarrow> a=b"
 by (simp add: sum_defs)
 
 lemma Inr_iff [iff]: "Inr(a)=Inr(b) \<longleftrightarrow> a=b"
 by (simp add: sum_defs)
 
 lemma Inl_Inr_iff [simp]: "Inl(a)=Inr(b) \<longleftrightarrow> False"
 by (simp add: sum_defs)
 
 lemma Inr_Inl_iff [simp]: "Inr(b)=Inl(a) \<longleftrightarrow> False"
 by (simp add: sum_defs)
 
 lemma sum_empty [simp]: "0+0 = 0"
 by (simp add: sum_defs)
 
 (*Injection and freeness rules*)
 
 lemmas Inl_inject = Inl_iff [THEN iffD1]
 lemmas Inr_inject = Inr_iff [THEN iffD1]
 lemmas Inl_neq_Inr = Inl_Inr_iff [THEN iffD1, THEN FalseE, elim!]
 lemmas Inr_neq_Inl = Inr_Inl_iff [THEN iffD1, THEN FalseE, elim!]
 
 
 lemma InlD: "Inl(a): A+B \<Longrightarrow> a \<in> A"
 by blast
 
 lemma InrD: "Inr(b): A+B \<Longrightarrow> b \<in> B"
 by blast
 
 lemma sum_iff: "u \<in> A+B \<longleftrightarrow> (\<exists>x. x \<in> A \<and> u=Inl(x)) | (\<exists>y. y \<in> B \<and> u=Inr(y))"
 by blast
 
 lemma Inl_in_sum_iff [simp]: "(Inl(x) \<in> A+B) \<longleftrightarrow> (x \<in> A)"
 by auto
 
 lemma Inr_in_sum_iff [simp]: "(Inr(y) \<in> A+B) \<longleftrightarrow> (y \<in> B)"
 by auto
 
 lemma sum_subset_iff: "A+B \<subseteq> C+D \<longleftrightarrow> A<=C \<and> B<=D"
 by blast
 
 lemma sum_equal_iff: "A+B = C+D \<longleftrightarrow> A=C \<and> B=D"
 by (simp add: extension sum_subset_iff, blast)
 
 lemma sum_eq_2_times: "A+A = 2*A"
 by (simp add: sum_def, blast)
 
 
 subsection\<open>The Eliminator: \<^term>\<open>case\<close>\<close>
 
 lemma case_Inl [simp]: "case(c, d, Inl(a)) = c(a)"
 by (simp add: sum_defs)
 
 lemma case_Inr [simp]: "case(c, d, Inr(b)) = d(b)"
 by (simp add: sum_defs)
 
 lemma case_type [TC]:
     "\<lbrakk>u \<in> A+B;
         \<And>x. x \<in> A \<Longrightarrow> c(x): C(Inl(x));
         \<And>y. y \<in> B \<Longrightarrow> d(y): C(Inr(y))
 \<rbrakk> \<Longrightarrow> case(c,d,u) \<in> C(u)"
 by auto
 
 lemma expand_case: "u \<in> A+B \<Longrightarrow>
         R(case(c,d,u)) \<longleftrightarrow>
         ((\<forall>x\<in>A. u = Inl(x) \<longrightarrow> R(c(x))) \<and>
         (\<forall>y\<in>B. u = Inr(y) \<longrightarrow> R(d(y))))"
 by auto
 
 lemma case_cong:
   "\<lbrakk>z \<in> A+B;
       \<And>x. x \<in> A \<Longrightarrow> c(x)=c'(x);
       \<And>y. y \<in> B \<Longrightarrow> d(y)=d'(y)
 \<rbrakk> \<Longrightarrow> case(c,d,z) = case(c',d',z)"
 by auto
 
 lemma case_case: "z \<in> A+B \<Longrightarrow>
         case(c, d, case(\<lambda>x. Inl(c'(x)), \<lambda>y. Inr(d'(y)), z)) =
         case(\<lambda>x. c(c'(x)), \<lambda>y. d(d'(y)), z)"
 by auto
 
 
 subsection\<open>More Rules for \<^term>\<open>Part(A,h)\<close>\<close>
 
 lemma Part_mono: "A<=B \<Longrightarrow> Part(A,h)<=Part(B,h)"
 by blast
 
 lemma Part_Collect: "Part(Collect(A,P), h) = Collect(Part(A,h), P)"
 by blast
 
 lemmas Part_CollectE =
      Part_Collect [THEN equalityD1, THEN subsetD, THEN CollectE]
 
 lemma Part_Inl: "Part(A+B,Inl) = {Inl(x). x \<in> A}"
 by blast
 
 lemma Part_Inr: "Part(A+B,Inr) = {Inr(y). y \<in> B}"
 by blast
 
 lemma PartD1: "a \<in> Part(A,h) \<Longrightarrow> a \<in> A"
 by (simp add: Part_def)
 
 lemma Part_id: "Part(A,\<lambda>x. x) = A"
 by blast
 
 lemma Part_Inr2: "Part(A+B, \<lambda>x. Inr(h(x))) = {Inr(y). y \<in> Part(B,h)}"
 by blast
 
 lemma Part_sum_equality: "C \<subseteq> A+B \<Longrightarrow> Part(C,Inl) \<union> Part(C,Inr) = C"
 by blast
 
 end
diff --git a/src/ZF/Trancl.thy b/src/ZF/Trancl.thy
--- a/src/ZF/Trancl.thy
+++ b/src/ZF/Trancl.thy
@@ -1,374 +1,374 @@
 (*  Title:      ZF/Trancl.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1992  University of Cambridge
 *)
 
 section\<open>Relations: Their General Properties and Transitive Closure\<close>
 
 theory Trancl imports Fixedpt Perm begin
 
 definition
   refl     :: "[i,i]\<Rightarrow>o"  where
     "refl(A,r) \<equiv> (\<forall>x\<in>A. \<langle>x,x\<rangle> \<in> r)"
 
 definition
   irrefl   :: "[i,i]\<Rightarrow>o"  where
     "irrefl(A,r) \<equiv> \<forall>x\<in>A. \<langle>x,x\<rangle> \<notin> r"
 
 definition
   sym      :: "i\<Rightarrow>o"  where
     "sym(r) \<equiv> \<forall>x y. \<langle>x,y\<rangle>: r \<longrightarrow> \<langle>y,x\<rangle>: r"
 
 definition
   asym     :: "i\<Rightarrow>o"  where
     "asym(r) \<equiv> \<forall>x y. \<langle>x,y\<rangle>:r \<longrightarrow> \<not> \<langle>y,x\<rangle>:r"
 
 definition
   antisym  :: "i\<Rightarrow>o"  where
     "antisym(r) \<equiv> \<forall>x y.\<langle>x,y\<rangle>:r \<longrightarrow> \<langle>y,x\<rangle>:r \<longrightarrow> x=y"
 
 definition
   trans    :: "i\<Rightarrow>o"  where
     "trans(r) \<equiv> \<forall>x y z. \<langle>x,y\<rangle>: r \<longrightarrow> \<langle>y,z\<rangle>: r \<longrightarrow> \<langle>x,z\<rangle>: r"
 
 definition
   trans_on :: "[i,i]\<Rightarrow>o"  (\<open>trans[_]'(_')\<close>)  where
     "trans[A](r) \<equiv> \<forall>x\<in>A. \<forall>y\<in>A. \<forall>z\<in>A.
                           \<langle>x,y\<rangle>: r \<longrightarrow> \<langle>y,z\<rangle>: r \<longrightarrow> \<langle>x,z\<rangle>: r"
 
 definition
   rtrancl :: "i\<Rightarrow>i"  (\<open>(_^*)\<close> [100] 100)  (*refl/transitive closure*)  where
     "r^* \<equiv> lfp(field(r)*field(r), \<lambda>s. id(field(r)) \<union> (r O s))"
 
 definition
   trancl  :: "i\<Rightarrow>i"  (\<open>(_^+)\<close> [100] 100)  (*transitive closure*)  where
     "r^+ \<equiv> r O r^*"
 
 definition
   equiv    :: "[i,i]\<Rightarrow>o"  where
     "equiv(A,r) \<equiv> r \<subseteq> A*A \<and> refl(A,r) \<and> sym(r) \<and> trans(r)"
 
 
 subsection\<open>General properties of relations\<close>
 
 subsubsection\<open>irreflexivity\<close>
 
 lemma irreflI:
     "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> \<langle>x,x\<rangle> \<notin> r\<rbrakk> \<Longrightarrow> irrefl(A,r)"
 by (simp add: irrefl_def)
 
 lemma irreflE: "\<lbrakk>irrefl(A,r);  x \<in> A\<rbrakk> \<Longrightarrow>  \<langle>x,x\<rangle> \<notin> r"
 by (simp add: irrefl_def)
 
 subsubsection\<open>symmetry\<close>
 
 lemma symI:
      "\<lbrakk>\<And>x y.\<langle>x,y\<rangle>: r \<Longrightarrow> \<langle>y,x\<rangle>: r\<rbrakk> \<Longrightarrow> sym(r)"
 by (unfold sym_def, blast)
 
 lemma symE: "\<lbrakk>sym(r); \<langle>x,y\<rangle>: r\<rbrakk>  \<Longrightarrow>  \<langle>y,x\<rangle>: r"
 by (unfold sym_def, blast)
 
 subsubsection\<open>antisymmetry\<close>
 
 lemma antisymI:
      "\<lbrakk>\<And>x y.\<lbrakk>\<langle>x,y\<rangle>: r;  \<langle>y,x\<rangle>: r\<rbrakk> \<Longrightarrow> x=y\<rbrakk> \<Longrightarrow> antisym(r)"
 by (simp add: antisym_def, blast)
 
 lemma antisymE: "\<lbrakk>antisym(r); \<langle>x,y\<rangle>: r;  \<langle>y,x\<rangle>: r\<rbrakk>  \<Longrightarrow>  x=y"
 by (simp add: antisym_def, blast)
 
 subsubsection\<open>transitivity\<close>
 
 lemma transD: "\<lbrakk>trans(r);  \<langle>a,b\<rangle>:r;  \<langle>b,c\<rangle>:r\<rbrakk> \<Longrightarrow> \<langle>a,c\<rangle>:r"
 by (unfold trans_def, blast)
 
 lemma trans_onD:
     "\<lbrakk>trans[A](r);  \<langle>a,b\<rangle>:r;  \<langle>b,c\<rangle>:r;  a \<in> A;  b \<in> A;  c \<in> A\<rbrakk> \<Longrightarrow> \<langle>a,c\<rangle>:r"
 by (unfold trans_on_def, blast)
 
 lemma trans_imp_trans_on: "trans(r) \<Longrightarrow> trans[A](r)"
 by (unfold trans_def trans_on_def, blast)
 
 lemma trans_on_imp_trans: "\<lbrakk>trans[A](r); r \<subseteq> A*A\<rbrakk> \<Longrightarrow> trans(r)"
 by (simp add: trans_on_def trans_def, blast)
 
 
 subsection\<open>Transitive closure of a relation\<close>
 
 lemma rtrancl_bnd_mono:
      "bnd_mono(field(r)*field(r), \<lambda>s. id(field(r)) \<union> (r O s))"
 by (rule bnd_monoI, blast+)
 
 lemma rtrancl_mono: "r<=s \<Longrightarrow> r^* \<subseteq> s^*"
-apply (unfold rtrancl_def)
+  unfolding rtrancl_def
 apply (rule lfp_mono)
 apply (rule rtrancl_bnd_mono)+
 apply blast
 done
 
 (* @{term"r^* = id(field(r)) \<union> ( r O r^* )"}    *)
 lemmas rtrancl_unfold =
      rtrancl_bnd_mono [THEN rtrancl_def [THEN def_lfp_unfold]]
 
 (** The relation rtrancl **)
 
 (*  @{term"r^* \<subseteq> field(r) * field(r)"}  *)
 lemmas rtrancl_type = rtrancl_def [THEN def_lfp_subset]
 
 lemma relation_rtrancl: "relation(r^*)"
 apply (simp add: relation_def)
 apply (blast dest: rtrancl_type [THEN subsetD])
 done
 
 (*Reflexivity of rtrancl*)
 lemma rtrancl_refl: "\<lbrakk>a \<in> field(r)\<rbrakk> \<Longrightarrow> \<langle>a,a\<rangle> \<in> r^*"
 apply (rule rtrancl_unfold [THEN ssubst])
 apply (erule idI [THEN UnI1])
 done
 
 (*Closure under composition with r  *)
 lemma rtrancl_into_rtrancl: "\<lbrakk>\<langle>a,b\<rangle> \<in> r^*;  \<langle>b,c\<rangle> \<in> r\<rbrakk> \<Longrightarrow> \<langle>a,c\<rangle> \<in> r^*"
 apply (rule rtrancl_unfold [THEN ssubst])
 apply (rule compI [THEN UnI2], assumption, assumption)
 done
 
 (*rtrancl of r contains all pairs in r  *)
 lemma r_into_rtrancl: "\<langle>a,b\<rangle> \<in> r \<Longrightarrow> \<langle>a,b\<rangle> \<in> r^*"
 by (rule rtrancl_refl [THEN rtrancl_into_rtrancl], blast+)
 
 (*The premise ensures that r consists entirely of pairs*)
 lemma r_subset_rtrancl: "relation(r) \<Longrightarrow> r \<subseteq> r^*"
 by (simp add: relation_def, blast intro: r_into_rtrancl)
 
 lemma rtrancl_field: "field(r^*) = field(r)"
 by (blast intro: r_into_rtrancl dest!: rtrancl_type [THEN subsetD])
 
 
 (** standard induction rule **)
 
 lemma rtrancl_full_induct [case_names initial step, consumes 1]:
   "\<lbrakk>\<langle>a,b\<rangle> \<in> r^*;
       \<And>x. x \<in> field(r) \<Longrightarrow> P(\<langle>x,x\<rangle>);
       \<And>x y z.\<lbrakk>P(\<langle>x,y\<rangle>); \<langle>x,y\<rangle>: r^*; \<langle>y,z\<rangle>: r\<rbrakk>  \<Longrightarrow>  P(\<langle>x,z\<rangle>)\<rbrakk>
    \<Longrightarrow>  P(\<langle>a,b\<rangle>)"
 by (erule def_induct [OF rtrancl_def rtrancl_bnd_mono], blast)
 
 (*nice induction rule.
   Tried adding the typing hypotheses y,z \<in> field(r), but these
   caused expensive case splits!*)
 lemma rtrancl_induct [case_names initial step, induct set: rtrancl]:
   "\<lbrakk>\<langle>a,b\<rangle> \<in> r^*;
       P(a);
       \<And>y z.\<lbrakk>\<langle>a,y\<rangle> \<in> r^*;  \<langle>y,z\<rangle> \<in> r;  P(y)\<rbrakk> \<Longrightarrow> P(z)
 \<rbrakk> \<Longrightarrow> P(b)"
 (*by induction on this formula*)
 apply (subgoal_tac "\<forall>y. \<langle>a,b\<rangle> = \<langle>a,y\<rangle> \<longrightarrow> P (y) ")
 (*now solve first subgoal: this formula is sufficient*)
 apply (erule spec [THEN mp], rule refl)
 (*now do the induction*)
 apply (erule rtrancl_full_induct, blast+)
 done
 
 (*transitivity of transitive closure\<And>-- by induction.*)
 lemma trans_rtrancl: "trans(r^*)"
-apply (unfold trans_def)
+  unfolding trans_def
 apply (intro allI impI)
 apply (erule_tac b = z in rtrancl_induct, assumption)
 apply (blast intro: rtrancl_into_rtrancl)
 done
 
 lemmas rtrancl_trans = trans_rtrancl [THEN transD]
 
 (*elimination of rtrancl -- by induction on a special formula*)
 lemma rtranclE:
     "\<lbrakk>\<langle>a,b\<rangle> \<in> r^*;  (a=b) \<Longrightarrow> P;
         \<And>y.\<lbrakk>\<langle>a,y\<rangle> \<in> r^*;   \<langle>y,b\<rangle> \<in> r\<rbrakk> \<Longrightarrow> P\<rbrakk>
      \<Longrightarrow> P"
 apply (subgoal_tac "a = b | (\<exists>y. \<langle>a,y\<rangle> \<in> r^* \<and> \<langle>y,b\<rangle> \<in> r) ")
 (*see HOL/trancl*)
 apply blast
 apply (erule rtrancl_induct, blast+)
 done
 
 
 (**** The relation trancl ****)
 
 (*Transitivity of r^+ is proved by transitivity of r^*  *)
 lemma trans_trancl: "trans(r^+)"
 apply (unfold trans_def trancl_def)
 apply (blast intro: rtrancl_into_rtrancl
                     trans_rtrancl [THEN transD, THEN compI])
 done
 
 lemmas trans_on_trancl = trans_trancl [THEN trans_imp_trans_on]
 
 lemmas trancl_trans = trans_trancl [THEN transD]
 
 (** Conversions between trancl and rtrancl **)
 
 lemma trancl_into_rtrancl: "\<langle>a,b\<rangle> \<in> r^+ \<Longrightarrow> \<langle>a,b\<rangle> \<in> r^*"
-apply (unfold trancl_def)
+  unfolding trancl_def
 apply (blast intro: rtrancl_into_rtrancl)
 done
 
 (*r^+ contains all pairs in r  *)
 lemma r_into_trancl: "\<langle>a,b\<rangle> \<in> r \<Longrightarrow> \<langle>a,b\<rangle> \<in> r^+"
-apply (unfold trancl_def)
+  unfolding trancl_def
 apply (blast intro!: rtrancl_refl)
 done
 
 (*The premise ensures that r consists entirely of pairs*)
 lemma r_subset_trancl: "relation(r) \<Longrightarrow> r \<subseteq> r^+"
 by (simp add: relation_def, blast intro: r_into_trancl)
 
 
 (*intro rule by definition: from r^* and r  *)
 lemma rtrancl_into_trancl1: "\<lbrakk>\<langle>a,b\<rangle> \<in> r^*;  \<langle>b,c\<rangle> \<in> r\<rbrakk>   \<Longrightarrow>  \<langle>a,c\<rangle> \<in> r^+"
 by (unfold trancl_def, blast)
 
 (*intro rule from r and r^*  *)
 lemma rtrancl_into_trancl2:
     "\<lbrakk>\<langle>a,b\<rangle> \<in> r;  \<langle>b,c\<rangle> \<in> r^*\<rbrakk>   \<Longrightarrow>  \<langle>a,c\<rangle> \<in> r^+"
 apply (erule rtrancl_induct)
  apply (erule r_into_trancl)
 apply (blast intro: r_into_trancl trancl_trans)
 done
 
 (*Nice induction rule for trancl*)
 lemma trancl_induct [case_names initial step, induct set: trancl]:
   "\<lbrakk>\<langle>a,b\<rangle> \<in> r^+;
       \<And>y.  \<lbrakk>\<langle>a,y\<rangle> \<in> r\<rbrakk> \<Longrightarrow> P(y);
       \<And>y z.\<lbrakk>\<langle>a,y\<rangle> \<in> r^+;  \<langle>y,z\<rangle> \<in> r;  P(y)\<rbrakk> \<Longrightarrow> P(z)
 \<rbrakk> \<Longrightarrow> P(b)"
 apply (rule compEpair)
 apply (unfold trancl_def, assumption)
 (*by induction on this formula*)
 apply (subgoal_tac "\<forall>z. \<langle>y,z\<rangle> \<in> r \<longrightarrow> P (z) ")
 (*now solve first subgoal: this formula is sufficient*)
  apply blast
 apply (erule rtrancl_induct)
 apply (blast intro: rtrancl_into_trancl1)+
 done
 
 (*elimination of r^+ -- NOT an induction rule*)
 lemma tranclE:
     "\<lbrakk>\<langle>a,b\<rangle> \<in> r^+;
         \<langle>a,b\<rangle> \<in> r \<Longrightarrow> P;
         \<And>y.\<lbrakk>\<langle>a,y\<rangle> \<in> r^+; \<langle>y,b\<rangle> \<in> r\<rbrakk> \<Longrightarrow> P
 \<rbrakk> \<Longrightarrow> P"
 apply (subgoal_tac "\<langle>a,b\<rangle> \<in> r | (\<exists>y. \<langle>a,y\<rangle> \<in> r^+ \<and> \<langle>y,b\<rangle> \<in> r) ")
 apply blast
 apply (rule compEpair)
 apply (unfold trancl_def, assumption)
 apply (erule rtranclE)
 apply (blast intro: rtrancl_into_trancl1)+
 done
 
 lemma trancl_type: "r^+ \<subseteq> field(r)*field(r)"
-apply (unfold trancl_def)
+  unfolding trancl_def
 apply (blast elim: rtrancl_type [THEN subsetD, THEN SigmaE2])
 done
 
 lemma relation_trancl: "relation(r^+)"
 apply (simp add: relation_def)
 apply (blast dest: trancl_type [THEN subsetD])
 done
 
 lemma trancl_subset_times: "r \<subseteq> A * A \<Longrightarrow> r^+ \<subseteq> A * A"
 by (insert trancl_type [of r], blast)
 
 lemma trancl_mono: "r<=s \<Longrightarrow> r^+ \<subseteq> s^+"
 by (unfold trancl_def, intro comp_mono rtrancl_mono)
 
 lemma trancl_eq_r: "\<lbrakk>relation(r); trans(r)\<rbrakk> \<Longrightarrow> r^+ = r"
 apply (rule equalityI)
  prefer 2 apply (erule r_subset_trancl, clarify)
 apply (frule trancl_type [THEN subsetD], clarify)
 apply (erule trancl_induct, assumption)
 apply (blast dest: transD)
 done
 
 
 (** Suggested by Sidi Ould Ehmety **)
 
 lemma rtrancl_idemp [simp]: "(r^*)^* = r^*"
 apply (rule equalityI, auto)
  prefer 2
  apply (frule rtrancl_type [THEN subsetD])
  apply (blast intro: r_into_rtrancl )
 txt\<open>converse direction\<close>
 apply (frule rtrancl_type [THEN subsetD], clarify)
 apply (erule rtrancl_induct)
 apply (simp add: rtrancl_refl rtrancl_field)
 apply (blast intro: rtrancl_trans)
 done
 
 lemma rtrancl_subset: "\<lbrakk>R \<subseteq> S; S \<subseteq> R^*\<rbrakk> \<Longrightarrow> S^* = R^*"
 apply (drule rtrancl_mono)
 apply (drule rtrancl_mono, simp_all, blast)
 done
 
 lemma rtrancl_Un_rtrancl:
      "\<lbrakk>relation(r); relation(s)\<rbrakk> \<Longrightarrow> (r^* \<union> s^*)^* = (r \<union> s)^*"
 apply (rule rtrancl_subset)
 apply (blast dest: r_subset_rtrancl)
 apply (blast intro: rtrancl_mono [THEN subsetD])
 done
 
 (*** "converse" laws by Sidi Ould Ehmety ***)
 
 (** rtrancl **)
 
 lemma rtrancl_converseD: "\<langle>x,y\<rangle>:converse(r)^* \<Longrightarrow> \<langle>x,y\<rangle>:converse(r^*)"
 apply (rule converseI)
 apply (frule rtrancl_type [THEN subsetD])
 apply (erule rtrancl_induct)
 apply (blast intro: rtrancl_refl)
 apply (blast intro: r_into_rtrancl rtrancl_trans)
 done
 
 lemma rtrancl_converseI: "\<langle>x,y\<rangle>:converse(r^*) \<Longrightarrow> \<langle>x,y\<rangle>:converse(r)^*"
 apply (drule converseD)
 apply (frule rtrancl_type [THEN subsetD])
 apply (erule rtrancl_induct)
 apply (blast intro: rtrancl_refl)
 apply (blast intro: r_into_rtrancl rtrancl_trans)
 done
 
 lemma rtrancl_converse: "converse(r)^* = converse(r^*)"
 apply (safe intro!: equalityI)
 apply (frule rtrancl_type [THEN subsetD])
 apply (safe dest!: rtrancl_converseD intro!: rtrancl_converseI)
 done
 
 (** trancl **)
 
 lemma trancl_converseD: "\<langle>a, b\<rangle>:converse(r)^+ \<Longrightarrow> \<langle>a, b\<rangle>:converse(r^+)"
 apply (erule trancl_induct)
 apply (auto intro: r_into_trancl trancl_trans)
 done
 
 lemma trancl_converseI: "\<langle>x,y\<rangle>:converse(r^+) \<Longrightarrow> \<langle>x,y\<rangle>:converse(r)^+"
 apply (drule converseD)
 apply (erule trancl_induct)
 apply (auto intro: r_into_trancl trancl_trans)
 done
 
 lemma trancl_converse: "converse(r)^+ = converse(r^+)"
 apply (safe intro!: equalityI)
 apply (frule trancl_type [THEN subsetD])
 apply (safe dest!: trancl_converseD intro!: trancl_converseI)
 done
 
 lemma converse_trancl_induct [case_names initial step, consumes 1]:
 "\<lbrakk>\<langle>a, b\<rangle>:r^+; \<And>y. \<langle>y, b\<rangle> :r \<Longrightarrow> P(y);
       \<And>y z. \<lbrakk>\<langle>y, z\<rangle> \<in> r; \<langle>z, b\<rangle> \<in> r^+; P(z)\<rbrakk> \<Longrightarrow> P(y)\<rbrakk>
        \<Longrightarrow> P(a)"
 apply (drule converseI)
 apply (simp (no_asm_use) add: trancl_converse [symmetric])
 apply (erule trancl_induct)
 apply (auto simp add: trancl_converse)
 done
 
 end
diff --git a/src/ZF/UNITY/AllocBase.thy b/src/ZF/UNITY/AllocBase.thy
--- a/src/ZF/UNITY/AllocBase.thy
+++ b/src/ZF/UNITY/AllocBase.thy
@@ -1,398 +1,398 @@
 (*  Title:      ZF/UNITY/AllocBase.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     Copyright   2001  University of Cambridge
 *)
 
 section\<open>Common declarations for Chandy and Charpentier's Allocator\<close>
 
 theory AllocBase imports Follows MultisetSum Guar begin
 
 abbreviation (input)
   tokbag   :: i  (* tokbags could be multisets...or any ordered type?*)
 where
   "tokbag \<equiv> nat"
 
 axiomatization
   NbT :: i and  (* Number of tokens in system *)
   Nclients :: i  (* Number of clients *)
 where
   NbT_pos: "NbT \<in> nat-{0}" and
   Nclients_pos: "Nclients \<in> nat-{0}"
   
 text\<open>This function merely sums the elements of a list\<close>
 consts tokens :: "i \<Rightarrow>i"
        item :: i (* Items to be merged/distributed *)
 primrec 
   "tokens(Nil) = 0"
   "tokens (Cons(x,xs)) = x #+ tokens(xs)"
 
 consts bag_of :: "i \<Rightarrow> i"
 primrec
   "bag_of(Nil)    = 0"
   "bag_of(Cons(x,xs)) = {#x#} +# bag_of(xs)"
 
 
 text\<open>Definitions needed in Client.thy.  We define a recursive predicate
 using 0 and 1 to code the truth values.\<close>
 consts all_distinct0 :: "i\<Rightarrow>i"
 primrec
   "all_distinct0(Nil) = 1"
   "all_distinct0(Cons(a, l)) =
      (if a \<in> set_of_list(l) then 0 else all_distinct0(l))"
 
 definition
   all_distinct  :: "i\<Rightarrow>o"  where
    "all_distinct(l) \<equiv> all_distinct0(l)=1"
   
 definition  
   state_of :: "i \<Rightarrow>i" \<comment> \<open>coersion from anyting to state\<close>  where
    "state_of(s) \<equiv> if s \<in> state then s else st0"
 
 definition
   lift :: "i \<Rightarrow>(i\<Rightarrow>i)" \<comment> \<open>simplifies the expression of programs\<close>  where
    "lift(x) \<equiv> \<lambda>s. s`x"
 
 text\<open>function to show that the set of variables is infinite\<close>
 consts
   nat_list_inj :: "i\<Rightarrow>i"
   var_inj      :: "i\<Rightarrow>i"
 
 primrec
   "nat_list_inj(0) = Nil"
   "nat_list_inj(succ(n)) = Cons(n, nat_list_inj(n))"
 
 primrec
   "var_inj(Var(l)) = length(l)"
 
 definition
   nat_var_inj  :: "i\<Rightarrow>i"  where
   "nat_var_inj(n) \<equiv> Var(nat_list_inj(n))"
 
 
 subsection\<open>Various simple lemmas\<close>
 
 lemma Nclients_NbT_gt_0 [simp]: "0 < Nclients \<and> 0 < NbT"
 apply (cut_tac Nclients_pos NbT_pos)
 apply (auto intro: Ord_0_lt)
 done
 
 lemma Nclients_NbT_not_0 [simp]: "Nclients \<noteq> 0 \<and> NbT \<noteq> 0"
 by (cut_tac Nclients_pos NbT_pos, auto)
 
 lemma Nclients_type [simp,TC]: "Nclients\<in>nat"
 by (cut_tac Nclients_pos NbT_pos, auto)
 
 lemma NbT_type [simp,TC]: "NbT\<in>nat"
 by (cut_tac Nclients_pos NbT_pos, auto)
 
 lemma INT_Nclient_iff [iff]:
      "b\<in>\<Inter>(RepFun(Nclients, B)) \<longleftrightarrow> (\<forall>x\<in>Nclients. b\<in>B(x))"
 by (force simp add: INT_iff)
 
 lemma setsum_fun_mono [rule_format]:
      "n\<in>nat \<Longrightarrow>  
       (\<forall>i\<in>nat. i<n \<longrightarrow> f(i) $\<le> g(i)) \<longrightarrow>  
       setsum(f, n) $\<le> setsum(g,n)"
 apply (induct_tac "n", simp_all)
 apply (subgoal_tac "Finite(x) \<and> x\<notin>x")
  prefer 2 apply (simp add: nat_into_Finite mem_not_refl, clarify)
 apply (simp (no_asm_simp) add: succ_def)
 apply (subgoal_tac "\<forall>i\<in>nat. i<x\<longrightarrow> f(i) $\<le> g(i) ")
  prefer 2 apply (force dest: leI) 
 apply (rule zadd_zle_mono, simp_all)
 done
 
 lemma tokens_type [simp,TC]: "l\<in>list(A) \<Longrightarrow> tokens(l)\<in>nat"
 by (erule list.induct, auto)
 
 lemma tokens_mono_aux [rule_format]:
      "xs\<in>list(A) \<Longrightarrow> \<forall>ys\<in>list(A). \<langle>xs, ys\<rangle>\<in>prefix(A)  
    \<longrightarrow> tokens(xs) \<le> tokens(ys)"
 apply (induct_tac "xs")
 apply (auto dest: gen_prefix.dom_subset [THEN subsetD] simp add: prefix_def)
 done
 
 lemma tokens_mono: "\<langle>xs, ys\<rangle>\<in>prefix(A) \<Longrightarrow> tokens(xs) \<le> tokens(ys)"
 apply (cut_tac prefix_type)
 apply (blast intro: tokens_mono_aux)
 done
 
 lemma mono_tokens [iff]: "mono1(list(A), prefix(A), nat, Le,tokens)"
-apply (unfold mono1_def)
+  unfolding mono1_def
 apply (auto intro: tokens_mono simp add: Le_def)
 done
 
 lemma tokens_append [simp]: 
 "\<lbrakk>xs\<in>list(A); ys\<in>list(A)\<rbrakk> \<Longrightarrow> tokens(xs@ys) = tokens(xs) #+ tokens(ys)"
 apply (induct_tac "xs", auto)
 done
 
 subsection\<open>The function \<^term>\<open>bag_of\<close>\<close>
 
 lemma bag_of_type [simp,TC]: "l\<in>list(A) \<Longrightarrow>bag_of(l)\<in>Mult(A)"
 apply (induct_tac "l")
 apply (auto simp add: Mult_iff_multiset)
 done
 
 lemma bag_of_multiset:
      "l\<in>list(A) \<Longrightarrow> multiset(bag_of(l)) \<and> mset_of(bag_of(l))<=A"
 apply (drule bag_of_type)
 apply (auto simp add: Mult_iff_multiset)
 done
 
 lemma bag_of_append [simp]:
     "\<lbrakk>xs\<in>list(A); ys\<in>list(A)\<rbrakk> \<Longrightarrow> bag_of(xs@ys) = bag_of(xs) +# bag_of(ys)"
 apply (induct_tac "xs")
 apply (auto simp add: bag_of_multiset munion_assoc)
 done
 
 lemma bag_of_mono_aux [rule_format]:
      "xs\<in>list(A) \<Longrightarrow> \<forall>ys\<in>list(A). \<langle>xs, ys\<rangle>\<in>prefix(A)  
       \<longrightarrow> <bag_of(xs), bag_of(ys)>\<in>MultLe(A, r)"
 apply (induct_tac "xs", simp_all, clarify) 
 apply (frule_tac l = ys in bag_of_multiset)
 apply (auto intro: empty_le_MultLe simp add: prefix_def)
 apply (rule munion_mono)
 apply (force simp add: MultLe_def Mult_iff_multiset)
 apply (blast dest: gen_prefix.dom_subset [THEN subsetD])
 done
 
 lemma bag_of_mono [intro]:
      "\<lbrakk>\<langle>xs, ys\<rangle>\<in>prefix(A); xs\<in>list(A); ys\<in>list(A)\<rbrakk>
       \<Longrightarrow> <bag_of(xs), bag_of(ys)>\<in>MultLe(A, r)"
 apply (blast intro: bag_of_mono_aux)
 done
 
 lemma mono_bag_of [simp]: 
      "mono1(list(A), prefix(A), Mult(A), MultLe(A,r), bag_of)"
 by (auto simp add:  mono1_def bag_of_type)
 
 
 subsection\<open>The function \<^term>\<open>msetsum\<close>\<close>
 
 lemmas nat_into_Fin = eqpoll_refl [THEN [2] Fin_lemma]
 
 lemma list_Int_length_Fin: "l \<in> list(A) \<Longrightarrow> C \<inter> length(l) \<in> Fin(length(l))"
 apply (drule length_type)
 apply (rule Fin_subset)
 apply (rule Int_lower2)
 apply (erule nat_into_Fin)
 done
 
 
 
 lemma mem_Int_imp_lt_length:
      "\<lbrakk>xs \<in> list(A); k \<in> C \<inter> length(xs)\<rbrakk> \<Longrightarrow> k < length(xs)"
 by (simp add: ltI)
 
 lemma Int_succ_right:
      "A \<inter> succ(k) = (if k \<in> A then cons(k, A \<inter> k) else A \<inter> k)"
 by auto
 
 
 lemma bag_of_sublist_lemma:
      "\<lbrakk>C \<subseteq> nat; x \<in> A; xs \<in> list(A)\<rbrakk>   
   \<Longrightarrow>  msetsum(\<lambda>i. {#nth(i, xs @ [x])#}, C \<inter> succ(length(xs)), A) =  
        (if length(xs) \<in> C then  
           {#x#} +# msetsum(\<lambda>x. {#nth(x, xs)#}, C \<inter> length(xs), A)  
         else msetsum(\<lambda>x. {#nth(x, xs)#}, C \<inter> length(xs), A))"
 apply (simp add: subsetD nth_append lt_not_refl mem_Int_imp_lt_length cong add: msetsum_cong)
 apply (simp add: Int_succ_right)
 apply (simp add: lt_not_refl mem_Int_imp_lt_length cong add: msetsum_cong, clarify)
 apply (subst msetsum_cons)
 apply (rule_tac [3] succI1)
 apply (blast intro: list_Int_length_Fin subset_succI [THEN Fin_mono, THEN subsetD])
 apply (simp add: mem_not_refl)
 apply (simp add: nth_type lt_not_refl)
 apply (blast intro: nat_into_Ord ltI length_type)
 apply (simp add: lt_not_refl mem_Int_imp_lt_length cong add: msetsum_cong)
 done
 
 lemma bag_of_sublist_lemma2:
      "l\<in>list(A) \<Longrightarrow>  
   C \<subseteq> nat \<Longrightarrow>  
   bag_of(sublist(l, C)) =  
       msetsum(\<lambda>i. {#nth(i, l)#}, C \<inter> length(l), A)"
 apply (erule list_append_induct)
 apply (simp (no_asm))
 apply (simp (no_asm_simp) add: sublist_append nth_append bag_of_sublist_lemma munion_commute bag_of_sublist_lemma msetsum_multiset munion_0)
 done
 
 
 lemma nat_Int_length_eq: "l \<in> list(A) \<Longrightarrow> nat \<inter> length(l) = length(l)"
 apply (rule Int_absorb1)
 apply (rule OrdmemD, auto)
 done
 
 (*eliminating the assumption C<=nat*)
 lemma bag_of_sublist:
      "l\<in>list(A) \<Longrightarrow>  
   bag_of(sublist(l, C)) = msetsum(\<lambda>i. {#nth(i, l)#}, C \<inter> length(l), A)"
 apply (subgoal_tac " bag_of (sublist (l, C \<inter> nat)) = msetsum (\<lambda>i. {#nth (i, l) #}, C \<inter> length (l), A) ")
 apply (simp add: sublist_Int_eq)
 apply (simp add: bag_of_sublist_lemma2 Int_lower2 Int_assoc nat_Int_length_eq)
 done
 
 lemma bag_of_sublist_Un_Int: 
 "l\<in>list(A) \<Longrightarrow>  
   bag_of(sublist(l, B \<union> C)) +# bag_of(sublist(l, B \<inter> C)) =  
       bag_of(sublist(l, B)) +# bag_of(sublist(l, C))"
 apply (subgoal_tac "B \<inter> C \<inter> length (l) = (B \<inter> length (l)) \<inter> (C \<inter> length (l))")
 prefer 2 apply blast
 apply (simp (no_asm_simp) add: bag_of_sublist Int_Un_distrib2 msetsum_Un_Int)
 apply (rule msetsum_Un_Int)
 apply (erule list_Int_length_Fin)+
  apply (simp add: ltI nth_type)
 done
 
 
 lemma bag_of_sublist_Un_disjoint:
      "\<lbrakk>l\<in>list(A); B \<inter> C = 0\<rbrakk> 
       \<Longrightarrow> bag_of(sublist(l, B \<union> C)) =  
           bag_of(sublist(l, B)) +# bag_of(sublist(l, C))"
 by (simp add: bag_of_sublist_Un_Int [symmetric] bag_of_multiset)
 
 
 lemma bag_of_sublist_UN_disjoint [rule_format]:
      "\<lbrakk>Finite(I); \<forall>i\<in>I. \<forall>j\<in>I. i\<noteq>j \<longrightarrow> A(i) \<inter> A(j) = 0;  
         l\<in>list(B)\<rbrakk>  
       \<Longrightarrow> bag_of(sublist(l, \<Union>i\<in>I. A(i))) =   
           (msetsum(\<lambda>i. bag_of(sublist(l, A(i))), I, B)) "
 apply (simp (no_asm_simp) del: UN_simps
            add: UN_simps [symmetric] bag_of_sublist)
 apply (subst  msetsum_UN_disjoint [of _ _ _ "length (l)"])
 apply (drule Finite_into_Fin, assumption)
 prefer 3 apply force
 apply (auto intro!: Fin_IntI2 Finite_into_Fin simp add: ltI nth_type length_type nat_into_Finite)
 done
 
 
 lemma part_ord_Lt [simp]: "part_ord(nat, Lt)"
 apply (unfold part_ord_def Lt_def irrefl_def trans_on_def)
 apply (auto intro: lt_trans)
 done
 
 subsubsection\<open>The function \<^term>\<open>all_distinct\<close>\<close>
 
 lemma all_distinct_Nil [simp]: "all_distinct(Nil)"
 by (unfold all_distinct_def, auto)
 
 lemma all_distinct_Cons [simp]: 
     "all_distinct(Cons(a,l)) \<longleftrightarrow>  
       (a\<in>set_of_list(l) \<longrightarrow> False) \<and> (a \<notin> set_of_list(l) \<longrightarrow> all_distinct(l))"
-apply (unfold all_distinct_def)
+  unfolding all_distinct_def
 apply (auto elim: list.cases)
 done
 
 subsubsection\<open>The function \<^term>\<open>state_of\<close>\<close>
 
 lemma state_of_state: "s\<in>state \<Longrightarrow> state_of(s)=s"
 by (unfold state_of_def, auto)
 declare state_of_state [simp]
 
 
 lemma state_of_idem: "state_of(state_of(s))=state_of(s)"
 
 apply (unfold state_of_def, auto)
 done
 declare state_of_idem [simp]
 
 
 lemma state_of_type [simp,TC]: "state_of(s)\<in>state"
 by (unfold state_of_def, auto)
 
 lemma lift_apply [simp]: "lift(x, s)=s`x"
 by (simp add: lift_def)
 
 
 (** Used in ClientImp **)
 
 lemma gen_Increains_state_of_eq: 
      "Increasing(A, r, \<lambda>s. f(state_of(s))) = Increasing(A, r, f)"
 apply (unfold Increasing_def, auto)
 done
 
 lemmas Increasing_state_ofD1 =  
       gen_Increains_state_of_eq [THEN equalityD1, THEN subsetD]
 lemmas Increasing_state_ofD2 =  
       gen_Increains_state_of_eq [THEN equalityD2, THEN subsetD]
 
 lemma Follows_state_of_eq: 
      "Follows(A, r, \<lambda>s. f(state_of(s)), \<lambda>s. g(state_of(s))) =   
       Follows(A, r, f, g)"
 apply (unfold Follows_def Increasing_def, auto)
 done
 
 lemmas Follows_state_ofD1 =
       Follows_state_of_eq [THEN equalityD1, THEN subsetD]
 lemmas Follows_state_ofD2 =
       Follows_state_of_eq [THEN equalityD2, THEN subsetD]
 
 lemma nat_list_inj_type: "n\<in>nat \<Longrightarrow> nat_list_inj(n)\<in>list(nat)"
 by (induct_tac "n", auto)
 
 lemma length_nat_list_inj: "n\<in>nat \<Longrightarrow> length(nat_list_inj(n)) = n"
 by (induct_tac "n", auto)
 
 lemma var_infinite_lemma: 
   "(\<lambda>x\<in>nat. nat_var_inj(x))\<in>inj(nat, var)"
-apply (unfold nat_var_inj_def)
+  unfolding nat_var_inj_def
 apply (rule_tac d = var_inj in lam_injective)
 apply (auto simp add: var.intros nat_list_inj_type)
 apply (simp add: length_nat_list_inj)
 done
 
 lemma nat_lepoll_var: "nat \<lesssim> var"
-apply (unfold lepoll_def)
+  unfolding lepoll_def
 apply (rule_tac x = " (\<lambda>x\<in>nat. nat_var_inj (x))" in exI)
 apply (rule var_infinite_lemma)
 done
 
 lemma var_not_Finite: "\<not>Finite(var)"
 apply (insert nat_not_Finite) 
 apply (blast intro: lepoll_Finite [OF nat_lepoll_var]) 
 done
 
 lemma not_Finite_imp_exist: "\<not>Finite(A) \<Longrightarrow> \<exists>x. x\<in>A"
 apply (subgoal_tac "A\<noteq>0")
 apply (auto simp add: Finite_0)
 done
 
 lemma Inter_Diff_var_iff:
      "Finite(A) \<Longrightarrow> b\<in>(\<Inter>(RepFun(var-A, B))) \<longleftrightarrow> (\<forall>x\<in>var-A. b\<in>B(x))"
 apply (subgoal_tac "\<exists>x. x\<in>var-A", auto)
 apply (subgoal_tac "\<not>Finite (var-A) ")
 apply (drule not_Finite_imp_exist, auto)
 apply (cut_tac var_not_Finite)
 apply (erule swap)
 apply (rule_tac B = A in Diff_Finite, auto)
 done
 
 lemma Inter_var_DiffD:
      "\<lbrakk>b\<in>\<Inter>(RepFun(var-A, B)); Finite(A); x\<in>var-A\<rbrakk> \<Longrightarrow> b\<in>B(x)"
 by (simp add: Inter_Diff_var_iff)
 
 (* \<lbrakk>Finite(A); (\<forall>x\<in>var-A. b\<in>B(x))\<rbrakk> \<Longrightarrow> b\<in>\<Inter>(RepFun(var-A, B)) *)
 lemmas Inter_var_DiffI = Inter_Diff_var_iff [THEN iffD2]
 
 declare Inter_var_DiffI [intro!]
 
 lemma Acts_subset_Int_Pow_simp [simp]:
      "Acts(F)<= A \<inter> Pow(state*state)  \<longleftrightarrow> Acts(F)<=A"
 by (insert Acts_type [of F], auto)
 
 lemma setsum_nsetsum_eq: 
      "\<lbrakk>Finite(A); \<forall>x\<in>A. g(x)\<in>nat\<rbrakk> 
       \<Longrightarrow> setsum(\<lambda>x. $#(g(x)), A) = $# nsetsum(\<lambda>x. g(x), A)"
 apply (erule Finite_induct)
 apply (auto simp add: int_of_add)
 done
 
 lemma nsetsum_cong: 
      "\<lbrakk>A=B;  \<forall>x\<in>A. f(x)=g(x);  \<forall>x\<in>A. g(x)\<in>nat;  Finite(A)\<rbrakk>  
       \<Longrightarrow> nsetsum(f, A) = nsetsum(g, B)"
 apply (subgoal_tac "$# nsetsum (f, A) = $# nsetsum (g, B)", simp)
 apply (simp add: setsum_nsetsum_eq [symmetric] cong: setsum_cong) 
 done
 
 end
diff --git a/src/ZF/UNITY/AllocImpl.thy b/src/ZF/UNITY/AllocImpl.thy
--- a/src/ZF/UNITY/AllocImpl.thy
+++ b/src/ZF/UNITY/AllocImpl.thy
@@ -1,661 +1,661 @@
 (*  Title:      ZF/UNITY/AllocImpl.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     Copyright   2002  University of Cambridge
 
 Single-client allocator implementation.
 Charpentier and Chandy, section 7 (page 17).
 *)
 
 theory AllocImpl imports ClientImpl begin
 
 abbreviation
   NbR :: i            (*number of consumed messages*)  where
   "NbR \<equiv> Var([succ(2)])"
 
 abbreviation
   available_tok :: i  (*number of free tokens (T in paper)*)  where
   "available_tok \<equiv> Var([succ(succ(2))])"
 
 axiomatization where
   alloc_type_assumes [simp]:
   "type_of(NbR) = nat \<and> type_of(available_tok)=nat" and
 
   alloc_default_val_assumes [simp]:
   "default_val(NbR)  = 0 \<and> default_val(available_tok)=0"
 
 definition
   "alloc_giv_act \<equiv>
        {\<langle>s, t\<rangle> \<in> state*state.
         \<exists>k. k = length(s`giv) \<and>
             t = s(giv := s`giv @ [nth(k, s`ask)],
                   available_tok := s`available_tok #- nth(k, s`ask)) \<and>
             k < length(s`ask) \<and> nth(k, s`ask) \<le> s`available_tok}"
 
 definition
   "alloc_rel_act \<equiv>
        {\<langle>s, t\<rangle> \<in> state*state.
         t = s(available_tok := s`available_tok #+ nth(s`NbR, s`rel),
               NbR := succ(s`NbR)) \<and>
         s`NbR < length(s`rel)}"
 
 definition
   (*The initial condition s`giv=[] is missing from the
     original definition: S. O. Ehmety *)
   "alloc_prog \<equiv>
        mk_program({s:state. s`available_tok=NbT \<and> s`NbR=0 \<and> s`giv=Nil},
                   {alloc_giv_act, alloc_rel_act},
                   \<Union>G \<in> preserves(lift(available_tok)) \<inter>
                         preserves(lift(NbR)) \<inter>
                         preserves(lift(giv)). Acts(G))"
 
 
 lemma available_tok_value_type [simp,TC]: "s\<in>state \<Longrightarrow> s`available_tok \<in> nat"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = available_tok in apply_type, auto)
 done
 
 lemma NbR_value_type [simp,TC]: "s\<in>state \<Longrightarrow> s`NbR \<in> nat"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = NbR in apply_type, auto)
 done
 
 (** The Alloc Program **)
 
 lemma alloc_prog_type [simp,TC]: "alloc_prog \<in> program"
 by (simp add: alloc_prog_def)
 
 declare alloc_prog_def [THEN def_prg_Init, simp]
 declare alloc_prog_def [THEN def_prg_AllowedActs, simp]
 declare alloc_prog_def [program]
 
 declare  alloc_giv_act_def [THEN def_act_simp, simp]
 declare  alloc_rel_act_def [THEN def_act_simp, simp]
 
 
 lemma alloc_prog_ok_iff:
 "\<forall>G \<in> program. (alloc_prog ok G) \<longleftrightarrow>
      (G \<in> preserves(lift(giv)) \<and> G \<in> preserves(lift(available_tok)) \<and>
        G \<in> preserves(lift(NbR)) \<and>  alloc_prog \<in> Allowed(G))"
 by (auto simp add: ok_iff_Allowed alloc_prog_def [THEN def_prg_Allowed])
 
 
 lemma alloc_prog_preserves:
     "alloc_prog \<in> (\<Inter>x \<in> var-{giv, available_tok, NbR}. preserves(lift(x)))"
 apply (rule Inter_var_DiffI, force)
 apply (rule ballI)
 apply (rule preservesI, safety)
 done
 
 (* As a special case of the rule above *)
 
 lemma alloc_prog_preserves_rel_ask_tok:
     "alloc_prog \<in>
        preserves(lift(rel)) \<inter> preserves(lift(ask)) \<inter> preserves(lift(tok))"
 apply auto
 apply (insert alloc_prog_preserves)
 apply (drule_tac [3] x = tok in Inter_var_DiffD)
 apply (drule_tac [2] x = ask in Inter_var_DiffD)
 apply (drule_tac x = rel in Inter_var_DiffD, auto)
 done
 
 lemma alloc_prog_Allowed:
 "Allowed(alloc_prog) =
   preserves(lift(giv)) \<inter> preserves(lift(available_tok)) \<inter> preserves(lift(NbR))"
 apply (cut_tac v="lift(giv)" in preserves_type)
 apply (auto simp add: Allowed_def client_prog_def [THEN def_prg_Allowed]
                       cons_Int_distrib safety_prop_Acts_iff)
 done
 
 (* In particular we have *)
 lemma alloc_prog_ok_client_prog: "alloc_prog ok client_prog"
 apply (auto simp add: ok_iff_Allowed)
 apply (cut_tac alloc_prog_preserves)
 apply (cut_tac [2] client_prog_preserves)
 apply (auto simp add: alloc_prog_Allowed client_prog_Allowed)
 apply (drule_tac [6] B = "preserves (lift (NbR))" in InterD)
 apply (drule_tac [5] B = "preserves (lift (available_tok))" in InterD)
 apply (drule_tac [4] B = "preserves (lift (giv))" in InterD)
 apply (drule_tac [3] B = "preserves (lift (tok))" in InterD)
 apply (drule_tac [2] B = "preserves (lift (ask))" in InterD)
 apply (drule_tac B = "preserves (lift (rel))" in InterD)
 apply auto
 done
 
 (** Safety property: (28) **)
 lemma alloc_prog_Increasing_giv: "alloc_prog \<in> program guarantees Incr(lift(giv))"
 apply (auto intro!: increasing_imp_Increasing simp add: guar_def
   Increasing.increasing_def alloc_prog_ok_iff alloc_prog_Allowed, safety+)
 apply (auto dest: ActsD)
 apply (drule_tac f = "lift (giv) " in preserves_imp_eq)
 apply auto
 done
 
 lemma giv_Bounded_lamma1:
 "alloc_prog \<in> stable({s\<in>state. s`NbR \<le> length(s`rel)} \<inter>
                      {s\<in>state. s`available_tok #+ tokens(s`giv) =
                                  NbT #+ tokens(take(s`NbR, s`rel))})"
 apply safety
 apply auto
 apply (simp add: diff_add_0 add_commute diff_add_inverse add_assoc add_diff_inverse)
 apply (simp (no_asm_simp) add: take_succ)
 done
 
 lemma giv_Bounded_lemma2:
 "\<lbrakk>G \<in> program; alloc_prog ok G; alloc_prog \<squnion> G \<in> Incr(lift(rel))\<rbrakk>
   \<Longrightarrow> alloc_prog \<squnion> G \<in> Stable({s\<in>state. s`NbR \<le> length(s`rel)} \<inter>
    {s\<in>state. s`available_tok #+ tokens(s`giv) =
     NbT #+ tokens(take(s`NbR, s`rel))})"
 apply (cut_tac giv_Bounded_lamma1)
 apply (cut_tac alloc_prog_preserves_rel_ask_tok)
 apply (auto simp add: Collect_conj_eq [symmetric] alloc_prog_ok_iff)
 apply (subgoal_tac "G \<in> preserves (fun_pair (lift (available_tok), fun_pair (lift (NbR), lift (giv))))")
 apply (rotate_tac -1)
 apply (cut_tac A = "nat * nat * list(nat)"
              and P = "%<m,n,l> y. n \<le> length(y) \<and>
                                   m #+ tokens(l) = NbT #+ tokens(take(n,y))"
              and g = "lift(rel)" and F = alloc_prog
        in stable_Join_Stable)
 prefer 3 apply assumption
 apply (auto simp add: Collect_conj_eq)
 apply (frule_tac g = length in imp_Increasing_comp)
 apply (blast intro: mono_length)
 apply (auto simp add: refl_prefix)
 apply (drule_tac a=xa and f = "length comp lift(rel)" in Increasing_imp_Stable)
 apply assumption
 apply (auto simp add: Le_def length_type)
 apply (auto dest: ActsD simp add: Stable_def Constrains_def constrains_def)
 apply (drule_tac f = "lift (rel) " in preserves_imp_eq)
 apply assumption+
 apply (force dest: ActsD)
 apply (erule_tac V = "\<forall>x \<in> Acts (alloc_prog) \<union> Acts (G). P(x)" for P in thin_rl)
 apply (erule_tac V = "alloc_prog \<in> stable (u)" for u in thin_rl)
 apply (drule_tac a = "xc`rel" and f = "lift (rel)" in Increasing_imp_Stable)
 apply (auto simp add: Stable_def Constrains_def constrains_def)
 apply (drule bspec, force)
 apply (drule subsetD)
 apply (rule imageI, assumption)
 apply (auto simp add: prefix_take_iff)
 apply (rotate_tac -1)
 apply (erule ssubst)
 apply (auto simp add: take_take min_def)
 done
 
 (*Property (29), page 18:
   the number of tokens in circulation never exceeds NbT*)
 lemma alloc_prog_giv_Bounded: "alloc_prog \<in> Incr(lift(rel))
       guarantees Always({s\<in>state. tokens(s`giv) \<le> NbT #+ tokens(s`rel)})"
 apply (cut_tac NbT_pos)
 apply (auto simp add: guar_def)
 apply (rule Always_weaken)
 apply (rule AlwaysI)
 apply (rule_tac [2] giv_Bounded_lemma2, auto)
 apply (rule_tac j = "NbT #+ tokens(take (x` NbR, x`rel))" in le_trans)
 apply (erule subst)
 apply (auto intro!: tokens_mono simp add: prefix_take_iff min_def length_take)
 done
 
 (*Property (30), page 18: the number of tokens given never exceeds the number
   asked for*)
 lemma alloc_prog_ask_prefix_giv:
      "alloc_prog \<in> Incr(lift(ask)) guarantees
                    Always({s\<in>state. <s`giv, s`ask> \<in> prefix(tokbag)})"
 apply (auto intro!: AlwaysI simp add: guar_def)
 apply (subgoal_tac "G \<in> preserves (lift (giv))")
  prefer 2 apply (simp add: alloc_prog_ok_iff)
 apply (rule_tac P = "\<lambda>x y. \<langle>x,y\<rangle> \<in> prefix(tokbag)" and A = "list(nat)"
        in stable_Join_Stable)
 apply safety
  prefer 2 apply (simp add: lift_def, clarify)
 apply (drule_tac a = k in Increasing_imp_Stable, auto)
 done
 
 subsection\<open>Towards proving the liveness property, (31)\<close>
 
 subsubsection\<open>First, we lead up to a proof of Lemma 49, page 28.\<close>
 
 lemma alloc_prog_transient_lemma:
      "\<lbrakk>G \<in> program; k\<in>nat\<rbrakk>
       \<Longrightarrow> alloc_prog \<squnion> G \<in>
              transient({s\<in>state. k \<le> length(s`rel)} \<inter>
              {s\<in>state. succ(s`NbR) = k})"
 apply auto
 apply (erule_tac V = "G\<notin>u" for u in thin_rl)
 apply (rule_tac act = alloc_rel_act in transientI)
 apply (simp (no_asm) add: alloc_prog_def [THEN def_prg_Acts])
 apply (simp (no_asm) add: alloc_rel_act_def [THEN def_act_eq, THEN act_subset])
 apply (auto simp add: alloc_prog_def [THEN def_prg_Acts] domain_def)
 apply (rule ReplaceI)
 apply (rule_tac x = "x (available_tok:= x`available_tok #+ nth (x`NbR, x`rel),
                         NbR:=succ (x`NbR))"
        in exI)
 apply (auto intro!: state_update_type)
 done
 
 lemma alloc_prog_rel_Stable_NbR_lemma:
     "\<lbrakk>G \<in> program; alloc_prog ok G; k\<in>nat\<rbrakk>
      \<Longrightarrow> alloc_prog \<squnion> G \<in> Stable({s\<in>state . k \<le> succ(s ` NbR)})"
 apply (auto intro!: stable_imp_Stable simp add: alloc_prog_ok_iff, safety, auto)
 apply (blast intro: le_trans leI)
 apply (drule_tac f = "lift (NbR)" and A = nat in preserves_imp_increasing)
 apply (drule_tac [2] g = succ in imp_increasing_comp)
 apply (rule_tac [2] mono_succ)
 apply (drule_tac [4] x = k in increasing_imp_stable)
     prefer 5 apply (simp add: Le_def comp_def, auto)
 done
 
 lemma alloc_prog_NbR_LeadsTo_lemma:
      "\<lbrakk>G \<in> program; alloc_prog ok G;
          alloc_prog \<squnion> G \<in> Incr(lift(rel)); k\<in>nat\<rbrakk>
       \<Longrightarrow> alloc_prog \<squnion> G \<in>
             {s\<in>state. k \<le> length(s`rel)} \<inter> {s\<in>state. succ(s`NbR) = k}
             \<longmapsto>w {s\<in>state. k \<le> s`NbR}"
 apply (subgoal_tac "alloc_prog \<squnion> G \<in> Stable ({s\<in>state. k \<le> length (s`rel)})")
 apply (drule_tac [2] a = k and g1 = length in imp_Increasing_comp [THEN Increasing_imp_Stable])
 apply (rule_tac [2] mono_length)
     prefer 3 apply simp
 apply (simp_all add: refl_prefix Le_def comp_def length_type)
 apply (rule LeadsTo_weaken)
 apply (rule PSP_Stable)
 prefer 2 apply assumption
 apply (rule PSP_Stable)
 apply (rule_tac [2] alloc_prog_rel_Stable_NbR_lemma)
 apply (rule alloc_prog_transient_lemma [THEN transient_imp_leadsTo, THEN leadsTo_imp_LeadsTo], assumption+)
 apply (auto dest: not_lt_imp_le elim: lt_asym simp add: le_iff)
 done
 
 lemma alloc_prog_NbR_LeadsTo_lemma2 [rule_format]:
     "\<lbrakk>G \<in> program; alloc_prog ok G; alloc_prog \<squnion> G \<in> Incr(lift(rel));
         k\<in>nat; n \<in> nat; n < k\<rbrakk>
       \<Longrightarrow> alloc_prog \<squnion> G \<in>
             {s\<in>state . k \<le> length(s ` rel)} \<inter> {s\<in>state . s ` NbR = n}
                \<longmapsto>w {x \<in> state. k \<le> length(x`rel)} \<inter>
                  (\<Union>m \<in> greater_than(n). {x \<in> state. x ` NbR=m})"
-apply (unfold greater_than_def)
+  unfolding greater_than_def
 apply (rule_tac A' = "{x \<in> state. k \<le> length(x`rel)} \<inter> {x \<in> state. n < x`NbR}"
        in LeadsTo_weaken_R)
 apply safe
 apply (subgoal_tac "alloc_prog \<squnion> G \<in> Stable ({s\<in>state. k \<le> length (s`rel) }) ")
 apply (drule_tac [2] a = k and g1 = length in imp_Increasing_comp [THEN Increasing_imp_Stable])
 apply (rule_tac [2] mono_length)
     prefer 3 apply simp
 apply (simp_all add: refl_prefix Le_def comp_def length_type)
 apply (subst Int_commute [of _ "{x \<in> state . n < x ` NbR}"])
 apply (rule_tac A = "({s \<in> state . k \<le> length (s ` rel) } \<inter>
                       {s\<in>state . s ` NbR = n}) \<inter> {s\<in>state. k \<le> length(s`rel)}"
        in LeadsTo_weaken_L)
 apply (rule PSP_Stable, safe)
 apply (rule_tac B = "{x \<in> state . n < length (x ` rel) } \<inter> {s\<in>state . s ` NbR = n}" in LeadsTo_Trans)
 apply (rule_tac [2] LeadsTo_weaken)
 apply (rule_tac [2] k = "succ (n)" in alloc_prog_NbR_LeadsTo_lemma)
 apply simp_all
 apply (rule subset_imp_LeadsTo, auto)
 apply (blast intro: lt_trans2)
 done
 
 lemma Collect_vimage_eq: "u\<in>nat \<Longrightarrow> {<s,f(s)>. s \<in> A} -`` u = {s\<in>A. f(s) < u}"
 by (force simp add: lt_def)
 
 (* Lemma 49, page 28 *)
 
 lemma alloc_prog_NbR_LeadsTo_lemma3:
   "\<lbrakk>G \<in> program; alloc_prog ok G; alloc_prog \<squnion> G \<in> Incr(lift(rel));
      k\<in>nat\<rbrakk>
    \<Longrightarrow> alloc_prog \<squnion> G \<in>
            {s\<in>state. k \<le> length(s`rel)} \<longmapsto>w {s\<in>state. k \<le> s`NbR}"
 (* Proof by induction over the difference between k and n *)
 apply (rule_tac f = "\<lambda>s\<in>state. k #- s`NbR" in LessThan_induct)
 apply (simp_all add: lam_def, auto)
 apply (rule single_LeadsTo_I, auto)
 apply (simp (no_asm_simp) add: Collect_vimage_eq)
 apply (rename_tac "s0")
 apply (case_tac "s0`NbR < k")
 apply (rule_tac [2] subset_imp_LeadsTo, safe)
 apply (auto dest!: not_lt_imp_le)
 apply (rule LeadsTo_weaken)
 apply (rule_tac n = "s0`NbR" in alloc_prog_NbR_LeadsTo_lemma2, safe)
 prefer 3 apply assumption
 apply (auto split: nat_diff_split simp add: greater_than_def not_lt_imp_le not_le_iff_lt)
 apply (blast dest: lt_asym)
 apply (force dest: add_lt_elim2)
 done
 
 subsubsection\<open>Towards proving lemma 50, page 29\<close>
 
 lemma alloc_prog_giv_Ensures_lemma:
 "\<lbrakk>G \<in> program; k\<in>nat; alloc_prog ok G;
   alloc_prog \<squnion> G \<in> Incr(lift(ask))\<rbrakk> \<Longrightarrow>
   alloc_prog \<squnion> G \<in>
   {s\<in>state. nth(length(s`giv), s`ask) \<le> s`available_tok} \<inter>
   {s\<in>state.  k < length(s`ask)} \<inter> {s\<in>state. length(s`giv)=k}
   Ensures {s\<in>state. \<not> k <length(s`ask)} \<union> {s\<in>state. length(s`giv) \<noteq> k}"
 apply (rule EnsuresI, auto)
 apply (erule_tac [2] V = "G\<notin>u" for u in thin_rl)
 apply (rule_tac [2] act = alloc_giv_act in transientI)
  prefer 2
  apply (simp add: alloc_prog_def [THEN def_prg_Acts])
  apply (simp add: alloc_giv_act_def [THEN def_act_eq, THEN act_subset])
 apply (auto simp add: alloc_prog_def [THEN def_prg_Acts] domain_def)
 apply (erule_tac [2] swap)
 apply (rule_tac [2] ReplaceI)
 apply (rule_tac [2] x = "x (giv := x ` giv @ [nth (length(x`giv), x ` ask) ], available_tok := x ` available_tok #- nth (length(x`giv), x ` ask))" in exI)
 apply (auto intro!: state_update_type simp add: app_type)
 apply (rule_tac A = "{s\<in>state . nth (length(s ` giv), s ` ask) \<le> s ` available_tok} \<inter> {s\<in>state . k < length(s ` ask) } \<inter> {s\<in>state. length(s`giv) =k}" and A' = "{s\<in>state . nth (length(s ` giv), s ` ask) \<le> s ` available_tok} \<union> {s\<in>state. \<not> k < length(s`ask) } \<union> {s\<in>state . length(s ` giv) \<noteq> k}" in Constrains_weaken)
 apply (auto dest: ActsD simp add: Constrains_def constrains_def alloc_prog_def [THEN def_prg_Acts] alloc_prog_ok_iff)
 apply (subgoal_tac "length(xa ` giv @ [nth (length(xa ` giv), xa ` ask) ]) = length(xa ` giv) #+ 1")
 apply (rule_tac [2] trans)
 apply (rule_tac [2] length_app, auto)
 apply (rule_tac j = "xa ` available_tok" in le_trans, auto)
 apply (drule_tac f = "lift (available_tok)" in preserves_imp_eq)
 apply assumption+
 apply auto
 apply (drule_tac a = "xa ` ask" and r = "prefix(tokbag)" and A = "list(tokbag)"
        in Increasing_imp_Stable)
 apply (auto simp add: prefix_iff)
 apply (drule StableD)
 apply (auto simp add: Constrains_def constrains_def, force)
 done
 
 lemma alloc_prog_giv_Stable_lemma:
 "\<lbrakk>G \<in> program; alloc_prog ok G; k\<in>nat\<rbrakk>
   \<Longrightarrow> alloc_prog \<squnion> G \<in> Stable({s\<in>state . k \<le> length(s`giv)})"
 apply (auto intro!: stable_imp_Stable simp add: alloc_prog_ok_iff, safety)
 apply (auto intro: leI)
 apply (drule_tac f = "lift (giv)" and g = length in imp_preserves_comp)
 apply (drule_tac f = "length comp lift (giv)" and A = nat and r = Le in preserves_imp_increasing)
 apply (drule_tac [2] x = k in increasing_imp_stable)
  prefer 3 apply (simp add: Le_def comp_def)
 apply (auto simp add: length_type)
 done
 
 (* Lemma 50, page 29 *)
 
 lemma alloc_prog_giv_LeadsTo_lemma:
 "\<lbrakk>G \<in> program; alloc_prog ok G;
     alloc_prog \<squnion> G \<in> Incr(lift(ask)); k\<in>nat\<rbrakk>
  \<Longrightarrow> alloc_prog \<squnion> G \<in>
         {s\<in>state. nth(length(s`giv), s`ask) \<le> s`available_tok} \<inter>
         {s\<in>state.  k < length(s`ask)} \<inter>
         {s\<in>state. length(s`giv) = k}
         \<longmapsto>w {s\<in>state. k < length(s`giv)}"
 apply (subgoal_tac "alloc_prog \<squnion> G \<in> {s\<in>state. nth (length(s`giv), s`ask) \<le> s`available_tok} \<inter> {s\<in>state. k < length(s`ask) } \<inter> {s\<in>state. length(s`giv) = k} \<longmapsto>w {s\<in>state. \<not> k <length(s`ask) } \<union> {s\<in>state. length(s`giv) \<noteq> k}")
 prefer 2 apply (blast intro: alloc_prog_giv_Ensures_lemma [THEN LeadsTo_Basis])
 apply (subgoal_tac "alloc_prog \<squnion> G \<in> Stable ({s\<in>state. k < length(s`ask) }) ")
 apply (drule PSP_Stable, assumption)
 apply (rule LeadsTo_weaken)
 apply (rule PSP_Stable)
 apply (rule_tac [2] k = k in alloc_prog_giv_Stable_lemma)
 apply (auto simp add: le_iff)
 apply (drule_tac a = "succ (k)" and g1 = length in imp_Increasing_comp [THEN Increasing_imp_Stable])
 apply (rule mono_length)
  prefer 2 apply simp
 apply (simp_all add: refl_prefix Le_def comp_def length_type)
 done
 
 
 text\<open>Lemma 51, page 29.
   This theorem states as invariant that if the number of
   tokens given does not exceed the number returned, then the upper limit
   (\<^term>\<open>NbT\<close>) does not exceed the number currently available.\<close>
 lemma alloc_prog_Always_lemma:
 "\<lbrakk>G \<in> program; alloc_prog ok G;
     alloc_prog \<squnion> G \<in> Incr(lift(ask));
     alloc_prog \<squnion> G \<in> Incr(lift(rel))\<rbrakk>
   \<Longrightarrow> alloc_prog \<squnion> G \<in>
         Always({s\<in>state. tokens(s`giv) \<le> tokens(take(s`NbR, s`rel)) \<longrightarrow>
                 NbT \<le> s`available_tok})"
 apply (subgoal_tac
        "alloc_prog \<squnion> G
           \<in> Always ({s\<in>state. s`NbR \<le> length(s`rel) } \<inter>
                     {s\<in>state. s`available_tok #+ tokens(s`giv) = 
                               NbT #+ tokens(take (s`NbR, s`rel))})")
 apply (rule_tac [2] AlwaysI)
 apply (rule_tac [3] giv_Bounded_lemma2, auto)
 apply (rule Always_weaken, assumption, auto)
 apply (subgoal_tac "0 \<le> tokens(take (x ` NbR, x ` rel)) #- tokens(x`giv) ")
  prefer 2 apply (force)
 apply (subgoal_tac "x`available_tok =
                     NbT #+ (tokens(take(x`NbR,x`rel)) #- tokens(x`giv))")
 apply (simp add: )
 apply (auto split: nat_diff_split dest: lt_trans2)
 done
 
 
 
 subsubsection\<open>Main lemmas towards proving property (31)\<close>
 
 lemma LeadsTo_strength_R:
     "\<lbrakk>F \<in> C \<longmapsto>w B'; F \<in> A-C \<longmapsto>w B; B'<=B\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w  B"
 by (blast intro: LeadsTo_weaken LeadsTo_Un_Un)
 
 lemma PSP_StableI:
 "\<lbrakk>F \<in> Stable(C); F \<in> A - C \<longmapsto>w B;
    F \<in> A \<inter> C \<longmapsto>w B \<union> (state - C)\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w  B"
 apply (rule_tac A = " (A-C) \<union> (A \<inter> C)" in LeadsTo_weaken_L)
  prefer 2 apply blast
 apply (rule LeadsTo_Un, assumption)
 apply (blast intro: LeadsTo_weaken dest: PSP_Stable)
 done
 
 lemma state_compl_eq [simp]: "state - {s\<in>state. P(s)} = {s\<in>state. \<not>P(s)}"
 by auto
 
 (*needed?*)
 lemma single_state_Diff_eq [simp]: "{s}-{x \<in> state. P(x)} = (if s\<in>state \<and> P(s) then 0 else {s})"
 by auto
 
 
 locale alloc_progress =
  fixes G
  assumes Gprog [intro,simp]: "G \<in> program"
      and okG [iff]:          "alloc_prog ok G"
      and Incr_rel [intro]:   "alloc_prog \<squnion> G \<in> Incr(lift(rel))"
      and Incr_ask [intro]:   "alloc_prog \<squnion> G \<in> Incr(lift(ask))"
      and safety:   "alloc_prog \<squnion> G
                       \<in> Always(\<Inter>k \<in> nat. {s\<in>state. nth(k, s`ask) \<le> NbT})"
      and progress: "alloc_prog \<squnion> G
                       \<in> (\<Inter>k\<in>nat. {s\<in>state. k \<le> tokens(s`giv)} \<longmapsto>w
                         {s\<in>state. k \<le> tokens(s`rel)})"
 
 (*First step in proof of (31) -- the corrected version from Charpentier.
   This lemma implies that if a client releases some tokens then the Allocator
   will eventually recognize that they've been released.*)
 lemma (in alloc_progress) tokens_take_NbR_lemma:
  "k \<in> tokbag
   \<Longrightarrow> alloc_prog \<squnion> G \<in>
         {s\<in>state. k \<le> tokens(s`rel)}
         \<longmapsto>w {s\<in>state. k \<le> tokens(take(s`NbR, s`rel))}"
 apply (rule single_LeadsTo_I, safe)
 apply (rule_tac a1 = "s`rel" in Increasing_imp_Stable [THEN PSP_StableI])
 apply (rule_tac [4] k1 = "length(s`rel)" in alloc_prog_NbR_LeadsTo_lemma3 [THEN LeadsTo_strength_R])
 apply (rule_tac [8] subset_imp_LeadsTo)
 apply (auto intro!: Incr_rel)
 apply (rule_tac j = "tokens(take (length(s`rel), x`rel))" in le_trans)
 apply (rule_tac j = "tokens(take (length(s`rel), s`rel))" in le_trans)
 apply (auto intro!: tokens_mono take_mono simp add: prefix_iff)
 done
 
 (*** Rest of proofs done by lcp ***)
 
 (*Second step in proof of (31): by LHS of the guarantee and transivity of
   \<longmapsto>w *)
 lemma (in alloc_progress) tokens_take_NbR_lemma2:
      "k \<in> tokbag
       \<Longrightarrow> alloc_prog \<squnion> G \<in>
             {s\<in>state. tokens(s`giv) = k}
             \<longmapsto>w {s\<in>state. k \<le> tokens(take(s`NbR, s`rel))}"
 apply (rule LeadsTo_Trans)
  apply (rule_tac [2] tokens_take_NbR_lemma)
  prefer 2 apply assumption
 apply (insert progress) 
 apply (blast intro: LeadsTo_weaken_L progress nat_into_Ord)
 done
 
 (*Third step in proof of (31): by PSP with the fact that giv increases *)
 lemma (in alloc_progress) length_giv_disj:
      "\<lbrakk>k \<in> tokbag; n \<in> nat\<rbrakk>
       \<Longrightarrow> alloc_prog \<squnion> G \<in>
             {s\<in>state. length(s`giv) = n \<and> tokens(s`giv) = k}
             \<longmapsto>w
               {s\<in>state. (length(s`giv) = n \<and> tokens(s`giv) = k \<and>
                          k \<le> tokens(take(s`NbR, s`rel))) | n < length(s`giv)}"
 apply (rule single_LeadsTo_I, safe)
 apply (rule_tac a1 = "s`giv" in Increasing_imp_Stable [THEN PSP_StableI])
 apply (rule alloc_prog_Increasing_giv [THEN guaranteesD])
 apply (simp_all add: Int_cons_left)
 apply (rule LeadsTo_weaken)
 apply (rule_tac k = "tokens(s`giv)" in tokens_take_NbR_lemma2)
 apply auto
 apply (force dest: prefix_length_le [THEN le_iff [THEN iffD1]]) 
 apply (simp add: not_lt_iff_le)
 apply (force dest: prefix_length_le_equal) 
 done
 
 (*Fourth step in proof of (31): we apply lemma (51) *)
 lemma (in alloc_progress) length_giv_disj2:
      "\<lbrakk>k \<in> tokbag; n \<in> nat\<rbrakk>
       \<Longrightarrow> alloc_prog \<squnion> G \<in>
             {s\<in>state. length(s`giv) = n \<and> tokens(s`giv) = k}
             \<longmapsto>w
               {s\<in>state. (length(s`giv) = n \<and> NbT \<le> s`available_tok) |
                         n < length(s`giv)}"
 apply (rule LeadsTo_weaken_R)
 apply (rule Always_LeadsToD [OF alloc_prog_Always_lemma length_giv_disj], auto)
 done
 
 (*Fifth step in proof of (31): from the fourth step, taking the union over all
   k\<in>nat *)
 lemma (in alloc_progress) length_giv_disj3:
      "n \<in> nat
       \<Longrightarrow> alloc_prog \<squnion> G \<in>
             {s\<in>state. length(s`giv) = n}
             \<longmapsto>w
               {s\<in>state. (length(s`giv) = n \<and> NbT \<le> s`available_tok) |
                         n < length(s`giv)}"
 apply (rule LeadsTo_weaken_L)
 apply (rule_tac I = nat in LeadsTo_UN)
 apply (rule_tac k = i in length_giv_disj2)
 apply (simp_all add: UN_conj_eq)
 done
 
 (*Sixth step in proof of (31): from the fifth step, by PSP with the
   assumption that ask increases *)
 lemma (in alloc_progress) length_ask_giv:
  "\<lbrakk>k \<in> nat;  n < k\<rbrakk>
   \<Longrightarrow> alloc_prog \<squnion> G \<in>
         {s\<in>state. length(s`ask) = k \<and> length(s`giv) = n}
         \<longmapsto>w
           {s\<in>state. (NbT \<le> s`available_tok \<and> length(s`giv) < length(s`ask) \<and>
                      length(s`giv) = n) |
                     n < length(s`giv)}"
 apply (rule single_LeadsTo_I, safe)
 apply (rule_tac a1 = "s`ask" and f1 = "lift(ask)" 
        in Increasing_imp_Stable [THEN PSP_StableI])
 apply (rule Incr_ask, simp_all)
 apply (rule LeadsTo_weaken)
 apply (rule_tac n = "length(s ` giv)" in length_giv_disj3)
 apply simp_all
 apply blast
 apply clarify
 apply simp
 apply (blast dest!: prefix_length_le intro: lt_trans2)
 done
 
 
 (*Seventh step in proof of (31): no request (ask[k]) exceeds NbT *)
 lemma (in alloc_progress) length_ask_giv2:
      "\<lbrakk>k \<in> nat;  n < k\<rbrakk>
       \<Longrightarrow> alloc_prog \<squnion> G \<in>
             {s\<in>state. length(s`ask) = k \<and> length(s`giv) = n}
             \<longmapsto>w
               {s\<in>state. (nth(length(s`giv), s`ask) \<le> s`available_tok \<and>
                          length(s`giv) < length(s`ask) \<and> length(s`giv) = n) |
                         n < length(s`giv)}"
 apply (rule LeadsTo_weaken_R)
 apply (rule Always_LeadsToD [OF safety length_ask_giv], assumption+, clarify)
 apply (simp add: INT_iff)
 apply (drule_tac x = "length(x ` giv)" and P = "\<lambda>x. f (x) \<le> NbT" for f in bspec)
 apply simp
 apply (blast intro: le_trans)
 done
 
 (*Eighth step in proof of (31): by 50, we get |giv| > n. *)
 lemma (in alloc_progress) extend_giv:
      "\<lbrakk>k \<in> nat;  n < k\<rbrakk>
       \<Longrightarrow> alloc_prog \<squnion> G \<in>
             {s\<in>state. length(s`ask) = k \<and> length(s`giv) = n}
             \<longmapsto>w {s\<in>state. n < length(s`giv)}"
 apply (rule LeadsTo_Un_duplicate)
 apply (rule LeadsTo_cancel1)
 apply (rule_tac [2] alloc_prog_giv_LeadsTo_lemma)
 apply (simp_all add: Incr_ask lt_nat_in_nat)
 apply (rule LeadsTo_weaken_R)
 apply (rule length_ask_giv2, auto)
 done
 
 (*Ninth and tenth steps in proof of (31): by 50, we get |giv| > n.
   The report has an error: putting |ask|=k for the precondition fails because
   we can't expect |ask| to remain fixed until |giv| increases.*)
 lemma (in alloc_progress) alloc_prog_ask_LeadsTo_giv:
  "k \<in> nat
   \<Longrightarrow> alloc_prog \<squnion> G \<in>
         {s\<in>state. k \<le> length(s`ask)} \<longmapsto>w {s\<in>state. k \<le> length(s`giv)}"
 (* Proof by induction over the difference between k and n *)
 apply (rule_tac f = "\<lambda>s\<in>state. k #- length(s`giv)" in LessThan_induct)
 apply (auto simp add: lam_def Collect_vimage_eq)
 apply (rule single_LeadsTo_I, auto)
 apply (rename_tac "s0")
 apply (case_tac "length(s0 ` giv) < length(s0 ` ask) ")
  apply (rule_tac [2] subset_imp_LeadsTo)
   apply (auto simp add: not_lt_iff_le)
  prefer 2 apply (blast dest: le_imp_not_lt intro: lt_trans2)
 apply (rule_tac a1 = "s0`ask" and f1 = "lift (ask)"
        in Increasing_imp_Stable [THEN PSP_StableI])
 apply (rule Incr_ask, simp)
 apply (force)
 apply (rule LeadsTo_weaken)
 apply (rule_tac n = "length(s0 ` giv)" and k = "length(s0 ` ask)"
        in extend_giv) 
 apply (auto dest: not_lt_imp_le simp add: leI diff_lt_iff_lt) 
 apply (blast dest!: prefix_length_le intro: lt_trans2)
 done
 
 (*Final lemma: combine previous result with lemma (30)*)
 lemma (in alloc_progress) final:
      "h \<in> list(tokbag)
       \<Longrightarrow> alloc_prog \<squnion> G
             \<in> {s\<in>state. <h, s`ask> \<in> prefix(tokbag)} \<longmapsto>w
               {s\<in>state. <h, s`giv> \<in> prefix(tokbag)}"
 apply (rule single_LeadsTo_I)
  prefer 2 apply simp
 apply (rename_tac s0)
 apply (rule_tac a1 = "s0`ask" and f1 = "lift (ask)"
        in Increasing_imp_Stable [THEN PSP_StableI])
    apply (rule Incr_ask)
   apply (simp_all add: Int_cons_left)
 apply (rule LeadsTo_weaken)
 apply (rule_tac k1 = "length(s0 ` ask)"
        in Always_LeadsToD [OF alloc_prog_ask_prefix_giv [THEN guaranteesD]
                               alloc_prog_ask_LeadsTo_giv])
 apply (auto simp add: Incr_ask)
 apply (blast intro: length_le_prefix_imp_prefix prefix_trans prefix_length_le 
                     lt_trans2)
 done
 
 (** alloc_prog liveness property (31), page 18 **)
 
 theorem alloc_prog_progress:
 "alloc_prog \<in>
     Incr(lift(ask)) \<inter> Incr(lift(rel)) \<inter>
     Always(\<Inter>k \<in> nat. {s\<in>state. nth(k, s`ask) \<le> NbT}) \<inter>
     (\<Inter>k\<in>nat. {s\<in>state. k \<le> tokens(s`giv)} \<longmapsto>w
               {s\<in>state. k \<le> tokens(s`rel)})
   guarantees (\<Inter>h \<in> list(tokbag).
               {s\<in>state. <h, s`ask> \<in> prefix(tokbag)} \<longmapsto>w
               {s\<in>state. <h, s`giv> \<in> prefix(tokbag)})"
 apply (rule guaranteesI)
 apply (rule INT_I)
 apply (rule alloc_progress.final)
 apply (auto simp add: alloc_progress_def)
 done
 
 end
diff --git a/src/ZF/UNITY/ClientImpl.thy b/src/ZF/UNITY/ClientImpl.thy
--- a/src/ZF/UNITY/ClientImpl.thy
+++ b/src/ZF/UNITY/ClientImpl.thy
@@ -1,307 +1,307 @@
 (*  Title:      ZF/UNITY/ClientImpl.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     Copyright   2002  University of Cambridge
 
 Distributed Resource Management System:  Client Implementation.
 *)
 
 theory ClientImpl imports AllocBase Guar begin
 
 abbreviation "ask \<equiv> Var(Nil)" (* input history:  tokens requested *)
 abbreviation "giv \<equiv> Var([0])" (* output history: tokens granted *)
 abbreviation "rel \<equiv> Var([1])" (* input history: tokens released *)
 abbreviation "tok \<equiv> Var([2])" (* the number of available tokens *)
 
 axiomatization where
   type_assumes:
   "type_of(ask) = list(tokbag) \<and> type_of(giv) = list(tokbag) \<and>
    type_of(rel) = list(tokbag) \<and> type_of(tok) = nat" and
   default_val_assumes:
   "default_val(ask) = Nil \<and> default_val(giv) = Nil \<and>
    default_val(rel) = Nil \<and> default_val(tok) = 0"
 
 
 (*Array indexing is translated to list indexing as A[n] \<equiv> nth(n-1,A). *)
 
 definition
  (** Release some client_tokens **)
     "client_rel_act \<equiv>
      {\<langle>s,t\<rangle> \<in> state*state.
       \<exists>nrel \<in> nat. nrel = length(s`rel) \<and>
                    t = s(rel:=(s`rel)@[nth(nrel, s`giv)]) \<and>
                    nrel < length(s`giv) \<and>
                    nth(nrel, s`ask) \<le> nth(nrel, s`giv)}"
 
   (** Choose a new token requirement **)
   (** Including t=s suppresses fairness, allowing the non-trivial part
       of the action to be ignored **)
 definition
   "client_tok_act \<equiv> {\<langle>s,t\<rangle> \<in> state*state. t=s |
                      t = s(tok:=succ(s`tok mod NbT))}"
 
 definition
   "client_ask_act \<equiv> {\<langle>s,t\<rangle> \<in> state*state. t=s | (t=s(ask:=s`ask@[s`tok]))}"
 
 definition
   "client_prog \<equiv>
    mk_program({s \<in> state. s`tok \<le> NbT \<and> s`giv = Nil \<and>
                        s`ask = Nil \<and> s`rel = Nil},
                     {client_rel_act, client_tok_act, client_ask_act},
                    \<Union>G \<in> preserves(lift(rel)) Int
                          preserves(lift(ask)) Int
                          preserves(lift(tok)).  Acts(G))"
 
 
 declare type_assumes [simp] default_val_assumes [simp]
 (* This part should be automated *)
 
 lemma ask_value_type [simp,TC]: "s \<in> state \<Longrightarrow> s`ask \<in> list(nat)"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = ask in apply_type, auto)
 done
 
 lemma giv_value_type [simp,TC]: "s \<in> state \<Longrightarrow> s`giv \<in> list(nat)"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = giv in apply_type, auto)
 done
 
 lemma rel_value_type [simp,TC]: "s \<in> state \<Longrightarrow> s`rel \<in> list(nat)"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = rel in apply_type, auto)
 done
 
 lemma tok_value_type [simp,TC]: "s \<in> state \<Longrightarrow> s`tok \<in> nat"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = tok in apply_type, auto)
 done
 
 (** The Client Program **)
 
 lemma client_type [simp,TC]: "client_prog \<in> program"
-apply (unfold client_prog_def)
+  unfolding client_prog_def
 apply (simp (no_asm))
 done
 
 declare client_prog_def [THEN def_prg_Init, simp]
 declare client_prog_def [THEN def_prg_AllowedActs, simp]
 declare client_prog_def [program]
 
 declare  client_rel_act_def [THEN def_act_simp, simp]
 declare  client_tok_act_def [THEN def_act_simp, simp]
 declare  client_ask_act_def [THEN def_act_simp, simp]
 
 lemma client_prog_ok_iff:
   "\<forall>G \<in> program. (client_prog ok G) \<longleftrightarrow>
    (G \<in> preserves(lift(rel)) \<and> G \<in> preserves(lift(ask)) \<and>
     G \<in> preserves(lift(tok)) \<and>  client_prog \<in> Allowed(G))"
 by (auto simp add: ok_iff_Allowed client_prog_def [THEN def_prg_Allowed])
 
 lemma client_prog_preserves:
     "client_prog:(\<Inter>x \<in> var-{ask, rel, tok}. preserves(lift(x)))"
 apply (rule Inter_var_DiffI, force)
 apply (rule ballI)
 apply (rule preservesI, safety, auto)
 done
 
 
 lemma preserves_lift_imp_stable:
      "G \<in> preserves(lift(ff)) \<Longrightarrow> G \<in> stable({s \<in> state. P(s`ff)})"
 apply (drule preserves_imp_stable)
 apply (simp add: lift_def)
 done
 
 lemma preserves_imp_prefix:
      "G \<in> preserves(lift(ff))
       \<Longrightarrow> G \<in> stable({s \<in> state. \<langle>k, s`ff\<rangle> \<in> prefix(nat)})"
 by (erule preserves_lift_imp_stable)
 
 (*Safety property 1 \<in> ask, rel are increasing: (24) *)
 lemma client_prog_Increasing_ask_rel:
 "client_prog: program guarantees Incr(lift(ask)) \<inter> Incr(lift(rel))"
-apply (unfold guar_def)
+  unfolding guar_def
 apply (auto intro!: increasing_imp_Increasing
             simp add: client_prog_ok_iff Increasing.increasing_def preserves_imp_prefix)
 apply (safety, force, force)+
 done
 
 declare nth_append [simp] append_one_prefix [simp]
 
 lemma NbT_pos2: "0<NbT"
 apply (cut_tac NbT_pos)
 apply (rule Ord_0_lt, auto)
 done
 
 (*Safety property 2 \<in> the client never requests too many tokens.
 With no Substitution Axiom, we must prove the two invariants simultaneously. *)
 
 lemma ask_Bounded_lemma:
 "\<lbrakk>client_prog ok G; G \<in> program\<rbrakk>
       \<Longrightarrow> client_prog \<squnion> G \<in>
               Always({s \<in> state. s`tok \<le> NbT}  \<inter>
                       {s \<in> state. \<forall>elt \<in> set_of_list(s`ask). elt \<le> NbT})"
 apply (rotate_tac -1)
 apply (auto simp add: client_prog_ok_iff)
 apply (rule invariantI [THEN stable_Join_Always2], force)
  prefer 2
  apply (fast intro: stable_Int preserves_lift_imp_stable, safety)
 apply (auto dest: ActsD)
 apply (cut_tac NbT_pos)
 apply (rule NbT_pos2 [THEN mod_less_divisor])
 apply (auto dest: ActsD preserves_imp_eq simp add: set_of_list_append)
 done
 
 (* Export version, with no mention of tok in the postcondition, but
   unfortunately tok must be declared local.*)
 lemma client_prog_ask_Bounded:
     "client_prog \<in> program guarantees
                    Always({s \<in> state. \<forall>elt \<in> set_of_list(s`ask). elt \<le> NbT})"
 apply (rule guaranteesI)
 apply (erule ask_Bounded_lemma [THEN Always_weaken], auto)
 done
 
 (*** Towards proving the liveness property ***)
 
 lemma client_prog_stable_rel_le_giv:
     "client_prog \<in> stable({s \<in> state. <s`rel, s`giv> \<in> prefix(nat)})"
 by (safety, auto)
 
 lemma client_prog_Join_Stable_rel_le_giv:
 "\<lbrakk>client_prog \<squnion> G \<in> Incr(lift(giv)); G \<in> preserves(lift(rel))\<rbrakk>
     \<Longrightarrow> client_prog \<squnion> G \<in> Stable({s \<in> state. <s`rel, s`giv> \<in> prefix(nat)})"
 apply (rule client_prog_stable_rel_le_giv [THEN Increasing_preserves_Stable])
 apply (auto simp add: lift_def)
 done
 
 lemma client_prog_Join_Always_rel_le_giv:
      "\<lbrakk>client_prog \<squnion> G \<in> Incr(lift(giv)); G \<in> preserves(lift(rel))\<rbrakk>
     \<Longrightarrow> client_prog \<squnion> G  \<in> Always({s \<in> state. <s`rel, s`giv> \<in> prefix(nat)})"
 by (force intro!: AlwaysI client_prog_Join_Stable_rel_le_giv)
 
 lemma def_act_eq:
      "A \<equiv> {\<langle>s, t\<rangle> \<in> state*state. P(s, t)} \<Longrightarrow> A={\<langle>s, t\<rangle> \<in> state*state. P(s, t)}"
 by auto
 
 lemma act_subset: "A={\<langle>s,t\<rangle> \<in> state*state. P(s, t)} \<Longrightarrow> A<=state*state"
 by auto
 
 lemma transient_lemma:
 "client_prog \<in>
   transient({s \<in> state. s`rel = k \<and> \<langle>k, h\<rangle> \<in> strict_prefix(nat)
    \<and> <h, s`giv> \<in> prefix(nat) \<and> h pfixGe s`ask})"
 apply (rule_tac act = client_rel_act in transientI)
 apply (simp (no_asm) add: client_prog_def [THEN def_prg_Acts])
 apply (simp (no_asm) add: client_rel_act_def [THEN def_act_eq, THEN act_subset])
 apply (auto simp add: client_prog_def [THEN def_prg_Acts] domain_def)
 apply (rule ReplaceI)
 apply (rule_tac x = "x (rel:= x`rel @ [nth (length (x`rel), x`giv) ]) " in exI)
 apply (auto intro!: state_update_type app_type length_type nth_type, auto)
 apply (blast intro: lt_trans2 prefix_length_le strict_prefix_length_lt)
 apply (blast intro: lt_trans2 prefix_length_le strict_prefix_length_lt)
 apply (simp (no_asm_use) add: gen_prefix_iff_nth)
 apply (subgoal_tac "h \<in> list(nat)")
  apply (simp_all (no_asm_simp) add: prefix_type [THEN subsetD, THEN SigmaD1])
 apply (auto simp add: prefix_def Ge_def)
 apply (drule strict_prefix_length_lt)
 apply (drule_tac x = "length (x`rel) " in spec)
 apply auto
 apply (simp (no_asm_use) add: gen_prefix_iff_nth)
 apply (auto simp add: id_def lam_def)
 done
 
 lemma strict_prefix_is_prefix:
     "\<langle>xs, ys\<rangle> \<in> strict_prefix(A) \<longleftrightarrow>  \<langle>xs, ys\<rangle> \<in> prefix(A) \<and> xs\<noteq>ys"
 apply (unfold strict_prefix_def id_def lam_def)
 apply (auto dest: prefix_type [THEN subsetD])
 done
 
 lemma induct_lemma:
 "\<lbrakk>client_prog \<squnion> G \<in> Incr(lift(giv)); client_prog ok G; G \<in> program\<rbrakk>
   \<Longrightarrow> client_prog \<squnion> G \<in>
   {s \<in> state. s`rel = k \<and> \<langle>k,h\<rangle> \<in> strict_prefix(nat)
    \<and> <h, s`giv> \<in> prefix(nat) \<and> h pfixGe s`ask}
         \<longmapsto>w {s \<in> state. <k, s`rel> \<in> strict_prefix(nat)
                           \<and> <s`rel, s`giv> \<in> prefix(nat) \<and>
                                   <h, s`giv> \<in> prefix(nat) \<and>
                 h pfixGe s`ask}"
 apply (rule single_LeadsTo_I)
  prefer 2 apply simp
 apply (frule client_prog_Increasing_ask_rel [THEN guaranteesD])
 apply (rotate_tac [3] 2)
 apply (auto simp add: client_prog_ok_iff)
 apply (rule transient_lemma [THEN Join_transient_I1, THEN transient_imp_leadsTo, THEN leadsTo_imp_LeadsTo, THEN PSP_Stable, THEN LeadsTo_weaken])
 apply (rule Stable_Int [THEN Stable_Int, THEN Stable_Int])
 apply (erule_tac f = "lift (giv) " and a = "s`giv" in Increasing_imp_Stable)
 apply (simp (no_asm_simp))
 apply (erule_tac f = "lift (ask) " and a = "s`ask" in Increasing_imp_Stable)
 apply (simp (no_asm_simp))
 apply (erule_tac f = "lift (rel) " and a = "s`rel" in Increasing_imp_Stable)
 apply (simp (no_asm_simp))
 apply (erule client_prog_Join_Stable_rel_le_giv, blast, simp_all)
  prefer 2
  apply (blast intro: sym strict_prefix_is_prefix [THEN iffD2] prefix_trans prefix_imp_pfixGe pfixGe_trans)
 apply (auto intro: strict_prefix_is_prefix [THEN iffD1, THEN conjunct1]
                    prefix_trans)
 done
 
 lemma rel_progress_lemma:
 "\<lbrakk>client_prog \<squnion> G  \<in> Incr(lift(giv)); client_prog ok G; G \<in> program\<rbrakk>
   \<Longrightarrow> client_prog \<squnion> G  \<in>
      {s \<in> state. <s`rel, h> \<in> strict_prefix(nat)
            \<and> <h, s`giv> \<in> prefix(nat) \<and> h pfixGe s`ask}
                       \<longmapsto>w {s \<in> state. <h, s`rel> \<in> prefix(nat)}"
 apply (rule_tac f = "\<lambda>x \<in> state. length(h) #- length(x`rel)"
        in LessThan_induct)
 apply (auto simp add: vimage_def)
  prefer 2 apply (force simp add: lam_def)
 apply (rule single_LeadsTo_I)
  prefer 2 apply simp
 apply (subgoal_tac "h \<in> list(nat)")
  prefer 2 apply (blast dest: prefix_type [THEN subsetD])
 apply (rule induct_lemma [THEN LeadsTo_weaken])
     apply (simp add: length_type lam_def)
 apply (auto intro: strict_prefix_is_prefix [THEN iffD2]
             dest: common_prefix_linear  prefix_type [THEN subsetD])
 apply (erule swap)
 apply (rule imageI)
  apply (force dest!: simp add: lam_def)
 apply (simp add: length_type lam_def, clarify)
 apply (drule strict_prefix_length_lt)+
 apply (drule less_imp_succ_add, simp)+
 apply clarify
 apply simp
 apply (erule diff_le_self [THEN ltD])
 done
 
 lemma progress_lemma:
 "\<lbrakk>client_prog \<squnion> G \<in> Incr(lift(giv)); client_prog ok G; G \<in> program\<rbrakk>
  \<Longrightarrow> client_prog \<squnion> G
        \<in> {s \<in> state. <h, s`giv> \<in> prefix(nat) \<and> h pfixGe s`ask}
          \<longmapsto>w  {s \<in> state. <h, s`rel> \<in> prefix(nat)}"
 apply (rule client_prog_Join_Always_rel_le_giv [THEN Always_LeadsToI],
        assumption)
 apply (force simp add: client_prog_ok_iff)
 apply (rule LeadsTo_weaken_L)
 apply (rule LeadsTo_Un [OF rel_progress_lemma
                            subset_refl [THEN subset_imp_LeadsTo]])
 apply (auto intro: strict_prefix_is_prefix [THEN iffD2]
             dest: common_prefix_linear prefix_type [THEN subsetD])
 done
 
 (*Progress property: all tokens that are given will be released*)
 lemma client_prog_progress:
 "client_prog \<in> Incr(lift(giv))  guarantees
       (\<Inter>h \<in> list(nat). {s \<in> state. <h, s`giv> \<in> prefix(nat) \<and>
               h pfixGe s`ask} \<longmapsto>w {s \<in> state. <h, s`rel> \<in> prefix(nat)})"
 apply (rule guaranteesI)
 apply (blast intro: progress_lemma, auto)
 done
 
 lemma client_prog_Allowed:
      "Allowed(client_prog) =
       preserves(lift(rel)) \<inter> preserves(lift(ask)) \<inter> preserves(lift(tok))"
 apply (cut_tac v = "lift (ask)" in preserves_type)
 apply (auto simp add: Allowed_def client_prog_def [THEN def_prg_Allowed]
                       cons_Int_distrib safety_prop_Acts_iff)
 done
 
 end
diff --git a/src/ZF/UNITY/Comp.thy b/src/ZF/UNITY/Comp.thy
--- a/src/ZF/UNITY/Comp.thy
+++ b/src/ZF/UNITY/Comp.thy
@@ -1,342 +1,342 @@
 (*  Title:      ZF/UNITY/Comp.thy
     Author:     Sidi O Ehmety, Computer Laboratory
     Copyright   1998  University of Cambridge
 
 From Chandy and Sanders, "Reasoning About Program Composition",
 Technical Report 2000-003, University of Florida, 2000.
 
 Revised by Sidi Ehmety on January  2001 
 
 Added: a strong form of the order relation over component and localize 
 
 Theory ported from HOL.
   
 *)
 
 section\<open>Composition\<close>
 
 theory Comp imports Union Increasing begin
 
 definition
   component :: "[i,i]\<Rightarrow>o"  (infixl \<open>component\<close> 65)  where
   "F component H \<equiv> (\<exists>G. F \<squnion> G = H)"
 
 definition
   strict_component :: "[i,i]\<Rightarrow>o" (infixl \<open>strict'_component\<close> 65)  where
   "F strict_component H \<equiv> F component H \<and> F\<noteq>H"
 
 definition
   (* A stronger form of the component relation *)
   component_of :: "[i,i]\<Rightarrow>o"   (infixl \<open>component'_of\<close> 65)  where
   "F component_of H  \<equiv> (\<exists>G. F ok G \<and> F \<squnion> G = H)"
   
 definition
   strict_component_of :: "[i,i]\<Rightarrow>o" (infixl \<open>strict'_component'_of\<close> 65)  where
   "F strict_component_of H  \<equiv> F component_of H  \<and> F\<noteq>H"
 
 definition
   (* Preserves a state function f, in particular a variable *)
   preserves :: "(i\<Rightarrow>i)\<Rightarrow>i"  where
   "preserves(f) \<equiv> {F:program. \<forall>z. F: stable({s:state. f(s) = z})}"
 
 definition
   fun_pair :: "[i\<Rightarrow>i, i \<Rightarrow>i] \<Rightarrow>(i\<Rightarrow>i)"  where
   "fun_pair(f, g) \<equiv> \<lambda>x. <f(x), g(x)>"
 
 definition
   localize  :: "[i\<Rightarrow>i, i] \<Rightarrow> i"  where
   "localize(f,F) \<equiv> mk_program(Init(F), Acts(F),
                        AllowedActs(F) \<inter> (\<Union>G\<in>preserves(f). Acts(G)))"
 
   
 (*** component and strict_component relations ***)
 
 lemma componentI: 
      "H component F | H component G \<Longrightarrow> H component (F \<squnion> G)"
 apply (unfold component_def, auto)
 apply (rule_tac x = "Ga \<squnion> G" in exI)
 apply (rule_tac [2] x = "G \<squnion> F" in exI)
 apply (auto simp add: Join_ac)
 done
 
 lemma component_eq_subset: 
      "G \<in> program \<Longrightarrow> (F component G) \<longleftrightarrow>  
    (Init(G) \<subseteq> Init(F) \<and> Acts(F) \<subseteq> Acts(G) \<and> AllowedActs(G) \<subseteq> AllowedActs(F))"
 apply (unfold component_def, auto)
 apply (rule exI)
 apply (rule program_equalityI, auto)
 done
 
 lemma component_SKIP [simp]: "F \<in> program \<Longrightarrow> SKIP component F"
-apply (unfold component_def)
+  unfolding component_def
 apply (rule_tac x = F in exI)
 apply (force intro: Join_SKIP_left)
 done
 
 lemma component_refl [simp]: "F \<in> program \<Longrightarrow> F component F"
-apply (unfold component_def)
+  unfolding component_def
 apply (rule_tac x = F in exI)
 apply (force intro: Join_SKIP_right)
 done
 
 lemma SKIP_minimal: "F component SKIP \<Longrightarrow> programify(F) = SKIP"
 apply (rule program_equalityI)
 apply (simp_all add: component_eq_subset, blast)
 done
 
 lemma component_Join1: "F component (F \<squnion> G)"
 by (unfold component_def, blast)
 
 lemma component_Join2: "G component (F \<squnion> G)"
-apply (unfold component_def)
+  unfolding component_def
 apply (simp (no_asm) add: Join_commute)
 apply blast
 done
 
 lemma Join_absorb1: "F component G \<Longrightarrow> F \<squnion> G = G"
 by (auto simp add: component_def Join_left_absorb)
 
 lemma Join_absorb2: "G component F \<Longrightarrow> F \<squnion> G = F"
 by (auto simp add: Join_ac component_def)
 
 lemma JOIN_component_iff:
      "H \<in> program\<Longrightarrow>(JOIN(I,F) component H) \<longleftrightarrow> (\<forall>i \<in> I. F(i) component H)"
 apply (case_tac "I=0", force)
 apply (simp (no_asm_simp) add: component_eq_subset)
 apply auto
 apply blast
 apply (rename_tac "y")
 apply (drule_tac c = y and A = "AllowedActs (H)" in subsetD)
 apply (blast elim!: not_emptyE)+
 done
 
 lemma component_JOIN: "i \<in> I \<Longrightarrow> F(i) component (\<Squnion>i \<in> I. (F(i)))"
-apply (unfold component_def)
+  unfolding component_def
 apply (blast intro: JOIN_absorb)
 done
 
 lemma component_trans: "\<lbrakk>F component G; G component H\<rbrakk> \<Longrightarrow> F component H"
-apply (unfold component_def)
+  unfolding component_def
 apply (blast intro: Join_assoc [symmetric])
 done
 
 lemma component_antisym:
      "\<lbrakk>F \<in> program; G \<in> program\<rbrakk> \<Longrightarrow>(F component G \<and> G  component F) \<longrightarrow> F = G"
 apply (simp (no_asm_simp) add: component_eq_subset)
 apply clarify
 apply (rule program_equalityI, auto)
 done
 
 lemma Join_component_iff:
      "H \<in> program \<Longrightarrow> 
       ((F \<squnion> G) component H) \<longleftrightarrow> (F component H \<and> G component H)"
 apply (simp (no_asm_simp) add: component_eq_subset)
 apply blast
 done
 
 lemma component_constrains:
      "\<lbrakk>F component G; G \<in> A co B; F \<in> program\<rbrakk> \<Longrightarrow> F \<in> A co B"
 apply (frule constrainsD2)
 apply (auto simp add: constrains_def component_eq_subset)
 done
 
 
 (*** preserves ***)
 
 lemma preserves_is_safety_prop [simp]: "safety_prop(preserves(f))"
 apply (unfold preserves_def safety_prop_def)
 apply (auto dest: ActsD simp add: stable_def constrains_def)
 apply (drule_tac c = act in subsetD, auto)
 done
 
 lemma preservesI [rule_format]: 
      "\<forall>z. F \<in> stable({s \<in> state. f(s) = z})  \<Longrightarrow> F \<in> preserves(f)"
 apply (auto simp add: preserves_def)
 apply (blast dest: stableD2)
 done
 
 lemma preserves_imp_eq: 
      "\<lbrakk>F \<in> preserves(f);  act \<in> Acts(F);  \<langle>s,t\<rangle> \<in> act\<rbrakk> \<Longrightarrow> f(s) = f(t)"
 apply (unfold preserves_def stable_def constrains_def)
 apply (subgoal_tac "s \<in> state \<and> t \<in> state")
  prefer 2 apply (blast dest!: Acts_type [THEN subsetD], force) 
 done
 
 lemma Join_preserves [iff]: 
 "(F \<squnion> G \<in> preserves(v)) \<longleftrightarrow>   
       (programify(F) \<in> preserves(v) \<and> programify(G) \<in> preserves(v))"
 by (auto simp add: preserves_def INT_iff)
  
 lemma JOIN_preserves [iff]:
      "(JOIN(I,F): preserves(v)) \<longleftrightarrow> (\<forall>i \<in> I. programify(F(i)):preserves(v))"
 by (auto simp add: JOIN_stable preserves_def INT_iff)
 
 lemma SKIP_preserves [iff]: "SKIP \<in> preserves(v)"
 by (auto simp add: preserves_def INT_iff)
 
 lemma fun_pair_apply [simp]: "fun_pair(f,g,x) = <f(x), g(x)>"
-apply (unfold fun_pair_def)
+  unfolding fun_pair_def
 apply (simp (no_asm))
 done
 
 lemma preserves_fun_pair:
      "preserves(fun_pair(v,w)) = preserves(v) \<inter> preserves(w)"
 apply (rule equalityI)
 apply (auto simp add: preserves_def stable_def constrains_def, blast+)
 done
 
 lemma preserves_fun_pair_iff [iff]:
      "F \<in> preserves(fun_pair(v, w))  \<longleftrightarrow> F \<in> preserves(v) \<inter> preserves(w)"
 by (simp add: preserves_fun_pair)
 
 lemma fun_pair_comp_distrib:
      "(fun_pair(f, g) comp h)(x) = fun_pair(f comp h, g comp h, x)"
 by (simp add: fun_pair_def metacomp_def)
 
 lemma comp_apply [simp]: "(f comp g)(x) = f(g(x))"
 by (simp add: metacomp_def)
 
 lemma preserves_type: "preserves(v)<=program"
 by (unfold preserves_def, auto)
 
 lemma preserves_into_program [TC]: "F \<in> preserves(f) \<Longrightarrow> F \<in> program"
 by (blast intro: preserves_type [THEN subsetD])
 
 lemma subset_preserves_comp: "preserves(f) \<subseteq> preserves(g comp f)"
 apply (auto simp add: preserves_def stable_def constrains_def)
 apply (drule_tac x = "f (xb)" in spec)
 apply (drule_tac x = act in bspec, auto)
 done
 
 lemma imp_preserves_comp: "F \<in> preserves(f) \<Longrightarrow> F \<in> preserves(g comp f)"
 by (blast intro: subset_preserves_comp [THEN subsetD])
 
 lemma preserves_subset_stable: "preserves(f) \<subseteq> stable({s \<in> state. P(f(s))})"
 apply (auto simp add: preserves_def stable_def constrains_def)
 apply (rename_tac s' s)
 apply (subgoal_tac "f (s) = f (s') ")
 apply (force+)
 done
 
 lemma preserves_imp_stable:
      "F \<in> preserves(f) \<Longrightarrow> F \<in> stable({s \<in> state. P(f(s))})"
 by (blast intro: preserves_subset_stable [THEN subsetD])
 
 lemma preserves_imp_increasing: 
  "\<lbrakk>F \<in> preserves(f); \<forall>x \<in> state. f(x):A\<rbrakk> \<Longrightarrow> F \<in> Increasing.increasing(A, r, f)"
 apply (unfold Increasing.increasing_def)
 apply (auto intro: preserves_into_program)
 apply (rule_tac P = "\<lambda>x. \<langle>k, x\<rangle>:r" in preserves_imp_stable, auto)
 done
 
 lemma preserves_id_subset_stable: 
  "st_set(A) \<Longrightarrow> preserves(\<lambda>x. x) \<subseteq> stable(A)"
 apply (unfold preserves_def stable_def constrains_def, auto)
 apply (drule_tac x = xb in spec)
 apply (drule_tac x = act in bspec)
 apply (auto dest: ActsD)
 done
 
 lemma preserves_id_imp_stable:
      "\<lbrakk>F \<in> preserves(\<lambda>x. x); st_set(A)\<rbrakk> \<Longrightarrow> F \<in> stable(A)"
 by (blast intro: preserves_id_subset_stable [THEN subsetD])
 
 (** Added by Sidi **)
 (** component_of **)
 
 (*  component_of is stronger than component *)
 lemma component_of_imp_component: 
 "F component_of H \<Longrightarrow> F component H"
 apply (unfold component_def component_of_def, blast)
 done
 
 (* component_of satisfies many of component's properties *)
 lemma component_of_refl [simp]: "F \<in> program \<Longrightarrow> F component_of F"
-apply (unfold component_of_def)
+  unfolding component_of_def
 apply (rule_tac x = SKIP in exI, auto)
 done
 
 lemma component_of_SKIP [simp]: "F \<in> program \<Longrightarrow>SKIP component_of F"
 apply (unfold component_of_def, auto)
 apply (rule_tac x = F in exI, auto)
 done
 
 lemma component_of_trans: 
      "\<lbrakk>F component_of G; G component_of H\<rbrakk> \<Longrightarrow> F component_of H"
-apply (unfold component_of_def)
+  unfolding component_of_def
 apply (blast intro: Join_assoc [symmetric])
 done
 
 (** localize **)
 lemma localize_Init_eq [simp]: "Init(localize(v,F)) = Init(F)"
 by (unfold localize_def, simp)
 
 lemma localize_Acts_eq [simp]: "Acts(localize(v,F)) = Acts(F)"
 by (unfold localize_def, simp)
 
 lemma localize_AllowedActs_eq [simp]: 
  "AllowedActs(localize(v,F)) = AllowedActs(F) \<inter> (\<Union>G \<in> preserves(v). Acts(G))"
-apply (unfold localize_def)
+  unfolding localize_def
 apply (rule equalityI)
 apply (auto dest: Acts_type [THEN subsetD])
 done
 
 
 (** Theorems used in ClientImpl **)
 
 lemma stable_localTo_stable2: 
  "\<lbrakk>F \<in> stable({s \<in> state. P(f(s), g(s))});  G \<in> preserves(f);  G \<in> preserves(g)\<rbrakk>  
       \<Longrightarrow> F \<squnion> G \<in> stable({s \<in> state. P(f(s), g(s))})"
 apply (auto dest: ActsD preserves_into_program simp add: stable_def constrains_def)
 apply (case_tac "act \<in> Acts (F) ")
 apply auto
 apply (drule preserves_imp_eq)
 apply (drule_tac [3] preserves_imp_eq, auto)
 done
 
 lemma Increasing_preserves_Stable:
      "\<lbrakk>F \<in> stable({s \<in> state. <f(s), g(s)>:r});  G \<in> preserves(f);    
          F \<squnion> G \<in> Increasing(A, r, g);  
          \<forall>x \<in> state. f(x):A \<and> g(x):A\<rbrakk>      
       \<Longrightarrow> F \<squnion> G \<in> Stable({s \<in> state. <f(s), g(s)>:r})"
 apply (auto simp add: stable_def Stable_def Increasing_def Constrains_def all_conj_distrib)
 apply (simp_all add: constrains_type [THEN subsetD] preserves_type [THEN subsetD])
 apply (blast intro: constrains_weaken)
 (*The G case remains*)
 apply (auto dest: ActsD simp add: preserves_def stable_def constrains_def ball_conj_distrib all_conj_distrib)
 (*We have a G-action, so delete assumptions about F-actions*)
 apply (erule_tac V = "\<forall>act \<in> Acts (F). P (act)" for P in thin_rl)
 apply (erule_tac V = "\<forall>k\<in>A. \<forall>act \<in> Acts (F) . P (k,act)" for P in thin_rl)
 apply (subgoal_tac "f (x) = f (xa) ")
 apply (auto dest!: bspec)
 done
 
 
 (** Lemma used in AllocImpl **)
 
 lemma Constrains_UN_left: 
      "\<lbrakk>\<forall>x \<in> I. F \<in> A(x) Co B; F \<in> program\<rbrakk> \<Longrightarrow> F:(\<Union>x \<in> I. A(x)) Co B"
 by (unfold Constrains_def constrains_def, auto)
 
 
 lemma stable_Join_Stable: 
  "\<lbrakk>F \<in> stable({s \<in> state. P(f(s), g(s))});  
      \<forall>k \<in> A. F \<squnion> G \<in> Stable({s \<in> state. P(k, g(s))});  
      G \<in> preserves(f); \<forall>s \<in> state. f(s):A\<rbrakk>
   \<Longrightarrow> F \<squnion> G \<in> Stable({s \<in> state. P(f(s), g(s))})"
 apply (unfold stable_def Stable_def preserves_def)
 apply (rule_tac A = "(\<Union>k \<in> A. {s \<in> state. f(s)=k} \<inter> {s \<in> state. P (f (s), g (s))})" in Constrains_weaken_L)
 prefer 2 apply blast
 apply (rule Constrains_UN_left, auto)
 apply (rule_tac A = "{s \<in> state. f(s)=k} \<inter> {s \<in> state. P (f (s), g (s))} \<inter> {s \<in> state. P (k, g (s))}" and A' = "({s \<in> state. f(s)=k} \<union> {s \<in> state. P (f (s), g (s))}) \<inter> {s \<in> state. P (k, g (s))}" in Constrains_weaken)
  prefer 2 apply blast 
  prefer 2 apply blast 
 apply (rule Constrains_Int)
 apply (rule constrains_imp_Constrains)
 apply (auto simp add: constrains_type [THEN subsetD])
 apply (blast intro: constrains_weaken) 
 apply (drule_tac x = k in spec)
 apply (blast intro: constrains_weaken) 
 done
 
 end
diff --git a/src/ZF/UNITY/Constrains.thy b/src/ZF/UNITY/Constrains.thy
--- a/src/ZF/UNITY/Constrains.thy
+++ b/src/ZF/UNITY/Constrains.thy
@@ -1,507 +1,507 @@
 (*  Title:      ZF/UNITY/Constrains.thy
     Author:     Sidi O Ehmety, Computer Laboratory
     Copyright   2001  University of Cambridge
 *)
 
 section\<open>Weak Safety Properties\<close>
 
 theory Constrains
 imports UNITY
 begin
 
 consts traces :: "[i, i] \<Rightarrow> i"
   (* Initial states and program \<Rightarrow> (final state, reversed trace to it)... 
       the domain may also be state*list(state) *)
 inductive 
   domains 
      "traces(init, acts)" <=
          "(init \<union> (\<Union>act\<in>acts. field(act)))*list(\<Union>act\<in>acts. field(act))"
   intros 
          (*Initial trace is empty*)
     Init: "s: init \<Longrightarrow> <s,[]> \<in> traces(init,acts)"
 
     Acts: "\<lbrakk>act:acts;  \<langle>s,evs\<rangle> \<in> traces(init,acts);  <s,s'>: act\<rbrakk>
            \<Longrightarrow> <s', Cons(s,evs)> \<in> traces(init, acts)"
   
   type_intros list.intros UnI1 UnI2 UN_I fieldI2 fieldI1
 
 
 consts reachable :: "i\<Rightarrow>i"
 inductive
   domains
   "reachable(F)" \<subseteq> "Init(F) \<union> (\<Union>act\<in>Acts(F). field(act))"
   intros 
     Init: "s:Init(F) \<Longrightarrow> s:reachable(F)"
 
     Acts: "\<lbrakk>act: Acts(F);  s:reachable(F);  <s,s'>: act\<rbrakk>
            \<Longrightarrow> s':reachable(F)"
 
   type_intros UnI1 UnI2 fieldI2 UN_I
 
   
 definition
   Constrains :: "[i,i] \<Rightarrow> i"  (infixl \<open>Co\<close> 60)  where
   "A Co B \<equiv> {F:program. F:(reachable(F) \<inter> A) co B}"
 
 definition
   op_Unless  :: "[i, i] \<Rightarrow> i"  (infixl \<open>Unless\<close> 60)  where
   "A Unless B \<equiv> (A-B) Co (A \<union> B)"
 
 definition
   Stable     :: "i \<Rightarrow> i"  where
   "Stable(A) \<equiv> A Co A"
 
 definition
   (*Always is the weak form of "invariant"*)
   Always :: "i \<Rightarrow> i"  where
   "Always(A) \<equiv> initially(A) \<inter> Stable(A)"
 
 
 (*** traces and reachable ***)
 
 lemma reachable_type: "reachable(F) \<subseteq> state"
 apply (cut_tac F = F in Init_type)
 apply (cut_tac F = F in Acts_type)
 apply (cut_tac F = F in reachable.dom_subset, blast)
 done
 
 lemma st_set_reachable: "st_set(reachable(F))"
-apply (unfold st_set_def)
+  unfolding st_set_def
 apply (rule reachable_type)
 done
 declare st_set_reachable [iff]
 
 lemma reachable_Int_state: "reachable(F) \<inter> state = reachable(F)"
 by (cut_tac reachable_type, auto)
 declare reachable_Int_state [iff]
 
 lemma state_Int_reachable: "state \<inter> reachable(F) = reachable(F)"
 by (cut_tac reachable_type, auto)
 declare state_Int_reachable [iff]
 
 lemma reachable_equiv_traces: 
 "F \<in> program \<Longrightarrow> reachable(F)={s \<in> state. \<exists>evs. \<langle>s,evs\<rangle>:traces(Init(F), Acts(F))}"
 apply (rule equalityI, safe)
 apply (blast dest: reachable_type [THEN subsetD])
 apply (erule_tac [2] traces.induct)
 apply (erule reachable.induct)
 apply (blast intro: reachable.intros traces.intros)+
 done
 
 lemma Init_into_reachable: "Init(F) \<subseteq> reachable(F)"
 by (blast intro: reachable.intros)
 
 lemma stable_reachable: "\<lbrakk>F \<in> program; G \<in> program;  
     Acts(G) \<subseteq> Acts(F)\<rbrakk> \<Longrightarrow> G \<in> stable(reachable(F))"
 apply (blast intro: stableI constrainsI st_setI
              reachable_type [THEN subsetD] reachable.intros)
 done
 
 declare stable_reachable [intro!]
 declare stable_reachable [simp]
 
 (*The set of all reachable states is an invariant...*)
 lemma invariant_reachable: 
    "F \<in> program \<Longrightarrow> F \<in> invariant(reachable(F))"
 apply (unfold invariant_def initially_def)
 apply (blast intro: reachable_type [THEN subsetD] reachable.intros)
 done
 
 (*...in fact the strongest invariant!*)
 lemma invariant_includes_reachable: "F \<in> invariant(A) \<Longrightarrow> reachable(F) \<subseteq> A"
 apply (cut_tac F = F in Acts_type)
 apply (cut_tac F = F in Init_type)
 apply (cut_tac F = F in reachable_type)
 apply (simp (no_asm_use) add: stable_def constrains_def invariant_def initially_def)
 apply (rule subsetI)
 apply (erule reachable.induct)
 apply (blast intro: reachable.intros)+
 done
 
 (*** Co ***)
 
 lemma constrains_reachable_Int: "F \<in> B co B'\<Longrightarrow>F:(reachable(F) \<inter> B) co (reachable(F) \<inter> B')"
 apply (frule constrains_type [THEN subsetD])
 apply (frule stable_reachable [OF _ _ subset_refl])
 apply (simp_all add: stable_def constrains_Int)
 done
 
 (*Resembles the previous definition of Constrains*)
 lemma Constrains_eq_constrains: 
 "A Co B = {F \<in> program. F:(reachable(F) \<inter> A) co (reachable(F)  \<inter>  B)}"
-apply (unfold Constrains_def)
+  unfolding Constrains_def
 apply (blast dest: constrains_reachable_Int constrains_type [THEN subsetD]
              intro: constrains_weaken)
 done
 
 lemmas Constrains_def2 = Constrains_eq_constrains [THEN eq_reflection]
 
 lemma constrains_imp_Constrains: "F \<in> A co A' \<Longrightarrow> F \<in> A Co A'"
-apply (unfold Constrains_def)
+  unfolding Constrains_def
 apply (blast intro: constrains_weaken_L dest: constrainsD2)
 done
 
 lemma ConstrainsI: 
     "\<lbrakk>\<And>act s s'. \<lbrakk>act \<in> Acts(F); <s,s'>:act; s \<in> A\<rbrakk> \<Longrightarrow> s':A'; 
        F \<in> program\<rbrakk>
      \<Longrightarrow> F \<in> A Co A'"
 apply (auto simp add: Constrains_def constrains_def st_set_def)
 apply (blast dest: reachable_type [THEN subsetD])
 done
 
 lemma Constrains_type: 
  "A Co B \<subseteq> program"
 apply (unfold Constrains_def, blast)
 done
 
 lemma Constrains_empty: "F \<in> 0 Co B \<longleftrightarrow> F \<in> program"
 by (auto dest: Constrains_type [THEN subsetD]
             intro: constrains_imp_Constrains)
 declare Constrains_empty [iff]
 
 lemma Constrains_state: "F \<in> A Co state \<longleftrightarrow> F \<in> program"
-apply (unfold Constrains_def)
+  unfolding Constrains_def
 apply (auto dest: Constrains_type [THEN subsetD] intro: constrains_imp_Constrains)
 done
 declare Constrains_state [iff]
 
 lemma Constrains_weaken_R: 
         "\<lbrakk>F \<in> A Co A'; A'<=B'\<rbrakk> \<Longrightarrow> F \<in> A Co B'"
-apply (unfold Constrains_def2)
+  unfolding Constrains_def2
 apply (blast intro: constrains_weaken_R)
 done
 
 lemma Constrains_weaken_L: 
     "\<lbrakk>F \<in> A Co A'; B<=A\<rbrakk> \<Longrightarrow> F \<in> B Co A'"
-apply (unfold Constrains_def2)
+  unfolding Constrains_def2
 apply (blast intro: constrains_weaken_L st_set_subset)
 done
 
 lemma Constrains_weaken: 
    "\<lbrakk>F \<in> A Co A'; B<=A; A'<=B'\<rbrakk> \<Longrightarrow> F \<in> B Co B'"
-apply (unfold Constrains_def2)
+  unfolding Constrains_def2
 apply (blast intro: constrains_weaken st_set_subset)
 done
 
 (** Union **)
 lemma Constrains_Un: 
     "\<lbrakk>F \<in> A Co A'; F \<in> B Co B'\<rbrakk> \<Longrightarrow> F \<in> (A \<union> B) Co (A' \<union> B')"
 apply (unfold Constrains_def2, auto)
 apply (simp add: Int_Un_distrib)
 apply (blast intro: constrains_Un)
 done
 
 lemma Constrains_UN: 
     "\<lbrakk>(\<And>i. i \<in> I\<Longrightarrow>F \<in> A(i) Co A'(i)); F \<in> program\<rbrakk> 
      \<Longrightarrow> F:(\<Union>i \<in> I. A(i)) Co (\<Union>i \<in> I. A'(i))"
 by (auto intro: constrains_UN simp del: UN_simps 
          simp add: Constrains_def2 Int_UN_distrib)
 
 
 (** Intersection **)
 
 lemma Constrains_Int: 
     "\<lbrakk>F \<in> A Co A'; F \<in> B Co B'\<rbrakk>\<Longrightarrow> F:(A \<inter> B) Co (A' \<inter> B')"
-apply (unfold Constrains_def)
+  unfolding Constrains_def
 apply (subgoal_tac "reachable (F) \<inter> (A \<inter> B) = (reachable (F) \<inter> A) \<inter> (reachable (F) \<inter> B) ")
 apply (auto intro: constrains_Int)
 done
 
 lemma Constrains_INT: 
     "\<lbrakk>(\<And>i. i \<in> I \<Longrightarrow>F \<in> A(i) Co A'(i)); F \<in> program\<rbrakk>  
      \<Longrightarrow> F:(\<Inter>i \<in> I. A(i)) Co (\<Inter>i \<in> I. A'(i))"
 apply (simp (no_asm_simp) del: INT_simps add: Constrains_def INT_extend_simps)
 apply (rule constrains_INT)
 apply (auto simp add: Constrains_def)
 done
 
 lemma Constrains_imp_subset: "F \<in> A Co A' \<Longrightarrow> reachable(F) \<inter> A \<subseteq> A'"
-apply (unfold Constrains_def)
+  unfolding Constrains_def
 apply (blast dest: constrains_imp_subset)
 done
 
 lemma Constrains_trans: 
  "\<lbrakk>F \<in> A Co B; F \<in> B Co C\<rbrakk> \<Longrightarrow> F \<in> A Co C"
-apply (unfold Constrains_def2)
+  unfolding Constrains_def2
 apply (blast intro: constrains_trans constrains_weaken)
 done
 
 lemma Constrains_cancel: 
 "\<lbrakk>F \<in> A Co (A' \<union> B); F \<in> B Co B'\<rbrakk> \<Longrightarrow> F \<in> A Co (A' \<union> B')"
-apply (unfold Constrains_def2)
+  unfolding Constrains_def2
 apply (simp (no_asm_use) add: Int_Un_distrib)
 apply (blast intro: constrains_cancel)
 done
 
 (*** Stable ***)
 (* Useful because there's no Stable_weaken.  [Tanja Vos] *)
 
 lemma stable_imp_Stable: 
 "F \<in> stable(A) \<Longrightarrow> F \<in> Stable(A)"
 
 apply (unfold stable_def Stable_def)
 apply (erule constrains_imp_Constrains)
 done
 
 lemma Stable_eq: "\<lbrakk>F \<in> Stable(A); A = B\<rbrakk> \<Longrightarrow> F \<in> Stable(B)"
 by blast
 
 lemma Stable_eq_stable: 
 "F \<in> Stable(A) \<longleftrightarrow>  (F \<in> stable(reachable(F) \<inter> A))"
 apply (auto dest: constrainsD2 simp add: Stable_def stable_def Constrains_def2)
 done
 
 lemma StableI: "F \<in> A Co A \<Longrightarrow> F \<in> Stable(A)"
 by (unfold Stable_def, assumption)
 
 lemma StableD: "F \<in> Stable(A) \<Longrightarrow> F \<in> A Co A"
 by (unfold Stable_def, assumption)
 
 lemma Stable_Un: 
     "\<lbrakk>F \<in> Stable(A); F \<in> Stable(A')\<rbrakk> \<Longrightarrow> F \<in> Stable(A \<union> A')"
-apply (unfold Stable_def)
+  unfolding Stable_def
 apply (blast intro: Constrains_Un)
 done
 
 lemma Stable_Int: 
     "\<lbrakk>F \<in> Stable(A); F \<in> Stable(A')\<rbrakk> \<Longrightarrow> F \<in> Stable (A \<inter> A')"
-apply (unfold Stable_def)
+  unfolding Stable_def
 apply (blast intro: Constrains_Int)
 done
 
 lemma Stable_Constrains_Un: 
     "\<lbrakk>F \<in> Stable(C); F \<in> A Co (C \<union> A')\<rbrakk>    
      \<Longrightarrow> F \<in> (C \<union> A) Co (C \<union> A')"
-apply (unfold Stable_def)
+  unfolding Stable_def
 apply (blast intro: Constrains_Un [THEN Constrains_weaken_R])
 done
 
 lemma Stable_Constrains_Int: 
     "\<lbrakk>F \<in> Stable(C); F \<in> (C \<inter> A) Co A'\<rbrakk>    
      \<Longrightarrow> F \<in> (C \<inter> A) Co (C \<inter> A')"
-apply (unfold Stable_def)
+  unfolding Stable_def
 apply (blast intro: Constrains_Int [THEN Constrains_weaken])
 done
 
 lemma Stable_UN: 
     "\<lbrakk>(\<And>i. i \<in> I \<Longrightarrow> F \<in> Stable(A(i))); F \<in> program\<rbrakk>
      \<Longrightarrow> F \<in> Stable (\<Union>i \<in> I. A(i))"
 apply (simp add: Stable_def)
 apply (blast intro: Constrains_UN)
 done
 
 lemma Stable_INT: 
     "\<lbrakk>(\<And>i. i \<in> I \<Longrightarrow> F \<in> Stable(A(i))); F \<in> program\<rbrakk>
      \<Longrightarrow> F \<in> Stable (\<Inter>i \<in> I. A(i))"
 apply (simp add: Stable_def)
 apply (blast intro: Constrains_INT)
 done
 
 lemma Stable_reachable: "F \<in> program \<Longrightarrow>F \<in> Stable (reachable(F))"
 apply (simp (no_asm_simp) add: Stable_eq_stable Int_absorb)
 done
 
 lemma Stable_type: "Stable(A) \<subseteq> program"
-apply (unfold Stable_def)
+  unfolding Stable_def
 apply (rule Constrains_type)
 done
 
 (*** The Elimination Theorem.  The "free" m has become universally quantified!
      Should the premise be \<And>m instead of \<forall>m ?  Would make it harder to use
      in forward proof. ***)
 
 lemma Elimination: 
     "\<lbrakk>\<forall>m \<in> M. F \<in> ({s \<in> A. x(s) = m}) Co (B(m)); F \<in> program\<rbrakk>  
      \<Longrightarrow> F \<in> ({s \<in> A. x(s):M}) Co (\<Union>m \<in> M. B(m))"
 apply (unfold Constrains_def, auto)
 apply (rule_tac A1 = "reachable (F) \<inter> A" 
         in UNITY.elimination [THEN constrains_weaken_L])
 apply (auto intro: constrains_weaken_L)
 done
 
 (* As above, but for the special case of A=state *)
 lemma Elimination2: 
  "\<lbrakk>\<forall>m \<in> M. F \<in> {s \<in> state. x(s) = m} Co B(m); F \<in> program\<rbrakk>  
      \<Longrightarrow> F \<in> {s \<in> state. x(s):M} Co (\<Union>m \<in> M. B(m))"
 apply (blast intro: Elimination)
 done
 
 (** Unless **)
 
 lemma Unless_type: "A Unless B <=program"
-apply (unfold op_Unless_def)
+  unfolding op_Unless_def
 apply (rule Constrains_type)
 done
 
 (*** Specialized laws for handling Always ***)
 
 (** Natural deduction rules for "Always A" **)
 
 lemma AlwaysI: 
 "\<lbrakk>Init(F)<=A;  F \<in> Stable(A)\<rbrakk> \<Longrightarrow> F \<in> Always(A)"
 
 apply (unfold Always_def initially_def)
 apply (frule Stable_type [THEN subsetD], auto)
 done
 
 lemma AlwaysD: "F \<in> Always(A) \<Longrightarrow> Init(F)<=A \<and> F \<in> Stable(A)"
 by (simp add: Always_def initially_def)
 
 lemmas AlwaysE = AlwaysD [THEN conjE]
 lemmas Always_imp_Stable = AlwaysD [THEN conjunct2]
 
 (*The set of all reachable states is Always*)
 lemma Always_includes_reachable: "F \<in> Always(A) \<Longrightarrow> reachable(F) \<subseteq> A"
 apply (simp (no_asm_use) add: Stable_def Constrains_def constrains_def Always_def initially_def)
 apply (rule subsetI)
 apply (erule reachable.induct)
 apply (blast intro: reachable.intros)+
 done
 
 lemma invariant_imp_Always: 
      "F \<in> invariant(A) \<Longrightarrow> F \<in> Always(A)"
 apply (unfold Always_def invariant_def Stable_def stable_def)
 apply (blast intro: constrains_imp_Constrains)
 done
 
 lemmas Always_reachable = invariant_reachable [THEN invariant_imp_Always]
 
 lemma Always_eq_invariant_reachable: "Always(A) = {F \<in> program. F \<in> invariant(reachable(F) \<inter> A)}"
 apply (simp (no_asm) add: Always_def invariant_def Stable_def Constrains_def2 stable_def initially_def)
 apply (rule equalityI, auto) 
 apply (blast intro: reachable.intros reachable_type)
 done
 
 (*the RHS is the traditional definition of the "always" operator*)
 lemma Always_eq_includes_reachable: "Always(A) = {F \<in> program. reachable(F) \<subseteq> A}"
 apply (rule equalityI, safe)
 apply (auto dest: invariant_includes_reachable 
    simp add: subset_Int_iff invariant_reachable Always_eq_invariant_reachable)
 done
 
 lemma Always_type: "Always(A) \<subseteq> program"
 by (unfold Always_def initially_def, auto)
 
 lemma Always_state_eq: "Always(state) = program"
 apply (rule equalityI)
 apply (auto dest: Always_type [THEN subsetD] reachable_type [THEN subsetD]
             simp add: Always_eq_includes_reachable)
 done
 declare Always_state_eq [simp]
 
 lemma state_AlwaysI: "F \<in> program \<Longrightarrow> F \<in> Always(state)"
 by (auto dest: reachable_type [THEN subsetD]
             simp add: Always_eq_includes_reachable)
 
 lemma Always_eq_UN_invariant: "st_set(A) \<Longrightarrow> Always(A) = (\<Union>I \<in> Pow(A). invariant(I))"
 apply (simp (no_asm) add: Always_eq_includes_reachable)
 apply (rule equalityI, auto) 
 apply (blast intro: invariantI rev_subsetD [OF _ Init_into_reachable] 
                     rev_subsetD [OF _ invariant_includes_reachable]  
              dest: invariant_type [THEN subsetD])+
 done
 
 lemma Always_weaken: "\<lbrakk>F \<in> Always(A); A \<subseteq> B\<rbrakk> \<Longrightarrow> F \<in> Always(B)"
 by (auto simp add: Always_eq_includes_reachable)
 
 
 (*** "Co" rules involving Always ***)
 lemmas Int_absorb2 = subset_Int_iff [unfolded iff_def, THEN conjunct1, THEN mp]
 
 lemma Always_Constrains_pre: "F \<in> Always(I) \<Longrightarrow> (F:(I \<inter> A) Co A') \<longleftrightarrow> (F \<in> A Co A')"
 apply (simp (no_asm_simp) add: Always_includes_reachable [THEN Int_absorb2] Constrains_def Int_assoc [symmetric])
 done
 
 lemma Always_Constrains_post: "F \<in> Always(I) \<Longrightarrow> (F \<in> A Co (I \<inter> A')) \<longleftrightarrow>(F \<in> A Co A')"
 apply (simp (no_asm_simp) add: Always_includes_reachable [THEN Int_absorb2] Constrains_eq_constrains Int_assoc [symmetric])
 done
 
 lemma Always_ConstrainsI: "\<lbrakk>F \<in> Always(I);  F \<in> (I \<inter> A) Co A'\<rbrakk> \<Longrightarrow> F \<in> A Co A'"
 by (blast intro: Always_Constrains_pre [THEN iffD1])
 
 (* \<lbrakk>F \<in> Always(I);  F \<in> A Co A'\<rbrakk> \<Longrightarrow> F \<in> A Co (I \<inter> A') *)
 lemmas Always_ConstrainsD = Always_Constrains_post [THEN iffD2]
 
 (*The analogous proof of Always_LeadsTo_weaken doesn't terminate*)
 lemma Always_Constrains_weaken: 
 "\<lbrakk>F \<in> Always(C); F \<in> A Co A'; C \<inter> B<=A; C \<inter> A'<=B'\<rbrakk>\<Longrightarrow>F \<in> B Co B'"
 apply (rule Always_ConstrainsI)
 apply (drule_tac [2] Always_ConstrainsD, simp_all) 
 apply (blast intro: Constrains_weaken)
 done
 
 (** Conjoining Always properties **)
 lemma Always_Int_distrib: "Always(A \<inter> B) = Always(A) \<inter> Always(B)"
 by (auto simp add: Always_eq_includes_reachable)
 
 (* the premise i \<in> I is need since \<Inter>is formally not defined for I=0 *)
 lemma Always_INT_distrib: "i \<in> I\<Longrightarrow>Always(\<Inter>i \<in> I. A(i)) = (\<Inter>i \<in> I. Always(A(i)))"
 apply (rule equalityI)
 apply (auto simp add: Inter_iff Always_eq_includes_reachable)
 done
 
 
 lemma Always_Int_I: "\<lbrakk>F \<in> Always(A);  F \<in> Always(B)\<rbrakk> \<Longrightarrow> F \<in> Always(A \<inter> B)"
 apply (simp (no_asm_simp) add: Always_Int_distrib)
 done
 
 (*Allows a kind of "implication introduction"*)
 lemma Always_Diff_Un_eq: "\<lbrakk>F \<in> Always(A)\<rbrakk> \<Longrightarrow> (F \<in> Always(C-A \<union> B)) \<longleftrightarrow> (F \<in> Always(B))"
 by (auto simp add: Always_eq_includes_reachable)
 
 (*Delete the nearest invariance assumption (which will be the second one
   used by Always_Int_I) *)
 lemmas Always_thin = thin_rl [of "F \<in> Always(A)"] for F A
 
 (*To allow expansion of the program's definition when appropriate*)
 named_theorems program "program definitions"
 
 ML
 \<open>
 (*Combines two invariance ASSUMPTIONS into one.  USEFUL??*)
 fun Always_Int_tac ctxt =
   dresolve_tac ctxt @{thms Always_Int_I} THEN'
   assume_tac ctxt THEN'
   eresolve_tac ctxt @{thms Always_thin};
 
 (*Combines a list of invariance THEOREMS into one.*)
 val Always_Int_rule = foldr1 (fn (th1,th2) => [th1,th2] MRS @{thm Always_Int_I});
 
 (*proves "co" properties when the program is specified*)
 
 fun constrains_tac ctxt =
    SELECT_GOAL
       (EVERY [REPEAT (Always_Int_tac ctxt 1),
               REPEAT (eresolve_tac ctxt @{thms Always_ConstrainsI} 1
                       ORELSE
                       resolve_tac ctxt [@{thm StableI}, @{thm stableI},
                                    @{thm constrains_imp_Constrains}] 1),
               resolve_tac ctxt @{thms constrainsI} 1,
               (* Three subgoals *)
               rewrite_goal_tac ctxt [@{thm st_set_def}] 3,
               REPEAT (force_tac ctxt 2),
               full_simp_tac (ctxt addsimps (Named_Theorems.get ctxt \<^named_theorems>\<open>program\<close>)) 1,
               ALLGOALS (clarify_tac ctxt),
               REPEAT (FIRSTGOAL (eresolve_tac ctxt @{thms disjE})),
               ALLGOALS (clarify_tac ctxt),
               REPEAT (FIRSTGOAL (eresolve_tac ctxt @{thms disjE})),
               ALLGOALS (clarify_tac ctxt),
               ALLGOALS (asm_full_simp_tac ctxt),
               ALLGOALS (clarify_tac ctxt)]);
 
 (*For proving invariants*)
 fun always_tac ctxt i =
   resolve_tac ctxt @{thms AlwaysI} i THEN
   force_tac ctxt i
   THEN constrains_tac ctxt i;
 \<close>
 
 method_setup safety = \<open>
   Scan.succeed (SIMPLE_METHOD' o constrains_tac)\<close>
   "for proving safety properties"
 
 method_setup always = \<open>
   Scan.succeed (SIMPLE_METHOD' o always_tac)\<close>
   "for proving invariants"
 
 end
diff --git a/src/ZF/UNITY/Distributor.thy b/src/ZF/UNITY/Distributor.thy
--- a/src/ZF/UNITY/Distributor.thy
+++ b/src/ZF/UNITY/Distributor.thy
@@ -1,166 +1,166 @@
 (*  Title:      ZF/UNITY/Distributor.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     Copyright   2002  University of Cambridge
 
 A multiple-client allocator from a single-client allocator:
 Distributor specification.
 *)
 
 theory Distributor imports AllocBase Follows  Guar GenPrefix begin
 
 text\<open>Distributor specification (the number of outputs is Nclients)\<close>
 
 text\<open>spec (14)\<close>
 
 definition
   distr_follows :: "[i, i, i, i \<Rightarrow>i] \<Rightarrow>i"  where
     "distr_follows(A, In, iIn, Out) \<equiv>
      (lift(In) IncreasingWrt prefix(A)/list(A)) \<inter>
      (lift(iIn) IncreasingWrt prefix(nat)/list(nat)) \<inter>
      Always({s \<in> state. \<forall>elt \<in> set_of_list(s`iIn). elt < Nclients})
          guarantees
          (\<Inter>n \<in> Nclients.
           lift(Out(n))
               Fols
           (\<lambda>s. sublist(s`In, {k \<in> nat. k<length(s`iIn) \<and> nth(k, s`iIn) = n}))
           Wrt prefix(A)/list(A))"
 
 definition
   distr_allowed_acts :: "[i\<Rightarrow>i]\<Rightarrow>i"  where
     "distr_allowed_acts(Out) \<equiv>
      {D \<in> program. AllowedActs(D) =
      cons(id(state), \<Union>G \<in> (\<Inter>n\<in>nat. preserves(lift(Out(n)))). Acts(G))}"
 
 definition
   distr_spec :: "[i, i, i, i \<Rightarrow>i]\<Rightarrow>i"  where
     "distr_spec(A, In, iIn, Out) \<equiv>
      distr_follows(A, In, iIn, Out) \<inter> distr_allowed_acts(Out)"
 
 locale distr =
   fixes In  \<comment> \<open>items to distribute\<close>
     and iIn \<comment> \<open>destinations of items to distribute\<close>
     and Out \<comment> \<open>distributed items\<close>
     and A   \<comment> \<open>the type of items being distributed\<close>
     and D
  assumes
      var_assumes [simp]:  "In \<in> var \<and> iIn \<in> var \<and> (\<forall>n. Out(n):var)"
  and all_distinct_vars:   "\<forall>n. all_distinct([In, iIn, Out(n)])"
  and type_assumes [simp]: "type_of(In)=list(A) \<and>  type_of(iIn)=list(nat) \<and>
                           (\<forall>n. type_of(Out(n))=list(A))"
  and default_val_assumes [simp]:
                          "default_val(In)=Nil \<and>
                           default_val(iIn)=Nil \<and>
                           (\<forall>n. default_val(Out(n))=Nil)"
  and distr_spec:  "D \<in> distr_spec(A, In, iIn, Out)"
 
 
 lemma (in distr) In_value_type [simp,TC]: "s \<in> state \<Longrightarrow> s`In \<in> list(A)"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = In in apply_type, auto)
 done
 
 lemma (in distr) iIn_value_type [simp,TC]:
      "s \<in> state \<Longrightarrow> s`iIn \<in> list(nat)"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = iIn in apply_type, auto)
 done
 
 lemma (in distr) Out_value_type [simp,TC]:
      "s \<in> state \<Longrightarrow> s`Out(n):list(A)"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = "Out (n)" in apply_type)
 apply auto
 done
 
 lemma (in distr) D_in_program [simp,TC]: "D \<in> program"
 apply (cut_tac distr_spec)
 apply (auto simp add: distr_spec_def distr_allowed_acts_def)
 done
 
 lemma (in distr) D_ok_iff:
      "G \<in> program \<Longrightarrow>
         D ok G \<longleftrightarrow> ((\<forall>n \<in> nat. G \<in> preserves(lift(Out(n)))) \<and> D \<in> Allowed(G))"
 apply (cut_tac distr_spec)
 apply (auto simp add: INT_iff distr_spec_def distr_allowed_acts_def
                       Allowed_def ok_iff_Allowed)
 apply (drule safety_prop_Acts_iff [THEN [2] rev_iffD1])
 apply (auto intro: safety_prop_Inter)
 done
 
 lemma (in distr) distr_Increasing_Out:
 "D \<in> ((lift(In) IncreasingWrt prefix(A)/list(A)) \<inter>
       (lift(iIn) IncreasingWrt prefix(nat)/list(nat)) \<inter>
       Always({s \<in> state. \<forall>elt \<in> set_of_list(s`iIn). elt<Nclients}))
       guarantees
           (\<Inter>n \<in> Nclients. lift(Out(n)) IncreasingWrt
                             prefix(A)/list(A))"
 apply (cut_tac D_in_program distr_spec)
 apply (simp (no_asm_use) add: distr_spec_def distr_follows_def)
 apply (auto intro!: guaranteesI intro: Follows_imp_Increasing_left 
             dest!: guaranteesD)
 done
 
 lemma (in distr) distr_bag_Follows_lemma:
 "\<lbrakk>\<forall>n \<in> nat. G \<in> preserves(lift(Out(n)));
    D \<squnion> G \<in> Always({s \<in> state.
           \<forall>elt \<in> set_of_list(s`iIn). elt < Nclients})\<rbrakk>
   \<Longrightarrow> D \<squnion> G \<in> Always
           ({s \<in> state. msetsum(\<lambda>n. bag_of (sublist(s`In,
                        {k \<in> nat. k < length(s`iIn) \<and>
                           nth(k, s`iIn)= n})),
                          Nclients, A) =
               bag_of(sublist(s`In, length(s`iIn)))})"
 apply (cut_tac D_in_program)
 apply (subgoal_tac "G \<in> program")
  prefer 2 apply (blast dest: preserves_type [THEN subsetD])
 apply (erule Always_Diff_Un_eq [THEN iffD1])
 apply (rule state_AlwaysI [THEN Always_weaken], auto)
 apply (rename_tac s)
 apply (subst bag_of_sublist_UN_disjoint [symmetric])
    apply (simp (no_asm_simp) add: nat_into_Finite)
   apply blast
  apply (simp (no_asm_simp))
 apply (simp add: set_of_list_conv_nth [of _ nat])
 apply (subgoal_tac
        "(\<Union>i \<in> Nclients. {k\<in>nat. k < length(s`iIn) \<and> nth(k, s`iIn) = i}) =
         length(s`iIn) ")
 apply (simp (no_asm_simp))
 apply (rule equalityI)
 apply (force simp add: ltD, safe)
 apply (rename_tac m)
 apply (subgoal_tac "length (s ` iIn) \<in> nat")
 apply typecheck
 apply (subgoal_tac "m \<in> nat")
 apply (drule_tac x = "nth(m, s`iIn) " and P = "\<lambda>elt. X (elt) \<longrightarrow> elt<Nclients" for X in bspec)
 apply (simp add: ltI)
 apply (simp_all add: Ord_mem_iff_lt)
 apply (blast dest: ltD)
 apply (blast intro: lt_trans)
 done
 
 theorem (in distr) distr_bag_Follows:
  "D \<in> ((lift(In) IncreasingWrt prefix(A)/list(A)) \<inter>
        (lift(iIn) IncreasingWrt prefix(nat)/list(nat)) \<inter>
         Always({s \<in> state. \<forall>elt \<in> set_of_list(s`iIn). elt < Nclients}))
       guarantees
        (\<Inter>n \<in> Nclients.
         (\<lambda>s. msetsum(\<lambda>i. bag_of(s`Out(i)),  Nclients, A))
         Fols
         (\<lambda>s. bag_of(sublist(s`In, length(s`iIn))))
         Wrt MultLe(A, r)/Mult(A))"
 apply (cut_tac distr_spec)
 apply (rule guaranteesI, clarify)
 apply (rule distr_bag_Follows_lemma [THEN Always_Follows2])
 apply (simp add: D_ok_iff, auto)
 apply (rule Follows_state_ofD1)
 apply (rule Follows_msetsum_UN)
    apply (simp_all add: nat_into_Finite bag_of_multiset [of _ A])
 apply (auto simp add: distr_spec_def distr_follows_def)
 apply (drule guaranteesD, assumption)
 apply (simp_all cong add: Follows_cong
                 add: refl_prefix
                    mono_bag_of [THEN subset_Follows_comp, THEN subsetD, 
                                 unfolded metacomp_def])
 done
 
 end
diff --git a/src/ZF/UNITY/FP.thy b/src/ZF/UNITY/FP.thy
--- a/src/ZF/UNITY/FP.thy
+++ b/src/ZF/UNITY/FP.thy
@@ -1,83 +1,83 @@
 (*  Title:      ZF/UNITY/FP.thy
     Author:     Sidi O Ehmety, Computer Laboratory
     Copyright   2001  University of Cambridge
 
 From Misra, "A Logic for Concurrent Programming", 1994
 
 Theory ported from HOL.
 *)
 
 section\<open>Fixed Point of a Program\<close>
 
 theory FP imports UNITY begin
 
 definition   
   FP_Orig :: "i\<Rightarrow>i"  where
     "FP_Orig(F) \<equiv> \<Union>({A \<in> Pow(state). \<forall>B. F \<in> stable(A \<inter> B)})"
 
 definition
   FP :: "i\<Rightarrow>i"  where
     "FP(F) \<equiv> {s\<in>state. F \<in> stable({s})}"
 
 
 lemma FP_Orig_type: "FP_Orig(F) \<subseteq> state"
 by (unfold FP_Orig_def, blast)
 
 lemma st_set_FP_Orig [iff]: "st_set(FP_Orig(F))"
-apply (unfold st_set_def)
+  unfolding st_set_def
 apply (rule FP_Orig_type)
 done
 
 lemma FP_type: "FP(F) \<subseteq> state"
 by (unfold FP_def, blast)
 
 lemma st_set_FP [iff]: "st_set(FP(F))"
-apply (unfold st_set_def)
+  unfolding st_set_def
 apply (rule FP_type)
 done
 
 lemma stable_FP_Orig_Int: "F \<in> program \<Longrightarrow> F \<in> stable(FP_Orig(F) \<inter> B)"
 apply (simp only: FP_Orig_def stable_def Int_Union2)
 apply (blast intro: constrains_UN)
 done
 
 lemma FP_Orig_weakest2: 
     "\<lbrakk>\<forall>B. F \<in> stable (A \<inter> B); st_set(A)\<rbrakk>  \<Longrightarrow> A \<subseteq> FP_Orig(F)"
 by (unfold FP_Orig_def stable_def st_set_def, blast)
 
 lemmas FP_Orig_weakest = allI [THEN FP_Orig_weakest2]
 
 lemma stable_FP_Int: "F \<in> program \<Longrightarrow> F \<in> stable (FP(F) \<inter> B)"
 apply (subgoal_tac "FP (F) \<inter> B = (\<Union>x\<in>B. FP (F) \<inter> {x}) ")
  prefer 2 apply blast
 apply (simp (no_asm_simp) add: Int_cons_right)
 apply (unfold FP_def stable_def)
 apply (rule constrains_UN)
 apply (auto simp add: cons_absorb)
 done
 
 lemma FP_subset_FP_Orig: "F \<in> program \<Longrightarrow> FP(F) \<subseteq> FP_Orig(F)"
 by (rule stable_FP_Int [THEN FP_Orig_weakest], auto)
 
 lemma FP_Orig_subset_FP: "F \<in> program \<Longrightarrow> FP_Orig(F) \<subseteq> FP(F)"
 apply (unfold FP_Orig_def FP_def, clarify)
 apply (drule_tac x = "{x}" in spec)
 apply (simp add: Int_cons_right)
 apply (frule stableD2)
 apply (auto simp add: cons_absorb st_set_def)
 done
 
 lemma FP_equivalence: "F \<in> program \<Longrightarrow> FP(F) = FP_Orig(F)"
 by (blast intro!: FP_Orig_subset_FP FP_subset_FP_Orig)
 
 lemma FP_weakest [rule_format]:
      "\<lbrakk>\<forall>B. F \<in> stable(A \<inter> B); F \<in> program; st_set(A)\<rbrakk> \<Longrightarrow> A \<subseteq> FP(F)"
 by (simp add: FP_equivalence FP_Orig_weakest)
 
 
 lemma Diff_FP: 
      "\<lbrakk>F \<in> program;  st_set(A)\<rbrakk> 
       \<Longrightarrow> A-FP(F) = (\<Union>act \<in> Acts(F). A - {s \<in> state. act``{s} \<subseteq> {s}})"
 by (unfold FP_def stable_def constrains_def st_set_def, blast)
 
 end
diff --git a/src/ZF/UNITY/Follows.thy b/src/ZF/UNITY/Follows.thy
--- a/src/ZF/UNITY/Follows.thy
+++ b/src/ZF/UNITY/Follows.thy
@@ -1,475 +1,475 @@
 (*  Title:      ZF/UNITY/Follows.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     Copyright   2002  University of Cambridge
 
 Theory ported from HOL.
 *)
 
 section\<open>The "Follows" relation of Charpentier and Sivilotte\<close>
 
 theory Follows imports SubstAx Increasing begin
 
 definition
   Follows :: "[i, i, i\<Rightarrow>i, i\<Rightarrow>i] \<Rightarrow> i"  where
   "Follows(A, r, f, g) \<equiv>
             Increasing(A, r, g) Int
             Increasing(A, r,f) Int
             Always({s \<in> state. <f(s), g(s)>:r}) Int
            (\<Inter>k \<in> A. {s \<in> state. <k, g(s)>:r} \<longmapsto>w {s \<in> state. <k,f(s)>:r})"
 
 abbreviation
   Incr :: "[i\<Rightarrow>i]\<Rightarrow>i" where
   "Incr(f) \<equiv> Increasing(list(nat), prefix(nat), f)"
 
 abbreviation
   n_Incr :: "[i\<Rightarrow>i]\<Rightarrow>i" where
   "n_Incr(f) \<equiv> Increasing(nat, Le, f)"
 
 abbreviation
   s_Incr :: "[i\<Rightarrow>i]\<Rightarrow>i" where
   "s_Incr(f) \<equiv> Increasing(Pow(nat), SetLe(nat), f)"
 
 abbreviation
   m_Incr :: "[i\<Rightarrow>i]\<Rightarrow>i" where
   "m_Incr(f) \<equiv> Increasing(Mult(nat), MultLe(nat, Le), f)"
 
 abbreviation
   n_Fols :: "[i\<Rightarrow>i, i\<Rightarrow>i]\<Rightarrow>i"   (infixl \<open>n'_Fols\<close> 65)  where
   "f n_Fols g \<equiv> Follows(nat, Le, f, g)"
 
 abbreviation
   Follows' :: "[i\<Rightarrow>i, i\<Rightarrow>i, i, i] \<Rightarrow> i"
         (\<open>(_ /Fols _ /Wrt (_ /'/ _))\<close> [60, 0, 0, 60] 60)  where
   "f Fols g Wrt r/A \<equiv> Follows(A,r,f,g)"
 
 
 (*Does this hold for "invariant"?*)
 
 lemma Follows_cong:
      "\<lbrakk>A=A'; r=r'; \<And>x. x \<in> state \<Longrightarrow> f(x)=f'(x); \<And>x. x \<in> state \<Longrightarrow> g(x)=g'(x)\<rbrakk> \<Longrightarrow> Follows(A, r, f, g) = Follows(A', r', f', g')"
 by (simp add: Increasing_def Follows_def)
 
 
 lemma subset_Always_comp:
 "\<lbrakk>mono1(A, r, B, s, h); \<forall>x \<in> state. f(x):A \<and> g(x):A\<rbrakk> \<Longrightarrow>
    Always({x \<in> state. <f(x), g(x)> \<in> r})<=Always({x \<in> state. <(h comp f)(x), (h comp g)(x)> \<in> s})"
 apply (unfold mono1_def metacomp_def)
 apply (auto simp add: Always_eq_includes_reachable)
 done
 
 lemma imp_Always_comp:
 "\<lbrakk>F \<in> Always({x \<in> state. <f(x), g(x)> \<in> r});
     mono1(A, r, B, s, h); \<forall>x \<in> state. f(x):A \<and> g(x):A\<rbrakk> \<Longrightarrow>
     F \<in> Always({x \<in> state. <(h comp f)(x), (h comp g)(x)> \<in> s})"
 by (blast intro: subset_Always_comp [THEN subsetD])
 
 
 lemma imp_Always_comp2:
 "\<lbrakk>F \<in> Always({x \<in> state. <f1(x), f(x)> \<in> r});
     F \<in> Always({x \<in> state. <g1(x), g(x)> \<in> s});
     mono2(A, r, B, s, C, t, h);
     \<forall>x \<in> state. f1(x):A \<and> f(x):A \<and> g1(x):B \<and> g(x):B\<rbrakk>
   \<Longrightarrow> F \<in> Always({x \<in> state. <h(f1(x), g1(x)), h(f(x), g(x))> \<in> t})"
 apply (auto simp add: Always_eq_includes_reachable mono2_def)
 apply (auto dest!: subsetD)
 done
 
 (* comp LeadsTo *)
 
 lemma subset_LeadsTo_comp:
 "\<lbrakk>mono1(A, r, B, s, h); refl(A,r); trans[B](s);
         \<forall>x \<in> state. f(x):A \<and> g(x):A\<rbrakk> \<Longrightarrow>
   (\<Inter>j \<in> A. {s \<in> state. <j, g(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f(s)> \<in> r}) <=
  (\<Inter>k \<in> B. {x \<in> state. <k, (h comp g)(x)> \<in> s} \<longmapsto>w {x \<in> state. <k, (h comp f)(x)> \<in> s})"
 
 apply (unfold mono1_def metacomp_def, clarify)
 apply (simp_all (no_asm_use) add: INT_iff)
 apply auto
 apply (rule single_LeadsTo_I)
 prefer 2 apply (blast dest: LeadsTo_type [THEN subsetD], auto)
 apply (rotate_tac 5)
 apply (drule_tac x = "g (sa) " in bspec)
 apply (erule_tac [2] LeadsTo_weaken)
 apply (auto simp add: part_order_def refl_def)
 apply (rule_tac b = "h (g (sa))" in trans_onD)
 apply blast
 apply auto
 done
 
 lemma imp_LeadsTo_comp:
 "\<lbrakk>F:(\<Inter>j \<in> A. {s \<in> state. <j, g(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f(s)> \<in> r});
     mono1(A, r, B, s, h); refl(A,r); trans[B](s);
     \<forall>x \<in> state. f(x):A \<and> g(x):A\<rbrakk> \<Longrightarrow>
    F:(\<Inter>k \<in> B. {x \<in> state. <k, (h comp g)(x)> \<in> s} \<longmapsto>w {x \<in> state. <k, (h comp f)(x)> \<in> s})"
 apply (rule subset_LeadsTo_comp [THEN subsetD], auto)
 done
 
 lemma imp_LeadsTo_comp_right:
 "\<lbrakk>F \<in> Increasing(B, s, g);
   \<forall>j \<in> A. F: {s \<in> state. <j, f(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f1(s)> \<in> r};
   mono2(A, r, B, s, C, t, h); refl(A, r); refl(B, s); trans[C](t);
   \<forall>x \<in> state. f1(x):A \<and> f(x):A \<and> g(x):B; k \<in> C\<rbrakk> \<Longrightarrow>
   F:{x \<in> state. <k, h(f(x), g(x))> \<in> t} \<longmapsto>w {x \<in> state. <k, h(f1(x), g(x))> \<in> t}"
 apply (unfold mono2_def Increasing_def)
 apply (rule single_LeadsTo_I, auto)
 apply (drule_tac x = "g (sa) " and A = B in bspec)
 apply auto
 apply (drule_tac x = "f (sa) " and P = "\<lambda>j. F \<in> X(j) \<longmapsto>w Y(j)" for X Y in bspec)
 apply auto
 apply (rule PSP_Stable [THEN LeadsTo_weaken], blast, blast)
 apply auto
 apply (force simp add: part_order_def refl_def)
 apply (force simp add: part_order_def refl_def)
 apply (drule_tac x = "f1 (x)" and x1 = "f (sa) " and P2 = "\<lambda>x y. \<forall>u\<in>B. P (x,y,u)" for P in bspec [THEN bspec])
 apply (drule_tac [3] x = "g (x) " and x1 = "g (sa) " and P2 = "\<lambda>x y. P (x,y) \<longrightarrow> d (x,y) \<in> t" for P d in bspec [THEN bspec])
 apply auto
 apply (rule_tac b = "h (f (sa), g (sa))" and A = C in trans_onD)
 apply (auto simp add: part_order_def)
 done
 
 lemma imp_LeadsTo_comp_left:
 "\<lbrakk>F \<in> Increasing(A, r, f);
   \<forall>j \<in> B. F: {x \<in> state. <j, g(x)> \<in> s} \<longmapsto>w {x \<in> state. <j,g1(x)> \<in> s};
   mono2(A, r, B, s, C, t, h); refl(A,r); refl(B, s); trans[C](t);
   \<forall>x \<in> state. f(x):A \<and> g1(x):B \<and> g(x):B; k \<in> C\<rbrakk> \<Longrightarrow>
   F:{x \<in> state. <k, h(f(x), g(x))> \<in> t} \<longmapsto>w {x \<in> state. <k, h(f(x), g1(x))> \<in> t}"
 apply (unfold mono2_def Increasing_def)
 apply (rule single_LeadsTo_I, auto)
 apply (drule_tac x = "f (sa) " and P = "\<lambda>k. F \<in> Stable (X (k))" for X in bspec)
 apply auto
 apply (drule_tac x = "g (sa) " in bspec)
 apply auto
 apply (rule PSP_Stable [THEN LeadsTo_weaken], blast, blast)
 apply auto
 apply (force simp add: part_order_def refl_def)
 apply (force simp add: part_order_def refl_def)
 apply (drule_tac x = "f (x) " and x1 = "f (sa) " in bspec [THEN bspec])
 apply (drule_tac [3] x = "g1 (x) " and x1 = "g (sa) " and P2 = "\<lambda>x y. P (x,y) \<longrightarrow> d (x,y) \<in> t" for P d in bspec [THEN bspec])
 apply auto
 apply (rule_tac b = "h (f (sa), g (sa))" and A = C in trans_onD)
 apply (auto simp add: part_order_def)
 done
 
 (**  This general result is used to prove Follows Un, munion, etc. **)
 lemma imp_LeadsTo_comp2:
 "\<lbrakk>F \<in> Increasing(A, r, f1) \<inter>  Increasing(B, s, g);
   \<forall>j \<in> A. F: {s \<in> state. <j, f(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f1(s)> \<in> r};
   \<forall>j \<in> B. F: {x \<in> state. <j, g(x)> \<in> s} \<longmapsto>w {x \<in> state. <j,g1(x)> \<in> s};
   mono2(A, r, B, s, C, t, h); refl(A,r); refl(B, s); trans[C](t);
   \<forall>x \<in> state. f(x):A \<and> g1(x):B \<and> f1(x):A \<and>g(x):B; k \<in> C\<rbrakk>
   \<Longrightarrow> F:{x \<in> state. <k, h(f(x), g(x))> \<in> t} \<longmapsto>w {x \<in> state. <k, h(f1(x), g1(x))> \<in> t}"
 apply (rule_tac B = "{x \<in> state. <k, h (f1 (x), g (x))> \<in> t}" in LeadsTo_Trans)
 apply (blast intro: imp_LeadsTo_comp_right)
 apply (blast intro: imp_LeadsTo_comp_left)
 done
 
 (* Follows type *)
 lemma Follows_type: "Follows(A, r, f, g)<=program"
-apply (unfold Follows_def)
+  unfolding Follows_def
 apply (blast dest: Increasing_type [THEN subsetD])
 done
 
 lemma Follows_into_program [TC]: "F \<in> Follows(A, r, f, g) \<Longrightarrow> F \<in> program"
 by (blast dest: Follows_type [THEN subsetD])
 
 lemma FollowsD:
 "F \<in> Follows(A, r, f, g)\<Longrightarrow>
   F \<in> program \<and> (\<exists>a. a \<in> A) \<and> (\<forall>x \<in> state. f(x):A \<and> g(x):A)"
-apply (unfold Follows_def)
+  unfolding Follows_def
 apply (blast dest: IncreasingD)
 done
 
 lemma Follows_constantI:
  "\<lbrakk>F \<in> program; c \<in> A; refl(A, r)\<rbrakk> \<Longrightarrow> F \<in> Follows(A, r, \<lambda>x. c, \<lambda>x. c)"
 apply (unfold Follows_def, auto)
 apply (auto simp add: refl_def)
 done
 
 lemma subset_Follows_comp:
 "\<lbrakk>mono1(A, r, B, s, h); refl(A, r); trans[B](s)\<rbrakk>
    \<Longrightarrow> Follows(A, r, f, g) \<subseteq> Follows(B, s,  h comp f, h comp g)"
 apply (unfold Follows_def, clarify)
 apply (frule_tac f = g in IncreasingD)
 apply (frule_tac f = f in IncreasingD)
 apply (rule IntI)
 apply (rule_tac [2] h = h in imp_LeadsTo_comp)
 prefer 5 apply assumption
 apply (auto intro: imp_Increasing_comp imp_Always_comp simp del: INT_simps)
 done
 
 lemma imp_Follows_comp:
 "\<lbrakk>F \<in> Follows(A, r, f, g);  mono1(A, r, B, s, h); refl(A, r); trans[B](s)\<rbrakk>
   \<Longrightarrow>  F \<in> Follows(B, s,  h comp f, h comp g)"
 apply (blast intro: subset_Follows_comp [THEN subsetD])
 done
 
 (* 2-place monotone operation \<in> this general result is used to prove Follows_Un, Follows_munion *)
 
 (* 2-place monotone operation \<in> this general result is
    used to prove Follows_Un, Follows_munion *)
 lemma imp_Follows_comp2:
 "\<lbrakk>F \<in> Follows(A, r, f1, f);  F \<in> Follows(B, s, g1, g);
    mono2(A, r, B, s, C, t, h); refl(A,r); refl(B, s); trans[C](t)\<rbrakk>
    \<Longrightarrow> F \<in> Follows(C, t, \<lambda>x. h(f1(x), g1(x)), \<lambda>x. h(f(x), g(x)))"
 apply (unfold Follows_def, clarify)
 apply (frule_tac f = g in IncreasingD)
 apply (frule_tac f = f in IncreasingD)
 apply (rule IntI, safe)
 apply (rule_tac [3] h = h in imp_Always_comp2)
 prefer 5 apply assumption
 apply (rule_tac [2] h = h in imp_Increasing_comp2)
 prefer 4 apply assumption
 apply (rule_tac h = h in imp_Increasing_comp2)
 prefer 3 apply assumption
 apply simp_all
 apply (blast dest!: IncreasingD)
 apply (rule_tac h = h in imp_LeadsTo_comp2)
 prefer 4 apply assumption
 apply auto
   prefer 3 apply (simp add: mono2_def)
 apply (blast dest: IncreasingD)+
 done
 
 
 lemma Follows_trans:
      "\<lbrakk>F \<in> Follows(A, r, f, g);  F \<in> Follows(A,r, g, h);
          trans[A](r)\<rbrakk> \<Longrightarrow> F \<in> Follows(A, r, f, h)"
 apply (frule_tac f = f in FollowsD)
 apply (frule_tac f = g in FollowsD)
 apply (simp add: Follows_def)
 apply (simp add: Always_eq_includes_reachable INT_iff, auto)
 apply (rule_tac [2] B = "{s \<in> state. <k, g (s) > \<in> r}" in LeadsTo_Trans)
 apply (rule_tac b = "g (x) " in trans_onD)
 apply blast+
 done
 
 (** Destruction rules for Follows **)
 
 lemma Follows_imp_Increasing_left:
      "F \<in> Follows(A, r, f,g) \<Longrightarrow> F \<in> Increasing(A, r, f)"
 by (unfold Follows_def, blast)
 
 lemma Follows_imp_Increasing_right:
      "F \<in> Follows(A, r, f,g) \<Longrightarrow> F \<in> Increasing(A, r, g)"
 by (unfold Follows_def, blast)
 
 lemma Follows_imp_Always:
  "F :Follows(A, r, f, g) \<Longrightarrow> F \<in> Always({s \<in> state. <f(s),g(s)> \<in> r})"
 by (unfold Follows_def, blast)
 
 lemma Follows_imp_LeadsTo:
  "\<lbrakk>F \<in> Follows(A, r, f, g); k \<in> A\<rbrakk>  \<Longrightarrow>
   F: {s \<in> state. <k,g(s)> \<in> r } \<longmapsto>w {s \<in> state. <k,f(s)> \<in> r}"
 by (unfold Follows_def, blast)
 
 lemma Follows_LeadsTo_pfixLe:
      "\<lbrakk>F \<in> Follows(list(nat), gen_prefix(nat, Le), f, g); k \<in> list(nat)\<rbrakk>
    \<Longrightarrow> F \<in> {s \<in> state. k pfixLe g(s)} \<longmapsto>w {s \<in> state. k pfixLe f(s)}"
 by (blast intro: Follows_imp_LeadsTo)
 
 lemma Follows_LeadsTo_pfixGe:
      "\<lbrakk>F \<in> Follows(list(nat), gen_prefix(nat, Ge), f, g); k \<in> list(nat)\<rbrakk>
    \<Longrightarrow> F \<in> {s \<in> state. k pfixGe g(s)} \<longmapsto>w {s \<in> state. k pfixGe f(s)}"
 by (blast intro: Follows_imp_LeadsTo)
 
 lemma Always_Follows1:
 "\<lbrakk>F \<in> Always({s \<in> state. f(s) = g(s)}); F \<in> Follows(A, r, f, h);
     \<forall>x \<in> state. g(x):A\<rbrakk> \<Longrightarrow> F \<in> Follows(A, r, g, h)"
 apply (unfold Follows_def Increasing_def Stable_def)
 apply (simp add: INT_iff, auto)
 apply (rule_tac [3] C = "{s \<in> state. f(s)=g(s)}"
         and A = "{s \<in> state. <k, h (s)> \<in> r}"
         and A' = "{s \<in> state. <k, f(s)> \<in> r}" in Always_LeadsTo_weaken)
 apply (erule_tac A = "{s \<in> state. <k,f(s) > \<in> r}"
            and A' = "{s \<in> state. <k,f(s) > \<in> r}" in Always_Constrains_weaken)
 apply auto
 apply (drule Always_Int_I, assumption)
 apply (erule_tac A = "{s \<in> state. f(s)=g(s)} \<inter> {s \<in> state. <f(s), h(s)> \<in> r}"
        in Always_weaken)
 apply auto
 done
 
 
 lemma Always_Follows2:
 "\<lbrakk>F \<in> Always({s \<in> state. g(s) = h(s)});
   F \<in> Follows(A, r, f, g); \<forall>x \<in> state. h(x):A\<rbrakk> \<Longrightarrow> F \<in> Follows(A, r, f, h)"
 apply (unfold Follows_def Increasing_def Stable_def)
 apply (simp add: INT_iff, auto)
 apply (rule_tac [3] C = "{s \<in> state. g (s) =h (s) }"
             and A = "{s \<in> state. <k, g (s) > \<in> r}"
             and A' = "{s \<in> state. <k, f (s) > \<in> r}" in Always_LeadsTo_weaken)
 apply (erule_tac A = "{s \<in> state. <k, g(s)> \<in> r}"
          and A' = "{s \<in> state. <k, g(s)> \<in> r}" in Always_Constrains_weaken)
 apply auto
 apply (drule Always_Int_I, assumption)
 apply (erule_tac A = "{s \<in> state. g(s)=h(s)} \<inter> {s \<in> state. <f(s), g(s)> \<in> r}"
        in Always_weaken)
 apply auto
 done
 
 (** Union properties (with the subset ordering) **)
 
 lemma refl_SetLe [simp]: "refl(Pow(A), SetLe(A))"
 by (unfold refl_def SetLe_def, auto)
 
 lemma trans_on_SetLe [simp]: "trans[Pow(A)](SetLe(A))"
 by (unfold trans_on_def SetLe_def, auto)
 
 lemma antisym_SetLe [simp]: "antisym(SetLe(A))"
 by (unfold antisym_def SetLe_def, auto)
 
 lemma part_order_SetLe [simp]: "part_order(Pow(A), SetLe(A))"
 by (unfold part_order_def, auto)
 
 lemma increasing_Un:
      "\<lbrakk>F \<in> Increasing.increasing(Pow(A), SetLe(A), f);
          F \<in> Increasing.increasing(Pow(A), SetLe(A), g)\<rbrakk>
      \<Longrightarrow> F \<in> Increasing.increasing(Pow(A), SetLe(A), \<lambda>x. f(x) \<union> g(x))"
 by (rule_tac h = "(Un)" in imp_increasing_comp2, auto)
 
 lemma Increasing_Un:
      "\<lbrakk>F \<in> Increasing(Pow(A), SetLe(A), f);
          F \<in> Increasing(Pow(A), SetLe(A), g)\<rbrakk>
      \<Longrightarrow> F \<in> Increasing(Pow(A), SetLe(A), \<lambda>x. f(x) \<union> g(x))"
 by (rule_tac h = "(Un)" in imp_Increasing_comp2, auto)
 
 lemma Always_Un:
      "\<lbrakk>F \<in> Always({s \<in> state. f1(s) \<subseteq> f(s)});
      F \<in> Always({s \<in> state. g1(s) \<subseteq> g(s)})\<rbrakk>
       \<Longrightarrow> F \<in> Always({s \<in> state. f1(s) \<union> g1(s) \<subseteq> f(s) \<union> g(s)})"
 by (simp add: Always_eq_includes_reachable, blast)
 
 lemma Follows_Un:
 "\<lbrakk>F \<in> Follows(Pow(A), SetLe(A), f1, f);
      F \<in> Follows(Pow(A), SetLe(A), g1, g)\<rbrakk>
      \<Longrightarrow> F \<in> Follows(Pow(A), SetLe(A), \<lambda>s. f1(s) \<union> g1(s), \<lambda>s. f(s) \<union> g(s))"
 by (rule_tac h = "(Un)" in imp_Follows_comp2, auto)
 
 (** Multiset union properties (with the MultLe ordering) **)
 
 lemma refl_MultLe [simp]: "refl(Mult(A), MultLe(A,r))"
 by (unfold MultLe_def refl_def, auto)
 
 lemma MultLe_refl1 [simp]:
  "\<lbrakk>multiset(M); mset_of(M)<=A\<rbrakk> \<Longrightarrow> \<langle>M, M\<rangle> \<in> MultLe(A, r)"
 apply (unfold MultLe_def id_def lam_def)
 apply (auto simp add: Mult_iff_multiset)
 done
 
 lemma MultLe_refl2 [simp]: "M \<in> Mult(A) \<Longrightarrow> \<langle>M, M\<rangle> \<in> MultLe(A, r)"
 by (unfold MultLe_def id_def lam_def, auto)
 
 
 lemma trans_on_MultLe [simp]: "trans[Mult(A)](MultLe(A,r))"
 apply (unfold MultLe_def trans_on_def)
 apply (auto intro: trancl_trans simp add: multirel_def)
 done
 
 lemma MultLe_type: "MultLe(A, r)<= (Mult(A) * Mult(A))"
 apply (unfold MultLe_def, auto)
 apply (drule multirel_type [THEN subsetD], auto)
 done
 
 lemma MultLe_trans:
      "\<lbrakk>\<langle>M,K\<rangle> \<in> MultLe(A,r); \<langle>K,N\<rangle> \<in> MultLe(A,r)\<rbrakk> \<Longrightarrow> \<langle>M,N\<rangle> \<in> MultLe(A,r)"
 apply (cut_tac A=A in trans_on_MultLe)
 apply (drule trans_onD, assumption)
 apply (auto dest: MultLe_type [THEN subsetD])
 done
 
 lemma part_order_imp_part_ord:
      "part_order(A, r) \<Longrightarrow> part_ord(A, r-id(A))"
 apply (unfold part_order_def part_ord_def)
 apply (simp add: refl_def id_def lam_def irrefl_def, auto)
 apply (simp (no_asm) add: trans_on_def)
 apply auto
 apply (blast dest: trans_onD)
 apply (simp (no_asm_use) add: antisym_def)
 apply auto
 done
 
 lemma antisym_MultLe [simp]:
   "part_order(A, r) \<Longrightarrow> antisym(MultLe(A,r))"
 apply (unfold MultLe_def antisym_def)
 apply (drule part_order_imp_part_ord, auto)
 apply (drule irrefl_on_multirel)
 apply (frule multirel_type [THEN subsetD])
 apply (drule multirel_trans)
 apply (auto simp add: irrefl_def)
 done
 
 lemma part_order_MultLe [simp]:
      "part_order(A, r) \<Longrightarrow>  part_order(Mult(A), MultLe(A, r))"
 apply (frule antisym_MultLe)
 apply (auto simp add: part_order_def)
 done
 
 lemma empty_le_MultLe [simp]:
 "\<lbrakk>multiset(M); mset_of(M)<= A\<rbrakk> \<Longrightarrow> \<langle>0, M\<rangle> \<in> MultLe(A, r)"
-apply (unfold MultLe_def)
+  unfolding MultLe_def
 apply (case_tac "M=0")
 apply (auto simp add: FiniteFun.intros)
 apply (subgoal_tac "<0 +# 0, 0 +# M> \<in> multirel (A, r - id (A))")
 apply (rule_tac [2] one_step_implies_multirel)
 apply (auto simp add: Mult_iff_multiset)
 done
 
 lemma empty_le_MultLe2 [simp]: "M \<in> Mult(A) \<Longrightarrow> \<langle>0, M\<rangle> \<in> MultLe(A, r)"
 by (simp add: Mult_iff_multiset)
 
 lemma munion_mono:
 "\<lbrakk>\<langle>M, N\<rangle> \<in> MultLe(A, r); \<langle>K, L\<rangle> \<in> MultLe(A, r)\<rbrakk> \<Longrightarrow>
   <M +# K, N +# L> \<in> MultLe(A, r)"
-apply (unfold MultLe_def)
+  unfolding MultLe_def
 apply (auto intro: munion_multirel_mono1 munion_multirel_mono2
        munion_multirel_mono multiset_into_Mult simp add: Mult_iff_multiset)
 done
 
 lemma increasing_munion:
      "\<lbrakk>F \<in> Increasing.increasing(Mult(A), MultLe(A,r), f);
          F \<in> Increasing.increasing(Mult(A), MultLe(A,r), g)\<rbrakk>
      \<Longrightarrow> F \<in> Increasing.increasing(Mult(A),MultLe(A,r), \<lambda>x. f(x) +# g(x))"
 by (rule_tac h = munion in imp_increasing_comp2, auto)
 
 lemma Increasing_munion:
      "\<lbrakk>F \<in> Increasing(Mult(A), MultLe(A,r), f);
          F \<in> Increasing(Mult(A), MultLe(A,r), g)\<rbrakk>
      \<Longrightarrow> F \<in> Increasing(Mult(A),MultLe(A,r), \<lambda>x. f(x) +# g(x))"
 by (rule_tac h = munion in imp_Increasing_comp2, auto)
 
 lemma Always_munion:
 "\<lbrakk>F \<in> Always({s \<in> state. <f1(s),f(s)> \<in> MultLe(A,r)});
           F \<in> Always({s \<in> state. <g1(s), g(s)> \<in> MultLe(A,r)});
   \<forall>x \<in> state. f1(x):Mult(A)\<and>f(x):Mult(A) \<and> g1(x):Mult(A) \<and> g(x):Mult(A)\<rbrakk>
       \<Longrightarrow> F \<in> Always({s \<in> state. <f1(s) +# g1(s), f(s) +# g(s)> \<in> MultLe(A,r)})"
 apply (rule_tac h = munion in imp_Always_comp2, simp_all)
 apply (blast intro: munion_mono, simp_all)
 done
 
 lemma Follows_munion:
 "\<lbrakk>F \<in> Follows(Mult(A), MultLe(A, r), f1, f);
     F \<in> Follows(Mult(A), MultLe(A, r), g1, g)\<rbrakk>
   \<Longrightarrow> F \<in> Follows(Mult(A), MultLe(A, r), \<lambda>s. f1(s) +# g1(s), \<lambda>s. f(s) +# g(s))"
 by (rule_tac h = munion in imp_Follows_comp2, auto)
 
 (** Used in ClientImp **)
 
 lemma Follows_msetsum_UN:
 "\<And>f. \<lbrakk>\<forall>i \<in> I. F \<in> Follows(Mult(A), MultLe(A, r), f'(i), f(i));
   \<forall>s. \<forall>i \<in> I. multiset(f'(i, s)) \<and> mset_of(f'(i, s))<=A \<and>
                         multiset(f(i, s)) \<and> mset_of(f(i, s))<=A ;
    Finite(I); F \<in> program\<rbrakk>
         \<Longrightarrow> F \<in> Follows(Mult(A),
                         MultLe(A, r), \<lambda>x. msetsum(\<lambda>i. f'(i, x), I, A),
                                       \<lambda>x. msetsum(\<lambda>i. f(i,  x), I, A))"
 apply (erule rev_mp)
 apply (drule Finite_into_Fin)
 apply (erule Fin_induct)
 apply (simp (no_asm_simp))
 apply (rule Follows_constantI)
 apply (simp_all (no_asm_simp) add: FiniteFun.intros)
 apply auto
 apply (rule Follows_munion, auto)
 done
 
 end
diff --git a/src/ZF/UNITY/GenPrefix.thy b/src/ZF/UNITY/GenPrefix.thy
--- a/src/ZF/UNITY/GenPrefix.thy
+++ b/src/ZF/UNITY/GenPrefix.thy
@@ -1,680 +1,680 @@
 (*  Title:      ZF/UNITY/GenPrefix.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     Copyright   2001  University of Cambridge
 
 \<langle>xs,ys\<rangle>:gen_prefix(r)
   if ys = xs' @ zs where length(xs) = length(xs')
   and corresponding elements of xs, xs' are pairwise related by r
 
 Based on Lex/Prefix
 *)
 
 section\<open>Charpentier's Generalized Prefix Relation\<close>
 
 theory GenPrefix
 imports ZF
 begin
 
 definition (*really belongs in ZF/Trancl*)
   part_order :: "[i, i] \<Rightarrow> o"  where
   "part_order(A, r) \<equiv> refl(A,r) \<and> trans[A](r) \<and> antisym(r)"
 
 consts
   gen_prefix :: "[i, i] \<Rightarrow> i"
 
 inductive
   (* Parameter A is the domain of zs's elements *)
 
   domains "gen_prefix(A, r)" \<subseteq> "list(A)*list(A)"
 
   intros
     Nil:     "<[],[]>:gen_prefix(A, r)"
 
     prepend: "\<lbrakk>\<langle>xs,ys\<rangle>:gen_prefix(A, r);  \<langle>x,y\<rangle>:r; x \<in> A; y \<in> A\<rbrakk>
               \<Longrightarrow> <Cons(x,xs), Cons(y,ys)>: gen_prefix(A, r)"
 
     append:  "\<lbrakk>\<langle>xs,ys\<rangle>:gen_prefix(A, r); zs:list(A)\<rbrakk>
               \<Longrightarrow> <xs, ys@zs>:gen_prefix(A, r)"
     type_intros app_type list.Nil list.Cons
 
 definition
   prefix :: "i\<Rightarrow>i"  where
   "prefix(A) \<equiv> gen_prefix(A, id(A))"
 
 definition
   strict_prefix :: "i\<Rightarrow>i"  where
   "strict_prefix(A) \<equiv> prefix(A) - id(list(A))"
 
 
 (* less or equal and greater or equal over prefixes *)
 
 abbreviation
   pfixLe :: "[i, i] \<Rightarrow> o"  (infixl \<open>pfixLe\<close> 50)  where
   "xs pfixLe ys \<equiv> \<langle>xs, ys\<rangle>:gen_prefix(nat, Le)"
 
 abbreviation
   pfixGe :: "[i, i] \<Rightarrow> o"  (infixl \<open>pfixGe\<close> 50)  where
   "xs pfixGe ys \<equiv> \<langle>xs, ys\<rangle>:gen_prefix(nat, Ge)"
 
 
 lemma reflD:
  "\<lbrakk>refl(A, r); x \<in> A\<rbrakk> \<Longrightarrow> \<langle>x,x\<rangle>:r"
 apply (unfold refl_def, auto)
 done
 
 (*** preliminary lemmas ***)
 
 lemma Nil_gen_prefix: "xs \<in> list(A) \<Longrightarrow> <[], xs> \<in> gen_prefix(A, r)"
 by (drule gen_prefix.append [OF gen_prefix.Nil], simp)
 declare Nil_gen_prefix [simp]
 
 
 lemma gen_prefix_length_le: "\<langle>xs,ys\<rangle> \<in> gen_prefix(A, r) \<Longrightarrow> length(xs) \<le> length(ys)"
 apply (erule gen_prefix.induct)
 apply (subgoal_tac [3] "ys \<in> list (A) ")
 apply (auto dest: gen_prefix.dom_subset [THEN subsetD]
             intro: le_trans simp add: length_app)
 done
 
 
 lemma Cons_gen_prefix_aux:
   "\<lbrakk><xs', ys'> \<in> gen_prefix(A, r)\<rbrakk>
    \<Longrightarrow> (\<forall>x xs. x \<in> A \<longrightarrow> xs'= Cons(x,xs) \<longrightarrow>
        (\<exists>y ys. y \<in> A \<and> ys' = Cons(y,ys) \<and>
        \<langle>x,y\<rangle>:r \<and> \<langle>xs, ys\<rangle> \<in> gen_prefix(A, r)))"
 apply (erule gen_prefix.induct)
 prefer 3 apply (force intro: gen_prefix.append, auto)
 done
 
 lemma Cons_gen_prefixE:
   "\<lbrakk><Cons(x,xs), zs> \<in> gen_prefix(A, r);
     \<And>y ys. \<lbrakk>zs = Cons(y, ys); y \<in> A; x \<in> A; \<langle>x,y\<rangle>:r;
       \<langle>xs,ys\<rangle> \<in> gen_prefix(A, r)\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 apply (frule gen_prefix.dom_subset [THEN subsetD], auto)
 apply (blast dest: Cons_gen_prefix_aux)
 done
 declare Cons_gen_prefixE [elim!]
 
 lemma Cons_gen_prefix_Cons:
 "(<Cons(x,xs),Cons(y,ys)> \<in> gen_prefix(A, r))
   \<longleftrightarrow> (x \<in> A \<and> y \<in> A \<and> \<langle>x,y\<rangle>:r \<and> \<langle>xs,ys\<rangle> \<in> gen_prefix(A, r))"
 apply (auto intro: gen_prefix.prepend)
 done
 declare Cons_gen_prefix_Cons [iff]
 
 (** Monotonicity of gen_prefix **)
 
 lemma gen_prefix_mono2: "r<=s \<Longrightarrow> gen_prefix(A, r) \<subseteq> gen_prefix(A, s)"
 apply clarify
 apply (frule gen_prefix.dom_subset [THEN subsetD], clarify)
 apply (erule rev_mp)
 apply (erule gen_prefix.induct)
 apply (auto intro: gen_prefix.append)
 done
 
 lemma gen_prefix_mono1: "A<=B \<Longrightarrow>gen_prefix(A, r) \<subseteq> gen_prefix(B, r)"
 apply clarify
 apply (frule gen_prefix.dom_subset [THEN subsetD], clarify)
 apply (erule rev_mp)
 apply (erule_tac P = "y \<in> list (A) " in rev_mp)
 apply (erule_tac P = "xa \<in> list (A) " in rev_mp)
 apply (erule gen_prefix.induct)
 apply (simp (no_asm_simp))
 apply clarify
 apply (erule ConsE)+
 apply (auto dest: gen_prefix.dom_subset [THEN subsetD]
             intro: gen_prefix.append list_mono [THEN subsetD])
 done
 
 lemma gen_prefix_mono: "\<lbrakk>A \<subseteq> B; r \<subseteq> s\<rbrakk> \<Longrightarrow> gen_prefix(A, r) \<subseteq> gen_prefix(B, s)"
 apply (rule subset_trans)
 apply (rule gen_prefix_mono1)
 apply (rule_tac [2] gen_prefix_mono2, auto)
 done
 
 (*** gen_prefix order ***)
 
 (* reflexivity *)
 lemma refl_gen_prefix: "refl(A, r) \<Longrightarrow> refl(list(A), gen_prefix(A, r))"
 apply (unfold refl_def, auto)
 apply (induct_tac "x", auto)
 done
 declare refl_gen_prefix [THEN reflD, simp]
 
 (* Transitivity *)
 (* A lemma for proving gen_prefix_trans_comp *)
 
 lemma append_gen_prefix [rule_format (no_asm)]: "xs \<in> list(A) \<Longrightarrow>
    \<forall>zs. <xs @ ys, zs> \<in> gen_prefix(A, r) \<longrightarrow> \<langle>xs, zs\<rangle>: gen_prefix(A, r)"
 apply (erule list.induct)
 apply (auto dest: gen_prefix.dom_subset [THEN subsetD])
 done
 
 (* Lemma proving transitivity and more*)
 
 lemma gen_prefix_trans_comp [rule_format (no_asm)]:
      "\<langle>x, y\<rangle>: gen_prefix(A, r) \<Longrightarrow>
    (\<forall>z \<in> list(A). \<langle>y,z\<rangle> \<in> gen_prefix(A, s)\<longrightarrow>\<langle>x, z\<rangle> \<in> gen_prefix(A, s O r))"
 apply (erule gen_prefix.induct)
 apply (auto elim: ConsE simp add: Nil_gen_prefix)
 apply (subgoal_tac "ys \<in> list (A) ")
 prefer 2 apply (blast dest: gen_prefix.dom_subset [THEN subsetD])
 apply (drule_tac xs = ys and r = s in append_gen_prefix, auto)
 done
 
 lemma trans_comp_subset: "trans(r) \<Longrightarrow> r O r \<subseteq> r"
 by (auto dest: transD)
 
 lemma trans_gen_prefix: "trans(r) \<Longrightarrow> trans(gen_prefix(A,r))"
 apply (simp (no_asm) add: trans_def)
 apply clarify
 apply (rule trans_comp_subset [THEN gen_prefix_mono2, THEN subsetD], assumption)
 apply (rule gen_prefix_trans_comp)
 apply (auto dest: gen_prefix.dom_subset [THEN subsetD])
 done
 
 lemma trans_on_gen_prefix:
  "trans(r) \<Longrightarrow> trans[list(A)](gen_prefix(A, r))"
 apply (drule_tac A = A in trans_gen_prefix)
 apply (unfold trans_def trans_on_def, blast)
 done
 
 lemma prefix_gen_prefix_trans:
     "\<lbrakk>\<langle>x,y\<rangle> \<in> prefix(A); \<langle>y, z\<rangle> \<in> gen_prefix(A, r); r<=A*A\<rbrakk>
       \<Longrightarrow>  \<langle>x, z\<rangle> \<in> gen_prefix(A, r)"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (rule_tac P = "\<lambda>r. \<langle>x,z\<rangle> \<in> gen_prefix (A, r) " in right_comp_id [THEN subst])
 apply (blast dest: gen_prefix_trans_comp gen_prefix.dom_subset [THEN subsetD])+
 done
 
 
 lemma gen_prefix_prefix_trans:
 "\<lbrakk>\<langle>x,y\<rangle> \<in> gen_prefix(A,r); \<langle>y, z\<rangle> \<in> prefix(A); r<=A*A\<rbrakk>
   \<Longrightarrow>  \<langle>x, z\<rangle> \<in> gen_prefix(A, r)"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (rule_tac P = "\<lambda>r. \<langle>x,z\<rangle> \<in> gen_prefix (A, r) " in left_comp_id [THEN subst])
 apply (blast dest: gen_prefix_trans_comp gen_prefix.dom_subset [THEN subsetD])+
 done
 
 (** Antisymmetry **)
 
 lemma nat_le_lemma [rule_format]: "n \<in> nat \<Longrightarrow> \<forall>b \<in> nat. n #+ b \<le> n \<longrightarrow> b = 0"
 by (induct_tac "n", auto)
 
 lemma antisym_gen_prefix: "antisym(r) \<Longrightarrow> antisym(gen_prefix(A, r))"
 apply (simp (no_asm) add: antisym_def)
 apply (rule impI [THEN allI, THEN allI])
 apply (erule gen_prefix.induct, blast)
 apply (simp add: antisym_def, blast)
 txt\<open>append case is hardest\<close>
 apply clarify
 apply (subgoal_tac "length (zs) = 0")
 apply (subgoal_tac "ys \<in> list (A) ")
 prefer 2 apply (blast dest: gen_prefix.dom_subset [THEN subsetD])
 apply (drule_tac psi = "<ys @ zs, xs> \<in> gen_prefix (A,r) " in asm_rl)
 apply simp
 apply (subgoal_tac "length (ys @ zs) = length (ys) #+ length (zs) \<and>ys \<in> list (A) \<and>xs \<in> list (A) ")
 prefer 2 apply (blast intro: length_app dest: gen_prefix.dom_subset [THEN subsetD])
 apply (drule gen_prefix_length_le)+
 apply clarify
 apply simp
 apply (drule_tac j = "length (xs) " in le_trans)
 apply blast
 apply (auto intro: nat_le_lemma)
 done
 
 (*** recursion equations ***)
 
 lemma gen_prefix_Nil: "xs \<in> list(A) \<Longrightarrow> <xs, []> \<in> gen_prefix(A,r) \<longleftrightarrow> (xs = [])"
 by (induct_tac "xs", auto)
 declare gen_prefix_Nil [simp]
 
 lemma same_gen_prefix_gen_prefix:
  "\<lbrakk>refl(A, r);  xs \<in> list(A)\<rbrakk> \<Longrightarrow>
     <xs@ys, xs@zs>: gen_prefix(A, r) \<longleftrightarrow> \<langle>ys,zs\<rangle> \<in> gen_prefix(A, r)"
-apply (unfold refl_def)
+  unfolding refl_def
 apply (induct_tac "xs")
 apply (simp_all (no_asm_simp))
 done
 declare same_gen_prefix_gen_prefix [simp]
 
 lemma gen_prefix_Cons: "\<lbrakk>xs \<in> list(A); ys \<in> list(A); y \<in> A\<rbrakk> \<Longrightarrow>
     <xs, Cons(y,ys)> \<in> gen_prefix(A,r)  \<longleftrightarrow>
       (xs=[] | (\<exists>z zs. xs=Cons(z,zs) \<and> z \<in> A \<and> \<langle>z,y\<rangle>:r \<and> \<langle>zs,ys\<rangle> \<in> gen_prefix(A,r)))"
 apply (induct_tac "xs", auto)
 done
 
 lemma gen_prefix_take_append: "\<lbrakk>refl(A,r);  \<langle>xs,ys\<rangle> \<in> gen_prefix(A, r); zs \<in> list(A)\<rbrakk>
       \<Longrightarrow>  <xs@zs, take(length(xs), ys) @ zs> \<in> gen_prefix(A, r)"
 apply (erule gen_prefix.induct)
 apply (simp (no_asm_simp))
 apply (frule_tac [!] gen_prefix.dom_subset [THEN subsetD], auto)
 apply (frule gen_prefix_length_le)
 apply (subgoal_tac "take (length (xs), ys) \<in> list (A) ")
 apply (simp_all (no_asm_simp) add: diff_is_0_iff [THEN iffD2] take_type)
 done
 
 lemma gen_prefix_append_both: "\<lbrakk>refl(A, r);  \<langle>xs,ys\<rangle> \<in> gen_prefix(A,r);
          length(xs) = length(ys); zs \<in> list(A)\<rbrakk>
       \<Longrightarrow>  <xs@zs, ys @ zs> \<in> gen_prefix(A, r)"
 apply (drule_tac zs = zs in gen_prefix_take_append, assumption+)
 apply (subgoal_tac "take (length (xs), ys) =ys")
 apply (auto intro!: take_all dest: gen_prefix.dom_subset [THEN subsetD])
 done
 
 (*NOT suitable for rewriting since [y] has the form y#ys*)
 lemma append_cons_conv: "xs \<in> list(A) \<Longrightarrow> xs @ Cons(y, ys) = (xs @ [y]) @ ys"
 by (auto simp add: app_assoc)
 
 lemma append_one_gen_prefix_lemma [rule_format]:
      "\<lbrakk>\<langle>xs,ys\<rangle> \<in> gen_prefix(A, r);  refl(A, r)\<rbrakk>
       \<Longrightarrow> length(xs) < length(ys) \<longrightarrow>
           <xs @ [nth(length(xs), ys)], ys> \<in> gen_prefix(A, r)"
 apply (erule gen_prefix.induct, blast)
 apply (frule gen_prefix.dom_subset [THEN subsetD], clarify)
 apply (simp_all add: length_type)
 (* Append case is hardest *)
 apply (frule gen_prefix_length_le [THEN le_iff [THEN iffD1]])
 apply (frule gen_prefix.dom_subset [THEN subsetD], clarify)
 apply (subgoal_tac "length (xs) :nat\<and>length (ys) :nat \<and>length (zs) :nat")
 prefer 2 apply (blast intro: length_type, clarify)
 apply (simp_all add: nth_append length_type length_app)
 apply (rule conjI)
 apply (blast intro: gen_prefix.append)
 apply (erule_tac V = "length (xs) < length (ys) \<longrightarrow>u" for u in thin_rl)
 apply (erule_tac a = zs in list.cases, auto)
 apply (rule_tac P1 = "\<lambda>x. <u(x), v>:w" for u v w in nat_diff_split [THEN iffD2])
 apply auto
 apply (simplesubst append_cons_conv)
 apply (rule_tac [2] gen_prefix.append)
 apply (auto elim: ConsE simp add: gen_prefix_append_both)
 done
 
 lemma append_one_gen_prefix: "\<lbrakk>\<langle>xs,ys\<rangle>: gen_prefix(A, r);  length(xs) < length(ys);  refl(A, r)\<rbrakk>
       \<Longrightarrow> <xs @ [nth(length(xs), ys)], ys> \<in> gen_prefix(A, r)"
 apply (blast intro: append_one_gen_prefix_lemma)
 done
 
 
 (** Proving the equivalence with Charpentier's definition **)
 
 lemma gen_prefix_imp_nth_lemma [rule_format]: "xs \<in> list(A) \<Longrightarrow>
   \<forall>ys \<in> list(A). \<forall>i \<in> nat. i < length(xs)
           \<longrightarrow> \<langle>xs, ys\<rangle>: gen_prefix(A, r) \<longrightarrow> <nth(i, xs), nth(i, ys)>:r"
 apply (induct_tac "xs", simp, clarify)
 apply simp
 apply (erule natE, auto)
 done
 
 lemma gen_prefix_imp_nth: "\<lbrakk>\<langle>xs,ys\<rangle> \<in> gen_prefix(A,r); i < length(xs)\<rbrakk>
       \<Longrightarrow> <nth(i, xs), nth(i, ys)>:r"
 apply (cut_tac A = A in gen_prefix.dom_subset)
 apply (rule gen_prefix_imp_nth_lemma)
 apply (auto simp add: lt_nat_in_nat)
 done
 
 lemma nth_imp_gen_prefix [rule_format]: "xs \<in> list(A) \<Longrightarrow>
   \<forall>ys \<in> list(A). length(xs) \<le> length(ys)
       \<longrightarrow> (\<forall>i. i < length(xs) \<longrightarrow> <nth(i, xs), nth(i,ys)>:r)
       \<longrightarrow> \<langle>xs, ys\<rangle> \<in> gen_prefix(A, r)"
 apply (induct_tac "xs")
 apply (simp_all (no_asm_simp))
 apply clarify
 apply (erule_tac a = ys in list.cases, simp)
 apply (force intro!: nat_0_le simp add: lt_nat_in_nat)
 done
 
 lemma gen_prefix_iff_nth: "(\<langle>xs,ys\<rangle> \<in> gen_prefix(A,r)) \<longleftrightarrow>
       (xs \<in> list(A) \<and> ys \<in> list(A) \<and> length(xs) \<le> length(ys) \<and>
       (\<forall>i. i < length(xs) \<longrightarrow> <nth(i,xs), nth(i, ys)>: r))"
 apply (rule iffI)
 apply (frule gen_prefix.dom_subset [THEN subsetD])
 apply (frule gen_prefix_length_le, auto)
 apply (rule_tac [2] nth_imp_gen_prefix)
 apply (drule gen_prefix_imp_nth)
 apply (auto simp add: lt_nat_in_nat)
 done
 
 (** prefix is a partial order: **)
 
 lemma refl_prefix: "refl(list(A), prefix(A))"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (rule refl_gen_prefix)
 apply (auto simp add: refl_def)
 done
 declare refl_prefix [THEN reflD, simp]
 
 lemma trans_prefix: "trans(prefix(A))"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (rule trans_gen_prefix)
 apply (auto simp add: trans_def)
 done
 
 lemmas prefix_trans = trans_prefix [THEN transD]
 
 lemma trans_on_prefix: "trans[list(A)](prefix(A))"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (rule trans_on_gen_prefix)
 apply (auto simp add: trans_def)
 done
 
 lemmas prefix_trans_on = trans_on_prefix [THEN trans_onD]
 
 (* Monotonicity of "set" operator WRT prefix *)
 
 lemma set_of_list_prefix_mono:
 "\<langle>xs,ys\<rangle> \<in> prefix(A) \<Longrightarrow> set_of_list(xs) \<subseteq> set_of_list(ys)"
 
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (erule gen_prefix.induct)
 apply (subgoal_tac [3] "xs \<in> list (A) \<and>ys \<in> list (A) ")
 prefer 4 apply (blast dest: gen_prefix.dom_subset [THEN subsetD])
 apply (auto simp add: set_of_list_append)
 done
 
 (** recursion equations **)
 
 lemma Nil_prefix: "xs \<in> list(A) \<Longrightarrow> <[],xs> \<in> prefix(A)"
 
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (simp (no_asm_simp) add: Nil_gen_prefix)
 done
 declare Nil_prefix [simp]
 
 
 lemma prefix_Nil: "<xs, []> \<in> prefix(A) \<longleftrightarrow> (xs = [])"
 
 apply (unfold prefix_def, auto)
 apply (frule gen_prefix.dom_subset [THEN subsetD])
 apply (drule_tac psi = "<xs, []> \<in> gen_prefix (A, id (A))" in asm_rl)
 apply (simp add: gen_prefix_Nil)
 done
 declare prefix_Nil [iff]
 
 lemma Cons_prefix_Cons:
 "<Cons(x,xs), Cons(y,ys)> \<in> prefix(A) \<longleftrightarrow> (x=y \<and> \<langle>xs,ys\<rangle> \<in> prefix(A) \<and> y \<in> A)"
 apply (unfold prefix_def, auto)
 done
 declare Cons_prefix_Cons [iff]
 
 lemma same_prefix_prefix:
 "xs \<in> list(A)\<Longrightarrow> <xs@ys,xs@zs> \<in> prefix(A) \<longleftrightarrow> (\<langle>ys,zs\<rangle> \<in> prefix(A))"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (subgoal_tac "refl (A,id (A))")
 apply (simp (no_asm_simp))
 apply (auto simp add: refl_def)
 done
 declare same_prefix_prefix [simp]
 
 lemma same_prefix_prefix_Nil: "xs \<in> list(A) \<Longrightarrow> <xs@ys,xs> \<in> prefix(A) \<longleftrightarrow> (<ys,[]> \<in> prefix(A))"
 apply (rule_tac P = "\<lambda>x. \<langle>u, x\<rangle>:v \<longleftrightarrow> w(x)" for u v w in app_right_Nil [THEN subst])
 apply (rule_tac [2] same_prefix_prefix, auto)
 done
 declare same_prefix_prefix_Nil [simp]
 
 lemma prefix_appendI:
 "\<lbrakk>\<langle>xs,ys\<rangle> \<in> prefix(A); zs \<in> list(A)\<rbrakk> \<Longrightarrow> <xs,ys@zs> \<in> prefix(A)"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (erule gen_prefix.append, assumption)
 done
 declare prefix_appendI [simp]
 
 lemma prefix_Cons:
 "\<lbrakk>xs \<in> list(A); ys \<in> list(A); y \<in> A\<rbrakk> \<Longrightarrow>
   <xs,Cons(y,ys)> \<in> prefix(A) \<longleftrightarrow>
   (xs=[] | (\<exists>zs. xs=Cons(y,zs) \<and> \<langle>zs,ys\<rangle> \<in> prefix(A)))"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (auto simp add: gen_prefix_Cons)
 done
 
 lemma append_one_prefix:
   "\<lbrakk>\<langle>xs,ys\<rangle> \<in> prefix(A); length(xs) < length(ys)\<rbrakk>
   \<Longrightarrow> <xs @ [nth(length(xs),ys)], ys> \<in> prefix(A)"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (subgoal_tac "refl (A, id (A))")
 apply (simp (no_asm_simp) add: append_one_gen_prefix)
 apply (auto simp add: refl_def)
 done
 
 lemma prefix_length_le:
 "\<langle>xs,ys\<rangle> \<in> prefix(A) \<Longrightarrow> length(xs) \<le> length(ys)"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (blast dest: gen_prefix_length_le)
 done
 
 lemma prefix_type: "prefix(A)<=list(A)*list(A)"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (blast intro!: gen_prefix.dom_subset)
 done
 
 lemma strict_prefix_type:
 "strict_prefix(A) \<subseteq> list(A)*list(A)"
-apply (unfold strict_prefix_def)
+  unfolding strict_prefix_def
 apply (blast intro!: prefix_type [THEN subsetD])
 done
 
 lemma strict_prefix_length_lt_aux:
      "\<langle>xs,ys\<rangle> \<in> prefix(A) \<Longrightarrow> xs\<noteq>ys \<longrightarrow> length(xs) < length(ys)"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (erule gen_prefix.induct, clarify)
 apply (subgoal_tac [!] "ys \<in> list(A) \<and> xs \<in> list(A)")
 apply (auto dest: gen_prefix.dom_subset [THEN subsetD]
             simp add: length_type)
 apply (subgoal_tac "length (zs) =0")
 apply (drule_tac [2] not_lt_imp_le)
 apply (rule_tac [5] j = "length (ys) " in lt_trans2)
 apply auto
 done
 
 lemma strict_prefix_length_lt:
      "\<langle>xs,ys\<rangle>:strict_prefix(A) \<Longrightarrow> length(xs) < length(ys)"
-apply (unfold strict_prefix_def)
+  unfolding strict_prefix_def
 apply (rule strict_prefix_length_lt_aux [THEN mp])
 apply (auto dest: prefix_type [THEN subsetD])
 done
 
 (*Equivalence to the definition used in Lex/Prefix.thy*)
 lemma prefix_iff:
     "\<langle>xs,zs\<rangle> \<in> prefix(A) \<longleftrightarrow> (\<exists>ys \<in> list(A). zs = xs@ys) \<and> xs \<in> list(A)"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (auto simp add: gen_prefix_iff_nth lt_nat_in_nat nth_append nth_type app_type length_app)
 apply (subgoal_tac "drop (length (xs), zs) \<in> list (A) ")
 apply (rule_tac x = "drop (length (xs), zs) " in bexI)
 apply safe
  prefer 2 apply (simp add: length_type drop_type)
 apply (rule nth_equalityI)
 apply (simp_all (no_asm_simp) add: nth_append app_type drop_type length_app length_drop)
 apply (rule nat_diff_split [THEN iffD2], simp_all, clarify)
 apply (drule_tac i = "length (zs) " in leI)
 apply (force simp add: le_subset_iff, safe)
 apply (subgoal_tac "length (xs) #+ (i #- length (xs)) = i")
 apply (subst nth_drop)
 apply (simp_all (no_asm_simp) add: leI split: nat_diff_split)
 done
 
 lemma prefix_snoc:
 "\<lbrakk>xs \<in> list(A); ys \<in> list(A); y \<in> A\<rbrakk> \<Longrightarrow>
    <xs, ys@[y]> \<in> prefix(A) \<longleftrightarrow> (xs = ys@[y] | \<langle>xs,ys\<rangle> \<in> prefix(A))"
 apply (simp (no_asm) add: prefix_iff)
 apply (rule iffI, clarify)
 apply (erule_tac xs = ysa in rev_list_elim, simp)
 apply (simp add: app_type app_assoc [symmetric])
 apply (auto simp add: app_assoc app_type)
 done
 declare prefix_snoc [simp]
 
 lemma prefix_append_iff [rule_format]: "zs \<in> list(A) \<Longrightarrow> \<forall>xs \<in> list(A). \<forall>ys \<in> list(A).
    (<xs, ys@zs> \<in> prefix(A)) \<longleftrightarrow>
   (\<langle>xs,ys\<rangle> \<in> prefix(A) | (\<exists>us. xs = ys@us \<and> \<langle>us,zs\<rangle> \<in> prefix(A)))"
 apply (erule list_append_induct, force, clarify)
 apply (rule iffI)
 apply (simp add: add: app_assoc [symmetric])
 apply (erule disjE)
 apply (rule disjI2)
 apply (rule_tac x = "y @ [x]" in exI)
 apply (simp add: add: app_assoc [symmetric], force+)
 done
 
 
 (*Although the prefix ordering is not linear, the prefixes of a list
   are linearly ordered.*)
 lemma common_prefix_linear_lemma [rule_format]: "\<lbrakk>zs \<in> list(A); xs \<in> list(A); ys \<in> list(A)\<rbrakk>
    \<Longrightarrow> \<langle>xs, zs\<rangle> \<in> prefix(A) \<longrightarrow> \<langle>ys,zs\<rangle> \<in> prefix(A)
   \<longrightarrow>\<langle>xs,ys\<rangle> \<in> prefix(A) | \<langle>ys,xs\<rangle> \<in> prefix(A)"
 apply (erule list_append_induct, auto)
 done
 
 lemma common_prefix_linear: "\<lbrakk>\<langle>xs, zs\<rangle> \<in> prefix(A); \<langle>ys,zs\<rangle> \<in> prefix(A)\<rbrakk>
       \<Longrightarrow> \<langle>xs,ys\<rangle> \<in> prefix(A) | \<langle>ys,xs\<rangle> \<in> prefix(A)"
 apply (cut_tac prefix_type)
 apply (blast del: disjCI intro: common_prefix_linear_lemma)
 done
 
 
 (*** pfixLe, pfixGe \<in> properties inherited from the translations ***)
 
 
 
 (** pfixLe **)
 
 lemma refl_Le: "refl(nat,Le)"
 
 apply (unfold refl_def, auto)
 done
 declare refl_Le [simp]
 
 lemma antisym_Le: "antisym(Le)"
-apply (unfold antisym_def)
+  unfolding antisym_def
 apply (auto intro: le_anti_sym)
 done
 declare antisym_Le [simp]
 
 lemma trans_on_Le: "trans[nat](Le)"
 apply (unfold trans_on_def, auto)
 apply (blast intro: le_trans)
 done
 declare trans_on_Le [simp]
 
 lemma trans_Le: "trans(Le)"
 apply (unfold trans_def, auto)
 apply (blast intro: le_trans)
 done
 declare trans_Le [simp]
 
 lemma part_order_Le: "part_order(nat,Le)"
 by (unfold part_order_def, auto)
 declare part_order_Le [simp]
 
 lemma pfixLe_refl: "x \<in> list(nat) \<Longrightarrow> x pfixLe x"
 by (blast intro: refl_gen_prefix [THEN reflD] refl_Le)
 declare pfixLe_refl [simp]
 
 lemma pfixLe_trans: "\<lbrakk>x pfixLe y; y pfixLe z\<rbrakk> \<Longrightarrow> x pfixLe z"
 by (blast intro: trans_gen_prefix [THEN transD] trans_Le)
 
 lemma pfixLe_antisym: "\<lbrakk>x pfixLe y; y pfixLe x\<rbrakk> \<Longrightarrow> x = y"
 by (blast intro: antisym_gen_prefix [THEN antisymE] antisym_Le)
 
 
 lemma prefix_imp_pfixLe:
 "\<langle>xs,ys\<rangle>:prefix(nat)\<Longrightarrow> xs pfixLe ys"
 
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (rule gen_prefix_mono [THEN subsetD], auto)
 done
 
 lemma refl_Ge: "refl(nat, Ge)"
 by (unfold refl_def Ge_def, auto)
 declare refl_Ge [iff]
 
 lemma antisym_Ge: "antisym(Ge)"
 apply (unfold antisym_def Ge_def)
 apply (auto intro: le_anti_sym)
 done
 declare antisym_Ge [iff]
 
 lemma trans_Ge: "trans(Ge)"
 apply (unfold trans_def Ge_def)
 apply (auto intro: le_trans)
 done
 declare trans_Ge [iff]
 
 lemma pfixGe_refl: "x \<in> list(nat) \<Longrightarrow> x pfixGe x"
 by (blast intro: refl_gen_prefix [THEN reflD])
 declare pfixGe_refl [simp]
 
 lemma pfixGe_trans: "\<lbrakk>x pfixGe y; y pfixGe z\<rbrakk> \<Longrightarrow> x pfixGe z"
 by (blast intro: trans_gen_prefix [THEN transD])
 
 lemma pfixGe_antisym: "\<lbrakk>x pfixGe y; y pfixGe x\<rbrakk> \<Longrightarrow> x = y"
 by (blast intro: antisym_gen_prefix [THEN antisymE])
 
 lemma prefix_imp_pfixGe:
   "\<langle>xs,ys\<rangle>:prefix(nat) \<Longrightarrow> xs pfixGe ys"
 apply (unfold prefix_def Ge_def)
 apply (rule gen_prefix_mono [THEN subsetD], auto)
 done
 (* Added by Sidi \<in> prefix and take *)
 
 lemma prefix_imp_take:
 "\<langle>xs, ys\<rangle> \<in> prefix(A) \<Longrightarrow> xs = take(length(xs), ys)"
 
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (erule gen_prefix.induct)
 apply (subgoal_tac [3] "length (xs) :nat")
 apply (auto dest: gen_prefix.dom_subset [THEN subsetD] simp add: length_type)
 apply (frule gen_prefix.dom_subset [THEN subsetD])
 apply (frule gen_prefix_length_le)
 apply (auto simp add: take_append)
 apply (subgoal_tac "length (xs) #- length (ys) =0")
 apply (simp_all (no_asm_simp) add: diff_is_0_iff)
 done
 
 lemma prefix_length_equal: "\<lbrakk>\<langle>xs,ys\<rangle> \<in> prefix(A); length(xs)=length(ys)\<rbrakk> \<Longrightarrow> xs = ys"
 apply (cut_tac A = A in prefix_type)
 apply (drule subsetD, auto)
 apply (drule prefix_imp_take)
 apply (erule trans, simp)
 done
 
 lemma prefix_length_le_equal: "\<lbrakk>\<langle>xs,ys\<rangle> \<in> prefix(A); length(ys) \<le> length(xs)\<rbrakk> \<Longrightarrow> xs = ys"
 by (blast intro: prefix_length_equal le_anti_sym prefix_length_le)
 
 lemma take_prefix [rule_format]: "xs \<in> list(A) \<Longrightarrow> \<forall>n \<in> nat. <take(n, xs), xs> \<in> prefix(A)"
-apply (unfold prefix_def)
+  unfolding prefix_def
 apply (erule list.induct, simp, clarify)
 apply (erule natE, auto)
 done
 
 lemma prefix_take_iff: "\<langle>xs,ys\<rangle> \<in> prefix(A) \<longleftrightarrow> (xs=take(length(xs), ys) \<and> xs \<in> list(A) \<and> ys \<in> list(A))"
 apply (rule iffI)
 apply (frule prefix_type [THEN subsetD])
 apply (blast intro: prefix_imp_take, clarify)
 apply (erule ssubst)
 apply (blast intro: take_prefix length_type)
 done
 
 lemma prefix_imp_nth: "\<lbrakk>\<langle>xs,ys\<rangle> \<in> prefix(A); i < length(xs)\<rbrakk> \<Longrightarrow> nth(i,xs) = nth(i,ys)"
 by (auto dest!: gen_prefix_imp_nth simp add: prefix_def)
 
 lemma nth_imp_prefix:
      "\<lbrakk>xs \<in> list(A); ys \<in> list(A); length(xs) \<le> length(ys);
         \<And>i. i < length(xs) \<Longrightarrow> nth(i, xs) = nth(i,ys)\<rbrakk>
       \<Longrightarrow> \<langle>xs,ys\<rangle> \<in> prefix(A)"
 apply (auto simp add: prefix_def nth_imp_gen_prefix)
 apply (auto intro!: nth_imp_gen_prefix simp add: prefix_def)
 apply (blast intro: nth_type lt_trans2)
 done
 
 
 lemma length_le_prefix_imp_prefix: "\<lbrakk>length(xs) \<le> length(ys);
         \<langle>xs,zs\<rangle> \<in> prefix(A); \<langle>ys,zs\<rangle> \<in> prefix(A)\<rbrakk> \<Longrightarrow> \<langle>xs,ys\<rangle> \<in> prefix(A)"
 apply (cut_tac A = A in prefix_type)
 apply (rule nth_imp_prefix, blast, blast)
  apply assumption
 apply (rule_tac b = "nth (i,zs)" in trans)
  apply (blast intro: prefix_imp_nth)
 apply (blast intro: sym prefix_imp_nth prefix_length_le lt_trans2)
 done
 
 end
diff --git a/src/ZF/UNITY/Guar.thy b/src/ZF/UNITY/Guar.thy
--- a/src/ZF/UNITY/Guar.thy
+++ b/src/ZF/UNITY/Guar.thy
@@ -1,532 +1,532 @@
 (*  Title:      ZF/UNITY/Guar.thy
     Author:     Sidi O Ehmety, Computer Laboratory
     Copyright   2001  University of Cambridge
 
 Guarantees, etc.
 
 From Chandy and Sanders, "Reasoning About Program Composition",
 Technical Report 2000-003, University of Florida, 2000.
 
 Revised by Sidi Ehmety on January 2001
 
 Added \<in> Compatibility, weakest guarantees, etc.
 
 and Weakest existential property,
 from Charpentier and Chandy "Theorems about Composition",
 Fifth International Conference on Mathematics of Program, 2000.
 
 Theory ported from HOL.
 *)
 
 
 section\<open>The Chandy-Sanders Guarantees Operator\<close>
 
 theory Guar imports Comp begin 
 
 
 (* To be moved to theory WFair???? *)
 lemma leadsTo_Basis': "\<lbrakk>F \<in> A co A \<union> B; F \<in> transient(A); st_set(B)\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto> B"
 apply (frule constrainsD2)
 apply (drule_tac B = "A-B" in constrains_weaken_L, blast) 
 apply (drule_tac B = "A-B" in transient_strengthen, blast) 
 apply (blast intro: ensuresI [THEN leadsTo_Basis])
 done
 
 
   (*Existential and Universal properties.  We formalize the two-program
     case, proving equivalence with Chandy and Sanders's n-ary definitions*)
 
 definition
    ex_prop :: "i \<Rightarrow> o"  where
    "ex_prop(X) \<equiv> X<=program \<and>
     (\<forall>F \<in> program. \<forall>G \<in> program. F ok G \<longrightarrow> F \<in> X | G \<in> X \<longrightarrow> (F \<squnion> G) \<in> X)"
 
 definition
   strict_ex_prop  :: "i \<Rightarrow> o"  where
   "strict_ex_prop(X) \<equiv> X<=program \<and>
    (\<forall>F \<in> program. \<forall>G \<in> program. F ok G \<longrightarrow> (F \<in> X | G \<in> X) \<longleftrightarrow> (F \<squnion> G \<in> X))"
 
 definition
   uv_prop  :: "i \<Rightarrow> o"  where
    "uv_prop(X) \<equiv> X<=program \<and>
     (SKIP \<in> X \<and> (\<forall>F \<in> program. \<forall>G \<in> program. F ok G \<longrightarrow> F \<in> X \<and> G \<in> X \<longrightarrow> (F \<squnion> G) \<in> X))"
   
 definition
  strict_uv_prop  :: "i \<Rightarrow> o"  where
    "strict_uv_prop(X) \<equiv> X<=program \<and>
     (SKIP \<in> X \<and> (\<forall>F \<in> program. \<forall>G \<in> program. F ok G \<longrightarrow>(F \<in> X \<and> G \<in> X) \<longleftrightarrow> (F \<squnion> G \<in> X)))"
 
 definition
   guar :: "[i, i] \<Rightarrow> i" (infixl \<open>guarantees\<close> 55)  where
               (*higher than membership, lower than Co*)
   "X guarantees Y \<equiv> {F \<in> program. \<forall>G \<in> program. F ok G \<longrightarrow> F \<squnion> G \<in> X \<longrightarrow> F \<squnion> G \<in> Y}"
   
 definition
   (* Weakest guarantees *)
    wg :: "[i,i] \<Rightarrow> i"  where
   "wg(F,Y) \<equiv> \<Union>({X \<in> Pow(program). F:(X guarantees Y)})"
 
 definition
   (* Weakest existential property stronger than X *)
    wx :: "i \<Rightarrow>i"  where
    "wx(X) \<equiv> \<Union>({Y \<in> Pow(program). Y<=X \<and> ex_prop(Y)})"
 
 definition
   (*Ill-defined programs can arise through "\<squnion>"*)
   welldef :: i  where
   "welldef \<equiv> {F \<in> program. Init(F) \<noteq> 0}"
   
 definition
   refines :: "[i, i, i] \<Rightarrow> o" (\<open>(3_ refines _ wrt _)\<close> [10,10,10] 10)  where
   "G refines F wrt X \<equiv>
    \<forall>H \<in> program. (F ok H  \<and> G ok H \<and> F \<squnion> H \<in> welldef \<inter> X)
     \<longrightarrow> (G \<squnion> H \<in> welldef \<inter> X)"
 
 definition
   iso_refines :: "[i,i, i] \<Rightarrow> o"  (\<open>(3_ iso'_refines _ wrt _)\<close> [10,10,10] 10)  where
   "G iso_refines F wrt X \<equiv>  F \<in> welldef \<inter> X \<longrightarrow> G \<in> welldef \<inter> X"
 
 
 (*** existential properties ***)
 
 lemma ex_imp_subset_program: "ex_prop(X) \<Longrightarrow> X\<subseteq>program"
 by (simp add: ex_prop_def)
 
 lemma ex1 [rule_format]: 
  "GG \<in> Fin(program) 
   \<Longrightarrow> ex_prop(X) \<longrightarrow> GG \<inter> X\<noteq>0 \<longrightarrow> OK(GG, (\<lambda>G. G)) \<longrightarrow>(\<Squnion>G \<in> GG. G) \<in> X"
-apply (unfold ex_prop_def)
+  unfolding ex_prop_def
 apply (erule Fin_induct)
 apply (simp_all add: OK_cons_iff)
 apply (safe elim!: not_emptyE, auto) 
 done
 
 lemma ex2 [rule_format]: 
 "X \<subseteq> program \<Longrightarrow>  
  (\<forall>GG \<in> Fin(program). GG \<inter> X \<noteq> 0 \<longrightarrow> OK(GG,(\<lambda>G. G))\<longrightarrow>(\<Squnion>G \<in> GG. G) \<in> X) 
    \<longrightarrow> ex_prop(X)"
 apply (unfold ex_prop_def, clarify)
 apply (drule_tac x = "{F,G}" in bspec)
 apply (simp_all add: OK_iff_ok)
 apply (auto intro: ok_sym)
 done
 
 (*Chandy \<and> Sanders take this as a definition*)
 
 lemma ex_prop_finite:
      "ex_prop(X) \<longleftrightarrow> (X\<subseteq>program \<and>  
   (\<forall>GG \<in> Fin(program). GG \<inter> X \<noteq> 0 \<and> OK(GG,(\<lambda>G. G))\<longrightarrow>(\<Squnion>G \<in> GG. G) \<in> X))"
 apply auto
 apply (blast intro: ex1 ex2 dest: ex_imp_subset_program)+
 done
 
 (* Equivalent definition of ex_prop given at the end of section 3*)
 lemma ex_prop_equiv: 
 "ex_prop(X) \<longleftrightarrow>  
   X\<subseteq>program \<and> (\<forall>G \<in> program. (G \<in> X \<longleftrightarrow> (\<forall>H \<in> program. (G component_of H) \<longrightarrow> H \<in> X)))"
 apply (unfold ex_prop_def component_of_def, safe, force, force, blast) 
 apply (subst Join_commute)
 apply (blast intro: ok_sym) 
 done
 
 (*** universal properties ***)
 
 lemma uv_imp_subset_program: "uv_prop(X)\<Longrightarrow> X\<subseteq>program"
-apply (unfold uv_prop_def)
+  unfolding uv_prop_def
 apply (simp (no_asm_simp))
 done
 
 lemma uv1 [rule_format]: 
      "GG \<in> Fin(program) \<Longrightarrow>  
       (uv_prop(X)\<longrightarrow> GG \<subseteq> X \<and> OK(GG, (\<lambda>G. G)) \<longrightarrow> (\<Squnion>G \<in> GG. G) \<in> X)"
-apply (unfold uv_prop_def)
+  unfolding uv_prop_def
 apply (erule Fin_induct)
 apply (auto simp add: OK_cons_iff)
 done
 
 lemma uv2 [rule_format]: 
      "X\<subseteq>program  \<Longrightarrow> 
       (\<forall>GG \<in> Fin(program). GG \<subseteq> X \<and> OK(GG,(\<lambda>G. G)) \<longrightarrow> (\<Squnion>G \<in> GG. G) \<in> X)
       \<longrightarrow> uv_prop(X)"
 apply (unfold uv_prop_def, auto)
 apply (drule_tac x = 0 in bspec, simp+) 
 apply (drule_tac x = "{F,G}" in bspec, simp) 
 apply (force dest: ok_sym simp add: OK_iff_ok) 
 done
 
 (*Chandy \<and> Sanders take this as a definition*)
 lemma uv_prop_finite: 
 "uv_prop(X) \<longleftrightarrow> X\<subseteq>program \<and>  
   (\<forall>GG \<in> Fin(program). GG \<subseteq> X \<and> OK(GG, \<lambda>G. G) \<longrightarrow> (\<Squnion>G \<in> GG. G) \<in>  X)"
 apply auto
 apply (blast dest: uv_imp_subset_program)
 apply (blast intro: uv1)
 apply (blast intro!: uv2 dest:)
 done
 
 (*** guarantees ***)
 lemma guaranteesI: 
      "\<lbrakk>(\<And>G. \<lbrakk>F ok G; F \<squnion> G \<in> X; G \<in> program\<rbrakk> \<Longrightarrow> F \<squnion> G \<in> Y); 
          F \<in> program\<rbrakk>   
     \<Longrightarrow> F \<in> X guarantees Y"
 by (simp add: guar_def component_def)
 
 lemma guaranteesD: 
      "\<lbrakk>F \<in> X guarantees Y;  F ok G;  F \<squnion> G \<in> X; G \<in> program\<rbrakk>  
       \<Longrightarrow> F \<squnion> G \<in> Y"
 by (simp add: guar_def component_def)
 
 
 (*This version of guaranteesD matches more easily in the conclusion
   The major premise can no longer be  F\<subseteq>H since we need to reason about G*)
 
 lemma component_guaranteesD: 
      "\<lbrakk>F \<in> X guarantees Y;  F \<squnion> G = H;  H \<in> X;  F ok G; G \<in> program\<rbrakk>  
       \<Longrightarrow> H \<in> Y"
 by (simp add: guar_def, blast)
 
 lemma guarantees_weaken: 
      "\<lbrakk>F \<in> X guarantees X'; Y \<subseteq> X; X' \<subseteq> Y'\<rbrakk> \<Longrightarrow> F \<in> Y guarantees Y'"
 by (simp add: guar_def, auto)
 
 lemma subset_imp_guarantees_program:
      "X \<subseteq> Y \<Longrightarrow> X guarantees Y = program"
 by (unfold guar_def, blast)
 
 (*Equivalent to subset_imp_guarantees_UNIV but more intuitive*)
 lemma subset_imp_guarantees:
      "\<lbrakk>X \<subseteq> Y; F \<in> program\<rbrakk> \<Longrightarrow> F \<in> X guarantees Y"
 by (unfold guar_def, blast)
 
 lemma component_of_Join1: "F ok G \<Longrightarrow> F component_of (F \<squnion> G)"
 by (unfold component_of_def, blast)
 
 lemma component_of_Join2: "F ok G \<Longrightarrow> G component_of (F \<squnion> G)"
 apply (subst Join_commute)
 apply (blast intro: ok_sym component_of_Join1)
 done
 
 (*Remark at end of section 4.1 *)
 lemma ex_prop_imp: 
      "ex_prop(Y) \<Longrightarrow> (Y = (program guarantees Y))"
 apply (simp (no_asm_use) add: ex_prop_equiv guar_def component_of_def)
 apply clarify
 apply (rule equalityI, blast, safe)
 apply (drule_tac x = x in bspec, assumption, force) 
 done
 
 lemma guarantees_imp: "(Y = program guarantees Y) \<Longrightarrow> ex_prop(Y)"
-apply (unfold guar_def)
+  unfolding guar_def
 apply (simp (no_asm_simp) add: ex_prop_equiv)
 apply safe
 apply (blast intro: elim: equalityE) 
 apply (simp_all (no_asm_use) add: component_of_def)
 apply (force elim: equalityE)+
 done
 
 lemma ex_prop_equiv2: "(ex_prop(Y)) \<longleftrightarrow> (Y = program guarantees Y)"
 by (blast intro: ex_prop_imp guarantees_imp)
 
 (** Distributive laws.  Re-orient to perform miniscoping **)
 
 lemma guarantees_UN_left: 
      "i \<in> I \<Longrightarrow>(\<Union>i \<in> I. X(i)) guarantees Y = (\<Inter>i \<in> I. X(i) guarantees Y)"
-apply (unfold guar_def)
+  unfolding guar_def
 apply (rule equalityI, safe)
  prefer 2 apply force
 apply blast+
 done
 
 lemma guarantees_Un_left: 
      "(X \<union> Y) guarantees Z = (X guarantees Z) \<inter> (Y guarantees Z)"
-apply (unfold guar_def)
+  unfolding guar_def
 apply (rule equalityI, safe, blast+)
 done
 
 lemma guarantees_INT_right: 
      "i \<in> I \<Longrightarrow> X guarantees (\<Inter>i \<in> I. Y(i)) = (\<Inter>i \<in> I. X guarantees Y(i))"
-apply (unfold guar_def)
+  unfolding guar_def
 apply (rule equalityI, safe, blast+)
 done
 
 lemma guarantees_Int_right: 
      "Z guarantees (X \<inter> Y) = (Z guarantees X) \<inter> (Z guarantees Y)"
 by (unfold guar_def, blast)
 
 lemma guarantees_Int_right_I:
      "\<lbrakk>F \<in> Z guarantees X;  F \<in> Z guarantees Y\<rbrakk>  
      \<Longrightarrow> F \<in> Z guarantees (X \<inter> Y)"
 by (simp (no_asm_simp) add: guarantees_Int_right)
 
 lemma guarantees_INT_right_iff:
      "i \<in> I\<Longrightarrow> (F \<in> X guarantees (\<Inter>i \<in> I. Y(i))) \<longleftrightarrow>  
       (\<forall>i \<in> I. F \<in> X guarantees Y(i))"
 by (simp add: guarantees_INT_right INT_iff, blast)
 
 
 lemma shunting: "(X guarantees Y) = (program guarantees ((program-X) \<union> Y))"
 by (unfold guar_def, auto)
 
 lemma contrapositive:
      "(X guarantees Y) = (program - Y) guarantees (program -X)"
 by (unfold guar_def, blast)
 
 (** The following two can be expressed using intersection and subset, which
     is more faithful to the text but looks cryptic.
 **)
 
 lemma combining1: 
     "\<lbrakk>F \<in> V guarantees X;  F \<in> (X \<inter> Y) guarantees Z\<rbrakk> 
      \<Longrightarrow> F \<in> (V \<inter> Y) guarantees Z"
 by (unfold guar_def, blast)
 
 lemma combining2: 
     "\<lbrakk>F \<in> V guarantees (X \<union> Y);  F \<in> Y guarantees Z\<rbrakk> 
      \<Longrightarrow> F \<in> V guarantees (X \<union> Z)"
 by (unfold guar_def, blast)
 
 
 (** The following two follow Chandy-Sanders, but the use of object-quantifiers
     does not suit Isabelle... **)
 
 (*Premise should be (\<And>i. i \<in> I \<Longrightarrow> F \<in> X guarantees Y i) *)
 lemma all_guarantees: 
      "\<lbrakk>\<forall>i \<in> I. F \<in> X guarantees Y(i); i \<in> I\<rbrakk>  
     \<Longrightarrow> F \<in> X guarantees (\<Inter>i \<in> I. Y(i))"
 by (unfold guar_def, blast)
 
 (*Premises should be \<lbrakk>F \<in> X guarantees Y i; i \<in> I\<rbrakk> *)
 lemma ex_guarantees: 
      "\<exists>i \<in> I. F \<in> X guarantees Y(i) \<Longrightarrow> F \<in> X guarantees (\<Union>i \<in> I. Y(i))"
 by (unfold guar_def, blast)
 
 
 (*** Additional guarantees laws, by lcp ***)
 
 lemma guarantees_Join_Int: 
     "\<lbrakk>F \<in> U guarantees V;  G \<in> X guarantees Y; F ok G\<rbrakk>  
      \<Longrightarrow> F \<squnion> G: (U \<inter> X) guarantees (V \<inter> Y)"
 
-apply (unfold guar_def)
+  unfolding guar_def
 apply (simp (no_asm))
 apply safe
 apply (simp add: Join_assoc)
 apply (subgoal_tac "F \<squnion> G \<squnion> Ga = G \<squnion> (F \<squnion> Ga) ")
 apply (simp add: ok_commute)
 apply (simp (no_asm_simp) add: Join_ac)
 done
 
 lemma guarantees_Join_Un: 
     "\<lbrakk>F \<in> U guarantees V;  G \<in> X guarantees Y; F ok G\<rbrakk>   
      \<Longrightarrow> F \<squnion> G: (U \<union> X) guarantees (V \<union> Y)"
-apply (unfold guar_def)
+  unfolding guar_def
 apply (simp (no_asm))
 apply safe
 apply (simp add: Join_assoc)
 apply (subgoal_tac "F \<squnion> G \<squnion> Ga = G \<squnion> (F \<squnion> Ga) ")
 apply (rotate_tac 4)
 apply (drule_tac x = "F \<squnion> Ga" in bspec)
 apply (simp (no_asm))
 apply (force simp add: ok_commute)
 apply (simp (no_asm_simp) add: Join_ac)
 done
 
 lemma guarantees_JOIN_INT: 
      "\<lbrakk>\<forall>i \<in> I. F(i) \<in> X(i) guarantees Y(i);  OK(I,F); i \<in> I\<rbrakk>  
       \<Longrightarrow> (\<Squnion>i \<in> I. F(i)) \<in> (\<Inter>i \<in> I. X(i)) guarantees (\<Inter>i \<in> I. Y(i))"
 apply (unfold guar_def, safe)
  prefer 2 apply blast
 apply (drule_tac x = xa in bspec)
 apply (simp_all add: INT_iff, safe)
 apply (drule_tac x = "(\<Squnion>x \<in> (I-{xa}) . F (x)) \<squnion> G" and A=program in bspec)
 apply (auto intro: OK_imp_ok simp add: Join_assoc [symmetric] JOIN_Join_diff JOIN_absorb)
 done
 
 lemma guarantees_JOIN_UN: 
     "\<lbrakk>\<forall>i \<in> I. F(i) \<in> X(i) guarantees Y(i);  OK(I,F)\<rbrakk>  
      \<Longrightarrow> JOIN(I,F) \<in> (\<Union>i \<in> I. X(i)) guarantees (\<Union>i \<in> I. Y(i))"
 apply (unfold guar_def, auto)
 apply (drule_tac x = y in bspec, simp_all, safe)
 apply (rename_tac G y)
 apply (drule_tac x = "JOIN (I-{y}, F) \<squnion> G" and A=program in bspec)
 apply (auto intro: OK_imp_ok simp add: Join_assoc [symmetric] JOIN_Join_diff JOIN_absorb)
 done
 
 (*** guarantees laws for breaking down the program, by lcp ***)
 
 lemma guarantees_Join_I1: 
      "\<lbrakk>F \<in> X guarantees Y;  F ok G\<rbrakk> \<Longrightarrow> F \<squnion> G \<in> X guarantees Y"
 apply (simp add: guar_def, safe)
 apply (simp add: Join_assoc)
 done
 
 lemma guarantees_Join_I2:
      "\<lbrakk>G \<in> X guarantees Y;  F ok G\<rbrakk> \<Longrightarrow> F \<squnion> G \<in> X guarantees Y"
 apply (simp add: Join_commute [of _ G] ok_commute [of _ G])
 apply (blast intro: guarantees_Join_I1)
 done
 
 lemma guarantees_JOIN_I: 
      "\<lbrakk>i \<in> I; F(i) \<in>  X guarantees Y;  OK(I,F)\<rbrakk>  
       \<Longrightarrow> (\<Squnion>i \<in> I. F(i)) \<in> X guarantees Y"
 apply (unfold guar_def, safe)
 apply (drule_tac x = "JOIN (I-{i},F) \<squnion> G" in bspec)
 apply (simp (no_asm))
 apply (auto intro: OK_imp_ok simp add: JOIN_Join_diff Join_assoc [symmetric])
 done
 
 (*** well-definedness ***)
 
 lemma Join_welldef_D1: "F \<squnion> G \<in> welldef \<Longrightarrow> programify(F) \<in>  welldef"
 by (unfold welldef_def, auto)
 
 lemma Join_welldef_D2: "F \<squnion> G \<in> welldef \<Longrightarrow> programify(G) \<in>  welldef"
 by (unfold welldef_def, auto)
 
 (*** refinement ***)
 
 lemma refines_refl: "F refines F wrt X"
 by (unfold refines_def, blast)
 
 (* More results on guarantees, added by Sidi Ehmety from Chandy \<and> Sander, section 6 *)
 
 lemma wg_type: "wg(F, X) \<subseteq> program"
 by (unfold wg_def, auto)
 
 lemma guarantees_type: "X guarantees Y \<subseteq> program"
 by (unfold guar_def, auto)
 
 lemma wgD2: "G \<in> wg(F, X) \<Longrightarrow> G \<in> program \<and> F \<in> program"
 apply (unfold wg_def, auto)
 apply (blast dest: guarantees_type [THEN subsetD])
 done
 
 lemma guarantees_equiv: 
 "(F \<in> X guarantees Y) \<longleftrightarrow>  
    F \<in> program \<and> (\<forall>H \<in> program. H \<in> X \<longrightarrow> (F component_of H \<longrightarrow> H \<in> Y))"
 by (unfold guar_def component_of_def, force) 
 
 lemma wg_weakest:
      "\<And>X. \<lbrakk>F \<in> (X guarantees Y); X \<subseteq> program\<rbrakk> \<Longrightarrow> X \<subseteq> wg(F,Y)"
 by (unfold wg_def, auto)
 
 lemma wg_guarantees: "F \<in> program \<Longrightarrow> F \<in> wg(F,Y) guarantees Y"
 by (unfold wg_def guar_def, blast)
 
 lemma wg_equiv:
      "H \<in> wg(F,X) \<longleftrightarrow> 
       ((F component_of H \<longrightarrow> H \<in> X) \<and> F \<in> program \<and> H \<in> program)"
 apply (simp add: wg_def guarantees_equiv)
 apply (rule iffI, safe)
 apply (rule_tac [4] x = "{H}" in bexI)
 apply (rule_tac [3] x = "{H}" in bexI, blast+)
 done
 
 lemma component_of_wg: 
     "F component_of H \<Longrightarrow> H \<in> wg(F,X) \<longleftrightarrow> (H \<in> X \<and> F \<in> program \<and> H \<in> program)"
 by (simp (no_asm_simp) add: wg_equiv)
 
 lemma wg_finite [rule_format]: 
 "\<forall>FF \<in> Fin(program). FF \<inter> X \<noteq> 0 \<longrightarrow> OK(FF, \<lambda>F. F)  
    \<longrightarrow> (\<forall>F \<in> FF. ((\<Squnion>F \<in> FF. F) \<in>  wg(F,X)) \<longleftrightarrow> ((\<Squnion>F \<in> FF. F) \<in> X))"
 apply clarify
 apply (subgoal_tac "F component_of (\<Squnion>F \<in> FF. F) ")
 apply (drule_tac X = X in component_of_wg)
 apply (force dest!: Fin.dom_subset [THEN subsetD, THEN PowD])
 apply (simp_all add: component_of_def)
 apply (rule_tac x = "\<Squnion>F \<in> (FF-{F}) . F" in exI)
 apply (auto intro: JOIN_Join_diff dest: ok_sym simp add: OK_iff_ok)
 done
 
 lemma wg_ex_prop:
      "ex_prop(X) \<Longrightarrow> (F \<in> X) \<longleftrightarrow> (\<forall>H \<in> program. H \<in> wg(F,X) \<and> F \<in> program)"
 apply (simp (no_asm_use) add: ex_prop_equiv wg_equiv)
 apply blast
 done
 
 (** From Charpentier and Chandy "Theorems About Composition" **)
 (* Proposition 2 *)
 lemma wx_subset: "wx(X)\<subseteq>X"
 by (unfold wx_def, auto)
 
 lemma wx_ex_prop: "ex_prop(wx(X))"
 apply (simp (no_asm_use) add: ex_prop_def wx_def)
 apply safe
 apply blast
 apply (rule_tac x=x in bexI, force, simp)+
 done
 
 lemma wx_weakest: "\<forall>Z. Z\<subseteq>program \<longrightarrow> Z\<subseteq> X \<longrightarrow> ex_prop(Z) \<longrightarrow> Z \<subseteq> wx(X)"
 by (unfold wx_def, auto)
 
 (* Proposition 6 *)
 lemma wx'_ex_prop: 
  "ex_prop({F \<in> program. \<forall>G \<in> program. F ok G \<longrightarrow> F \<squnion> G \<in> X})"
 apply (unfold ex_prop_def, safe)
  apply (drule_tac x = "G \<squnion> Ga" in bspec)
   apply (simp (no_asm))
  apply (force simp add: Join_assoc)
 apply (drule_tac x = "F \<squnion> Ga" in bspec)
  apply (simp (no_asm))
 apply (simp (no_asm_use))
 apply safe
  apply (simp (no_asm_simp) add: ok_commute)
 apply (subgoal_tac "F \<squnion> G = G \<squnion> F")
  apply (simp (no_asm_simp) add: Join_assoc)
 apply (simp (no_asm) add: Join_commute)
 done
 
 (* Equivalence with the other definition of wx *)
 
 lemma wx_equiv: 
      "wx(X) = {F \<in> program. \<forall>G \<in> program. F ok G \<longrightarrow> (F \<squnion> G) \<in> X}"
-apply (unfold wx_def)
+  unfolding wx_def
 apply (rule equalityI, safe, blast)
  apply (simp (no_asm_use) add: ex_prop_def)
 apply blast 
 apply (rule_tac B = "{F \<in> program. \<forall>G \<in> program. F ok G \<longrightarrow> F \<squnion> G \<in> X}" 
          in UnionI, 
        safe)
 apply (rule_tac [2] wx'_ex_prop)
 apply (drule_tac x=SKIP in bspec, simp)+
 apply auto 
 done
 
 (* Propositions 7 to 11 are all about this second definition of wx. And
    by equivalence between the two definition, they are the same as the ones proved *)
 
 
 (* Proposition 12 *)
 (* Main result of the paper *)
 lemma guarantees_wx_eq: "(X guarantees Y) = wx((program-X) \<union> Y)"
 by (auto simp add: guar_def wx_equiv)
 
 (* 
 {* Corollary, but this result has already been proved elsewhere *}
  "ex_prop(X guarantees Y)"
 *)
 
 (* Rules given in section 7 of Chandy and Sander's
     Reasoning About Program composition paper *)
 
 lemma stable_guarantees_Always:
      "\<lbrakk>Init(F) \<subseteq> A; F \<in> program\<rbrakk> \<Longrightarrow> F \<in> stable(A) guarantees Always(A)"
 apply (rule guaranteesI)
  prefer 2 apply assumption
 apply (simp (no_asm) add: Join_commute)
 apply (rule stable_Join_Always1)
 apply (simp_all add: invariant_def)
 apply (auto simp add: programify_def initially_def)
 done
 
 lemma constrains_guarantees_leadsTo:
      "\<lbrakk>F \<in> transient(A); st_set(B)\<rbrakk> 
       \<Longrightarrow> F: (A co A \<union> B) guarantees (A \<longmapsto> (B-A))"
 apply (rule guaranteesI)
  prefer 2 apply (blast dest: transient_type [THEN subsetD])
 apply (rule leadsTo_Basis')
   apply (blast intro: constrains_weaken_R) 
  apply (blast intro!: Join_transient_I1, blast)
 done
 
 end
diff --git a/src/ZF/UNITY/Increasing.thy b/src/ZF/UNITY/Increasing.thy
--- a/src/ZF/UNITY/Increasing.thy
+++ b/src/ZF/UNITY/Increasing.thy
@@ -1,227 +1,227 @@
 (*  Title:      ZF/UNITY/Increasing.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     Copyright   2001  University of Cambridge
 
 Increasing's parameters are a state function f, a domain A and an order
 relation r over the domain A. 
 *)
 
 section\<open>Charpentier's "Increasing" Relation\<close>
 
 theory Increasing imports Constrains Monotonicity begin
 
 definition
   increasing :: "[i, i, i\<Rightarrow>i] \<Rightarrow> i" (\<open>increasing[_]'(_, _')\<close>)  where
   "increasing[A](r, f) \<equiv>
     {F \<in> program. (\<forall>k \<in> A. F \<in> stable({s \<in> state. <k, f(s)> \<in> r})) \<and>
                 (\<forall>x \<in> state. f(x):A)}"
   
 definition
   Increasing :: "[i, i, i\<Rightarrow>i] \<Rightarrow> i" (\<open>Increasing[_]'(_, _')\<close>)  where
   "Increasing[A](r, f) \<equiv>
     {F \<in> program. (\<forall>k \<in> A. F \<in> Stable({s \<in> state. <k, f(s)> \<in> r})) \<and>
                 (\<forall>x \<in> state. f(x):A)}"
 
 abbreviation (input)
   IncWrt ::  "[i\<Rightarrow>i, i, i] \<Rightarrow> i" (\<open>(_ IncreasingWrt _ '/ _)\<close> [60, 0, 60] 60)  where
   "f IncreasingWrt r/A \<equiv> Increasing[A](r,f)"
 
 
 (** increasing **)
 
 lemma increasing_type: "increasing[A](r, f) \<subseteq> program"
 by (unfold increasing_def, blast)
 
 lemma increasing_into_program: "F \<in> increasing[A](r, f) \<Longrightarrow> F \<in> program"
 by (unfold increasing_def, blast)
 
 lemma increasing_imp_stable: 
 "\<lbrakk>F \<in> increasing[A](r, f); x \<in> A\<rbrakk> \<Longrightarrow>F \<in> stable({s \<in> state. <x, f(s)>:r})"
 by (unfold increasing_def, blast)
 
 lemma increasingD: 
 "F \<in> increasing[A](r,f) \<Longrightarrow> F \<in> program \<and> (\<exists>a. a \<in> A) \<and> (\<forall>s \<in> state. f(s):A)"
-apply (unfold increasing_def)
+  unfolding increasing_def
 apply (subgoal_tac "\<exists>x. x \<in> state")
 apply (auto dest: stable_type [THEN subsetD] intro: st0_in_state)
 done
 
 lemma increasing_constant [simp]: 
  "F \<in> increasing[A](r, \<lambda>s. c) \<longleftrightarrow> F \<in> program \<and> c \<in> A"
 apply (unfold increasing_def stable_def)
 apply (subgoal_tac "\<exists>x. x \<in> state")
 apply (auto dest: stable_type [THEN subsetD] intro: st0_in_state)
 done
 
 lemma subset_increasing_comp: 
 "\<lbrakk>mono1(A, r, B, s, g); refl(A, r); trans[B](s)\<rbrakk> \<Longrightarrow>  
    increasing[A](r, f) \<subseteq> increasing[B](s, g comp f)"
 apply (unfold increasing_def stable_def part_order_def 
        constrains_def mono1_def metacomp_def, clarify, simp)
 apply clarify
 apply (subgoal_tac "xa \<in> state")
 prefer 2 apply (blast dest!: ActsD)
 apply (subgoal_tac "<f (xb), f (xb) >:r")
 prefer 2 apply (force simp add: refl_def)
 apply (rotate_tac 5)
 apply (drule_tac x = "f (xb) " in bspec)
 apply (rotate_tac [2] -1)
 apply (drule_tac [2] x = act in bspec, simp_all)
 apply (drule_tac A = "act``u" and c = xa for u in subsetD, blast)
 apply (drule_tac x = "f(xa) " and x1 = "f(xb)" in bspec [THEN bspec])
 apply (rule_tac [3] b = "g (f (xb))" and A = B in trans_onD)
 apply simp_all
 done
 
 lemma imp_increasing_comp:
      "\<lbrakk>F \<in> increasing[A](r, f); mono1(A, r, B, s, g);  
          refl(A, r); trans[B](s)\<rbrakk> \<Longrightarrow> F \<in> increasing[B](s, g comp f)"
 by (rule subset_increasing_comp [THEN subsetD], auto)
 
 lemma strict_increasing: 
    "increasing[nat](Le, f) \<subseteq> increasing[nat](Lt, f)"
 by (unfold increasing_def Lt_def, auto)
 
 lemma strict_gt_increasing: 
    "increasing[nat](Ge, f) \<subseteq> increasing[nat](Gt, f)"
 apply (unfold increasing_def Gt_def Ge_def, auto)
 apply (erule natE)
 apply (auto simp add: stable_def)
 done
 
 (** Increasing **)
 
 lemma increasing_imp_Increasing: 
      "F \<in> increasing[A](r, f) \<Longrightarrow> F \<in> Increasing[A](r, f)"
 
 apply (unfold increasing_def Increasing_def)
 apply (auto intro: stable_imp_Stable)
 done
 
 lemma Increasing_type: "Increasing[A](r, f) \<subseteq> program"
 by (unfold Increasing_def, auto)
 
 lemma Increasing_into_program: "F \<in> Increasing[A](r, f) \<Longrightarrow> F \<in> program"
 by (unfold Increasing_def, auto)
 
 lemma Increasing_imp_Stable: 
 "\<lbrakk>F \<in> Increasing[A](r, f); a \<in> A\<rbrakk> \<Longrightarrow> F \<in> Stable({s \<in> state. <a,f(s)>:r})"
 by (unfold Increasing_def, blast)
 
 lemma IncreasingD: 
 "F \<in> Increasing[A](r, f) \<Longrightarrow> F \<in> program \<and> (\<exists>a. a \<in> A) \<and> (\<forall>s \<in> state. f(s):A)"
-apply (unfold Increasing_def)
+  unfolding Increasing_def
 apply (subgoal_tac "\<exists>x. x \<in> state")
 apply (auto intro: st0_in_state)
 done
 
 lemma Increasing_constant [simp]: 
      "F \<in> Increasing[A](r, \<lambda>s. c) \<longleftrightarrow> F \<in> program \<and> (c \<in> A)"
 apply (subgoal_tac "\<exists>x. x \<in> state")
 apply (auto dest!: IncreasingD intro: st0_in_state increasing_imp_Increasing)
 done
 
 lemma subset_Increasing_comp: 
 "\<lbrakk>mono1(A, r, B, s, g); refl(A, r); trans[B](s)\<rbrakk> \<Longrightarrow>  
    Increasing[A](r, f) \<subseteq> Increasing[B](s, g comp f)"
 apply (unfold Increasing_def Stable_def Constrains_def part_order_def 
        constrains_def mono1_def metacomp_def, safe)
 apply (simp_all add: ActsD)
 apply (subgoal_tac "xb \<in> state \<and> xa \<in> state")
  prefer 2 apply (simp add: ActsD)
 apply (subgoal_tac "<f (xb), f (xb) >:r")
 prefer 2 apply (force simp add: refl_def)
 apply (rotate_tac 5)
 apply (drule_tac x = "f (xb) " in bspec)
 apply simp_all
 apply clarify
 apply (rotate_tac -2)
 apply (drule_tac x = act in bspec)
 apply (drule_tac [2] A = "act``u" and c = xa for u in subsetD, simp_all, blast)
 apply (drule_tac x = "f(xa)" and x1 = "f(xb)" in bspec [THEN bspec])
 apply (rule_tac [3] b = "g (f (xb))" and A = B in trans_onD)
 apply simp_all
 done
 
 lemma imp_Increasing_comp:
  "\<lbrakk>F \<in> Increasing[A](r, f); mono1(A, r, B, s, g); refl(A, r); trans[B](s)\<rbrakk> 
   \<Longrightarrow> F \<in> Increasing[B](s, g comp f)"
 apply (rule subset_Increasing_comp [THEN subsetD], auto)
 done
   
 lemma strict_Increasing: "Increasing[nat](Le, f) \<subseteq> Increasing[nat](Lt, f)"
 by (unfold Increasing_def Lt_def, auto)
 
 lemma strict_gt_Increasing: "Increasing[nat](Ge, f)<= Increasing[nat](Gt, f)"
 apply (unfold Increasing_def Ge_def Gt_def, auto)
 apply (erule natE)
 apply (auto simp add: Stable_def)
 done
 
 (** Two-place monotone operations **)
 
 lemma imp_increasing_comp2: 
 "\<lbrakk>F \<in> increasing[A](r, f); F \<in> increasing[B](s, g);  
     mono2(A, r, B, s, C, t, h); refl(A, r); refl(B, s); trans[C](t)\<rbrakk>
  \<Longrightarrow> F \<in> increasing[C](t, \<lambda>x. h(f(x), g(x)))"
 apply (unfold increasing_def stable_def 
        part_order_def constrains_def mono2_def, clarify, simp)
 apply clarify
 apply (rename_tac xa xb)
 apply (subgoal_tac "xb \<in> state \<and> xa \<in> state")
  prefer 2 apply (blast dest!: ActsD)
 apply (subgoal_tac "<f (xb), f (xb) >:r \<and> <g (xb), g (xb) >:s")
 prefer 2 apply (force simp add: refl_def)
 apply (rotate_tac 6)
 apply (drule_tac x = "f (xb) " in bspec)
 apply (rotate_tac [2] 1)
 apply (drule_tac [2] x = "g (xb) " in bspec)
 apply simp_all
 apply (rotate_tac -1)
 apply (drule_tac x = act in bspec)
 apply (rotate_tac [2] -3)
 apply (drule_tac [2] x = act in bspec, simp_all)
 apply (drule_tac A = "act``u" and c = xa for u in subsetD)
 apply (drule_tac [2] A = "act``u" and c = xa for u in subsetD, blast, blast)
 apply (rotate_tac -4)
 apply (drule_tac x = "f (xa) " and x1 = "f (xb) " in bspec [THEN bspec])
 apply (rotate_tac [3] -1)
 apply (drule_tac [3] x = "g (xa) " and x1 = "g (xb) " in bspec [THEN bspec])
 apply simp_all
 apply (rule_tac b = "h (f (xb), g (xb))" and A = C in trans_onD)
 apply simp_all
 done
 
 lemma imp_Increasing_comp2: 
 "\<lbrakk>F \<in> Increasing[A](r, f); F \<in> Increasing[B](s, g);  
   mono2(A, r, B, s, C, t, h); refl(A, r); refl(B, s); trans[C](t)\<rbrakk> \<Longrightarrow>  
   F \<in> Increasing[C](t, \<lambda>x. h(f(x), g(x)))"
 apply (unfold Increasing_def stable_def 
        part_order_def constrains_def mono2_def Stable_def Constrains_def, safe)
 apply (simp_all add: ActsD)
 apply (subgoal_tac "xa \<in> state \<and> x \<in> state")
 prefer 2 apply (blast dest!: ActsD)
 apply (subgoal_tac "<f (xa), f (xa) >:r \<and> <g (xa), g (xa) >:s")
 prefer 2 apply (force simp add: refl_def)
 apply (rotate_tac 6)
 apply (drule_tac x = "f (xa) " in bspec)
 apply (rotate_tac [2] 1)
 apply (drule_tac [2] x = "g (xa) " in bspec)
 apply simp_all
 apply clarify
 apply (rotate_tac -2)
 apply (drule_tac x = act in bspec)
 apply (rotate_tac [2] -3)
 apply (drule_tac [2] x = act in bspec, simp_all)
 apply (drule_tac A = "act``u" and c = x for u in subsetD)
 apply (drule_tac [2] A = "act``u" and c = x for u in subsetD, blast, blast)
 apply (rotate_tac -9)
 apply (drule_tac x = "f (x) " and x1 = "f (xa) " in bspec [THEN bspec])
 apply (rotate_tac [3] -1)
 apply (drule_tac [3] x = "g (x) " and x1 = "g (xa) " in bspec [THEN bspec])
 apply simp_all
 apply (rule_tac b = "h (f (xa), g (xa))" and A = C in trans_onD)
 apply simp_all
 done
 
 end
diff --git a/src/ZF/UNITY/Merge.thy b/src/ZF/UNITY/Merge.thy
--- a/src/ZF/UNITY/Merge.thy
+++ b/src/ZF/UNITY/Merge.thy
@@ -1,196 +1,196 @@
 (*  Title:      ZF/UNITY/Merge.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     Copyright   2002  University of Cambridge
 
 A multiple-client allocator from a single-client allocator: Merge
 specification.
 *)
 
 theory Merge imports AllocBase Follows  Guar GenPrefix begin
 
 (** Merge specification (the number of inputs is Nclients) ***)
 (** Parameter A represents the type of items to Merge **)
 
 definition
   (*spec (10)*)
   merge_increasing :: "[i, i, i] \<Rightarrow>i"  where
     "merge_increasing(A, Out, iOut) \<equiv> program guarantees
          (lift(Out) IncreasingWrt  prefix(A)/list(A)) Int
          (lift(iOut) IncreasingWrt prefix(nat)/list(nat))"
 
 definition
   (*spec (11)*)
   merge_eq_Out :: "[i, i] \<Rightarrow>i"  where
   "merge_eq_Out(Out, iOut) \<equiv> program guarantees
          Always({s \<in> state. length(s`Out) = length(s`iOut)})"
 
 definition
   (*spec (12)*)
   merge_bounded :: "i\<Rightarrow>i"  where
   "merge_bounded(iOut) \<equiv> program guarantees
          Always({s \<in> state. \<forall>elt \<in> set_of_list(s`iOut). elt<Nclients})"
   
 definition
   (*spec (13)*)
   (* Parameter A represents the type of tokens *)
   merge_follows :: "[i, i\<Rightarrow>i, i, i] \<Rightarrow>i"  where
     "merge_follows(A, In, Out, iOut) \<equiv>
      (\<Inter>n \<in> Nclients. lift(In(n)) IncreasingWrt prefix(A)/list(A))
                    guarantees
      (\<Inter>n \<in> Nclients. 
         (\<lambda>s. sublist(s`Out, {k \<in> nat. k < length(s`iOut) \<and>
                       nth(k, s`iOut) = n})) Fols lift(In(n))
          Wrt prefix(A)/list(A))"
 
 definition
   (*spec: preserves part*)
   merge_preserves :: "[i\<Rightarrow>i] \<Rightarrow>i"  where
     "merge_preserves(In) \<equiv> \<Inter>n \<in> nat. preserves(lift(In(n)))"
 
 definition
 (* environmental constraints*)
   merge_allowed_acts :: "[i, i] \<Rightarrow>i"  where
   "merge_allowed_acts(Out, iOut) \<equiv>
          {F \<in> program. AllowedActs(F) =
             cons(id(state), (\<Union>G \<in> preserves(lift(Out)) \<inter>
                                    preserves(lift(iOut)). Acts(G)))}"
   
 definition
   merge_spec :: "[i, i \<Rightarrow>i, i, i]\<Rightarrow>i"  where
   "merge_spec(A, In, Out, iOut) \<equiv>
    merge_increasing(A, Out, iOut) \<inter> merge_eq_Out(Out, iOut) \<inter>
    merge_bounded(iOut) \<inter>  merge_follows(A, In, Out, iOut)
    \<inter> merge_allowed_acts(Out, iOut) \<inter> merge_preserves(In)"
 
 (** State definitions.  OUTPUT variables are locals **)
 locale merge =
   fixes In   \<comment> \<open>merge's INPUT histories: streams to merge\<close>
     and Out  \<comment> \<open>merge's OUTPUT history: merged items\<close>
     and iOut \<comment> \<open>merge's OUTPUT history: origins of merged items\<close>
     and A    \<comment> \<open>the type of items being merged\<close>
     and M
  assumes var_assumes [simp]:
            "(\<forall>n. In(n):var) \<and> Out \<in> var \<and> iOut \<in> var"
      and all_distinct_vars:
            "\<forall>n. all_distinct([In(n), Out, iOut])"
      and type_assumes [simp]:
            "(\<forall>n. type_of(In(n))=list(A)) \<and>
             type_of(Out)=list(A) \<and>
             type_of(iOut)=list(nat)"
      and default_val_assumes [simp]: 
            "(\<forall>n. default_val(In(n))=Nil) \<and>
             default_val(Out)=Nil \<and>
             default_val(iOut)=Nil"
      and merge_spec:  "M \<in> merge_spec(A, In, Out, iOut)"
 
 
 lemma (in merge) In_value_type [TC,simp]: "s \<in> state \<Longrightarrow> s`In(n) \<in> list(A)"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = "In (n)" in apply_type)
 apply auto
 done
 
 lemma (in merge) Out_value_type [TC,simp]: "s \<in> state \<Longrightarrow> s`Out \<in> list(A)"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = Out in apply_type, auto)
 done
 
 lemma (in merge) iOut_value_type [TC,simp]: "s \<in> state \<Longrightarrow> s`iOut \<in> list(nat)"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = iOut in apply_type, auto)
 done
 
 lemma (in merge) M_in_program [intro,simp]: "M \<in> program"
 apply (cut_tac merge_spec)
 apply (auto dest: guarantees_type [THEN subsetD]
             simp add: merge_spec_def merge_increasing_def)
 done
 
 lemma (in merge) merge_Allowed: 
      "Allowed(M) = (preserves(lift(Out)) \<inter> preserves(lift(iOut)))"
 apply (insert merge_spec preserves_type [of "lift (Out)"])
 apply (auto simp add: merge_spec_def merge_allowed_acts_def Allowed_def safety_prop_Acts_iff)
 done
 
 lemma (in merge) M_ok_iff: 
      "G \<in> program \<Longrightarrow>  
        M ok G \<longleftrightarrow> (G \<in> preserves(lift(Out)) \<and>   
                    G \<in> preserves(lift(iOut)) \<and> M \<in> Allowed(G))"
 apply (cut_tac merge_spec)
 apply (auto simp add: merge_Allowed ok_iff_Allowed)
 done
 
 lemma (in merge) merge_Always_Out_eq_iOut: 
      "\<lbrakk>G \<in> preserves(lift(Out)); G \<in> preserves(lift(iOut));  
          M \<in> Allowed(G)\<rbrakk>
       \<Longrightarrow> M \<squnion> G \<in> Always({s \<in> state. length(s`Out)=length(s`iOut)})"
 apply (frule preserves_type [THEN subsetD])
 apply (subgoal_tac "G \<in> program")
  prefer 2 apply assumption
 apply (frule M_ok_iff)
 apply (cut_tac merge_spec)
 apply (force dest: guaranteesD simp add: merge_spec_def merge_eq_Out_def)
 done
 
 lemma (in merge) merge_Bounded: 
      "\<lbrakk>G \<in> preserves(lift(iOut)); G \<in> preserves(lift(Out));  
          M \<in> Allowed(G)\<rbrakk> \<Longrightarrow>  
        M \<squnion> G: Always({s \<in> state. \<forall>elt \<in> set_of_list(s`iOut). elt<Nclients})"
 apply (frule preserves_type [THEN subsetD])
 apply (frule M_ok_iff)
 apply (cut_tac merge_spec)
 apply (force dest: guaranteesD simp add: merge_spec_def merge_bounded_def)
 done
 
 lemma (in merge) merge_bag_Follows_lemma: 
 "\<lbrakk>G \<in> preserves(lift(iOut));  
     G: preserves(lift(Out)); M \<in> Allowed(G)\<rbrakk>  
   \<Longrightarrow> M \<squnion> G \<in> Always  
     ({s \<in> state. msetsum(\<lambda>i. bag_of(sublist(s`Out,  
       {k \<in> nat. k < length(s`iOut) \<and> nth(k, s`iOut)=i})),  
                    Nclients, A) = bag_of(s`Out)})"
 apply (rule Always_Diff_Un_eq [THEN iffD1]) 
 apply (rule_tac [2] state_AlwaysI [THEN Always_weaken]) 
 apply (rule Always_Int_I [OF merge_Always_Out_eq_iOut merge_Bounded], auto)
 apply (subst bag_of_sublist_UN_disjoint [symmetric])
 apply (auto simp add: nat_into_Finite set_of_list_conv_nth  [OF iOut_value_type])
 apply (subgoal_tac " (\<Union>i \<in> Nclients. {k \<in> nat. k < length (x`iOut) \<and> nth (k, x`iOut) = i}) = length (x`iOut) ")
 apply (auto simp add: sublist_upt_eq_take [OF Out_value_type] 
                       length_type  [OF iOut_value_type]  
                       take_all [OF _ Out_value_type] 
                       length_type [OF iOut_value_type])
 apply (rule equalityI)
 apply (blast dest: ltD, clarify)
 apply (subgoal_tac "length (x ` iOut) \<in> nat")
  prefer 2 apply (simp add: length_type [OF iOut_value_type]) 
 apply (subgoal_tac "xa \<in> nat")
 apply (simp_all add: Ord_mem_iff_lt)
 prefer 2 apply (blast intro: lt_trans)
 apply (drule_tac x = "nth (xa, x`iOut)" and P = "\<lambda>elt. X (elt) \<longrightarrow> elt<Nclients" for X in bspec)
 apply (simp add: ltI nat_into_Ord)
 apply (blast dest: ltD)
 done
 
 theorem (in merge) merge_bag_Follows: 
     "M \<in> (\<Inter>n \<in> Nclients. lift(In(n)) IncreasingWrt prefix(A)/list(A))  
             guarantees   
       (\<lambda>s. bag_of(s`Out)) Fols  
       (\<lambda>s. msetsum(\<lambda>i. bag_of(s`In(i)),Nclients, A)) Wrt MultLe(A, r)/Mult(A)"
 apply (cut_tac merge_spec)
 apply (rule merge_bag_Follows_lemma [THEN Always_Follows1, THEN guaranteesI])
      apply (simp_all add: M_ok_iff, clarify)
 apply (rule Follows_state_ofD1 [OF Follows_msetsum_UN])
    apply (simp_all add: nat_into_Finite bag_of_multiset [of _ A])
 apply (simp add: INT_iff merge_spec_def merge_follows_def, clarify)
 apply (cut_tac merge_spec)
 apply (subgoal_tac "M ok G")
  prefer 2 apply (force intro: M_ok_iff [THEN iffD2])
 apply (drule guaranteesD, assumption)
   apply (simp add: merge_spec_def merge_follows_def, blast)
 apply (simp cong add: Follows_cong
             add: refl_prefix
                mono_bag_of [THEN subset_Follows_comp, THEN subsetD, 
                             unfolded metacomp_def])
 done
 
 end
diff --git a/src/ZF/UNITY/Monotonicity.thy b/src/ZF/UNITY/Monotonicity.thy
--- a/src/ZF/UNITY/Monotonicity.thy
+++ b/src/ZF/UNITY/Monotonicity.thy
@@ -1,120 +1,120 @@
 (*  Title:      ZF/UNITY/Monotonicity.thy
     Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
     Copyright   2002  University of Cambridge
 
 Monotonicity of an operator (meta-function) with respect to arbitrary
 set relations.
 *)
 
 section\<open>Monotonicity of an Operator WRT a Relation\<close>
 
 theory Monotonicity imports GenPrefix MultisetSum
 begin
 
 definition
   mono1 :: "[i, i, i, i, i\<Rightarrow>i] \<Rightarrow> o"  where
   "mono1(A, r, B, s, f) \<equiv>
     (\<forall>x \<in> A. \<forall>y \<in> A. \<langle>x,y\<rangle> \<in> r \<longrightarrow> <f(x), f(y)> \<in> s) \<and> (\<forall>x \<in> A. f(x) \<in> B)"
 
   (* monotonicity of a 2-place meta-function f *)
 
 definition
   mono2 :: "[i, i, i, i, i, i, [i,i]\<Rightarrow>i] \<Rightarrow> o"  where
   "mono2(A, r, B, s, C, t, f) \<equiv> 
     (\<forall>x \<in> A. \<forall>y \<in> A. \<forall>u \<in> B. \<forall>v \<in> B.
               \<langle>x,y\<rangle> \<in> r \<and> \<langle>u,v\<rangle> \<in> s \<longrightarrow> <f(x,u), f(y,v)> \<in> t) \<and>
     (\<forall>x \<in> A. \<forall>y \<in> B. f(x,y) \<in> C)"
 
  (* Internalized relations on sets and multisets *)
 
 definition
   SetLe :: "i \<Rightarrow>i"  where
   "SetLe(A) \<equiv> {\<langle>x,y\<rangle> \<in> Pow(A)*Pow(A). x \<subseteq> y}"
 
 definition
   MultLe :: "[i,i] \<Rightarrow>i"  where
   "MultLe(A, r) \<equiv> multirel(A, r - id(A)) \<union> id(Mult(A))"
 
 
 lemma mono1D: 
   "\<lbrakk>mono1(A, r, B, s, f); \<langle>x, y\<rangle> \<in> r; x \<in> A; y \<in> A\<rbrakk> \<Longrightarrow> <f(x), f(y)> \<in> s"
 by (unfold mono1_def, auto)
 
 lemma mono2D: 
      "\<lbrakk>mono2(A, r, B, s, C, t, f);  
          \<langle>x, y\<rangle> \<in> r; \<langle>u,v\<rangle> \<in> s; x \<in> A; y \<in> A; u \<in> B; v \<in> B\<rbrakk> 
       \<Longrightarrow> <f(x, u), f(y,v)> \<in> t"
 by (unfold mono2_def, auto)
 
 
 (** Monotonicity of take **)
 
 lemma take_mono_left_lemma:
      "\<lbrakk>i \<le> j; xs \<in> list(A); i \<in> nat; j \<in> nat\<rbrakk> 
       \<Longrightarrow> <take(i, xs), take(j, xs)> \<in> prefix(A)"
 apply (case_tac "length (xs) \<le> i")
  apply (subgoal_tac "length (xs) \<le> j")
   apply (simp)
  apply (blast intro: le_trans)
 apply (drule not_lt_imp_le, auto)
 apply (case_tac "length (xs) \<le> j")
  apply (auto simp add: take_prefix)
 apply (drule not_lt_imp_le, auto)
 apply (drule_tac m = i in less_imp_succ_add, auto)
 apply (subgoal_tac "i #+ k \<le> length (xs) ")
  apply (simp add: take_add prefix_iff take_type drop_type)
 apply (blast intro: leI)
 done
 
 lemma take_mono_left:
      "\<lbrakk>i \<le> j; xs \<in> list(A); j \<in> nat\<rbrakk>
       \<Longrightarrow> <take(i, xs), take(j, xs)> \<in> prefix(A)"
 by (blast intro: le_in_nat take_mono_left_lemma) 
 
 lemma take_mono_right:
      "\<lbrakk>\<langle>xs,ys\<rangle> \<in> prefix(A); i \<in> nat\<rbrakk> 
       \<Longrightarrow> <take(i, xs), take(i, ys)> \<in> prefix(A)"
 by (auto simp add: prefix_iff)
 
 lemma take_mono:
      "\<lbrakk>i \<le> j; \<langle>xs, ys\<rangle> \<in> prefix(A); j \<in> nat\<rbrakk>
       \<Longrightarrow> <take(i, xs), take(j, ys)> \<in> prefix(A)"
 apply (rule_tac b = "take (j, xs) " in prefix_trans)
 apply (auto dest: prefix_type [THEN subsetD] intro: take_mono_left take_mono_right)
 done
 
 lemma mono_take [iff]:
      "mono2(nat, Le, list(A), prefix(A), list(A), prefix(A), take)"
 apply (unfold mono2_def Le_def, auto)
 apply (blast intro: take_mono)
 done
 
 (** Monotonicity of length **)
 
 lemmas length_mono = prefix_length_le
 
 lemma mono_length [iff]:
      "mono1(list(A), prefix(A), nat, Le, length)"
-apply (unfold mono1_def)
+  unfolding mono1_def
 apply (auto dest: prefix_length_le simp add: Le_def)
 done
 
 (** Monotonicity of \<union> **)
 
 lemma mono_Un [iff]: 
      "mono2(Pow(A), SetLe(A), Pow(A), SetLe(A), Pow(A), SetLe(A), (Un))"
 by (unfold mono2_def SetLe_def, auto)
 
 (* Monotonicity of multiset union *)
 
 lemma mono_munion [iff]: 
      "mono2(Mult(A), MultLe(A,r), Mult(A), MultLe(A, r), Mult(A), MultLe(A, r), munion)"
 apply (unfold mono2_def MultLe_def)
 apply (auto simp add: Mult_iff_multiset)
 apply (blast intro: munion_multirel_mono munion_multirel_mono1 munion_multirel_mono2 multiset_into_Mult)+
 done
 
 lemma mono_succ [iff]: "mono1(nat, Le, nat, Le, succ)"
 by (unfold mono1_def Le_def, auto)
 
 end
diff --git a/src/ZF/UNITY/Mutex.thy b/src/ZF/UNITY/Mutex.thy
--- a/src/ZF/UNITY/Mutex.thy
+++ b/src/ZF/UNITY/Mutex.thy
@@ -1,320 +1,320 @@
 (*  Title:      ZF/UNITY/Mutex.thy
     Author:     Sidi O Ehmety, Computer Laboratory
     Copyright   2001  University of Cambridge
 
 Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra.
 
 Variables' types are introduced globally so that type verification
 reduces to the usual ZF typechecking \<in> an ill-tyed expression will
 reduce to the empty set.
 *)
 
 section\<open>Mutual Exclusion\<close>
 
 theory Mutex
 imports SubstAx
 begin
 
 text\<open>Based on "A Family of 2-Process Mutual Exclusion Algorithms" by J Misra
 
 Variables' types are introduced globally so that type verification reduces to
 the usual ZF typechecking: an ill-tyed expressions reduce to the empty set.
 \<close>
 
 abbreviation "p \<equiv> Var([0])"
 abbreviation "m \<equiv> Var([1])"
 abbreviation "n \<equiv> Var([0,0])"
 abbreviation "u \<equiv> Var([0,1])"
 abbreviation "v \<equiv> Var([1,0])"
 
 axiomatization where \<comment> \<open>Type declarations\<close>
   p_type:  "type_of(p)=bool \<and> default_val(p)=0" and
   m_type:  "type_of(m)=int  \<and> default_val(m)=#0" and
   n_type:  "type_of(n)=int  \<and> default_val(n)=#0" and
   u_type:  "type_of(u)=bool \<and> default_val(u)=0" and
   v_type:  "type_of(v)=bool \<and> default_val(v)=0"
 
 definition
   (** The program for process U **)
   "U0 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(u:=1, m:=#1) \<and> s`m = #0}"
 
 definition
   "U1 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(p:= s`v, m:=#2) \<and>  s`m = #1}"
 
 definition
   "U2 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(m:=#3) \<and> s`p=0 \<and> s`m = #2}"
 
 definition
   "U3 \<equiv> {\<langle>s,t\<rangle>:state*state. t=s(u:=0, m:=#4) \<and> s`m = #3}"
 
 definition
   "U4 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(p:=1, m:=#0) \<and> s`m = #4}"
 
 
    (** The program for process V **)
 
 definition
   "V0 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s (v:=1, n:=#1) \<and> s`n = #0}"
 
 definition
   "V1 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s(p:=not(s`u), n:=#2) \<and> s`n = #1}"
 
 definition
   "V2 \<equiv> {\<langle>s,t\<rangle>:state*state. t  = s(n:=#3) \<and> s`p=1 \<and> s`n = #2}"
 
 definition
   "V3 \<equiv> {\<langle>s,t\<rangle>:state*state. t = s (v:=0, n:=#4) \<and> s`n = #3}"
 
 definition
   "V4 \<equiv> {\<langle>s,t\<rangle>:state*state. t  = s (p:=0, n:=#0) \<and> s`n = #4}"
 
 definition
   "Mutex \<equiv> mk_program({s:state. s`u=0 \<and> s`v=0 \<and> s`m = #0 \<and> s`n = #0},
               {U0, U1, U2, U3, U4, V0, V1, V2, V3, V4}, Pow(state*state))"
 
   (** The correct invariants **)
 
 definition
   "IU \<equiv> {s:state. (s`u = 1\<longleftrightarrow>(#1 $\<le> s`m \<and> s`m $\<le> #3))
                      \<and> (s`m = #3 \<longrightarrow> s`p=0)}"
 
 definition
   "IV \<equiv> {s:state. (s`v = 1 \<longleftrightarrow> (#1 $\<le> s`n \<and> s`n $\<le> #3))
                       \<and> (s`n = #3 \<longrightarrow> s`p=1)}"
 
   (** The faulty invariant (for U alone) **)
 
 definition
   "bad_IU \<equiv> {s:state. (s`u = 1 \<longleftrightarrow> (#1 $\<le> s`m \<and> s`m  $\<le> #3))\<and>
                    (#3 $\<le> s`m \<and> s`m $\<le> #4 \<longrightarrow> s`p=0)}"
 
 
 (** Variables' types **)
 
 declare p_type [simp] u_type [simp] v_type [simp] m_type [simp] n_type [simp]
 
 lemma u_value_type: "s \<in> state \<Longrightarrow>s`u \<in> bool"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = u in apply_type, auto)
 done
 
 lemma v_value_type: "s \<in> state \<Longrightarrow> s`v \<in> bool"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = v in apply_type, auto)
 done
 
 lemma p_value_type: "s \<in> state \<Longrightarrow> s`p \<in> bool"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = p in apply_type, auto)
 done
 
 lemma m_value_type: "s \<in> state \<Longrightarrow> s`m \<in> int"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = m in apply_type, auto)
 done
 
 lemma n_value_type: "s \<in> state \<Longrightarrow>s`n \<in> int"
-apply (unfold state_def)
+  unfolding state_def
 apply (drule_tac a = n in apply_type, auto)
 done
 
 declare p_value_type [simp] u_value_type [simp] v_value_type [simp]
         m_value_type [simp] n_value_type [simp]
 
 declare p_value_type [TC] u_value_type [TC] v_value_type [TC]
         m_value_type [TC] n_value_type [TC]
 
 
 
 text\<open>Mutex is a program\<close>
 
 lemma Mutex_in_program [simp,TC]: "Mutex \<in> program"
 by (simp add: Mutex_def)
 
 
 declare Mutex_def [THEN def_prg_Init, simp]
 declare Mutex_def [program]
 
 declare  U0_def [THEN def_act_simp, simp]
 declare  U1_def [THEN def_act_simp, simp]
 declare  U2_def [THEN def_act_simp, simp]
 declare  U3_def [THEN def_act_simp, simp]
 declare  U4_def [THEN def_act_simp, simp]
 
 declare  V0_def [THEN def_act_simp, simp]
 declare  V1_def [THEN def_act_simp, simp]
 declare  V2_def [THEN def_act_simp, simp]
 declare  V3_def [THEN def_act_simp, simp]
 declare  V4_def [THEN def_act_simp, simp]
 
 declare  U0_def [THEN def_set_simp, simp]
 declare  U1_def [THEN def_set_simp, simp]
 declare  U2_def [THEN def_set_simp, simp]
 declare  U3_def [THEN def_set_simp, simp]
 declare  U4_def [THEN def_set_simp, simp]
 
 declare  V0_def [THEN def_set_simp, simp]
 declare  V1_def [THEN def_set_simp, simp]
 declare  V2_def [THEN def_set_simp, simp]
 declare  V3_def [THEN def_set_simp, simp]
 declare  V4_def [THEN def_set_simp, simp]
 
 declare  IU_def [THEN def_set_simp, simp]
 declare  IV_def [THEN def_set_simp, simp]
 declare  bad_IU_def [THEN def_set_simp, simp]
 
 lemma IU: "Mutex \<in> Always(IU)"
 apply (rule AlwaysI, force)
 apply (unfold Mutex_def, safety, auto)
 done
 
 lemma IV: "Mutex \<in> Always(IV)"
 apply (rule AlwaysI, force)
 apply (unfold Mutex_def, safety)
 done
 
 (*The safety property: mutual exclusion*)
 lemma mutual_exclusion: "Mutex \<in> Always({s \<in> state. \<not>(s`m = #3 \<and> s`n = #3)})"
 apply (rule Always_weaken)
 apply (rule Always_Int_I [OF IU IV], auto)
 done
 
 (*The bad invariant FAILS in V1*)
 
 lemma less_lemma: "\<lbrakk>x$<#1; #3 $\<le> x\<rbrakk> \<Longrightarrow> P"
 apply (drule_tac j = "#1" and k = "#3" in zless_zle_trans)
 apply (drule_tac [2] j = x in zle_zless_trans, auto)
 done
 
 lemma "Mutex \<in> Always(bad_IU)"
 apply (rule AlwaysI, force)
 apply (unfold Mutex_def, safety, auto)
 apply (subgoal_tac "#1 $\<le> #3")
 apply (drule_tac x = "#1" and y = "#3" in zle_trans, auto)
 apply (simp (no_asm) add: not_zless_iff_zle [THEN iff_sym])
 apply auto
 (*Resulting state: n=1, p=false, m=4, u=false.
   Execution of V1 (the command of process v guarded by n=1) sets p:=true,
   violating the invariant!*)
 oops
 
 
 
 (*** Progress for U ***)
 
 lemma U_F0: "Mutex \<in> {s \<in> state. s`m=#2} Unless {s \<in> state. s`m=#3}"
 by (unfold op_Unless_def Mutex_def, safety)
 
 lemma U_F1:
      "Mutex \<in> {s \<in> state. s`m=#1} \<longmapsto>w {s \<in> state. s`p = s`v \<and> s`m = #2}"
 by (unfold Mutex_def, ensures U1)
 
 lemma U_F2: "Mutex \<in> {s \<in> state. s`p =0 \<and> s`m = #2} \<longmapsto>w {s \<in> state. s`m = #3}"
 apply (cut_tac IU)
 apply (unfold Mutex_def, ensures U2)
 done
 
 lemma U_F3: "Mutex \<in> {s \<in> state. s`m = #3} \<longmapsto>w {s \<in> state. s`p=1}"
 apply (rule_tac B = "{s \<in> state. s`m = #4}" in LeadsTo_Trans)
- apply (unfold Mutex_def)
+   unfolding Mutex_def
  apply (ensures U3)
 apply (ensures U4)
 done
 
 
 lemma U_lemma2: "Mutex \<in> {s \<in> state. s`m = #2} \<longmapsto>w {s \<in> state. s`p=1}"
 apply (rule LeadsTo_Diff [OF LeadsTo_weaken_L
                              Int_lower2 [THEN subset_imp_LeadsTo]])
 apply (rule LeadsTo_Trans [OF U_F2 U_F3], auto)
 apply (auto dest!: p_value_type simp add: bool_def)
 done
 
 lemma U_lemma1: "Mutex \<in> {s \<in> state. s`m = #1} \<longmapsto>w {s \<in> state. s`p =1}"
 by (rule LeadsTo_Trans [OF U_F1 [THEN LeadsTo_weaken_R] U_lemma2], blast)
 
 lemma eq_123: "i \<in> int \<Longrightarrow> (#1 $\<le> i \<and> i $\<le> #3) \<longleftrightarrow> (i=#1 | i=#2 | i=#3)"
 apply auto
 apply (auto simp add: neq_iff_zless)
 apply (drule_tac [4] j = "#3" and i = i in zle_zless_trans)
 apply (drule_tac [2] j = i and i = "#1" in zle_zless_trans)
 apply (drule_tac j = i and i = "#1" in zle_zless_trans, auto)
 apply (rule zle_anti_sym)
 apply (simp_all (no_asm_simp) add: zless_add1_iff_zle [THEN iff_sym])
 done
 
 
 lemma U_lemma123: "Mutex \<in> {s \<in> state. #1 $\<le> s`m \<and> s`m $\<le> #3} \<longmapsto>w {s \<in> state. s`p=1}"
 by (simp add: eq_123 Collect_disj_eq LeadsTo_Un_distrib U_lemma1 U_lemma2 U_F3)
 
 
 (*Misra's F4*)
 lemma u_Leadsto_p: "Mutex \<in> {s \<in> state. s`u = 1} \<longmapsto>w {s \<in> state. s`p=1}"
 by (rule Always_LeadsTo_weaken [OF IU U_lemma123], auto)
 
 
 (*** Progress for V ***)
 
 lemma V_F0: "Mutex \<in> {s \<in> state. s`n=#2} Unless {s \<in> state. s`n=#3}"
 by (unfold op_Unless_def Mutex_def, safety)
 
 lemma V_F1: "Mutex \<in> {s \<in> state. s`n=#1} \<longmapsto>w {s \<in> state. s`p = not(s`u) \<and> s`n = #2}"
 by (unfold Mutex_def, ensures "V1")
 
 lemma V_F2: "Mutex \<in> {s \<in> state. s`p=1 \<and> s`n = #2} \<longmapsto>w {s \<in> state. s`n = #3}"
 apply (cut_tac IV)
 apply (unfold Mutex_def, ensures "V2")
 done
 
 lemma V_F3: "Mutex \<in> {s \<in> state. s`n = #3} \<longmapsto>w {s \<in> state. s`p=0}"
 apply (rule_tac B = "{s \<in> state. s`n = #4}" in LeadsTo_Trans)
- apply (unfold Mutex_def)
+   unfolding Mutex_def
  apply (ensures V3)
 apply (ensures V4)
 done
 
 lemma V_lemma2: "Mutex \<in> {s \<in> state. s`n = #2} \<longmapsto>w {s \<in> state. s`p=0}"
 apply (rule LeadsTo_Diff [OF LeadsTo_weaken_L
                              Int_lower2 [THEN subset_imp_LeadsTo]])
 apply (rule LeadsTo_Trans [OF V_F2 V_F3], auto)
 apply (auto dest!: p_value_type simp add: bool_def)
 done
 
 lemma V_lemma1: "Mutex \<in> {s \<in> state. s`n = #1} \<longmapsto>w {s \<in> state. s`p = 0}"
 by (rule LeadsTo_Trans [OF V_F1 [THEN LeadsTo_weaken_R] V_lemma2], blast)
 
 lemma V_lemma123: "Mutex \<in> {s \<in> state. #1 $\<le> s`n \<and> s`n $\<le> #3} \<longmapsto>w {s \<in> state. s`p = 0}"
 by (simp add: eq_123 Collect_disj_eq LeadsTo_Un_distrib V_lemma1 V_lemma2 V_F3)
 
 (*Misra's F4*)
 lemma v_Leadsto_not_p: "Mutex \<in> {s \<in> state. s`v = 1} \<longmapsto>w {s \<in> state. s`p = 0}"
 by (rule Always_LeadsTo_weaken [OF IV V_lemma123], auto)
 
 
 (** Absence of starvation **)
 
 (*Misra's F6*)
 lemma m1_Leadsto_3: "Mutex \<in> {s \<in> state. s`m = #1} \<longmapsto>w {s \<in> state. s`m = #3}"
 apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
 apply (rule_tac [2] U_F2)
 apply (simp add: Collect_conj_eq)
 apply (subst Un_commute)
 apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
  apply (rule_tac [2] PSP_Unless [OF v_Leadsto_not_p U_F0])
 apply (rule U_F1 [THEN LeadsTo_weaken_R], auto)
 apply (auto dest!: v_value_type simp add: bool_def)
 done
 
 
 (*The same for V*)
 lemma n1_Leadsto_3: "Mutex \<in> {s \<in> state. s`n = #1} \<longmapsto>w {s \<in> state. s`n = #3}"
 apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
 apply (rule_tac [2] V_F2)
 apply (simp add: Collect_conj_eq)
 apply (subst Un_commute)
 apply (rule LeadsTo_cancel2 [THEN LeadsTo_Un_duplicate])
  apply (rule_tac [2] PSP_Unless [OF u_Leadsto_p V_F0])
 apply (rule V_F1 [THEN LeadsTo_weaken_R], auto)
 apply (auto dest!: u_value_type simp add: bool_def)
 done
 
 end
diff --git a/src/ZF/UNITY/SubstAx.thy b/src/ZF/UNITY/SubstAx.thy
--- a/src/ZF/UNITY/SubstAx.thy
+++ b/src/ZF/UNITY/SubstAx.thy
@@ -1,380 +1,380 @@
 (*  Title:      ZF/UNITY/SubstAx.thy
     Author:     Sidi O Ehmety, Computer Laboratory
     Copyright   2001  University of Cambridge
 
 Theory ported from HOL.
 *)
 
 section\<open>Weak LeadsTo relation (restricted to the set of reachable states)\<close>
 
 theory SubstAx
 imports WFair Constrains
 begin
 
 definition
   (* The definitions below are not `conventional', but yield simpler rules *)
   Ensures :: "[i,i] \<Rightarrow> i"            (infixl \<open>Ensures\<close> 60)  where
   "A Ensures B \<equiv> {F \<in> program. F \<in> (reachable(F) \<inter> A) ensures (reachable(F) \<inter> B) }"
 
 definition
   LeadsTo :: "[i, i] \<Rightarrow> i"            (infixl \<open>\<longmapsto>w\<close> 60)  where
   "A \<longmapsto>w B \<equiv> {F \<in> program. F:(reachable(F) \<inter> A) \<longmapsto> (reachable(F) \<inter> B)}"
 
 
 (*Resembles the previous definition of LeadsTo*)
 
 (* Equivalence with the HOL-like definition *)
 lemma LeadsTo_eq:
 "st_set(B)\<Longrightarrow> A \<longmapsto>w B = {F \<in> program. F:(reachable(F) \<inter> A) \<longmapsto> B}"
-apply (unfold LeadsTo_def)
+  unfolding LeadsTo_def
 apply (blast dest: psp_stable2 leadsToD2 constrainsD2 intro: leadsTo_weaken)
 done
 
 lemma LeadsTo_type: "A \<longmapsto>w B <=program"
 by (unfold LeadsTo_def, auto)
 
 (*** Specialized laws for handling invariants ***)
 
 (** Conjoining an Always property **)
 lemma Always_LeadsTo_pre: "F \<in> Always(I) \<Longrightarrow> (F:(I \<inter> A) \<longmapsto>w A') \<longleftrightarrow> (F \<in> A \<longmapsto>w A')"
 by (simp add: LeadsTo_def Always_eq_includes_reachable Int_absorb2 Int_assoc [symmetric] leadsToD2)
 
 lemma Always_LeadsTo_post: "F \<in> Always(I) \<Longrightarrow> (F \<in> A \<longmapsto>w (I \<inter> A')) \<longleftrightarrow> (F \<in> A \<longmapsto>w A')"
-apply (unfold LeadsTo_def)
+  unfolding LeadsTo_def
 apply (simp add: Always_eq_includes_reachable Int_absorb2 Int_assoc [symmetric] leadsToD2)
 done
 
 (* Like 'Always_LeadsTo_pre RS iffD1', but with premises in the good order *)
 lemma Always_LeadsToI: "\<lbrakk>F \<in> Always(C); F \<in> (C \<inter> A) \<longmapsto>w A'\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w A'"
 by (blast intro: Always_LeadsTo_pre [THEN iffD1])
 
 (* Like 'Always_LeadsTo_post RS iffD2', but with premises in the good order *)
 lemma Always_LeadsToD: "\<lbrakk>F \<in> Always(C);  F \<in> A \<longmapsto>w A'\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w (C \<inter> A')"
 by (blast intro: Always_LeadsTo_post [THEN iffD2])
 
 (*** Introduction rules \<in> Basis, Trans, Union ***)
 
 lemma LeadsTo_Basis: "F \<in> A Ensures B \<Longrightarrow> F \<in> A \<longmapsto>w B"
 by (auto simp add: Ensures_def LeadsTo_def)
 
 lemma LeadsTo_Trans:
      "\<lbrakk>F \<in> A \<longmapsto>w B;  F \<in> B \<longmapsto>w C\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w C"
 apply (simp (no_asm_use) add: LeadsTo_def)
 apply (blast intro: leadsTo_Trans)
 done
 
 lemma LeadsTo_Union:
 "\<lbrakk>(\<And>A. A \<in> S \<Longrightarrow> F \<in> A \<longmapsto>w B); F \<in> program\<rbrakk>\<Longrightarrow>F \<in> \<Union>(S) \<longmapsto>w B"
 apply (simp add: LeadsTo_def)
 apply (subst Int_Union_Union2)
 apply (rule leadsTo_UN, auto)
 done
 
 (*** Derived rules ***)
 
 lemma leadsTo_imp_LeadsTo: "F \<in> A \<longmapsto> B \<Longrightarrow> F \<in> A \<longmapsto>w B"
 apply (frule leadsToD2, clarify)
 apply (simp (no_asm_simp) add: LeadsTo_eq)
 apply (blast intro: leadsTo_weaken_L)
 done
 
 (*Useful with cancellation, disjunction*)
 lemma LeadsTo_Un_duplicate: "F \<in> A \<longmapsto>w (A' \<union> A') \<Longrightarrow> F \<in> A \<longmapsto>w A'"
 by (simp add: Un_ac)
 
 lemma LeadsTo_Un_duplicate2:
      "F \<in> A \<longmapsto>w (A' \<union> C \<union> C) \<Longrightarrow> F \<in> A \<longmapsto>w (A' \<union> C)"
 by (simp add: Un_ac)
 
 lemma LeadsTo_UN:
     "\<lbrakk>(\<And>i. i \<in> I \<Longrightarrow> F \<in> A(i) \<longmapsto>w B); F \<in> program\<rbrakk>
      \<Longrightarrow>F:(\<Union>i \<in> I. A(i)) \<longmapsto>w B"
 apply (simp add: LeadsTo_def)
 apply (simp (no_asm_simp) del: UN_simps add: Int_UN_distrib)
 apply (rule leadsTo_UN, auto)
 done
 
 (*Binary union introduction rule*)
 lemma LeadsTo_Un:
      "\<lbrakk>F \<in> A \<longmapsto>w C; F \<in> B \<longmapsto>w C\<rbrakk> \<Longrightarrow> F \<in> (A \<union> B) \<longmapsto>w C"
 apply (subst Un_eq_Union)
 apply (rule LeadsTo_Union)
 apply (auto dest: LeadsTo_type [THEN subsetD])
 done
 
 (*Lets us look at the starting state*)
 lemma single_LeadsTo_I:
     "\<lbrakk>(\<And>s. s \<in> A \<Longrightarrow> F:{s} \<longmapsto>w B); F \<in> program\<rbrakk>\<Longrightarrow>F \<in> A \<longmapsto>w B"
 apply (subst UN_singleton [symmetric], rule LeadsTo_UN, auto)
 done
 
 lemma subset_imp_LeadsTo: "\<lbrakk>A \<subseteq> B; F \<in> program\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w B"
 apply (simp (no_asm_simp) add: LeadsTo_def)
 apply (blast intro: subset_imp_leadsTo)
 done
 
 lemma empty_LeadsTo: "F \<in> 0 \<longmapsto>w A \<longleftrightarrow> F \<in> program"
 by (auto dest: LeadsTo_type [THEN subsetD]
             intro: empty_subsetI [THEN subset_imp_LeadsTo])
 declare empty_LeadsTo [iff]
 
 lemma LeadsTo_state: "F \<in> A \<longmapsto>w state \<longleftrightarrow> F \<in> program"
 by (auto dest: LeadsTo_type [THEN subsetD] simp add: LeadsTo_eq)
 declare LeadsTo_state [iff]
 
 lemma LeadsTo_weaken_R: "\<lbrakk>F \<in> A \<longmapsto>w A';  A'<=B'\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w B'"
-apply (unfold LeadsTo_def)
+  unfolding LeadsTo_def
 apply (auto intro: leadsTo_weaken_R)
 done
 
 lemma LeadsTo_weaken_L: "\<lbrakk>F \<in> A \<longmapsto>w A'; B \<subseteq> A\<rbrakk> \<Longrightarrow> F \<in> B \<longmapsto>w A'"
-apply (unfold LeadsTo_def)
+  unfolding LeadsTo_def
 apply (auto intro: leadsTo_weaken_L)
 done
 
 lemma LeadsTo_weaken: "\<lbrakk>F \<in> A \<longmapsto>w A'; B<=A; A'<=B'\<rbrakk> \<Longrightarrow> F \<in> B \<longmapsto>w B'"
 by (blast intro: LeadsTo_weaken_R LeadsTo_weaken_L LeadsTo_Trans)
 
 lemma Always_LeadsTo_weaken:
 "\<lbrakk>F \<in> Always(C);  F \<in> A \<longmapsto>w A'; C \<inter> B \<subseteq> A;   C \<inter> A' \<subseteq> B'\<rbrakk>
       \<Longrightarrow> F \<in> B \<longmapsto>w B'"
 apply (blast dest: Always_LeadsToI intro: LeadsTo_weaken Always_LeadsToD)
 done
 
 (** Two theorems for "proof lattices" **)
 
 lemma LeadsTo_Un_post: "F \<in> A \<longmapsto>w B \<Longrightarrow> F:(A \<union> B) \<longmapsto>w B"
 by (blast dest: LeadsTo_type [THEN subsetD]
              intro: LeadsTo_Un subset_imp_LeadsTo)
 
 lemma LeadsTo_Trans_Un: "\<lbrakk>F \<in> A \<longmapsto>w B;  F \<in> B \<longmapsto>w C\<rbrakk>
       \<Longrightarrow> F \<in> (A \<union> B) \<longmapsto>w C"
 apply (blast intro: LeadsTo_Un subset_imp_LeadsTo LeadsTo_weaken_L LeadsTo_Trans dest: LeadsTo_type [THEN subsetD])
 done
 
 (** Distributive laws **)
 lemma LeadsTo_Un_distrib: "(F \<in> (A \<union> B) \<longmapsto>w C)  \<longleftrightarrow> (F \<in> A \<longmapsto>w C \<and> F \<in> B \<longmapsto>w C)"
 by (blast intro: LeadsTo_Un LeadsTo_weaken_L)
 
 lemma LeadsTo_UN_distrib: "(F \<in> (\<Union>i \<in> I. A(i)) \<longmapsto>w B) \<longleftrightarrow>  (\<forall>i \<in> I. F \<in> A(i) \<longmapsto>w B) \<and> F \<in> program"
 by (blast dest: LeadsTo_type [THEN subsetD]
              intro: LeadsTo_UN LeadsTo_weaken_L)
 
 lemma LeadsTo_Union_distrib: "(F \<in> \<Union>(S) \<longmapsto>w B)  \<longleftrightarrow>  (\<forall>A \<in> S. F \<in> A \<longmapsto>w B) \<and> F \<in> program"
 by (blast dest: LeadsTo_type [THEN subsetD]
              intro: LeadsTo_Union LeadsTo_weaken_L)
 
 (** More rules using the premise "Always(I)" **)
 
 lemma EnsuresI: "\<lbrakk>F:(A-B) Co (A \<union> B);  F \<in> transient (A-B)\<rbrakk> \<Longrightarrow> F \<in> A Ensures B"
 apply (simp add: Ensures_def Constrains_eq_constrains)
 apply (blast intro: ensuresI constrains_weaken transient_strengthen dest: constrainsD2)
 done
 
 lemma Always_LeadsTo_Basis: "\<lbrakk>F \<in> Always(I); F \<in> (I \<inter> (A-A')) Co (A \<union> A');
          F \<in> transient (I \<inter> (A-A'))\<rbrakk>
   \<Longrightarrow> F \<in> A \<longmapsto>w A'"
 apply (rule Always_LeadsToI, assumption)
 apply (blast intro: EnsuresI LeadsTo_Basis Always_ConstrainsD [THEN Constrains_weaken] transient_strengthen)
 done
 
 (*Set difference: maybe combine with leadsTo_weaken_L??
   This is the most useful form of the "disjunction" rule*)
 lemma LeadsTo_Diff:
      "\<lbrakk>F \<in> (A-B) \<longmapsto>w C;  F \<in> (A \<inter> B) \<longmapsto>w C\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w C"
 by (blast intro: LeadsTo_Un LeadsTo_weaken)
 
 lemma LeadsTo_UN_UN:
      "\<lbrakk>(\<And>i. i \<in> I \<Longrightarrow> F \<in> A(i) \<longmapsto>w A'(i)); F \<in> program\<rbrakk>
       \<Longrightarrow> F \<in> (\<Union>i \<in> I. A(i)) \<longmapsto>w (\<Union>i \<in> I. A'(i))"
 apply (rule LeadsTo_Union, auto)
 apply (blast intro: LeadsTo_weaken_R)
 done
 
 (*Binary union version*)
 lemma LeadsTo_Un_Un:
   "\<lbrakk>F \<in> A \<longmapsto>w A'; F \<in> B \<longmapsto>w B'\<rbrakk> \<Longrightarrow> F:(A \<union> B) \<longmapsto>w (A' \<union> B')"
 by (blast intro: LeadsTo_Un LeadsTo_weaken_R)
 
 (** The cancellation law **)
 
 lemma LeadsTo_cancel2: "\<lbrakk>F \<in> A \<longmapsto>w(A' \<union> B); F \<in> B \<longmapsto>w B'\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w (A' \<union> B')"
 by (blast intro: LeadsTo_Un_Un subset_imp_LeadsTo LeadsTo_Trans dest: LeadsTo_type [THEN subsetD])
 
 lemma Un_Diff: "A \<union> (B - A) = A \<union> B"
 by auto
 
 lemma LeadsTo_cancel_Diff2: "\<lbrakk>F \<in> A \<longmapsto>w (A' \<union> B); F \<in> (B-A') \<longmapsto>w B'\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w (A' \<union> B')"
 apply (rule LeadsTo_cancel2)
 prefer 2 apply assumption
 apply (simp (no_asm_simp) add: Un_Diff)
 done
 
 lemma LeadsTo_cancel1: "\<lbrakk>F \<in> A \<longmapsto>w (B \<union> A'); F \<in> B \<longmapsto>w B'\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w (B' \<union> A')"
 apply (simp add: Un_commute)
 apply (blast intro!: LeadsTo_cancel2)
 done
 
 lemma Diff_Un2: "(B - A) \<union> A = B \<union> A"
 by auto
 
 lemma LeadsTo_cancel_Diff1: "\<lbrakk>F \<in> A \<longmapsto>w (B \<union> A'); F \<in> (B-A') \<longmapsto>w B'\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w (B' \<union> A')"
 apply (rule LeadsTo_cancel1)
 prefer 2 apply assumption
 apply (simp (no_asm_simp) add: Diff_Un2)
 done
 
 (** The impossibility law **)
 
 (*The set "A" may be non-empty, but it contains no reachable states*)
 lemma LeadsTo_empty: "F \<in> A \<longmapsto>w 0 \<Longrightarrow> F \<in> Always (state -A)"
 apply (simp (no_asm_use) add: LeadsTo_def Always_eq_includes_reachable)
 apply (cut_tac reachable_type)
 apply (auto dest!: leadsTo_empty)
 done
 
 (** PSP \<in> Progress-Safety-Progress **)
 
 (*Special case of PSP \<in> Misra's "stable conjunction"*)
 lemma PSP_Stable: "\<lbrakk>F \<in> A \<longmapsto>w A';  F \<in> Stable(B)\<rbrakk>\<Longrightarrow> F:(A \<inter> B) \<longmapsto>w (A' \<inter> B)"
 apply (simp add: LeadsTo_def Stable_eq_stable, clarify)
 apply (drule psp_stable, assumption)
 apply (simp add: Int_ac)
 done
 
 lemma PSP_Stable2: "\<lbrakk>F \<in> A \<longmapsto>w A'; F \<in> Stable(B)\<rbrakk> \<Longrightarrow> F \<in> (B \<inter> A) \<longmapsto>w (B \<inter> A')"
 apply (simp (no_asm_simp) add: PSP_Stable Int_ac)
 done
 
 lemma PSP: "\<lbrakk>F \<in> A \<longmapsto>w A'; F \<in> B Co B'\<rbrakk>\<Longrightarrow> F \<in> (A \<inter> B') \<longmapsto>w ((A' \<inter> B) \<union> (B' - B))"
 apply (simp (no_asm_use) add: LeadsTo_def Constrains_eq_constrains)
 apply (blast dest: psp intro: leadsTo_weaken)
 done
 
 lemma PSP2: "\<lbrakk>F \<in> A \<longmapsto>w A'; F \<in> B Co B'\<rbrakk>\<Longrightarrow> F:(B' \<inter> A) \<longmapsto>w ((B \<inter> A') \<union> (B' - B))"
 by (simp (no_asm_simp) add: PSP Int_ac)
 
 lemma PSP_Unless:
 "\<lbrakk>F \<in> A \<longmapsto>w A'; F \<in> B Unless B'\<rbrakk>\<Longrightarrow> F:(A \<inter> B) \<longmapsto>w ((A' \<inter> B) \<union> B')"
-apply (unfold op_Unless_def)
+  unfolding op_Unless_def
 apply (drule PSP, assumption)
 apply (blast intro: LeadsTo_Diff LeadsTo_weaken subset_imp_LeadsTo)
 done
 
 (*** Induction rules ***)
 
 (** Meta or object quantifier ????? **)
 lemma LeadsTo_wf_induct: "\<lbrakk>wf(r);
          \<forall>m \<in> I. F \<in> (A \<inter> f-``{m}) \<longmapsto>w
                             ((A \<inter> f-``(converse(r) `` {m})) \<union> B);
          field(r)<=I; A<=f-``I; F \<in> program\<rbrakk>
       \<Longrightarrow> F \<in> A \<longmapsto>w B"
 apply (simp (no_asm_use) add: LeadsTo_def)
 apply auto
 apply (erule_tac I = I and f = f in leadsTo_wf_induct, safe)
 apply (drule_tac [2] x = m in bspec, safe)
 apply (rule_tac [2] A' = "reachable (F) \<inter> (A \<inter> f -`` (converse (r) ``{m}) \<union> B) " in leadsTo_weaken_R)
 apply (auto simp add: Int_assoc)
 done
 
 
 lemma LessThan_induct: "\<lbrakk>\<forall>m \<in> nat. F:(A \<inter> f-``{m}) \<longmapsto>w ((A \<inter> f-``m) \<union> B);
       A<=f-``nat; F \<in> program\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto>w B"
 apply (rule_tac A1 = nat and f1 = "\<lambda>x. x" in wf_measure [THEN LeadsTo_wf_induct])
 apply (simp_all add: nat_measure_field)
 apply (simp add: ltI Image_inverse_lessThan vimage_def [symmetric])
 done
 
 
 (******
  To be ported ??? I am not sure.
 
   integ_0_le_induct
   LessThan_bounded_induct
   GreaterThan_bounded_induct
 
 *****)
 
 (*** Completion \<in> Binary and General Finite versions ***)
 
 lemma Completion: "\<lbrakk>F \<in> A \<longmapsto>w (A' \<union> C);  F \<in> A' Co (A' \<union> C);
          F \<in> B \<longmapsto>w (B' \<union> C);  F \<in> B' Co (B' \<union> C)\<rbrakk>
       \<Longrightarrow> F \<in> (A \<inter> B) \<longmapsto>w ((A' \<inter> B') \<union> C)"
 apply (simp (no_asm_use) add: LeadsTo_def Constrains_eq_constrains Int_Un_distrib)
 apply (blast intro: completion leadsTo_weaken)
 done
 
 lemma Finite_completion_aux:
      "\<lbrakk>I \<in> Fin(X);F \<in> program\<rbrakk>
       \<Longrightarrow> (\<forall>i \<in> I. F \<in> (A(i)) \<longmapsto>w (A'(i) \<union> C)) \<longrightarrow>
           (\<forall>i \<in> I. F \<in> (A'(i)) Co (A'(i) \<union> C)) \<longrightarrow>
           F \<in> (\<Inter>i \<in> I. A(i)) \<longmapsto>w ((\<Inter>i \<in> I. A'(i)) \<union> C)"
 apply (erule Fin_induct)
 apply (auto simp del: INT_simps simp add: Inter_0)
 apply (rule Completion, auto)
 apply (simp del: INT_simps add: INT_extend_simps)
 apply (blast intro: Constrains_INT)
 done
 
 lemma Finite_completion:
      "\<lbrakk>I \<in> Fin(X); \<And>i. i \<in> I \<Longrightarrow> F \<in> A(i) \<longmapsto>w (A'(i) \<union> C);
          \<And>i. i \<in> I \<Longrightarrow> F \<in> A'(i) Co (A'(i) \<union> C);
          F \<in> program\<rbrakk>
       \<Longrightarrow> F \<in> (\<Inter>i \<in> I. A(i)) \<longmapsto>w ((\<Inter>i \<in> I. A'(i)) \<union> C)"
 by (blast intro: Finite_completion_aux [THEN mp, THEN mp])
 
 lemma Stable_completion:
      "\<lbrakk>F \<in> A \<longmapsto>w A';  F \<in> Stable(A');
          F \<in> B \<longmapsto>w B';  F \<in> Stable(B')\<rbrakk>
     \<Longrightarrow> F \<in> (A \<inter> B) \<longmapsto>w (A' \<inter> B')"
-apply (unfold Stable_def)
+  unfolding Stable_def
 apply (rule_tac C1 = 0 in Completion [THEN LeadsTo_weaken_R])
     prefer 5
     apply blast
 apply auto
 done
 
 lemma Finite_stable_completion:
      "\<lbrakk>I \<in> Fin(X);
          (\<And>i. i \<in> I \<Longrightarrow> F \<in> A(i) \<longmapsto>w A'(i));
          (\<And>i. i \<in> I \<Longrightarrow>F \<in> Stable(A'(i)));   F \<in> program\<rbrakk>
       \<Longrightarrow> F \<in> (\<Inter>i \<in> I. A(i)) \<longmapsto>w (\<Inter>i \<in> I. A'(i))"
-apply (unfold Stable_def)
+  unfolding Stable_def
 apply (rule_tac C1 = 0 in Finite_completion [THEN LeadsTo_weaken_R], simp_all)
 apply (rule_tac [3] subset_refl, auto)
 done
 
 ML \<open>
 (*proves "ensures/leadsTo" properties when the program is specified*)
 fun ensures_tac ctxt sact =
   SELECT_GOAL
     (EVERY [REPEAT (Always_Int_tac ctxt 1),
             eresolve_tac ctxt @{thms Always_LeadsTo_Basis} 1
                 ORELSE   (*subgoal may involve LeadsTo, leadsTo or ensures*)
                 REPEAT (ares_tac ctxt [@{thm LeadsTo_Basis}, @{thm leadsTo_Basis},
                                   @{thm EnsuresI}, @{thm ensuresI}] 1),
             (*now there are two subgoals: co \<and> transient*)
             simp_tac (ctxt addsimps (Named_Theorems.get ctxt \<^named_theorems>\<open>program\<close>)) 2,
             Rule_Insts.res_inst_tac ctxt
               [((("act", 0), Position.none), sact)] [] @{thm transientI} 2,
                (*simplify the command's domain*)
             simp_tac (ctxt addsimps [@{thm domain_def}]) 3,
             (* proving the domain part *)
            clarify_tac ctxt 3,
            dresolve_tac ctxt @{thms swap} 3, force_tac ctxt 4,
            resolve_tac ctxt @{thms ReplaceI} 3, force_tac ctxt 3, force_tac ctxt 4,
            asm_full_simp_tac ctxt 3, resolve_tac ctxt @{thms conjI} 3, simp_tac ctxt 4,
            REPEAT (resolve_tac ctxt @{thms state_update_type} 3),
            constrains_tac ctxt 1,
            ALLGOALS (clarify_tac ctxt),
            ALLGOALS (asm_full_simp_tac (ctxt addsimps [@{thm st_set_def}])),
                       ALLGOALS (clarify_tac ctxt),
           ALLGOALS (asm_lr_simp_tac ctxt)]);
 \<close>
 
 method_setup ensures = \<open>
     Args.goal_spec -- Scan.lift Parse.embedded_inner_syntax >>
     (fn (quant, s) => fn ctxt => SIMPLE_METHOD'' quant (ensures_tac ctxt s))
 \<close> "for proving progress properties"
 
 end
diff --git a/src/ZF/UNITY/UNITY.thy b/src/ZF/UNITY/UNITY.thy
--- a/src/ZF/UNITY/UNITY.thy
+++ b/src/ZF/UNITY/UNITY.thy
@@ -1,625 +1,625 @@
 (*  Title:      ZF/UNITY/UNITY.thy
     Author:     Sidi O Ehmety, Computer Laboratory
     Copyright   2001  University of Cambridge
 *)
 
 section \<open>The Basic UNITY Theory\<close>
 
 theory UNITY imports State begin
 
 text\<open>The basic UNITY theory (revised version, based upon the "co" operator)
 From Misra, "A Logic for Concurrent Programming", 1994.
 
 This ZF theory was ported from its HOL equivalent.\<close>
 
 definition
   program  :: i  where
   "program \<equiv> {<init, acts, allowed>:
                Pow(state) * Pow(Pow(state*state)) * Pow(Pow(state*state)).
                id(state) \<in> acts \<and> id(state) \<in> allowed}"
 
 definition
   mk_program :: "[i,i,i]\<Rightarrow>i"  where
   \<comment> \<open>The definition yields a program thanks to the coercions
        init \<inter> state, acts \<inter> Pow(state*state), etc.\<close>
   "mk_program(init, acts, allowed) \<equiv>
     <init \<inter> state, cons(id(state), acts \<inter> Pow(state*state)),
               cons(id(state), allowed \<inter> Pow(state*state))>"
 
 definition
   SKIP :: i  (\<open>\<bottom>\<close>) where
   "SKIP \<equiv> mk_program(state, 0, Pow(state*state))"
 
   (* Coercion from anything to program *)
 definition
   programify :: "i\<Rightarrow>i"  where
   "programify(F) \<equiv> if F \<in> program then F else SKIP"
 
 definition
   RawInit :: "i\<Rightarrow>i"  where
   "RawInit(F) \<equiv> fst(F)"
 
 definition
   Init :: "i\<Rightarrow>i"  where
   "Init(F) \<equiv> RawInit(programify(F))"
 
 definition
   RawActs :: "i\<Rightarrow>i"  where
   "RawActs(F) \<equiv> cons(id(state), fst(snd(F)))"
 
 definition
   Acts :: "i\<Rightarrow>i"  where
   "Acts(F) \<equiv> RawActs(programify(F))"
 
 definition
   RawAllowedActs :: "i\<Rightarrow>i"  where
   "RawAllowedActs(F) \<equiv> cons(id(state), snd(snd(F)))"
 
 definition
   AllowedActs :: "i\<Rightarrow>i"  where
   "AllowedActs(F) \<equiv> RawAllowedActs(programify(F))"
 
 
 definition
   Allowed :: "i \<Rightarrow>i"  where
   "Allowed(F) \<equiv> {G \<in> program. Acts(G) \<subseteq> AllowedActs(F)}"
 
 definition
   initially :: "i\<Rightarrow>i"  where
   "initially(A) \<equiv> {F \<in> program. Init(F)\<subseteq>A}"
 
 definition "constrains" :: "[i, i] \<Rightarrow> i"  (infixl \<open>co\<close> 60)  where
   "A co B \<equiv> {F \<in> program. (\<forall>act \<in> Acts(F). act``A\<subseteq>B) \<and> st_set(A)}"
     \<comment> \<open>the condition \<^term>\<open>st_set(A)\<close> makes the definition slightly
          stronger than the HOL one\<close>
 
 definition unless :: "[i, i] \<Rightarrow> i"  (infixl \<open>unless\<close> 60)  where
   "A unless B \<equiv> (A - B) co (A \<union> B)"
 
 definition
   stable     :: "i\<Rightarrow>i"  where
    "stable(A) \<equiv> A co A"
 
 definition
   strongest_rhs :: "[i, i] \<Rightarrow> i"  where
   "strongest_rhs(F, A) \<equiv> \<Inter>({B \<in> Pow(state). F \<in> A co B})"
 
 definition
   invariant :: "i \<Rightarrow> i"  where
   "invariant(A) \<equiv> initially(A) \<inter> stable(A)"
 
   (* meta-function composition *)
 definition
   metacomp :: "[i\<Rightarrow>i, i\<Rightarrow>i] \<Rightarrow> (i\<Rightarrow>i)" (infixl \<open>comp\<close> 65)  where
   "f comp g \<equiv> \<lambda>x. f(g(x))"
 
 definition
   pg_compl :: "i\<Rightarrow>i"  where
   "pg_compl(X)\<equiv> program - X"
 
 text\<open>SKIP\<close>
 lemma SKIP_in_program [iff,TC]: "SKIP \<in> program"
 by (force simp add: SKIP_def program_def mk_program_def)
 
 
 subsection\<open>The function \<^term>\<open>programify\<close>, the coercion from anything to
  program\<close>
 
 lemma programify_program [simp]: "F \<in> program \<Longrightarrow> programify(F)=F"
 by (force simp add: programify_def) 
 
 lemma programify_in_program [iff,TC]: "programify(F) \<in> program"
 by (force simp add: programify_def) 
 
 text\<open>Collapsing rules: to remove programify from expressions\<close>
 lemma programify_idem [simp]: "programify(programify(F))=programify(F)"
 by (force simp add: programify_def) 
 
 lemma Init_programify [simp]: "Init(programify(F)) = Init(F)"
 by (simp add: Init_def)
 
 lemma Acts_programify [simp]: "Acts(programify(F)) = Acts(F)"
 by (simp add: Acts_def)
 
 lemma AllowedActs_programify [simp]:
      "AllowedActs(programify(F)) = AllowedActs(F)"
 by (simp add: AllowedActs_def)
 
 subsection\<open>The Inspectors for Programs\<close>
 
 lemma id_in_RawActs: "F \<in> program \<Longrightarrow>id(state) \<in> RawActs(F)"
 by (auto simp add: program_def RawActs_def)
 
 lemma id_in_Acts [iff,TC]: "id(state) \<in> Acts(F)"
 by (simp add: id_in_RawActs Acts_def)
 
 lemma id_in_RawAllowedActs: "F \<in> program \<Longrightarrow>id(state) \<in> RawAllowedActs(F)"
 by (auto simp add: program_def RawAllowedActs_def)
 
 lemma id_in_AllowedActs [iff,TC]: "id(state) \<in> AllowedActs(F)"
 by (simp add: id_in_RawAllowedActs AllowedActs_def)
 
 lemma cons_id_Acts [simp]: "cons(id(state), Acts(F)) = Acts(F)"
 by (simp add: cons_absorb)
 
 lemma cons_id_AllowedActs [simp]:
      "cons(id(state), AllowedActs(F)) = AllowedActs(F)"
 by (simp add: cons_absorb)
 
 
 subsection\<open>Types of the Inspectors\<close>
 
 lemma RawInit_type: "F \<in> program \<Longrightarrow> RawInit(F)\<subseteq>state"
 by (auto simp add: program_def RawInit_def)
 
 lemma RawActs_type: "F \<in> program \<Longrightarrow> RawActs(F)\<subseteq>Pow(state*state)"
 by (auto simp add: program_def RawActs_def)
 
 lemma RawAllowedActs_type:
      "F \<in> program \<Longrightarrow> RawAllowedActs(F)\<subseteq>Pow(state*state)"
 by (auto simp add: program_def RawAllowedActs_def)
 
 lemma Init_type: "Init(F)\<subseteq>state"
 by (simp add: RawInit_type Init_def)
 
 lemmas InitD = Init_type [THEN subsetD]
 
 lemma st_set_Init [iff]: "st_set(Init(F))"
-apply (unfold st_set_def)
+  unfolding st_set_def
 apply (rule Init_type)
 done
 
 lemma Acts_type: "Acts(F)\<subseteq>Pow(state*state)"
 by (simp add: RawActs_type Acts_def)
 
 lemma AllowedActs_type: "AllowedActs(F) \<subseteq> Pow(state*state)"
 by (simp add: RawAllowedActs_type AllowedActs_def)
 
 text\<open>Needed in Behaviors\<close>
 lemma ActsD: "\<lbrakk>act \<in> Acts(F); <s,s'> \<in> act\<rbrakk> \<Longrightarrow> s \<in> state \<and> s' \<in> state"
 by (blast dest: Acts_type [THEN subsetD])
 
 lemma AllowedActsD:
      "\<lbrakk>act \<in> AllowedActs(F); <s,s'> \<in> act\<rbrakk> \<Longrightarrow> s \<in> state \<and> s' \<in> state"
 by (blast dest: AllowedActs_type [THEN subsetD])
 
 subsection\<open>Simplification rules involving \<^term>\<open>state\<close>, \<^term>\<open>Init\<close>, 
   \<^term>\<open>Acts\<close>, and \<^term>\<open>AllowedActs\<close>\<close>
 
 text\<open>But are they really needed?\<close>
 
 lemma state_subset_is_Init_iff [iff]: "state \<subseteq> Init(F) \<longleftrightarrow> Init(F)=state"
 by (cut_tac F = F in Init_type, auto)
 
 lemma Pow_state_times_state_is_subset_Acts_iff [iff]:
      "Pow(state*state) \<subseteq> Acts(F) \<longleftrightarrow> Acts(F)=Pow(state*state)"
 by (cut_tac F = F in Acts_type, auto)
 
 lemma Pow_state_times_state_is_subset_AllowedActs_iff [iff]:
      "Pow(state*state) \<subseteq> AllowedActs(F) \<longleftrightarrow> AllowedActs(F)=Pow(state*state)"
 by (cut_tac F = F in AllowedActs_type, auto)
 
 subsubsection\<open>Eliminating \<open>\<inter> state\<close> from expressions\<close>
 
 lemma Init_Int_state [simp]: "Init(F) \<inter> state = Init(F)"
 by (cut_tac F = F in Init_type, blast)
 
 lemma state_Int_Init [simp]: "state \<inter> Init(F) = Init(F)"
 by (cut_tac F = F in Init_type, blast)
 
 lemma Acts_Int_Pow_state_times_state [simp]:
      "Acts(F) \<inter> Pow(state*state) = Acts(F)"
 by (cut_tac F = F in Acts_type, blast)
 
 lemma state_times_state_Int_Acts [simp]:
      "Pow(state*state) \<inter> Acts(F) = Acts(F)"
 by (cut_tac F = F in Acts_type, blast)
 
 lemma AllowedActs_Int_Pow_state_times_state [simp]:
      "AllowedActs(F) \<inter> Pow(state*state) = AllowedActs(F)"
 by (cut_tac F = F in AllowedActs_type, blast)
 
 lemma state_times_state_Int_AllowedActs [simp]:
      "Pow(state*state) \<inter> AllowedActs(F) = AllowedActs(F)"
 by (cut_tac F = F in AllowedActs_type, blast)
 
 
 subsubsection\<open>The Operator \<^term>\<open>mk_program\<close>\<close>
 
 lemma mk_program_in_program [iff,TC]:
      "mk_program(init, acts, allowed) \<in> program"
 by (auto simp add: mk_program_def program_def)
 
 lemma RawInit_eq [simp]:
      "RawInit(mk_program(init, acts, allowed)) = init \<inter> state"
 by (auto simp add: mk_program_def RawInit_def)
 
 lemma RawActs_eq [simp]:
      "RawActs(mk_program(init, acts, allowed)) = 
       cons(id(state), acts \<inter> Pow(state*state))"
 by (auto simp add: mk_program_def RawActs_def)
 
 lemma RawAllowedActs_eq [simp]:
      "RawAllowedActs(mk_program(init, acts, allowed)) =
       cons(id(state), allowed \<inter> Pow(state*state))"
 by (auto simp add: mk_program_def RawAllowedActs_def)
 
 lemma Init_eq [simp]: "Init(mk_program(init, acts, allowed)) = init \<inter> state"
 by (simp add: Init_def)
 
 lemma Acts_eq [simp]:
      "Acts(mk_program(init, acts, allowed)) = 
       cons(id(state), acts  \<inter> Pow(state*state))"
 by (simp add: Acts_def)
 
 lemma AllowedActs_eq [simp]:
      "AllowedActs(mk_program(init, acts, allowed))=
       cons(id(state), allowed \<inter> Pow(state*state))"
 by (simp add: AllowedActs_def)
 
 text\<open>Init, Acts, and AlowedActs  of SKIP\<close>
 
 lemma RawInit_SKIP [simp]: "RawInit(SKIP) = state"
 by (simp add: SKIP_def)
 
 lemma RawAllowedActs_SKIP [simp]: "RawAllowedActs(SKIP) = Pow(state*state)"
 by (force simp add: SKIP_def)
 
 lemma RawActs_SKIP [simp]: "RawActs(SKIP) = {id(state)}"
 by (force simp add: SKIP_def)
 
 lemma Init_SKIP [simp]: "Init(SKIP) = state"
 by (force simp add: SKIP_def)
 
 lemma Acts_SKIP [simp]: "Acts(SKIP) = {id(state)}"
 by (force simp add: SKIP_def)
 
 lemma AllowedActs_SKIP [simp]: "AllowedActs(SKIP) = Pow(state*state)"
 by (force simp add: SKIP_def)
 
 text\<open>Equality of UNITY programs\<close>
 
 lemma raw_surjective_mk_program:
      "F \<in> program \<Longrightarrow> mk_program(RawInit(F), RawActs(F), RawAllowedActs(F))=F"
 apply (auto simp add: program_def mk_program_def RawInit_def RawActs_def
             RawAllowedActs_def, blast+)
 done
 
 lemma surjective_mk_program [simp]:
   "mk_program(Init(F), Acts(F), AllowedActs(F)) = programify(F)"
 by (auto simp add: raw_surjective_mk_program Init_def Acts_def AllowedActs_def)
 
 lemma program_equalityI:                             
     "\<lbrakk>Init(F) = Init(G); Acts(F) = Acts(G);
        AllowedActs(F) = AllowedActs(G); F \<in> program; G \<in> program\<rbrakk> \<Longrightarrow> F = G"
 apply (subgoal_tac "programify(F) = programify(G)") 
 apply simp 
 apply (simp only: surjective_mk_program [symmetric]) 
 done
 
 lemma program_equalityE:                             
  "\<lbrakk>F = G;
     \<lbrakk>Init(F) = Init(G); Acts(F) = Acts(G); AllowedActs(F) = AllowedActs(G)\<rbrakk>
     \<Longrightarrow> P\<rbrakk> 
   \<Longrightarrow> P"
 by force
 
 
 lemma program_equality_iff:
     "\<lbrakk>F \<in> program; G \<in> program\<rbrakk> \<Longrightarrow>(F=G)  \<longleftrightarrow>
      (Init(F) = Init(G) \<and> Acts(F) = Acts(G) \<and> AllowedActs(F) = AllowedActs(G))"
 by (blast intro: program_equalityI program_equalityE)
 
 subsection\<open>These rules allow "lazy" definition expansion\<close>
 
 lemma def_prg_Init:
      "F \<equiv> mk_program (init,acts,allowed) \<Longrightarrow> Init(F) = init \<inter> state"
 by auto
 
 lemma def_prg_Acts:
      "F \<equiv> mk_program (init,acts,allowed)
       \<Longrightarrow> Acts(F) = cons(id(state), acts \<inter> Pow(state*state))"
 by auto
 
 lemma def_prg_AllowedActs:
      "F \<equiv> mk_program (init,acts,allowed)
       \<Longrightarrow> AllowedActs(F) = cons(id(state), allowed \<inter> Pow(state*state))"
 by auto
 
 lemma def_prg_simps:
     "\<lbrakk>F \<equiv> mk_program (init,acts,allowed)\<rbrakk>
      \<Longrightarrow> Init(F) = init \<inter> state \<and> 
          Acts(F) = cons(id(state), acts \<inter> Pow(state*state)) \<and>
          AllowedActs(F) = cons(id(state), allowed \<inter> Pow(state*state))"
 by auto
 
 
 text\<open>An action is expanded only if a pair of states is being tested against it\<close>
 lemma def_act_simp:
      "\<lbrakk>act \<equiv> {<s,s'> \<in> A*B. P(s, s')}\<rbrakk>
       \<Longrightarrow> (<s,s'> \<in> act) \<longleftrightarrow> (<s,s'> \<in> A*B \<and> P(s, s'))"
 by auto
 
 text\<open>A set is expanded only if an element is being tested against it\<close>
 lemma def_set_simp: "A \<equiv> B \<Longrightarrow> (x \<in> A) \<longleftrightarrow> (x \<in> B)"
 by auto
 
 
 subsection\<open>The Constrains Operator\<close>
 
 lemma constrains_type: "A co B \<subseteq> program"
 by (force simp add: constrains_def)
 
 lemma constrainsI:
     "\<lbrakk>(\<And>act s s'. \<lbrakk>act: Acts(F);  <s,s'> \<in> act; s \<in> A\<rbrakk> \<Longrightarrow> s' \<in> A');
         F \<in> program; st_set(A)\<rbrakk>  \<Longrightarrow> F \<in> A co A'"
 by (force simp add: constrains_def)
 
 lemma constrainsD:
    "F \<in> A co B \<Longrightarrow> \<forall>act \<in> Acts(F). act``A\<subseteq>B"
 by (force simp add: constrains_def)
 
 lemma constrainsD2: "F \<in> A co B \<Longrightarrow> F \<in> program \<and> st_set(A)"
 by (force simp add: constrains_def)
 
 lemma constrains_empty [iff]: "F \<in> 0 co B \<longleftrightarrow> F \<in> program"
 by (force simp add: constrains_def st_set_def)
 
 lemma constrains_empty2 [iff]: "(F \<in> A co 0) \<longleftrightarrow> (A=0 \<and> F \<in> program)"
 by (force simp add: constrains_def st_set_def)
 
 lemma constrains_state [iff]: "(F \<in> state co B) \<longleftrightarrow> (state\<subseteq>B \<and> F \<in> program)"
 apply (cut_tac F = F in Acts_type)
 apply (force simp add: constrains_def st_set_def)
 done
 
 lemma constrains_state2 [iff]: "F \<in> A co state \<longleftrightarrow> (F \<in> program \<and> st_set(A))"
 apply (cut_tac F = F in Acts_type)
 apply (force simp add: constrains_def st_set_def)
 done
 
 text\<open>monotonic in 2nd argument\<close>
 lemma constrains_weaken_R:
     "\<lbrakk>F \<in> A co A'; A'\<subseteq>B'\<rbrakk> \<Longrightarrow> F \<in> A co B'"
 apply (unfold constrains_def, blast)
 done
 
 text\<open>anti-monotonic in 1st argument\<close>
 lemma constrains_weaken_L:
     "\<lbrakk>F \<in> A co A'; B\<subseteq>A\<rbrakk> \<Longrightarrow> F \<in> B co A'"
 apply (unfold constrains_def st_set_def, blast)
 done
 
 lemma constrains_weaken:
    "\<lbrakk>F \<in> A co A'; B\<subseteq>A; A'\<subseteq>B'\<rbrakk> \<Longrightarrow> F \<in> B co B'"
 apply (drule constrains_weaken_R)
 apply (drule_tac [2] constrains_weaken_L, blast+)
 done
 
 
 subsection\<open>Constrains and Union\<close>
 
 lemma constrains_Un:
     "\<lbrakk>F \<in> A co A'; F \<in> B co B'\<rbrakk> \<Longrightarrow> F \<in> (A \<union> B) co (A' \<union> B')"
 by (auto simp add: constrains_def st_set_def, force)
 
 lemma constrains_UN:
      "\<lbrakk>\<And>i. i \<in> I \<Longrightarrow> F \<in> A(i) co A'(i); F \<in> program\<rbrakk>
       \<Longrightarrow> F \<in> (\<Union>i \<in> I. A(i)) co (\<Union>i \<in> I. A'(i))"
 by (force simp add: constrains_def st_set_def) 
 
 lemma constrains_Un_distrib:
      "(A \<union> B) co C = (A co C) \<inter> (B co C)"
 by (force simp add: constrains_def st_set_def)
 
 lemma constrains_UN_distrib:
    "i \<in> I \<Longrightarrow> (\<Union>i \<in> I. A(i)) co B = (\<Inter>i \<in> I. A(i) co B)"
 by (force simp add: constrains_def st_set_def)
 
 
 subsection\<open>Constrains and Intersection\<close>
 
 lemma constrains_Int_distrib: "C co (A \<inter> B) = (C co A) \<inter> (C co B)"
 by (force simp add: constrains_def st_set_def)
 
 lemma constrains_INT_distrib:
      "x \<in> I \<Longrightarrow> A co (\<Inter>i \<in> I. B(i)) = (\<Inter>i \<in> I. A co B(i))"
 by (force simp add: constrains_def st_set_def)
 
 lemma constrains_Int:
     "\<lbrakk>F \<in> A co A'; F \<in> B co B'\<rbrakk> \<Longrightarrow> F \<in> (A \<inter> B) co (A' \<inter> B')"
 by (force simp add: constrains_def st_set_def)
 
 lemma constrains_INT [rule_format]:
      "\<lbrakk>\<forall>i \<in> I. F \<in> A(i) co A'(i); F \<in> program\<rbrakk>
       \<Longrightarrow> F \<in> (\<Inter>i \<in> I. A(i)) co (\<Inter>i \<in> I. A'(i))"
 apply (case_tac "I=0")
  apply (simp add: Inter_def)
 apply (erule not_emptyE)
 apply (auto simp add: constrains_def st_set_def, blast) 
 apply (drule bspec, assumption, force) 
 done
 
 (* The rule below simulates the HOL's one for (\<Inter>z. A i) co (\<Inter>z. B i) *)
 lemma constrains_All:
 "\<lbrakk>\<forall>z. F:{s \<in> state. P(s, z)} co {s \<in> state. Q(s, z)}; F \<in> program\<rbrakk>\<Longrightarrow>
     F:{s \<in> state. \<forall>z. P(s, z)} co {s \<in> state. \<forall>z. Q(s, z)}"
 by (unfold constrains_def, blast)
 
 lemma constrains_imp_subset:
   "\<lbrakk>F \<in> A co A'\<rbrakk> \<Longrightarrow> A \<subseteq> A'"
 by (unfold constrains_def st_set_def, force)
 
 text\<open>The reasoning is by subsets since "co" refers to single actions
   only.  So this rule isn't that useful.\<close>
 
 lemma constrains_trans: "\<lbrakk>F \<in> A co B; F \<in> B co C\<rbrakk> \<Longrightarrow> F \<in> A co C"
 by (unfold constrains_def st_set_def, auto, blast)
 
 lemma constrains_cancel:
 "\<lbrakk>F \<in> A co (A' \<union> B); F \<in> B co B'\<rbrakk> \<Longrightarrow> F \<in> A co (A' \<union> B')"
 apply (drule_tac A = B in constrains_imp_subset)
 apply (blast intro: constrains_weaken_R)
 done
 
 
 subsection\<open>The Unless Operator\<close>
 
 lemma unless_type: "A unless B \<subseteq> program"
 by (force simp add: unless_def constrains_def) 
 
 lemma unlessI: "\<lbrakk>F \<in> (A-B) co (A \<union> B)\<rbrakk> \<Longrightarrow> F \<in> A unless B"
-apply (unfold unless_def)
+  unfolding unless_def
 apply (blast dest: constrainsD2)
 done
 
 lemma unlessD: "F :A unless B \<Longrightarrow> F \<in> (A-B) co (A \<union> B)"
 by (unfold unless_def, auto)
 
 
 subsection\<open>The Operator \<^term>\<open>initially\<close>\<close>
 
 lemma initially_type: "initially(A) \<subseteq> program"
 by (unfold initially_def, blast)
 
 lemma initiallyI: "\<lbrakk>F \<in> program; Init(F)\<subseteq>A\<rbrakk> \<Longrightarrow> F \<in> initially(A)"
 by (unfold initially_def, blast)
 
 lemma initiallyD: "F \<in> initially(A) \<Longrightarrow> Init(F)\<subseteq>A"
 by (unfold initially_def, blast)
 
 
 subsection\<open>The Operator \<^term>\<open>stable\<close>\<close>
 
 lemma stable_type: "stable(A)\<subseteq>program"
 by (unfold stable_def constrains_def, blast)
 
 lemma stableI: "F \<in> A co A \<Longrightarrow> F \<in> stable(A)"
 by (unfold stable_def, assumption)
 
 lemma stableD: "F \<in> stable(A) \<Longrightarrow> F \<in> A co A"
 by (unfold stable_def, assumption)
 
 lemma stableD2: "F \<in> stable(A) \<Longrightarrow> F \<in> program \<and> st_set(A)"
 by (unfold stable_def constrains_def, auto)
 
 lemma stable_state [simp]: "stable(state) = program"
 by (auto simp add: stable_def constrains_def dest: Acts_type [THEN subsetD])
 
 
 lemma stable_unless: "stable(A)= A unless 0"
 by (auto simp add: unless_def stable_def)
 
 
 subsection\<open>Union and Intersection with \<^term>\<open>stable\<close>\<close>
 
 lemma stable_Un:
     "\<lbrakk>F \<in> stable(A); F \<in> stable(A')\<rbrakk> \<Longrightarrow> F \<in> stable(A \<union> A')"
-apply (unfold stable_def)
+  unfolding stable_def
 apply (blast intro: constrains_Un)
 done
 
 lemma stable_UN:
      "\<lbrakk>\<And>i. i\<in>I \<Longrightarrow> F \<in> stable(A(i)); F \<in> program\<rbrakk> 
       \<Longrightarrow> F \<in> stable (\<Union>i \<in> I. A(i))"
-apply (unfold stable_def)
+  unfolding stable_def
 apply (blast intro: constrains_UN)
 done
 
 lemma stable_Int:
     "\<lbrakk>F \<in> stable(A);  F \<in> stable(A')\<rbrakk> \<Longrightarrow> F \<in> stable (A \<inter> A')"
-apply (unfold stable_def)
+  unfolding stable_def
 apply (blast intro: constrains_Int)
 done
 
 lemma stable_INT:
      "\<lbrakk>\<And>i. i \<in> I \<Longrightarrow> F \<in> stable(A(i)); F \<in> program\<rbrakk>
       \<Longrightarrow> F \<in> stable (\<Inter>i \<in> I. A(i))"
-apply (unfold stable_def)
+  unfolding stable_def
 apply (blast intro: constrains_INT)
 done
 
 lemma stable_All:
     "\<lbrakk>\<forall>z. F \<in> stable({s \<in> state. P(s, z)}); F \<in> program\<rbrakk>
      \<Longrightarrow> F \<in> stable({s \<in> state. \<forall>z. P(s, z)})"
-apply (unfold stable_def)
+  unfolding stable_def
 apply (rule constrains_All, auto)
 done
 
 lemma stable_constrains_Un:
      "\<lbrakk>F \<in> stable(C); F \<in> A co (C \<union> A')\<rbrakk> \<Longrightarrow> F \<in> (C \<union> A) co (C \<union> A')"
 apply (unfold stable_def constrains_def st_set_def, auto)
 apply (blast dest!: bspec)
 done
 
 lemma stable_constrains_Int:
      "\<lbrakk>F \<in> stable(C); F \<in>  (C \<inter> A) co A'\<rbrakk> \<Longrightarrow> F \<in> (C \<inter> A) co (C \<inter> A')"
 by (unfold stable_def constrains_def st_set_def, blast)
 
 (* \<lbrakk>F \<in> stable(C); F  \<in> (C \<inter> A) co A\<rbrakk> \<Longrightarrow> F \<in> stable(C \<inter> A) *)
 lemmas stable_constrains_stable = stable_constrains_Int [THEN stableI]
 
 subsection\<open>The Operator \<^term>\<open>invariant\<close>\<close>
 
 lemma invariant_type: "invariant(A) \<subseteq> program"
-apply (unfold invariant_def)
+  unfolding invariant_def
 apply (blast dest: stable_type [THEN subsetD])
 done
 
 lemma invariantI: "\<lbrakk>Init(F)\<subseteq>A;  F \<in> stable(A)\<rbrakk> \<Longrightarrow> F \<in> invariant(A)"
 apply (unfold invariant_def initially_def)
 apply (frule stable_type [THEN subsetD], auto)
 done
 
 lemma invariantD: "F \<in> invariant(A) \<Longrightarrow> Init(F)\<subseteq>A \<and> F \<in> stable(A)"
 by (unfold invariant_def initially_def, auto)
 
 lemma invariantD2: "F \<in> invariant(A) \<Longrightarrow> F \<in> program \<and> st_set(A)"
-apply (unfold invariant_def)
+  unfolding invariant_def
 apply (blast dest: stableD2)
 done
 
 text\<open>Could also say
       \<^term>\<open>invariant(A) \<inter> invariant(B) \<subseteq> invariant (A \<inter> B)\<close>\<close>
 lemma invariant_Int:
   "\<lbrakk>F \<in> invariant(A);  F \<in> invariant(B)\<rbrakk> \<Longrightarrow> F \<in> invariant(A \<inter> B)"
 apply (unfold invariant_def initially_def)
 apply (simp add: stable_Int, blast)
 done
 
 
 subsection\<open>The Elimination Theorem\<close>
 
 (** The "free" m has become universally quantified!
  Should the premise be \<And>m instead of \<forall>m ? Would make it harder
  to use in forward proof. **)
 
 text\<open>The general case is easier to prove than the special case!\<close>
 lemma "elimination":
     "\<lbrakk>\<forall>m \<in> M. F \<in> {s \<in> A. x(s) = m} co B(m); F \<in> program\<rbrakk>
      \<Longrightarrow> F \<in> {s \<in> A. x(s) \<in> M} co (\<Union>m \<in> M. B(m))"
 by (auto simp add: constrains_def st_set_def, blast)
 
 text\<open>As above, but for the special case of A=state\<close>
 lemma elimination2:
      "\<lbrakk>\<forall>m \<in> M. F \<in> {s \<in> state. x(s) = m} co B(m); F \<in> program\<rbrakk>
      \<Longrightarrow> F:{s \<in> state. x(s) \<in> M} co (\<Union>m \<in> M. B(m))"
 by (rule UNITY.elimination, auto)
 
 subsection\<open>The Operator \<^term>\<open>strongest_rhs\<close>\<close>
 
 lemma constrains_strongest_rhs:
     "\<lbrakk>F \<in> program; st_set(A)\<rbrakk> \<Longrightarrow> F \<in> A co (strongest_rhs(F,A))"
 by (auto simp add: constrains_def strongest_rhs_def st_set_def
               dest: Acts_type [THEN subsetD])
 
 lemma strongest_rhs_is_strongest:
      "\<lbrakk>F \<in> A co B; st_set(B)\<rbrakk> \<Longrightarrow> strongest_rhs(F,A) \<subseteq> B"
 by (auto simp add: constrains_def strongest_rhs_def st_set_def)
 
 ML \<open>
 fun simp_of_act def = def RS @{thm def_act_simp};
 fun simp_of_set def = def RS @{thm def_set_simp};
 \<close>
 
 end
diff --git a/src/ZF/UNITY/Union.thy b/src/ZF/UNITY/Union.thy
--- a/src/ZF/UNITY/Union.thy
+++ b/src/ZF/UNITY/Union.thy
@@ -1,576 +1,576 @@
 (*  Title:      ZF/UNITY/Union.thy
     Author:     Sidi O Ehmety, Computer Laboratory
     Copyright   2001  University of Cambridge
 
 Unions of programs
 
 Partly from Misra's Chapter 5 \<in> Asynchronous Compositions of Programs
 
 Theory ported form HOL..
 
 *)
 
 theory Union imports SubstAx FP
 begin
 
 definition
   (*FIXME: conjoin Init(F) \<inter> Init(G) \<noteq> 0 *)
   ok :: "[i, i] \<Rightarrow> o"     (infixl \<open>ok\<close> 65)  where
     "F ok G \<equiv> Acts(F) \<subseteq> AllowedActs(G) \<and>
                Acts(G) \<subseteq> AllowedActs(F)"
 
 definition
   (*FIXME: conjoin (\<Inter>i \<in> I. Init(F(i))) \<noteq> 0 *)
   OK  :: "[i, i\<Rightarrow>i] \<Rightarrow> o"  where
     "OK(I,F) \<equiv> (\<forall>i \<in> I. \<forall>j \<in> I-{i}. Acts(F(i)) \<subseteq> AllowedActs(F(j)))"
 
 definition
   JOIN  :: "[i, i\<Rightarrow>i] \<Rightarrow> i"  where
   "JOIN(I,F) \<equiv> if I = 0 then SKIP else
                  mk_program(\<Inter>i \<in> I. Init(F(i)), \<Union>i \<in> I. Acts(F(i)),
                  \<Inter>i \<in> I. AllowedActs(F(i)))"
 
 definition
   Join :: "[i, i] \<Rightarrow> i"  (infixl \<open>\<squnion>\<close> 65)  where
   "F \<squnion> G \<equiv> mk_program (Init(F) \<inter> Init(G), Acts(F) \<union> Acts(G),
                                 AllowedActs(F) \<inter> AllowedActs(G))"
 definition
   (*Characterizes safety properties.  Used with specifying AllowedActs*)
   safety_prop :: "i \<Rightarrow> o"  where
   "safety_prop(X) \<equiv> X\<subseteq>program \<and>
       SKIP \<in> X \<and> (\<forall>G \<in> program. Acts(G) \<subseteq> (\<Union>F \<in> X. Acts(F)) \<longrightarrow> G \<in> X)"
 
 syntax
   "_JOIN1"  :: "[pttrns, i] \<Rightarrow> i"     (\<open>(3\<Squnion>_./ _)\<close> 10)
   "_JOIN"   :: "[pttrn, i, i] \<Rightarrow> i"   (\<open>(3\<Squnion>_ \<in> _./ _)\<close> 10)
 
 translations
   "\<Squnion>x \<in> A. B" == "CONST JOIN(A, (\<lambda>x. B))"
   "\<Squnion>x y. B"   == "\<Squnion>x. \<Squnion>y. B"
   "\<Squnion>x. B"     == "CONST JOIN(CONST state, (\<lambda>x. B))"
 
 
 subsection\<open>SKIP\<close>
 
 lemma reachable_SKIP [simp]: "reachable(SKIP) = state"
 by (force elim: reachable.induct intro: reachable.intros)
 
 text\<open>Elimination programify from ok and \<squnion>\<close>
 
 lemma ok_programify_left [iff]: "programify(F) ok G \<longleftrightarrow> F ok G"
 by (simp add: ok_def)
 
 lemma ok_programify_right [iff]: "F ok programify(G) \<longleftrightarrow> F ok G"
 by (simp add: ok_def)
 
 lemma Join_programify_left [simp]: "programify(F) \<squnion> G = F \<squnion> G"
 by (simp add: Join_def)
 
 lemma Join_programify_right [simp]: "F \<squnion> programify(G) = F \<squnion> G"
 by (simp add: Join_def)
 
 subsection\<open>SKIP and safety properties\<close>
 
 lemma SKIP_in_constrains_iff [iff]: "(SKIP \<in> A co B) \<longleftrightarrow> (A\<subseteq>B \<and> st_set(A))"
 by (unfold constrains_def st_set_def, auto)
 
 lemma SKIP_in_Constrains_iff [iff]: "(SKIP \<in> A Co B)\<longleftrightarrow> (state \<inter> A\<subseteq>B)"
 by (unfold Constrains_def, auto)
 
 lemma SKIP_in_stable [iff]: "SKIP \<in> stable(A) \<longleftrightarrow> st_set(A)"
 by (auto simp add: stable_def)
 
 lemma SKIP_in_Stable [iff]: "SKIP \<in> Stable(A)"
 by (unfold Stable_def, auto)
 
 subsection\<open>Join and JOIN types\<close>
 
 lemma Join_in_program [iff,TC]: "F \<squnion> G \<in> program"
 by (unfold Join_def, auto)
 
 lemma JOIN_in_program [iff,TC]: "JOIN(I,F) \<in> program"
 by (unfold JOIN_def, auto)
 
 subsection\<open>Init, Acts, and AllowedActs of Join and JOIN\<close>
 lemma Init_Join [simp]: "Init(F \<squnion> G) = Init(F) \<inter> Init(G)"
 by (simp add: Int_assoc Join_def)
 
 lemma Acts_Join [simp]: "Acts(F \<squnion> G) = Acts(F) \<union> Acts(G)"
 by (simp add: Int_Un_distrib2 cons_absorb Join_def)
 
 lemma AllowedActs_Join [simp]: "AllowedActs(F \<squnion> G) =
   AllowedActs(F) \<inter> AllowedActs(G)"
 apply (simp add: Int_assoc cons_absorb Join_def)
 done
 
 subsection\<open>Join's algebraic laws\<close>
 
 lemma Join_commute: "F \<squnion> G = G \<squnion> F"
 by (simp add: Join_def Un_commute Int_commute)
 
 lemma Join_left_commute: "A \<squnion> (B \<squnion> C) = B \<squnion> (A \<squnion> C)"
 apply (simp add: Join_def Int_Un_distrib2 cons_absorb)
 apply (simp add: Un_ac Int_ac Int_Un_distrib2 cons_absorb)
 done
 
 lemma Join_assoc: "(F \<squnion> G) \<squnion> H = F \<squnion> (G \<squnion> H)"
 by (simp add: Un_ac Join_def cons_absorb Int_assoc Int_Un_distrib2)
 
 subsection\<open>Needed below\<close>
 lemma cons_id [simp]: "cons(id(state), Pow(state * state)) = Pow(state*state)"
 by auto
 
 lemma Join_SKIP_left [simp]: "SKIP \<squnion> F = programify(F)"
 apply (unfold Join_def SKIP_def)
 apply (auto simp add: Int_absorb cons_eq)
 done
 
 lemma Join_SKIP_right [simp]: "F \<squnion> SKIP =  programify(F)"
 apply (subst Join_commute)
 apply (simp add: Join_SKIP_left)
 done
 
 lemma Join_absorb [simp]: "F \<squnion> F = programify(F)"
 by (rule program_equalityI, auto)
 
 lemma Join_left_absorb: "F \<squnion> (F \<squnion> G) = F \<squnion> G"
 by (simp add: Join_assoc [symmetric])
 
 subsection\<open>Join is an AC-operator\<close>
 lemmas Join_ac = Join_assoc Join_left_absorb Join_commute Join_left_commute
 
 subsection\<open>Eliminating programify form JOIN and OK expressions\<close>
 
 lemma OK_programify [iff]: "OK(I, \<lambda>x. programify(F(x))) \<longleftrightarrow> OK(I, F)"
 by (simp add: OK_def)
 
 lemma JOIN_programify [iff]: "JOIN(I, \<lambda>x. programify(F(x))) = JOIN(I, F)"
 by (simp add: JOIN_def)
 
 
 subsection\<open>JOIN\<close>
 
 lemma JOIN_empty [simp]: "JOIN(0, F) = SKIP"
 by (unfold JOIN_def, auto)
 
 lemma Init_JOIN [simp]:
      "Init(\<Squnion>i \<in> I. F(i)) = (if I=0 then state else (\<Inter>i \<in> I. Init(F(i))))"
 by (simp add: JOIN_def INT_extend_simps del: INT_simps)
 
 lemma Acts_JOIN [simp]:
      "Acts(JOIN(I,F)) = cons(id(state), \<Union>i \<in> I.  Acts(F(i)))"
-apply (unfold JOIN_def)
+  unfolding JOIN_def
 apply (auto simp del: INT_simps UN_simps)
 apply (rule equalityI)
 apply (auto dest: Acts_type [THEN subsetD])
 done
 
 lemma AllowedActs_JOIN [simp]:
      "AllowedActs(\<Squnion>i \<in> I. F(i)) =
       (if I=0 then Pow(state*state) else (\<Inter>i \<in> I. AllowedActs(F(i))))"
 apply (unfold JOIN_def, auto)
 apply (rule equalityI)
 apply (auto elim!: not_emptyE dest: AllowedActs_type [THEN subsetD])
 done
 
 lemma JOIN_cons [simp]: "(\<Squnion>i \<in> cons(a,I). F(i)) = F(a) \<squnion> (\<Squnion>i \<in> I. F(i))"
 by (rule program_equalityI, auto)
 
 lemma JOIN_cong [cong]:
     "\<lbrakk>I=J;  \<And>i. i \<in> J \<Longrightarrow> F(i) = G(i)\<rbrakk> \<Longrightarrow>
      (\<Squnion>i \<in> I. F(i)) = (\<Squnion>i \<in> J. G(i))"
 by (simp add: JOIN_def)
 
 
 
 subsection\<open>JOIN laws\<close>
 lemma JOIN_absorb: "k \<in> I \<Longrightarrow>F(k) \<squnion> (\<Squnion>i \<in> I. F(i)) = (\<Squnion>i \<in> I. F(i))"
 apply (subst JOIN_cons [symmetric])
 apply (auto simp add: cons_absorb)
 done
 
 lemma JOIN_Un: "(\<Squnion>i \<in> I \<union> J. F(i)) = ((\<Squnion>i \<in> I. F(i)) \<squnion> (\<Squnion>i \<in> J. F(i)))"
 apply (rule program_equalityI)
 apply (simp_all add: UN_Un INT_Un)
 apply (simp_all del: INT_simps add: INT_extend_simps, blast)
 done
 
 lemma JOIN_constant: "(\<Squnion>i \<in> I. c) = (if I=0 then SKIP else programify(c))"
 by (rule program_equalityI, auto)
 
 lemma JOIN_Join_distrib:
      "(\<Squnion>i \<in> I. F(i) \<squnion> G(i)) = (\<Squnion>i \<in> I. F(i))  \<squnion>  (\<Squnion>i \<in> I. G(i))"
 apply (rule program_equalityI)
 apply (simp_all add: INT_Int_distrib, blast)
 done
 
 lemma JOIN_Join_miniscope: "(\<Squnion>i \<in> I. F(i) \<squnion> G) = ((\<Squnion>i \<in> I. F(i) \<squnion> G))"
 by (simp add: JOIN_Join_distrib JOIN_constant)
 
 text\<open>Used to prove guarantees_JOIN_I\<close>
 lemma JOIN_Join_diff: "i \<in> I\<Longrightarrow>F(i) \<squnion> JOIN(I - {i}, F) = JOIN(I, F)"
 apply (rule program_equalityI)
 apply (auto elim!: not_emptyE)
 done
 
 subsection\<open>Safety: co, stable, FP\<close>
 
 
 (*Fails if I=0 because it collapses to SKIP \<in> A co B, i.e. to A\<subseteq>B.  So an
   alternative precondition is A\<subseteq>B, but most proofs using this rule require
   I to be nonempty for other reasons anyway.*)
 
 lemma JOIN_constrains:
  "i \<in> I\<Longrightarrow>(\<Squnion>i \<in> I. F(i)) \<in> A co B \<longleftrightarrow> (\<forall>i \<in> I. programify(F(i)) \<in> A co B)"
 
 apply (unfold constrains_def JOIN_def st_set_def, auto)
 prefer 2 apply blast
 apply (rename_tac j act y z)
 apply (cut_tac F = "F (j) " in Acts_type)
 apply (drule_tac x = act in bspec, auto)
 done
 
 lemma Join_constrains [iff]:
      "(F \<squnion> G \<in> A co B) \<longleftrightarrow> (programify(F) \<in> A co B \<and> programify(G) \<in> A co B)"
 by (auto simp add: constrains_def)
 
 lemma Join_unless [iff]:
      "(F \<squnion> G \<in> A unless B) \<longleftrightarrow>
     (programify(F) \<in> A unless B \<and> programify(G) \<in> A unless B)"
 by (simp add: Join_constrains unless_def)
 
 
 (*Analogous weak versions FAIL; see Misra [1994] 5.4.1, Substitution Axiom.
   reachable (F \<squnion> G) could be much bigger than reachable F, reachable G
 *)
 
 lemma Join_constrains_weaken:
      "\<lbrakk>F \<in> A co A';  G \<in> B co B'\<rbrakk>
       \<Longrightarrow> F \<squnion> G \<in> (A \<inter> B) co (A' \<union> B')"
 apply (subgoal_tac "st_set (A) \<and> st_set (B) \<and> F \<in> program \<and> G \<in> program")
 prefer 2 apply (blast dest: constrainsD2, simp)
 apply (blast intro: constrains_weaken)
 done
 
 (*If I=0, it degenerates to SKIP \<in> state co 0, which is false.*)
 lemma JOIN_constrains_weaken:
   assumes major: "(\<And>i. i \<in> I \<Longrightarrow> F(i) \<in> A(i) co A'(i))"
       and minor: "i \<in> I"
   shows "(\<Squnion>i \<in> I. F(i)) \<in> (\<Inter>i \<in> I. A(i)) co (\<Union>i \<in> I. A'(i))"
 apply (cut_tac minor)
 apply (simp (no_asm_simp) add: JOIN_constrains)
 apply clarify
 apply (rename_tac "j")
 apply (frule_tac i = j in major)
 apply (frule constrainsD2, simp)
 apply (blast intro: constrains_weaken)
 done
 
 lemma JOIN_stable:
      "(\<Squnion>i \<in> I. F(i)) \<in>  stable(A) \<longleftrightarrow> ((\<forall>i \<in> I. programify(F(i)) \<in> stable(A)) \<and> st_set(A))"
 apply (auto simp add: stable_def constrains_def JOIN_def)
 apply (cut_tac F = "F (i) " in Acts_type)
 apply (drule_tac x = act in bspec, auto)
 done
 
 lemma initially_JOIN_I:
   assumes major: "(\<And>i. i \<in> I \<Longrightarrow>F(i) \<in> initially(A))"
       and minor: "i \<in> I"
   shows  "(\<Squnion>i \<in> I. F(i)) \<in> initially(A)"
 apply (cut_tac minor)
 apply (auto elim!: not_emptyE simp add: Inter_iff initially_def)
 apply (frule_tac i = x in major)
 apply (auto simp add: initially_def)
 done
 
 lemma invariant_JOIN_I:
   assumes major: "(\<And>i. i \<in> I \<Longrightarrow> F(i) \<in> invariant(A))"
       and minor: "i \<in> I"
   shows "(\<Squnion>i \<in> I. F(i)) \<in> invariant(A)"
 apply (cut_tac minor)
 apply (auto intro!: initially_JOIN_I dest: major simp add: invariant_def JOIN_stable)
 apply (erule_tac V = "i \<in> I" in thin_rl)
 apply (frule major)
 apply (drule_tac [2] major)
 apply (auto simp add: invariant_def)
 apply (frule stableD2, force)+
 done
 
 lemma Join_stable [iff]:
      " (F \<squnion> G \<in> stable(A)) \<longleftrightarrow>
       (programify(F) \<in> stable(A) \<and> programify(G) \<in>  stable(A))"
 by (simp add: stable_def)
 
 lemma initially_JoinI [intro!]:
      "\<lbrakk>F \<in> initially(A); G \<in> initially(A)\<rbrakk> \<Longrightarrow> F \<squnion> G \<in> initially(A)"
 by (unfold initially_def, auto)
 
 lemma invariant_JoinI:
      "\<lbrakk>F \<in> invariant(A); G \<in> invariant(A)\<rbrakk>
       \<Longrightarrow> F \<squnion> G \<in> invariant(A)"
 apply (subgoal_tac "F \<in> program\<and>G \<in> program")
 prefer 2 apply (blast dest: invariantD2)
 apply (simp add: invariant_def)
 apply (auto intro: Join_in_program)
 done
 
 
 (* Fails if I=0 because \<Inter>i \<in> 0. A(i) = 0 *)
 lemma FP_JOIN: "i \<in> I \<Longrightarrow> FP(\<Squnion>i \<in> I. F(i)) = (\<Inter>i \<in> I. FP (programify(F(i))))"
 by (auto simp add: FP_def Inter_def st_set_def JOIN_stable)
 
 subsection\<open>Progress: transient, ensures\<close>
 
 lemma JOIN_transient:
      "i \<in> I \<Longrightarrow>
       (\<Squnion>i \<in> I. F(i)) \<in> transient(A) \<longleftrightarrow> (\<exists>i \<in> I. programify(F(i)) \<in> transient(A))"
 apply (auto simp add: transient_def JOIN_def)
-apply (unfold st_set_def)
+  unfolding st_set_def
 apply (drule_tac [2] x = act in bspec)
 apply (auto dest: Acts_type [THEN subsetD])
 done
 
 lemma Join_transient [iff]:
      "F \<squnion> G \<in> transient(A) \<longleftrightarrow>
       (programify(F) \<in> transient(A) | programify(G) \<in> transient(A))"
 apply (auto simp add: transient_def Join_def Int_Un_distrib2)
 done
 
 lemma Join_transient_I1: "F \<in> transient(A) \<Longrightarrow> F \<squnion> G \<in> transient(A)"
 by (simp add: Join_transient transientD2)
 
 
 lemma Join_transient_I2: "G \<in> transient(A) \<Longrightarrow> F \<squnion> G \<in> transient(A)"
 by (simp add: Join_transient transientD2)
 
 (*If I=0 it degenerates to (SKIP \<in> A ensures B) = False, i.e. to \<not>(A\<subseteq>B) *)
 lemma JOIN_ensures:
      "i \<in> I \<Longrightarrow>
       (\<Squnion>i \<in> I. F(i)) \<in> A ensures B \<longleftrightarrow>
       ((\<forall>i \<in> I. programify(F(i)) \<in> (A-B) co (A \<union> B)) \<and>
       (\<exists>i \<in> I. programify(F(i)) \<in> A ensures B))"
 by (auto simp add: ensures_def JOIN_constrains JOIN_transient)
 
 
 lemma Join_ensures:
      "F \<squnion> G \<in> A ensures B  \<longleftrightarrow>
       (programify(F) \<in> (A-B) co (A \<union> B) \<and> programify(G) \<in> (A-B) co (A \<union> B) \<and>
        (programify(F) \<in>  transient (A-B) | programify(G) \<in> transient (A-B)))"
 
-apply (unfold ensures_def)
+  unfolding ensures_def
 apply (auto simp add: Join_transient)
 done
 
 lemma stable_Join_constrains:
     "\<lbrakk>F \<in> stable(A);  G \<in> A co A'\<rbrakk>
      \<Longrightarrow> F \<squnion> G \<in> A co A'"
 apply (unfold stable_def constrains_def Join_def st_set_def)
 apply (cut_tac F = F in Acts_type)
 apply (cut_tac F = G in Acts_type, force)
 done
 
 (*Premise for G cannot use Always because  F \<in> Stable A  is
    weaker than G \<in> stable A *)
 lemma stable_Join_Always1:
      "\<lbrakk>F \<in> stable(A);  G \<in> invariant(A)\<rbrakk> \<Longrightarrow> F \<squnion> G \<in> Always(A)"
 apply (subgoal_tac "F \<in> program \<and> G \<in> program \<and> st_set (A) ")
 prefer 2 apply (blast dest: invariantD2 stableD2)
 apply (simp add: Always_def invariant_def initially_def Stable_eq_stable)
 apply (force intro: stable_Int)
 done
 
 (*As above, but exchanging the roles of F and G*)
 lemma stable_Join_Always2:
      "\<lbrakk>F \<in> invariant(A);  G \<in> stable(A)\<rbrakk> \<Longrightarrow> F \<squnion> G \<in> Always(A)"
 apply (subst Join_commute)
 apply (blast intro: stable_Join_Always1)
 done
 
 
 
 lemma stable_Join_ensures1:
      "\<lbrakk>F \<in> stable(A);  G \<in> A ensures B\<rbrakk> \<Longrightarrow> F \<squnion> G \<in> A ensures B"
 apply (subgoal_tac "F \<in> program \<and> G \<in> program \<and> st_set (A) ")
 prefer 2 apply (blast dest: stableD2 ensures_type [THEN subsetD])
 apply (simp (no_asm_simp) add: Join_ensures)
 apply (simp add: stable_def ensures_def)
 apply (erule constrains_weaken, auto)
 done
 
 
 (*As above, but exchanging the roles of F and G*)
 lemma stable_Join_ensures2:
      "\<lbrakk>F \<in> A ensures B;  G \<in> stable(A)\<rbrakk> \<Longrightarrow> F \<squnion> G \<in> A ensures B"
 apply (subst Join_commute)
 apply (blast intro: stable_Join_ensures1)
 done
 
 subsection\<open>The ok and OK relations\<close>
 
 lemma ok_SKIP1 [iff]: "SKIP ok F"
 by (auto dest: Acts_type [THEN subsetD] simp add: ok_def)
 
 lemma ok_SKIP2 [iff]: "F ok SKIP"
 by (auto dest: Acts_type [THEN subsetD] simp add: ok_def)
 
 lemma ok_Join_commute:
      "(F ok G \<and> (F \<squnion> G) ok H) \<longleftrightarrow> (G ok H \<and> F ok (G \<squnion> H))"
 by (auto simp add: ok_def)
 
 lemma ok_commute: "(F ok G) \<longleftrightarrow>(G ok F)"
 by (auto simp add: ok_def)
 
 lemmas ok_sym = ok_commute [THEN iffD1]
 
 lemma ok_iff_OK: "OK({\<langle>0,F\<rangle>,\<langle>1,G\<rangle>,\<langle>2,H\<rangle>}, snd) \<longleftrightarrow> (F ok G \<and> (F \<squnion> G) ok H)"
 by (simp add: ok_def Join_def OK_def Int_assoc cons_absorb
                  Int_Un_distrib2 Ball_def,  safe, force+)
 
 lemma ok_Join_iff1 [iff]: "F ok (G \<squnion> H) \<longleftrightarrow> (F ok G \<and> F ok H)"
 by (auto simp add: ok_def)
 
 lemma ok_Join_iff2 [iff]: "(G \<squnion> H) ok F \<longleftrightarrow> (G ok F \<and> H ok F)"
 by (auto simp add: ok_def)
 
 (*useful?  Not with the previous two around*)
 lemma ok_Join_commute_I: "\<lbrakk>F ok G; (F \<squnion> G) ok H\<rbrakk> \<Longrightarrow> F ok (G \<squnion> H)"
 by (auto simp add: ok_def)
 
 lemma ok_JOIN_iff1 [iff]: "F ok JOIN(I,G) \<longleftrightarrow> (\<forall>i \<in> I. F ok G(i))"
 by (force dest: Acts_type [THEN subsetD] elim!: not_emptyE simp add: ok_def)
 
 lemma ok_JOIN_iff2 [iff]: "JOIN(I,G) ok F   \<longleftrightarrow>  (\<forall>i \<in> I. G(i) ok F)"
 apply (auto elim!: not_emptyE simp add: ok_def)
 apply (blast dest: Acts_type [THEN subsetD])
 done
 
 lemma OK_iff_ok: "OK(I,F) \<longleftrightarrow> (\<forall>i \<in> I. \<forall>j \<in> I-{i}. F(i) ok (F(j)))"
 by (auto simp add: ok_def OK_def)
 
 lemma OK_imp_ok: "\<lbrakk>OK(I,F); i \<in> I; j \<in> I; i\<noteq>j\<rbrakk> \<Longrightarrow> F(i) ok F(j)"
 by (auto simp add: OK_iff_ok)
 
 
 lemma OK_0 [iff]: "OK(0,F)"
 by (simp add: OK_def)
 
 lemma OK_cons_iff:
      "OK(cons(i, I), F) \<longleftrightarrow>
       (i \<in> I \<and> OK(I, F)) | (i\<notin>I \<and> OK(I, F) \<and> F(i) ok JOIN(I,F))"
 apply (simp add: OK_iff_ok)
 apply (blast intro: ok_sym)
 done
 
 
 subsection\<open>Allowed\<close>
 
 lemma Allowed_SKIP [simp]: "Allowed(SKIP) = program"
 by (auto dest: Acts_type [THEN subsetD] simp add: Allowed_def)
 
 lemma Allowed_Join [simp]:
      "Allowed(F \<squnion> G) =
    Allowed(programify(F)) \<inter> Allowed(programify(G))"
 apply (auto simp add: Allowed_def)
 done
 
 lemma Allowed_JOIN [simp]:
      "i \<in> I \<Longrightarrow>
    Allowed(JOIN(I,F)) = (\<Inter>i \<in> I. Allowed(programify(F(i))))"
 apply (auto simp add: Allowed_def, blast)
 done
 
 lemma ok_iff_Allowed:
      "F ok G \<longleftrightarrow> (programify(F) \<in> Allowed(programify(G)) \<and>
    programify(G) \<in> Allowed(programify(F)))"
 by (simp add: ok_def Allowed_def)
 
 
 lemma OK_iff_Allowed:
      "OK(I,F) \<longleftrightarrow>
   (\<forall>i \<in> I. \<forall>j \<in> I-{i}. programify(F(i)) \<in> Allowed(programify(F(j))))"
 apply (auto simp add: OK_iff_ok ok_iff_Allowed)
 done
 
 subsection\<open>safety_prop, for reasoning about given instances of "ok"\<close>
 
 lemma safety_prop_Acts_iff:
      "safety_prop(X) \<Longrightarrow> (Acts(G) \<subseteq> cons(id(state), (\<Union>F \<in> X. Acts(F)))) \<longleftrightarrow> (programify(G) \<in> X)"
 apply (simp (no_asm_use) add: safety_prop_def)
 apply clarify
 apply (case_tac "G \<in> program", simp_all, blast, safe)
 prefer 2 apply force
 apply (force simp add: programify_def)
 done
 
 lemma safety_prop_AllowedActs_iff_Allowed:
      "safety_prop(X) \<Longrightarrow>
   (\<Union>G \<in> X. Acts(G)) \<subseteq> AllowedActs(F) \<longleftrightarrow> (X \<subseteq> Allowed(programify(F)))"
 apply (simp add: Allowed_def safety_prop_Acts_iff [THEN iff_sym]
                  safety_prop_def, blast)
 done
 
 
 lemma Allowed_eq:
      "safety_prop(X) \<Longrightarrow> Allowed(mk_program(init, acts, \<Union>F \<in> X. Acts(F))) = X"
 apply (subgoal_tac "cons (id (state), \<Union>(RepFun (X, Acts)) \<inter> Pow (state * state)) = \<Union>(RepFun (X, Acts))")
 apply (rule_tac [2] equalityI)
   apply (simp del: UN_simps add: Allowed_def safety_prop_Acts_iff safety_prop_def, auto)
 apply (force dest: Acts_type [THEN subsetD] simp add: safety_prop_def)+
 done
 
 lemma def_prg_Allowed:
      "\<lbrakk>F \<equiv> mk_program (init, acts, \<Union>F \<in> X. Acts(F)); safety_prop(X)\<rbrakk>
       \<Longrightarrow> Allowed(F) = X"
 by (simp add: Allowed_eq)
 
 (*For safety_prop to hold, the property must be satisfiable!*)
 lemma safety_prop_constrains [iff]:
      "safety_prop(A co B) \<longleftrightarrow> (A \<subseteq> B \<and> st_set(A))"
 by (simp add: safety_prop_def constrains_def st_set_def, blast)
 
 (* To be used with resolution *)
 lemma safety_prop_constrainsI [iff]:
      "\<lbrakk>A\<subseteq>B; st_set(A)\<rbrakk> \<Longrightarrow>safety_prop(A co B)"
 by auto
 
 lemma safety_prop_stable [iff]: "safety_prop(stable(A)) \<longleftrightarrow> st_set(A)"
 by (simp add: stable_def)
 
 lemma safety_prop_stableI: "st_set(A) \<Longrightarrow> safety_prop(stable(A))"
 by auto
 
 lemma safety_prop_Int [simp]:
      "\<lbrakk>safety_prop(X) ; safety_prop(Y)\<rbrakk> \<Longrightarrow> safety_prop(X \<inter> Y)"
 apply (simp add: safety_prop_def, safe, blast)
 apply (drule_tac [2] B = "\<Union>(RepFun (X \<inter> Y, Acts))" and C = "\<Union>(RepFun (Y, Acts))" in subset_trans)
 apply (drule_tac B = "\<Union>(RepFun (X \<inter> Y, Acts))" and C = "\<Union>(RepFun (X, Acts))" in subset_trans)
 apply blast+
 done
 
 (* If I=0 the conclusion becomes safety_prop(0) which is false *)
 lemma safety_prop_Inter:
   assumes major: "(\<And>i. i \<in> I \<Longrightarrow>safety_prop(X(i)))"
       and minor: "i \<in> I"
   shows "safety_prop(\<Inter>i \<in> I. X(i))"
 apply (simp add: safety_prop_def)
 apply (cut_tac minor, safe)
 apply (simp (no_asm_use) add: Inter_iff)
 apply clarify
 apply (frule major)
 apply (drule_tac [2] i = xa in major)
 apply (frule_tac [4] i = xa in major)
 apply (auto simp add: safety_prop_def)
 apply (drule_tac B = "\<Union>(RepFun (\<Inter>(RepFun (I, X)), Acts))" and C = "\<Union>(RepFun (X (xa), Acts))" in subset_trans)
 apply blast+
 done
 
 lemma def_UNION_ok_iff:
 "\<lbrakk>F \<equiv> mk_program(init,acts, \<Union>G \<in> X. Acts(G)); safety_prop(X)\<rbrakk>
       \<Longrightarrow> F ok G \<longleftrightarrow> (programify(G) \<in> X \<and> acts \<inter> Pow(state*state) \<subseteq> AllowedActs(G))"
-apply (unfold ok_def)
+  unfolding ok_def
 apply (drule_tac G = G in safety_prop_Acts_iff)
 apply (cut_tac F = G in AllowedActs_type)
 apply (cut_tac F = G in Acts_type, auto)
 done
 
 end
diff --git a/src/ZF/UNITY/WFair.thy b/src/ZF/UNITY/WFair.thy
--- a/src/ZF/UNITY/WFair.thy
+++ b/src/ZF/UNITY/WFair.thy
@@ -1,707 +1,707 @@
 (*  Title:      ZF/UNITY/WFair.thy
     Author:     Sidi Ehmety, Computer Laboratory
     Copyright   1998  University of Cambridge
 *)
 
 section\<open>Progress under Weak Fairness\<close>
 
 theory WFair
 imports UNITY ZFC
 begin
 
 text\<open>This theory defines the operators transient, ensures and leadsTo,
 assuming weak fairness. From Misra, "A Logic for Concurrent Programming",
 1994.\<close>
 
 definition
   (* This definition specifies weak fairness.  The rest of the theory
     is generic to all forms of fairness.*)
   transient :: "i\<Rightarrow>i"  where
   "transient(A) \<equiv>{F \<in> program. (\<exists>act\<in>Acts(F). A<=domain(act) \<and>
                                act``A \<subseteq> state-A) \<and> st_set(A)}"
 
 definition
   ensures :: "[i,i] \<Rightarrow> i"       (infixl \<open>ensures\<close> 60)  where
   "A ensures B \<equiv> ((A-B) co (A \<union> B)) \<inter> transient(A-B)"
 
 consts
 
   (*LEADS-TO constant for the inductive definition*)
   leads :: "[i, i]\<Rightarrow>i"
 
 inductive
   domains
      "leads(D, F)" \<subseteq> "Pow(D)*Pow(D)"
   intros
     Basis:  "\<lbrakk>F \<in> A ensures B;  A \<in> Pow(D); B \<in> Pow(D)\<rbrakk> \<Longrightarrow> \<langle>A,B\<rangle>:leads(D, F)"
     Trans:  "\<lbrakk>\<langle>A,B\<rangle> \<in> leads(D, F); \<langle>B,C\<rangle> \<in> leads(D, F)\<rbrakk> \<Longrightarrow>  \<langle>A,C\<rangle>:leads(D, F)"
     Union:   "\<lbrakk>S \<in> Pow({A \<in> S. \<langle>A, B\<rangle>:leads(D, F)}); B \<in> Pow(D); S \<in> Pow(Pow(D))\<rbrakk> \<Longrightarrow>
               <\<Union>(S),B>:leads(D, F)"
 
   monos        Pow_mono
   type_intros  Union_Pow_iff [THEN iffD2] UnionI PowI
 
 definition
   (* The Visible version of the LEADS-TO relation*)
   leadsTo :: "[i, i] \<Rightarrow> i"       (infixl \<open>\<longmapsto>\<close> 60)  where
   "A \<longmapsto> B \<equiv> {F \<in> program. \<langle>A,B\<rangle>:leads(state, F)}"
 
 definition
   (* wlt(F, B) is the largest set that leads to B*)
   wlt :: "[i, i] \<Rightarrow> i"  where
     "wlt(F, B) \<equiv> \<Union>({A \<in> Pow(state). F \<in> A \<longmapsto> B})"
 
 (** Ad-hoc set-theory rules **)
 
 lemma Int_Union_Union: "\<Union>(B) \<inter> A = (\<Union>b \<in> B. b \<inter> A)"
 by auto
 
 lemma Int_Union_Union2: "A \<inter> \<Union>(B) = (\<Union>b \<in> B. A \<inter> b)"
 by auto
 
 (*** transient ***)
 
 lemma transient_type: "transient(A)<=program"
 by (unfold transient_def, auto)
 
 lemma transientD2:
 "F \<in> transient(A) \<Longrightarrow> F \<in> program \<and> st_set(A)"
 apply (unfold transient_def, auto)
 done
 
 lemma stable_transient_empty: "\<lbrakk>F \<in> stable(A); F \<in> transient(A)\<rbrakk> \<Longrightarrow> A = 0"
 by (simp add: stable_def constrains_def transient_def, fast)
 
 lemma transient_strengthen: "\<lbrakk>F \<in> transient(A); B<=A\<rbrakk> \<Longrightarrow> F \<in> transient(B)"
 apply (simp add: transient_def st_set_def, clarify)
 apply (blast intro!: rev_bexI)
 done
 
 lemma transientI:
 "\<lbrakk>act \<in> Acts(F); A \<subseteq> domain(act); act``A \<subseteq> state-A;
     F \<in> program; st_set(A)\<rbrakk> \<Longrightarrow> F \<in> transient(A)"
 by (simp add: transient_def, blast)
 
 lemma transientE:
      "\<lbrakk>F \<in> transient(A);
          \<And>act. \<lbrakk>act \<in> Acts(F);  A \<subseteq> domain(act); act``A \<subseteq> state-A\<rbrakk>\<Longrightarrow>P\<rbrakk>
       \<Longrightarrow>P"
 by (simp add: transient_def, blast)
 
 lemma transient_state: "transient(state) = 0"
 apply (simp add: transient_def)
 apply (rule equalityI, auto)
 apply (cut_tac F = x in Acts_type)
 apply (simp add: Diff_cancel)
 apply (auto intro: st0_in_state)
 done
 
 lemma transient_state2: "state<=B \<Longrightarrow> transient(B) = 0"
 apply (simp add: transient_def st_set_def)
 apply (rule equalityI, auto)
 apply (cut_tac F = x in Acts_type)
 apply (subgoal_tac "B=state")
 apply (auto intro: st0_in_state)
 done
 
 lemma transient_empty: "transient(0) = program"
 by (auto simp add: transient_def)
 
 declare transient_empty [simp] transient_state [simp] transient_state2 [simp]
 
 (*** ensures ***)
 
 lemma ensures_type: "A ensures B <=program"
 by (simp add: ensures_def constrains_def, auto)
 
 lemma ensuresI:
 "\<lbrakk>F:(A-B) co (A \<union> B); F \<in> transient(A-B)\<rbrakk>\<Longrightarrow>F \<in> A ensures B"
-apply (unfold ensures_def)
+  unfolding ensures_def
 apply (auto simp add: transient_type [THEN subsetD])
 done
 
 (* Added by Sidi, from Misra's notes, Progress chapter, exercise 4 *)
 lemma ensuresI2: "\<lbrakk>F \<in> A co A \<union> B; F \<in> transient(A)\<rbrakk> \<Longrightarrow> F \<in> A ensures B"
 apply (drule_tac B = "A-B" in constrains_weaken_L)
 apply (drule_tac [2] B = "A-B" in transient_strengthen)
 apply (auto simp add: ensures_def transient_type [THEN subsetD])
 done
 
 lemma ensuresD: "F \<in> A ensures B \<Longrightarrow> F:(A-B) co (A \<union> B) \<and> F \<in> transient (A-B)"
 by (unfold ensures_def, auto)
 
 lemma ensures_weaken_R: "\<lbrakk>F \<in> A ensures A'; A'<=B'\<rbrakk> \<Longrightarrow> F \<in> A ensures B'"
-apply (unfold ensures_def)
+  unfolding ensures_def
 apply (blast intro: transient_strengthen constrains_weaken)
 done
 
 (*The L-version (precondition strengthening) fails, but we have this*)
 lemma stable_ensures_Int:
      "\<lbrakk>F \<in> stable(C);  F \<in> A ensures B\<rbrakk> \<Longrightarrow> F:(C \<inter> A) ensures (C \<inter> B)"
 
-apply (unfold ensures_def)
+  unfolding ensures_def
 apply (simp (no_asm) add: Int_Un_distrib [symmetric] Diff_Int_distrib [symmetric])
 apply (blast intro: transient_strengthen stable_constrains_Int constrains_weaken)
 done
 
 lemma stable_transient_ensures: "\<lbrakk>F \<in> stable(A);  F \<in> transient(C); A<=B \<union> C\<rbrakk> \<Longrightarrow> F \<in> A ensures B"
 apply (frule stable_type [THEN subsetD])
 apply (simp add: ensures_def stable_def)
 apply (blast intro: transient_strengthen constrains_weaken)
 done
 
 lemma ensures_eq: "(A ensures B) = (A unless B) \<inter> transient (A-B)"
 by (auto simp add: ensures_def unless_def)
 
 lemma subset_imp_ensures: "\<lbrakk>F \<in> program; A<=B\<rbrakk> \<Longrightarrow> F \<in> A ensures B"
 by (auto simp add: ensures_def constrains_def transient_def st_set_def)
 
 (*** leadsTo ***)
 lemmas leads_left = leads.dom_subset [THEN subsetD, THEN SigmaD1]
 lemmas leads_right = leads.dom_subset [THEN subsetD, THEN SigmaD2]
 
 lemma leadsTo_type: "A \<longmapsto> B \<subseteq> program"
 by (unfold leadsTo_def, auto)
 
 lemma leadsToD2:
 "F \<in> A \<longmapsto> B \<Longrightarrow> F \<in> program \<and> st_set(A) \<and> st_set(B)"
 apply (unfold leadsTo_def st_set_def)
 apply (blast dest: leads_left leads_right)
 done
 
 lemma leadsTo_Basis:
     "\<lbrakk>F \<in> A ensures B; st_set(A); st_set(B)\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto> B"
 apply (unfold leadsTo_def st_set_def)
 apply (cut_tac ensures_type)
 apply (auto intro: leads.Basis)
 done
 declare leadsTo_Basis [intro]
 
 (* Added by Sidi, from Misra's notes, Progress chapter, exercise number 4 *)
 (* \<lbrakk>F \<in> program; A<=B;  st_set(A); st_set(B)\<rbrakk> \<Longrightarrow> A \<longmapsto> B *)
 lemmas subset_imp_leadsTo = subset_imp_ensures [THEN leadsTo_Basis]
 
 lemma leadsTo_Trans: "\<lbrakk>F \<in> A \<longmapsto> B;  F \<in> B \<longmapsto> C\<rbrakk>\<Longrightarrow>F \<in> A \<longmapsto> C"
-apply (unfold leadsTo_def)
+  unfolding leadsTo_def
 apply (auto intro: leads.Trans)
 done
 
 (* Better when used in association with leadsTo_weaken_R *)
 lemma transient_imp_leadsTo: "F \<in> transient(A) \<Longrightarrow> F \<in> A \<longmapsto> (state-A)"
-apply (unfold transient_def)
+  unfolding transient_def
 apply (blast intro: ensuresI [THEN leadsTo_Basis] constrains_weaken transientI)
 done
 
 (*Useful with cancellation, disjunction*)
 lemma leadsTo_Un_duplicate: "F \<in> A \<longmapsto> (A' \<union> A') \<Longrightarrow> F \<in> A \<longmapsto> A'"
 by simp
 
 lemma leadsTo_Un_duplicate2:
      "F \<in> A \<longmapsto> (A' \<union> C \<union> C) \<Longrightarrow> F \<in> A \<longmapsto> (A' \<union> C)"
 by (simp add: Un_ac)
 
 (*The Union introduction rule as we should have liked to state it*)
 lemma leadsTo_Union:
     "\<lbrakk>\<And>A. A \<in> S \<Longrightarrow> F \<in> A \<longmapsto> B; F \<in> program; st_set(B)\<rbrakk>
      \<Longrightarrow> F \<in> \<Union>(S) \<longmapsto> B"
 apply (unfold leadsTo_def st_set_def)
 apply (blast intro: leads.Union dest: leads_left)
 done
 
 lemma leadsTo_Union_Int:
     "\<lbrakk>\<And>A. A \<in> S \<Longrightarrow>F \<in> (A \<inter> C) \<longmapsto> B; F \<in> program; st_set(B)\<rbrakk>
      \<Longrightarrow> F \<in> (\<Union>(S)Int C)\<longmapsto> B"
 apply (unfold leadsTo_def st_set_def)
 apply (simp only: Int_Union_Union)
 apply (blast dest: leads_left intro: leads.Union)
 done
 
 lemma leadsTo_UN:
     "\<lbrakk>\<And>i. i \<in> I \<Longrightarrow> F \<in> A(i) \<longmapsto> B; F \<in> program; st_set(B)\<rbrakk>
      \<Longrightarrow> F:(\<Union>i \<in> I. A(i)) \<longmapsto> B"
 apply (simp add: Int_Union_Union leadsTo_def st_set_def)
 apply (blast dest: leads_left intro: leads.Union)
 done
 
 (* Binary union introduction rule *)
 lemma leadsTo_Un:
      "\<lbrakk>F \<in> A \<longmapsto> C; F \<in> B \<longmapsto> C\<rbrakk> \<Longrightarrow> F \<in> (A \<union> B) \<longmapsto> C"
 apply (subst Un_eq_Union)
 apply (blast intro: leadsTo_Union dest: leadsToD2)
 done
 
 lemma single_leadsTo_I:
     "\<lbrakk>\<And>x. x \<in> A\<Longrightarrow> F:{x} \<longmapsto> B; F \<in> program; st_set(B)\<rbrakk>
      \<Longrightarrow> F \<in> A \<longmapsto> B"
 apply (rule_tac b = A in UN_singleton [THEN subst])
 apply (rule leadsTo_UN, auto)
 done
 
 lemma leadsTo_refl: "\<lbrakk>F \<in> program; st_set(A)\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto> A"
 by (blast intro: subset_imp_leadsTo)
 
 lemma leadsTo_refl_iff: "F \<in> A \<longmapsto> A \<longleftrightarrow> F \<in> program \<and> st_set(A)"
 by (auto intro: leadsTo_refl dest: leadsToD2)
 
 lemma empty_leadsTo: "F \<in> 0 \<longmapsto> B \<longleftrightarrow> (F \<in> program \<and> st_set(B))"
 by (auto intro: subset_imp_leadsTo dest: leadsToD2)
 declare empty_leadsTo [iff]
 
 lemma leadsTo_state: "F \<in> A \<longmapsto> state \<longleftrightarrow> (F \<in> program \<and> st_set(A))"
 by (auto intro: subset_imp_leadsTo dest: leadsToD2 st_setD)
 declare leadsTo_state [iff]
 
 lemma leadsTo_weaken_R: "\<lbrakk>F \<in> A \<longmapsto> A'; A'<=B'; st_set(B')\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto> B'"
 by (blast dest: leadsToD2 intro: subset_imp_leadsTo leadsTo_Trans)
 
 lemma leadsTo_weaken_L: "\<lbrakk>F \<in> A \<longmapsto> A'; B<=A\<rbrakk> \<Longrightarrow> F \<in> B \<longmapsto> A'"
 apply (frule leadsToD2)
 apply (blast intro: leadsTo_Trans subset_imp_leadsTo st_set_subset)
 done
 
 lemma leadsTo_weaken: "\<lbrakk>F \<in> A \<longmapsto> A'; B<=A; A'<=B'; st_set(B')\<rbrakk>\<Longrightarrow> F \<in> B \<longmapsto> B'"
 apply (frule leadsToD2)
 apply (blast intro: leadsTo_weaken_R leadsTo_weaken_L leadsTo_Trans leadsTo_refl)
 done
 
 (* This rule has a nicer conclusion *)
 lemma transient_imp_leadsTo2: "\<lbrakk>F \<in> transient(A); state-A<=B; st_set(B)\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto> B"
 apply (frule transientD2)
 apply (rule leadsTo_weaken_R)
 apply (auto simp add: transient_imp_leadsTo)
 done
 
 (*Distributes over binary unions*)
 lemma leadsTo_Un_distrib: "F:(A \<union> B) \<longmapsto> C  \<longleftrightarrow>  (F \<in> A \<longmapsto> C \<and> F \<in> B \<longmapsto> C)"
 by (blast intro: leadsTo_Un leadsTo_weaken_L)
 
 lemma leadsTo_UN_distrib:
 "(F:(\<Union>i \<in> I. A(i)) \<longmapsto> B)\<longleftrightarrow> ((\<forall>i \<in> I. F \<in> A(i) \<longmapsto> B) \<and> F \<in> program \<and> st_set(B))"
 apply (blast dest: leadsToD2 intro: leadsTo_UN leadsTo_weaken_L)
 done
 
 lemma leadsTo_Union_distrib: "(F \<in> \<Union>(S) \<longmapsto> B) \<longleftrightarrow>  (\<forall>A \<in> S. F \<in> A \<longmapsto> B) \<and> F \<in> program \<and> st_set(B)"
 by (blast dest: leadsToD2 intro: leadsTo_Union leadsTo_weaken_L)
 
 text\<open>Set difference: maybe combine with \<open>leadsTo_weaken_L\<close>??\<close>
 lemma leadsTo_Diff:
      "\<lbrakk>F: (A-B) \<longmapsto> C; F \<in> B \<longmapsto> C; st_set(C)\<rbrakk>
       \<Longrightarrow> F \<in> A \<longmapsto> C"
 by (blast intro: leadsTo_Un leadsTo_weaken dest: leadsToD2)
 
 lemma leadsTo_UN_UN:
     "\<lbrakk>\<And>i. i \<in> I \<Longrightarrow> F \<in> A(i) \<longmapsto> A'(i); F \<in> program\<rbrakk>
      \<Longrightarrow> F: (\<Union>i \<in> I. A(i)) \<longmapsto> (\<Union>i \<in> I. A'(i))"
 apply (rule leadsTo_Union)
 apply (auto intro: leadsTo_weaken_R dest: leadsToD2)
 done
 
 (*Binary union version*)
 lemma leadsTo_Un_Un: "\<lbrakk>F \<in> A \<longmapsto> A'; F \<in> B \<longmapsto> B'\<rbrakk> \<Longrightarrow> F \<in> (A \<union> B) \<longmapsto> (A' \<union> B')"
 apply (subgoal_tac "st_set (A) \<and> st_set (A') \<and> st_set (B) \<and> st_set (B') ")
 prefer 2 apply (blast dest: leadsToD2)
 apply (blast intro: leadsTo_Un leadsTo_weaken_R)
 done
 
 (** The cancellation law **)
 lemma leadsTo_cancel2: "\<lbrakk>F \<in> A \<longmapsto> (A' \<union> B); F \<in> B \<longmapsto> B'\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto> (A' \<union> B')"
 apply (subgoal_tac "st_set (A) \<and> st_set (A') \<and> st_set (B) \<and> st_set (B') \<and>F \<in> program")
 prefer 2 apply (blast dest: leadsToD2)
 apply (blast intro: leadsTo_Trans leadsTo_Un_Un leadsTo_refl)
 done
 
 lemma leadsTo_cancel_Diff2: "\<lbrakk>F \<in> A \<longmapsto> (A' \<union> B); F \<in> (B-A') \<longmapsto> B'\<rbrakk>\<Longrightarrow> F \<in> A \<longmapsto> (A' \<union> B')"
 apply (rule leadsTo_cancel2)
 prefer 2 apply assumption
 apply (blast dest: leadsToD2 intro: leadsTo_weaken_R)
 done
 
 
 lemma leadsTo_cancel1: "\<lbrakk>F \<in> A \<longmapsto> (B \<union> A'); F \<in> B \<longmapsto> B'\<rbrakk> \<Longrightarrow> F \<in> A \<longmapsto> (B' \<union> A')"
 apply (simp add: Un_commute)
 apply (blast intro!: leadsTo_cancel2)
 done
 
 lemma leadsTo_cancel_Diff1:
      "\<lbrakk>F \<in> A \<longmapsto> (B \<union> A'); F: (B-A') \<longmapsto> B'\<rbrakk>\<Longrightarrow> F \<in> A \<longmapsto> (B' \<union> A')"
 apply (rule leadsTo_cancel1)
 prefer 2 apply assumption
 apply (blast intro: leadsTo_weaken_R dest: leadsToD2)
 done
 
 (*The INDUCTION rule as we should have liked to state it*)
 lemma leadsTo_induct:
   assumes major: "F \<in> za \<longmapsto> zb"
       and basis: "\<And>A B. \<lbrakk>F \<in> A ensures B; st_set(A); st_set(B)\<rbrakk> \<Longrightarrow> P(A,B)"
       and trans: "\<And>A B C. \<lbrakk>F \<in> A \<longmapsto> B; P(A, B);
                               F \<in> B \<longmapsto> C; P(B, C)\<rbrakk> \<Longrightarrow> P(A,C)"
       and union: "\<And>B S. \<lbrakk>\<forall>A \<in> S. F \<in> A \<longmapsto> B; \<forall>A \<in> S. P(A,B);
                            st_set(B); \<forall>A \<in> S. st_set(A)\<rbrakk> \<Longrightarrow> P(\<Union>(S), B)"
   shows "P(za, zb)"
 apply (cut_tac major)
 apply (unfold leadsTo_def, clarify)
 apply (erule leads.induct)
   apply (blast intro: basis [unfolded st_set_def])
  apply (blast intro: trans [unfolded leadsTo_def])
 apply (force intro: union [unfolded st_set_def leadsTo_def])
 done
 
 
 (* Added by Sidi, an induction rule without ensures *)
 lemma leadsTo_induct2:
   assumes major: "F \<in> za \<longmapsto> zb"
       and basis1: "\<And>A B. \<lbrakk>A<=B; st_set(B)\<rbrakk> \<Longrightarrow> P(A, B)"
       and basis2: "\<And>A B. \<lbrakk>F \<in> A co A \<union> B; F \<in> transient(A); st_set(B)\<rbrakk>
                           \<Longrightarrow> P(A, B)"
       and trans: "\<And>A B C. \<lbrakk>F \<in> A \<longmapsto> B; P(A, B);
                               F \<in> B \<longmapsto> C; P(B, C)\<rbrakk> \<Longrightarrow> P(A,C)"
       and union: "\<And>B S. \<lbrakk>\<forall>A \<in> S. F \<in> A \<longmapsto> B; \<forall>A \<in> S. P(A,B);
                            st_set(B); \<forall>A \<in> S. st_set(A)\<rbrakk> \<Longrightarrow> P(\<Union>(S), B)"
   shows "P(za, zb)"
 apply (cut_tac major)
 apply (erule leadsTo_induct)
 apply (auto intro: trans union)
 apply (simp add: ensures_def, clarify)
 apply (frule constrainsD2)
 apply (drule_tac B' = " (A-B) \<union> B" in constrains_weaken_R)
 apply blast
 apply (frule ensuresI2 [THEN leadsTo_Basis])
 apply (drule_tac [4] basis2, simp_all)
 apply (frule_tac A1 = A and B = B in Int_lower2 [THEN basis1])
 apply (subgoal_tac "A=\<Union>({A - B, A \<inter> B}) ")
 prefer 2 apply blast
 apply (erule ssubst)
 apply (rule union)
 apply (auto intro: subset_imp_leadsTo)
 done
 
 
 (** Variant induction rule: on the preconditions for B **)
 (*Lemma is the weak version: can't see how to do it in one step*)
 lemma leadsTo_induct_pre_aux:
   "\<lbrakk>F \<in> za \<longmapsto> zb;
       P(zb);
       \<And>A B. \<lbrakk>F \<in> A ensures B;  P(B); st_set(A); st_set(B)\<rbrakk> \<Longrightarrow> P(A);
       \<And>S. \<lbrakk>\<forall>A \<in> S. P(A); \<forall>A \<in> S. st_set(A)\<rbrakk> \<Longrightarrow> P(\<Union>(S))
 \<rbrakk> \<Longrightarrow> P(za)"
 txt\<open>by induction on this formula\<close>
 apply (subgoal_tac "P (zb) \<longrightarrow> P (za) ")
 txt\<open>now solve first subgoal: this formula is sufficient\<close>
 apply (blast intro: leadsTo_refl)
 apply (erule leadsTo_induct)
 apply (blast+)
 done
 
 
 lemma leadsTo_induct_pre:
   "\<lbrakk>F \<in> za \<longmapsto> zb;
       P(zb);
       \<And>A B. \<lbrakk>F \<in> A ensures B;  F \<in> B \<longmapsto> zb;  P(B); st_set(A)\<rbrakk> \<Longrightarrow> P(A);
       \<And>S. \<forall>A \<in> S. F \<in> A \<longmapsto> zb \<and> P(A) \<and> st_set(A) \<Longrightarrow> P(\<Union>(S))
 \<rbrakk> \<Longrightarrow> P(za)"
 apply (subgoal_tac " (F \<in> za \<longmapsto> zb) \<and> P (za) ")
 apply (erule conjunct2)
 apply (frule leadsToD2)
 apply (erule leadsTo_induct_pre_aux)
 prefer 3 apply (blast dest: leadsToD2 intro: leadsTo_Union)
 prefer 2 apply (blast intro: leadsTo_Trans leadsTo_Basis)
 apply (blast intro: leadsTo_refl)
 done
 
 (** The impossibility law **)
 lemma leadsTo_empty:
    "F \<in> A \<longmapsto> 0 \<Longrightarrow> A=0"
 apply (erule leadsTo_induct_pre)
 apply (auto simp add: ensures_def constrains_def transient_def st_set_def)
 apply (drule bspec, assumption)+
 apply blast
 done
 declare leadsTo_empty [simp]
 
 subsection\<open>PSP: Progress-Safety-Progress\<close>
 
 text\<open>Special case of PSP: Misra's "stable conjunction"\<close>
 
 lemma psp_stable:
    "\<lbrakk>F \<in> A \<longmapsto> A'; F \<in> stable(B)\<rbrakk> \<Longrightarrow> F:(A \<inter> B) \<longmapsto> (A' \<inter> B)"
-apply (unfold stable_def)
+  unfolding stable_def
 apply (frule leadsToD2)
 apply (erule leadsTo_induct)
 prefer 3 apply (blast intro: leadsTo_Union_Int)
 prefer 2 apply (blast intro: leadsTo_Trans)
 apply (rule leadsTo_Basis)
 apply (simp add: ensures_def Diff_Int_distrib2 [symmetric] Int_Un_distrib2 [symmetric])
 apply (auto intro: transient_strengthen constrains_Int)
 done
 
 
 lemma psp_stable2: "\<lbrakk>F \<in> A \<longmapsto> A'; F \<in> stable(B)\<rbrakk>\<Longrightarrow>F: (B \<inter> A) \<longmapsto> (B \<inter> A')"
 apply (simp (no_asm_simp) add: psp_stable Int_ac)
 done
 
 lemma psp_ensures:
 "\<lbrakk>F \<in> A ensures A'; F \<in> B co B'\<rbrakk>\<Longrightarrow> F: (A \<inter> B') ensures ((A' \<inter> B) \<union> (B' - B))"
 apply (unfold ensures_def constrains_def st_set_def)
 (*speeds up the proof*)
 apply clarify
 apply (blast intro: transient_strengthen)
 done
 
 lemma psp:
 "\<lbrakk>F \<in> A \<longmapsto> A'; F \<in> B co B'; st_set(B')\<rbrakk>\<Longrightarrow> F:(A \<inter> B') \<longmapsto> ((A' \<inter> B) \<union> (B' - B))"
 apply (subgoal_tac "F \<in> program \<and> st_set (A) \<and> st_set (A') \<and> st_set (B) ")
 prefer 2 apply (blast dest!: constrainsD2 leadsToD2)
 apply (erule leadsTo_induct)
 prefer 3 apply (blast intro: leadsTo_Union_Int)
  txt\<open>Basis case\<close>
  apply (blast intro: psp_ensures leadsTo_Basis)
 txt\<open>Transitivity case has a delicate argument involving "cancellation"\<close>
 apply (rule leadsTo_Un_duplicate2)
 apply (erule leadsTo_cancel_Diff1)
 apply (simp add: Int_Diff Diff_triv)
 apply (blast intro: leadsTo_weaken_L dest: constrains_imp_subset)
 done
 
 
 lemma psp2: "\<lbrakk>F \<in> A \<longmapsto> A'; F \<in> B co B'; st_set(B')\<rbrakk>
     \<Longrightarrow> F \<in> (B' \<inter> A) \<longmapsto> ((B \<inter> A') \<union> (B' - B))"
 by (simp (no_asm_simp) add: psp Int_ac)
 
 lemma psp_unless:
    "\<lbrakk>F \<in> A \<longmapsto> A';  F \<in> B unless B'; st_set(B); st_set(B')\<rbrakk>
     \<Longrightarrow> F \<in> (A \<inter> B) \<longmapsto> ((A' \<inter> B) \<union> B')"
-apply (unfold unless_def)
+  unfolding unless_def
 apply (subgoal_tac "st_set (A) \<and>st_set (A') ")
 prefer 2 apply (blast dest: leadsToD2)
 apply (drule psp, assumption, blast)
 apply (blast intro: leadsTo_weaken)
 done
 
 
 subsection\<open>Proving the induction rules\<close>
 
 (** The most general rule \<in> r is any wf relation; f is any variant function **)
 lemma leadsTo_wf_induct_aux: "\<lbrakk>wf(r);
          m \<in> I;
          field(r)<=I;
          F \<in> program; st_set(B);
          \<forall>m \<in> I. F \<in> (A \<inter> f-``{m}) \<longmapsto>
                     ((A \<inter> f-``(converse(r)``{m})) \<union> B)\<rbrakk>
       \<Longrightarrow> F \<in> (A \<inter> f-``{m}) \<longmapsto> B"
 apply (erule_tac a = m in wf_induct2, simp_all)
 apply (subgoal_tac "F \<in> (A \<inter> (f-`` (converse (r) ``{x}))) \<longmapsto> B")
  apply (blast intro: leadsTo_cancel1 leadsTo_Un_duplicate)
 apply (subst vimage_eq_UN)
 apply (simp del: UN_simps add: Int_UN_distrib)
 apply (auto intro: leadsTo_UN simp del: UN_simps simp add: Int_UN_distrib)
 done
 
 (** Meta or object quantifier ? **)
 lemma leadsTo_wf_induct: "\<lbrakk>wf(r);
          field(r)<=I;
          A<=f-``I;
          F \<in> program; st_set(A); st_set(B);
          \<forall>m \<in> I. F \<in> (A \<inter> f-``{m}) \<longmapsto>
                     ((A \<inter> f-``(converse(r)``{m})) \<union> B)\<rbrakk>
       \<Longrightarrow> F \<in> A \<longmapsto> B"
 apply (rule_tac b = A in subst)
  defer 1
  apply (rule_tac I = I in leadsTo_UN)
  apply (erule_tac I = I in leadsTo_wf_induct_aux, assumption+, best)
 done
 
 lemma nat_measure_field: "field(measure(nat, \<lambda>x. x)) = nat"
-apply (unfold field_def)
+  unfolding field_def
 apply (simp add: measure_def)
 apply (rule equalityI, force, clarify)
 apply (erule_tac V = "x\<notin>range (y)" for y in thin_rl)
 apply (erule nat_induct)
 apply (rule_tac [2] b = "succ (succ (xa))" in domainI)
 apply (rule_tac b = "succ (0) " in domainI)
 apply simp_all
 done
 
 
 lemma Image_inverse_lessThan: "k<A \<Longrightarrow> measure(A, \<lambda>x. x) -`` {k} = k"
 apply (rule equalityI)
 apply (auto simp add: measure_def)
 apply (blast intro: ltD)
 apply (rule vimageI)
 prefer 2 apply blast
 apply (simp add: lt_Ord lt_Ord2 Ord_mem_iff_lt)
 apply (blast intro: lt_trans)
 done
 
 (*Alternative proof is via the lemma F \<in> (A \<inter> f-`(lessThan m)) \<longmapsto> B*)
 lemma lessThan_induct:
  "\<lbrakk>A<=f-``nat;
      F \<in> program; st_set(A); st_set(B);
      \<forall>m \<in> nat. F:(A \<inter> f-``{m}) \<longmapsto> ((A \<inter> f -`` m) \<union> B)\<rbrakk>
       \<Longrightarrow> F \<in> A \<longmapsto> B"
 apply (rule_tac A1 = nat and f1 = "\<lambda>x. x" in wf_measure [THEN leadsTo_wf_induct])
 apply (simp_all add: nat_measure_field)
 apply (simp add: ltI Image_inverse_lessThan vimage_def [symmetric])
 done
 
 
 (*** wlt ****)
 
 (*Misra's property W3*)
 lemma wlt_type: "wlt(F,B) <=state"
 by (unfold wlt_def, auto)
 
 lemma wlt_st_set: "st_set(wlt(F, B))"
-apply (unfold st_set_def)
+  unfolding st_set_def
 apply (rule wlt_type)
 done
 declare wlt_st_set [iff]
 
 lemma wlt_leadsTo_iff: "F \<in> wlt(F, B) \<longmapsto> B \<longleftrightarrow> (F \<in> program \<and> st_set(B))"
-apply (unfold wlt_def)
+  unfolding wlt_def
 apply (blast dest: leadsToD2 intro!: leadsTo_Union)
 done
 
 (* \<lbrakk>F \<in> program;  st_set(B)\<rbrakk> \<Longrightarrow> F \<in> wlt(F, B) \<longmapsto> B  *)
 lemmas wlt_leadsTo = conjI [THEN wlt_leadsTo_iff [THEN iffD2]]
 
 lemma leadsTo_subset: "F \<in> A \<longmapsto> B \<Longrightarrow> A \<subseteq> wlt(F, B)"
-apply (unfold wlt_def)
+  unfolding wlt_def
 apply (frule leadsToD2)
 apply (auto simp add: st_set_def)
 done
 
 (*Misra's property W2*)
 lemma leadsTo_eq_subset_wlt: "F \<in> A \<longmapsto> B \<longleftrightarrow> (A \<subseteq> wlt(F,B) \<and> F \<in> program \<and> st_set(B))"
 apply auto
 apply (blast dest: leadsToD2 leadsTo_subset intro: leadsTo_weaken_L wlt_leadsTo)+
 done
 
 (*Misra's property W4*)
 lemma wlt_increasing: "\<lbrakk>F \<in> program; st_set(B)\<rbrakk> \<Longrightarrow> B \<subseteq> wlt(F,B)"
 apply (rule leadsTo_subset)
 apply (simp (no_asm_simp) add: leadsTo_eq_subset_wlt [THEN iff_sym] subset_imp_leadsTo)
 done
 
 (*Used in the Trans case below*)
 lemma leadsTo_123_aux:
    "\<lbrakk>B \<subseteq> A2;
        F \<in> (A1 - B) co (A1 \<union> B);
        F \<in> (A2 - C) co (A2 \<union> C)\<rbrakk>
     \<Longrightarrow> F \<in> (A1 \<union> A2 - C) co (A1 \<union> A2 \<union> C)"
 apply (unfold constrains_def st_set_def, blast)
 done
 
 (*Lemma (1,2,3) of Misra's draft book, Chapter 4, "Progress"*)
 (* slightly different from the HOL one \<in> B here is bounded *)
 lemma leadsTo_123: "F \<in> A \<longmapsto> A'
       \<Longrightarrow> \<exists>B \<in> Pow(state). A<=B \<and> F \<in> B \<longmapsto> A' \<and> F \<in> (B-A') co (B \<union> A')"
 apply (frule leadsToD2)
 apply (erule leadsTo_induct)
   txt\<open>Basis\<close>
   apply (blast dest: ensuresD constrainsD2 st_setD)
  txt\<open>Trans\<close>
  apply clarify
  apply (rule_tac x = "Ba \<union> Bb" in bexI)
  apply (blast intro: leadsTo_123_aux leadsTo_Un_Un leadsTo_cancel1 leadsTo_Un_duplicate, blast)
 txt\<open>Union\<close>
 apply (clarify dest!: ball_conj_distrib [THEN iffD1])
 apply (subgoal_tac "\<exists>y. y \<in> Pi (S, \<lambda>A. {Ba \<in> Pow (state) . A<=Ba \<and> F \<in> Ba \<longmapsto> B \<and> F \<in> Ba - B co Ba \<union> B}) ")
 defer 1
 apply (rule AC_ball_Pi, safe)
 apply (rotate_tac 1)
 apply (drule_tac x = x in bspec, blast, blast)
 apply (rule_tac x = "\<Union>A \<in> S. y`A" in bexI, safe)
 apply (rule_tac [3] I1 = S in constrains_UN [THEN constrains_weaken])
 apply (rule_tac [2] leadsTo_Union)
 prefer 5 apply (blast dest!: apply_type, simp_all)
 apply (force dest!: apply_type)+
 done
 
 
 (*Misra's property W5*)
 lemma wlt_constrains_wlt: "\<lbrakk>F \<in> program; st_set(B)\<rbrakk> \<Longrightarrow>F \<in> (wlt(F, B) - B) co (wlt(F,B))"
 apply (cut_tac F = F in wlt_leadsTo [THEN leadsTo_123], assumption, blast)
 apply clarify
 apply (subgoal_tac "Ba = wlt (F,B) ")
 prefer 2 apply (blast dest: leadsTo_eq_subset_wlt [THEN iffD1], clarify)
 apply (simp add: wlt_increasing [THEN subset_Un_iff2 [THEN iffD1]])
 done
 
 
 subsection\<open>Completion: Binary and General Finite versions\<close>
 
 lemma completion_aux: "\<lbrakk>W = wlt(F, (B' \<union> C));
        F \<in> A \<longmapsto> (A' \<union> C);  F \<in> A' co (A' \<union> C);
        F \<in> B \<longmapsto> (B' \<union> C);  F \<in> B' co (B' \<union> C)\<rbrakk>
     \<Longrightarrow> F \<in> (A \<inter> B) \<longmapsto> ((A' \<inter> B') \<union> C)"
 apply (subgoal_tac "st_set (C) \<and>st_set (W) \<and>st_set (W-C) \<and>st_set (A') \<and>st_set (A) \<and> st_set (B) \<and> st_set (B') \<and> F \<in> program")
  prefer 2
  apply simp
  apply (blast dest!: leadsToD2)
 apply (subgoal_tac "F \<in> (W-C) co (W \<union> B' \<union> C) ")
  prefer 2
  apply (blast intro!: constrains_weaken [OF constrains_Un [OF _ wlt_constrains_wlt]])
 apply (subgoal_tac "F \<in> (W-C) co W")
  prefer 2
  apply (simp add: wlt_increasing [THEN subset_Un_iff2 [THEN iffD1]] Un_assoc)
 apply (subgoal_tac "F \<in> (A \<inter> W - C) \<longmapsto> (A' \<inter> W \<union> C) ")
  prefer 2 apply (blast intro: wlt_leadsTo psp [THEN leadsTo_weaken])
 (** step 13 **)
 apply (subgoal_tac "F \<in> (A' \<inter> W \<union> C) \<longmapsto> (A' \<inter> B' \<union> C) ")
 apply (drule leadsTo_Diff)
 apply (blast intro: subset_imp_leadsTo dest: leadsToD2 constrainsD2)
 apply (force simp add: st_set_def)
 apply (subgoal_tac "A \<inter> B \<subseteq> A \<inter> W")
 prefer 2 apply (blast dest!: leadsTo_subset intro!: subset_refl [THEN Int_mono])
 apply (blast intro: leadsTo_Trans subset_imp_leadsTo)
 txt\<open>last subgoal\<close>
 apply (rule_tac leadsTo_Un_duplicate2)
 apply (rule_tac leadsTo_Un_Un)
  prefer 2 apply (blast intro: leadsTo_refl)
 apply (rule_tac A'1 = "B' \<union> C" in wlt_leadsTo[THEN psp2, THEN leadsTo_weaken])
 apply blast+
 done
 
 lemmas completion = refl [THEN completion_aux]
 
 lemma finite_completion_aux:
      "\<lbrakk>I \<in> Fin(X); F \<in> program; st_set(C)\<rbrakk> \<Longrightarrow>
        (\<forall>i \<in> I. F \<in> (A(i)) \<longmapsto> (A'(i) \<union> C)) \<longrightarrow>
                      (\<forall>i \<in> I. F \<in> (A'(i)) co (A'(i) \<union> C)) \<longrightarrow>
                    F \<in> (\<Inter>i \<in> I. A(i)) \<longmapsto> ((\<Inter>i \<in> I. A'(i)) \<union> C)"
 apply (erule Fin_induct)
 apply (auto simp add: Inter_0)
 apply (rule completion)
 apply (auto simp del: INT_simps simp add: INT_extend_simps)
 apply (blast intro: constrains_INT)
 done
 
 lemma finite_completion:
      "\<lbrakk>I \<in> Fin(X);
          \<And>i. i \<in> I \<Longrightarrow> F \<in> A(i) \<longmapsto> (A'(i) \<union> C);
          \<And>i. i \<in> I \<Longrightarrow> F \<in> A'(i) co (A'(i) \<union> C); F \<in> program; st_set(C)\<rbrakk>
       \<Longrightarrow> F \<in> (\<Inter>i \<in> I. A(i)) \<longmapsto> ((\<Inter>i \<in> I. A'(i)) \<union> C)"
 by (blast intro: finite_completion_aux [THEN mp, THEN mp])
 
 lemma stable_completion:
      "\<lbrakk>F \<in> A \<longmapsto> A';  F \<in> stable(A');
          F \<in> B \<longmapsto> B';  F \<in> stable(B')\<rbrakk>
     \<Longrightarrow> F \<in> (A \<inter> B) \<longmapsto> (A' \<inter> B')"
-apply (unfold stable_def)
+  unfolding stable_def
 apply (rule_tac C1 = 0 in completion [THEN leadsTo_weaken_R], simp+)
 apply (blast dest: leadsToD2)
 done
 
 
 lemma finite_stable_completion:
      "\<lbrakk>I \<in> Fin(X);
          (\<And>i. i \<in> I \<Longrightarrow> F \<in> A(i) \<longmapsto> A'(i));
          (\<And>i. i \<in> I \<Longrightarrow> F \<in> stable(A'(i)));  F \<in> program\<rbrakk>
       \<Longrightarrow> F \<in> (\<Inter>i \<in> I. A(i)) \<longmapsto> (\<Inter>i \<in> I. A'(i))"
-apply (unfold stable_def)
+  unfolding stable_def
 apply (subgoal_tac "st_set (\<Inter>i \<in> I. A' (i))")
 prefer 2 apply (blast dest: leadsToD2)
 apply (rule_tac C1 = 0 in finite_completion [THEN leadsTo_weaken_R], auto)
 done
 
 end
diff --git a/src/ZF/Univ.thy b/src/ZF/Univ.thy
--- a/src/ZF/Univ.thy
+++ b/src/ZF/Univ.thy
@@ -1,797 +1,797 @@
 (*  Title:      ZF/Univ.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1992  University of Cambridge
 
 Standard notation for Vset(i) is V(i), but users might want V for a
 variable.
 
 NOTE: univ(A) could be a translation; would simplify many proofs!
   But Ind_Syntax.univ refers to the constant "Univ.univ"
 *)
 
 section\<open>The Cumulative Hierarchy and a Small Universe for Recursive Types\<close>
 
 theory Univ imports Epsilon Cardinal begin
 
 definition
   Vfrom       :: "[i,i]\<Rightarrow>i"  where
     "Vfrom(A,i) \<equiv> transrec(i, \<lambda>x f. A \<union> (\<Union>y\<in>x. Pow(f`y)))"
 
 abbreviation
   Vset :: "i\<Rightarrow>i" where
   "Vset(x) \<equiv> Vfrom(0,x)"
 
 
 definition
   Vrec        :: "[i, [i,i]\<Rightarrow>i] \<Rightarrow>i"  where
     "Vrec(a,H) \<equiv> transrec(rank(a), \<lambda>x g. \<lambda>z\<in>Vset(succ(x)).
                            H(z, \<lambda>w\<in>Vset(x). g`rank(w)`w)) ` a"
 
 definition
   Vrecursor   :: "[[i,i]\<Rightarrow>i, i] \<Rightarrow>i"  where
     "Vrecursor(H,a) \<equiv> transrec(rank(a), \<lambda>x g. \<lambda>z\<in>Vset(succ(x)).
                                 H(\<lambda>w\<in>Vset(x). g`rank(w)`w, z)) ` a"
 
 definition
   univ        :: "i\<Rightarrow>i"  where
     "univ(A) \<equiv> Vfrom(A,nat)"
 
 
 subsection\<open>Immediate Consequences of the Definition of \<^term>\<open>Vfrom(A,i)\<close>\<close>
 
 text\<open>NOT SUITABLE FOR REWRITING -- RECURSIVE!\<close>
 lemma Vfrom: "Vfrom(A,i) = A \<union> (\<Union>j\<in>i. Pow(Vfrom(A,j)))"
 by (subst Vfrom_def [THEN def_transrec], simp)
 
 subsubsection\<open>Monotonicity\<close>
 
 lemma Vfrom_mono [rule_format]:
      "A<=B \<Longrightarrow> \<forall>j. i<=j \<longrightarrow> Vfrom(A,i) \<subseteq> Vfrom(B,j)"
 apply (rule_tac a=i in eps_induct)
 apply (rule impI [THEN allI])
 apply (subst Vfrom [of A])
 apply (subst Vfrom [of B])
 apply (erule Un_mono)
 apply (erule UN_mono, blast)
 done
 
 lemma VfromI: "\<lbrakk>a \<in> Vfrom(A,j);  j<i\<rbrakk> \<Longrightarrow> a \<in> Vfrom(A,i)"
 by (blast dest: Vfrom_mono [OF subset_refl le_imp_subset [OF leI]])
 
 
 subsubsection\<open>A fundamental equality: Vfrom does not require ordinals!\<close>
 
 
 
 lemma Vfrom_rank_subset1: "Vfrom(A,x) \<subseteq> Vfrom(A,rank(x))"
 proof (induct x rule: eps_induct)
   fix x
   assume "\<forall>y\<in>x. Vfrom(A,y) \<subseteq> Vfrom(A,rank(y))"
   thus "Vfrom(A, x) \<subseteq> Vfrom(A, rank(x))"
     by (simp add: Vfrom [of _ x] Vfrom [of _ "rank(x)"],
         blast intro!: rank_lt [THEN ltD])
 qed
 
 lemma Vfrom_rank_subset2: "Vfrom(A,rank(x)) \<subseteq> Vfrom(A,x)"
 apply (rule_tac a=x in eps_induct)
 apply (subst Vfrom)
 apply (subst Vfrom, rule subset_refl [THEN Un_mono])
 apply (rule UN_least)
 txt\<open>expand \<open>rank(x1) = (\<Union>y\<in>x1. succ(rank(y)))\<close> in assumptions\<close>
 apply (erule rank [THEN equalityD1, THEN subsetD, THEN UN_E])
 apply (rule subset_trans)
 apply (erule_tac [2] UN_upper)
 apply (rule subset_refl [THEN Vfrom_mono, THEN subset_trans, THEN Pow_mono])
 apply (erule ltI [THEN le_imp_subset])
 apply (rule Ord_rank [THEN Ord_succ])
 apply (erule bspec, assumption)
 done
 
 lemma Vfrom_rank_eq: "Vfrom(A,rank(x)) = Vfrom(A,x)"
 apply (rule equalityI)
 apply (rule Vfrom_rank_subset2)
 apply (rule Vfrom_rank_subset1)
 done
 
 
 subsection\<open>Basic Closure Properties\<close>
 
 lemma zero_in_Vfrom: "y:x \<Longrightarrow> 0 \<in> Vfrom(A,x)"
 by (subst Vfrom, blast)
 
 lemma i_subset_Vfrom: "i \<subseteq> Vfrom(A,i)"
 apply (rule_tac a=i in eps_induct)
 apply (subst Vfrom, blast)
 done
 
 lemma A_subset_Vfrom: "A \<subseteq> Vfrom(A,i)"
 apply (subst Vfrom)
 apply (rule Un_upper1)
 done
 
 lemmas A_into_Vfrom = A_subset_Vfrom [THEN subsetD]
 
 lemma subset_mem_Vfrom: "a \<subseteq> Vfrom(A,i) \<Longrightarrow> a \<in> Vfrom(A,succ(i))"
 by (subst Vfrom, blast)
 
 subsubsection\<open>Finite sets and ordered pairs\<close>
 
 lemma singleton_in_Vfrom: "a \<in> Vfrom(A,i) \<Longrightarrow> {a} \<in> Vfrom(A,succ(i))"
 by (rule subset_mem_Vfrom, safe)
 
 lemma doubleton_in_Vfrom:
      "\<lbrakk>a \<in> Vfrom(A,i);  b \<in> Vfrom(A,i)\<rbrakk> \<Longrightarrow> {a,b} \<in> Vfrom(A,succ(i))"
 by (rule subset_mem_Vfrom, safe)
 
 lemma Pair_in_Vfrom:
     "\<lbrakk>a \<in> Vfrom(A,i);  b \<in> Vfrom(A,i)\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle> \<in> Vfrom(A,succ(succ(i)))"
-apply (unfold Pair_def)
+  unfolding Pair_def
 apply (blast intro: doubleton_in_Vfrom)
 done
 
 lemma succ_in_Vfrom: "a \<subseteq> Vfrom(A,i) \<Longrightarrow> succ(a) \<in> Vfrom(A,succ(succ(i)))"
 apply (intro subset_mem_Vfrom succ_subsetI, assumption)
 apply (erule subset_trans)
 apply (rule Vfrom_mono [OF subset_refl subset_succI])
 done
 
 subsection\<open>0, Successor and Limit Equations for \<^term>\<open>Vfrom\<close>\<close>
 
 lemma Vfrom_0: "Vfrom(A,0) = A"
 by (subst Vfrom, blast)
 
 lemma Vfrom_succ_lemma: "Ord(i) \<Longrightarrow> Vfrom(A,succ(i)) = A \<union> Pow(Vfrom(A,i))"
 apply (rule Vfrom [THEN trans])
 apply (rule equalityI [THEN subst_context,
                        OF _ succI1 [THEN RepFunI, THEN Union_upper]])
 apply (rule UN_least)
 apply (rule subset_refl [THEN Vfrom_mono, THEN Pow_mono])
 apply (erule ltI [THEN le_imp_subset])
 apply (erule Ord_succ)
 done
 
 lemma Vfrom_succ: "Vfrom(A,succ(i)) = A \<union> Pow(Vfrom(A,i))"
 apply (rule_tac x1 = "succ (i)" in Vfrom_rank_eq [THEN subst])
 apply (rule_tac x1 = i in Vfrom_rank_eq [THEN subst])
 apply (subst rank_succ)
 apply (rule Ord_rank [THEN Vfrom_succ_lemma])
 done
 
 (*The premise distinguishes this from Vfrom(A,0);  allowing X=0 forces
   the conclusion to be Vfrom(A,\<Union>(X)) = A \<union> (\<Union>y\<in>X. Vfrom(A,y)) *)
 lemma Vfrom_Union: "y:X \<Longrightarrow> Vfrom(A,\<Union>(X)) = (\<Union>y\<in>X. Vfrom(A,y))"
 apply (subst Vfrom)
 apply (rule equalityI)
 txt\<open>first inclusion\<close>
 apply (rule Un_least)
 apply (rule A_subset_Vfrom [THEN subset_trans])
 apply (rule UN_upper, assumption)
 apply (rule UN_least)
 apply (erule UnionE)
 apply (rule subset_trans)
 apply (erule_tac [2] UN_upper,
        subst Vfrom, erule subset_trans [OF UN_upper Un_upper2])
 txt\<open>opposite inclusion\<close>
 apply (rule UN_least)
 apply (subst Vfrom, blast)
 done
 
 subsection\<open>\<^term>\<open>Vfrom\<close> applied to Limit Ordinals\<close>
 
 (*NB. limit ordinals are non-empty:
       Vfrom(A,0) = A = A \<union> (\<Union>y\<in>0. Vfrom(A,y)) *)
 lemma Limit_Vfrom_eq:
     "Limit(i) \<Longrightarrow> Vfrom(A,i) = (\<Union>y\<in>i. Vfrom(A,y))"
 apply (rule Limit_has_0 [THEN ltD, THEN Vfrom_Union, THEN subst], assumption)
 apply (simp add: Limit_Union_eq)
 done
 
 lemma Limit_VfromE:
     "\<lbrakk>a \<in> Vfrom(A,i);  \<not>R \<Longrightarrow> Limit(i);
         \<And>x. \<lbrakk>x<i;  a \<in> Vfrom(A,x)\<rbrakk> \<Longrightarrow> R
 \<rbrakk> \<Longrightarrow> R"
 apply (rule classical)
 apply (rule Limit_Vfrom_eq [THEN equalityD1, THEN subsetD, THEN UN_E])
   prefer 2 apply assumption
  apply blast
 apply (blast intro: ltI Limit_is_Ord)
 done
 
 lemma singleton_in_VLimit:
     "\<lbrakk>a \<in> Vfrom(A,i);  Limit(i)\<rbrakk> \<Longrightarrow> {a} \<in> Vfrom(A,i)"
 apply (erule Limit_VfromE, assumption)
 apply (erule singleton_in_Vfrom [THEN VfromI])
 apply (blast intro: Limit_has_succ)
 done
 
 lemmas Vfrom_UnI1 =
     Un_upper1 [THEN subset_refl [THEN Vfrom_mono, THEN subsetD]]
 lemmas Vfrom_UnI2 =
     Un_upper2 [THEN subset_refl [THEN Vfrom_mono, THEN subsetD]]
 
 text\<open>Hard work is finding a single j:i such that {a,b}<=Vfrom(A,j)\<close>
 lemma doubleton_in_VLimit:
     "\<lbrakk>a \<in> Vfrom(A,i);  b \<in> Vfrom(A,i);  Limit(i)\<rbrakk> \<Longrightarrow> {a,b} \<in> Vfrom(A,i)"
 apply (erule Limit_VfromE, assumption)
 apply (erule Limit_VfromE, assumption)
 apply (blast intro:  VfromI [OF doubleton_in_Vfrom]
                      Vfrom_UnI1 Vfrom_UnI2 Limit_has_succ Un_least_lt)
 done
 
 lemma Pair_in_VLimit:
     "\<lbrakk>a \<in> Vfrom(A,i);  b \<in> Vfrom(A,i);  Limit(i)\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle> \<in> Vfrom(A,i)"
 txt\<open>Infer that a, b occur at ordinals x,xa < i.\<close>
 apply (erule Limit_VfromE, assumption)
 apply (erule Limit_VfromE, assumption)
 txt\<open>Infer that \<^term>\<open>succ(succ(x \<union> xa)) < i\<close>\<close>
 apply (blast intro: VfromI [OF Pair_in_Vfrom]
                     Vfrom_UnI1 Vfrom_UnI2 Limit_has_succ Un_least_lt)
 done
 
 lemma product_VLimit: "Limit(i) \<Longrightarrow> Vfrom(A,i) * Vfrom(A,i) \<subseteq> Vfrom(A,i)"
 by (blast intro: Pair_in_VLimit)
 
 lemmas Sigma_subset_VLimit =
      subset_trans [OF Sigma_mono product_VLimit]
 
 lemmas nat_subset_VLimit =
      subset_trans [OF nat_le_Limit [THEN le_imp_subset] i_subset_Vfrom]
 
 lemma nat_into_VLimit: "\<lbrakk>n: nat;  Limit(i)\<rbrakk> \<Longrightarrow> n \<in> Vfrom(A,i)"
 by (blast intro: nat_subset_VLimit [THEN subsetD])
 
 subsubsection\<open>Closure under Disjoint Union\<close>
 
 lemmas zero_in_VLimit = Limit_has_0 [THEN ltD, THEN zero_in_Vfrom]
 
 lemma one_in_VLimit: "Limit(i) \<Longrightarrow> 1 \<in> Vfrom(A,i)"
 by (blast intro: nat_into_VLimit)
 
 lemma Inl_in_VLimit:
     "\<lbrakk>a \<in> Vfrom(A,i); Limit(i)\<rbrakk> \<Longrightarrow> Inl(a) \<in> Vfrom(A,i)"
-apply (unfold Inl_def)
+  unfolding Inl_def
 apply (blast intro: zero_in_VLimit Pair_in_VLimit)
 done
 
 lemma Inr_in_VLimit:
     "\<lbrakk>b \<in> Vfrom(A,i); Limit(i)\<rbrakk> \<Longrightarrow> Inr(b) \<in> Vfrom(A,i)"
-apply (unfold Inr_def)
+  unfolding Inr_def
 apply (blast intro: one_in_VLimit Pair_in_VLimit)
 done
 
 lemma sum_VLimit: "Limit(i) \<Longrightarrow> Vfrom(C,i)+Vfrom(C,i) \<subseteq> Vfrom(C,i)"
 by (blast intro!: Inl_in_VLimit Inr_in_VLimit)
 
 lemmas sum_subset_VLimit = subset_trans [OF sum_mono sum_VLimit]
 
 
 
 subsection\<open>Properties assuming \<^term>\<open>Transset(A)\<close>\<close>
 
 lemma Transset_Vfrom: "Transset(A) \<Longrightarrow> Transset(Vfrom(A,i))"
 apply (rule_tac a=i in eps_induct)
 apply (subst Vfrom)
 apply (blast intro!: Transset_Union_family Transset_Un Transset_Pow)
 done
 
 lemma Transset_Vfrom_succ:
      "Transset(A) \<Longrightarrow> Vfrom(A, succ(i)) = Pow(Vfrom(A,i))"
 apply (rule Vfrom_succ [THEN trans])
 apply (rule equalityI [OF _ Un_upper2])
 apply (rule Un_least [OF _ subset_refl])
 apply (rule A_subset_Vfrom [THEN subset_trans])
 apply (erule Transset_Vfrom [THEN Transset_iff_Pow [THEN iffD1]])
 done
 
 lemma Transset_Pair_subset: "\<lbrakk>\<langle>a,b\<rangle> \<subseteq> C; Transset(C)\<rbrakk> \<Longrightarrow> a: C \<and> b: C"
 by (unfold Pair_def Transset_def, blast)
 
 lemma Transset_Pair_subset_VLimit:
      "\<lbrakk>\<langle>a,b\<rangle> \<subseteq> Vfrom(A,i);  Transset(A);  Limit(i)\<rbrakk>
       \<Longrightarrow> \<langle>a,b\<rangle> \<in> Vfrom(A,i)"
 apply (erule Transset_Pair_subset [THEN conjE])
 apply (erule Transset_Vfrom)
 apply (blast intro: Pair_in_VLimit)
 done
 
 lemma Union_in_Vfrom:
      "\<lbrakk>X \<in> Vfrom(A,j);  Transset(A)\<rbrakk> \<Longrightarrow> \<Union>(X) \<in> Vfrom(A, succ(j))"
 apply (drule Transset_Vfrom)
 apply (rule subset_mem_Vfrom)
 apply (unfold Transset_def, blast)
 done
 
 lemma Union_in_VLimit:
      "\<lbrakk>X \<in> Vfrom(A,i);  Limit(i);  Transset(A)\<rbrakk> \<Longrightarrow> \<Union>(X) \<in> Vfrom(A,i)"
 apply (rule Limit_VfromE, assumption+)
 apply (blast intro: Limit_has_succ VfromI Union_in_Vfrom)
 done
 
 
 (*** Closure under product/sum applied to elements -- thus Vfrom(A,i)
      is a model of simple type theory provided A is a transitive set
      and i is a limit ordinal
 ***)
 
 text\<open>General theorem for membership in Vfrom(A,i) when i is a limit ordinal\<close>
 lemma in_VLimit:
   "\<lbrakk>a \<in> Vfrom(A,i);  b \<in> Vfrom(A,i);  Limit(i);
       \<And>x y j. \<lbrakk>j<i; 1:j; x \<in> Vfrom(A,j); y \<in> Vfrom(A,j)\<rbrakk>
                \<Longrightarrow> \<exists>k. h(x,y) \<in> Vfrom(A,k) \<and> k<i\<rbrakk>
    \<Longrightarrow> h(a,b) \<in> Vfrom(A,i)"
 txt\<open>Infer that a, b occur at ordinals x,xa < i.\<close>
 apply (erule Limit_VfromE, assumption)
 apply (erule Limit_VfromE, assumption, atomize)
 apply (drule_tac x=a in spec)
 apply (drule_tac x=b in spec)
 apply (drule_tac x="x \<union> xa \<union> 2" in spec)
 apply (simp add: Un_least_lt_iff lt_Ord Vfrom_UnI1 Vfrom_UnI2)
 apply (blast intro: Limit_has_0 Limit_has_succ VfromI)
 done
 
 subsubsection\<open>Products\<close>
 
 lemma prod_in_Vfrom:
     "\<lbrakk>a \<in> Vfrom(A,j);  b \<in> Vfrom(A,j);  Transset(A)\<rbrakk>
      \<Longrightarrow> a*b \<in> Vfrom(A, succ(succ(succ(j))))"
 apply (drule Transset_Vfrom)
 apply (rule subset_mem_Vfrom)
-apply (unfold Transset_def)
+  unfolding Transset_def
 apply (blast intro: Pair_in_Vfrom)
 done
 
 lemma prod_in_VLimit:
   "\<lbrakk>a \<in> Vfrom(A,i);  b \<in> Vfrom(A,i);  Limit(i);  Transset(A)\<rbrakk>
    \<Longrightarrow> a*b \<in> Vfrom(A,i)"
 apply (erule in_VLimit, assumption+)
 apply (blast intro: prod_in_Vfrom Limit_has_succ)
 done
 
 subsubsection\<open>Disjoint Sums, or Quine Ordered Pairs\<close>
 
 lemma sum_in_Vfrom:
     "\<lbrakk>a \<in> Vfrom(A,j);  b \<in> Vfrom(A,j);  Transset(A);  1:j\<rbrakk>
      \<Longrightarrow> a+b \<in> Vfrom(A, succ(succ(succ(j))))"
-apply (unfold sum_def)
+  unfolding sum_def
 apply (drule Transset_Vfrom)
 apply (rule subset_mem_Vfrom)
-apply (unfold Transset_def)
+  unfolding Transset_def
 apply (blast intro: zero_in_Vfrom Pair_in_Vfrom i_subset_Vfrom [THEN subsetD])
 done
 
 lemma sum_in_VLimit:
   "\<lbrakk>a \<in> Vfrom(A,i);  b \<in> Vfrom(A,i);  Limit(i);  Transset(A)\<rbrakk>
    \<Longrightarrow> a+b \<in> Vfrom(A,i)"
 apply (erule in_VLimit, assumption+)
 apply (blast intro: sum_in_Vfrom Limit_has_succ)
 done
 
 subsubsection\<open>Function Space!\<close>
 
 lemma fun_in_Vfrom:
     "\<lbrakk>a \<in> Vfrom(A,j);  b \<in> Vfrom(A,j);  Transset(A)\<rbrakk> \<Longrightarrow>
           a->b \<in> Vfrom(A, succ(succ(succ(succ(j)))))"
-apply (unfold Pi_def)
+  unfolding Pi_def
 apply (drule Transset_Vfrom)
 apply (rule subset_mem_Vfrom)
 apply (rule Collect_subset [THEN subset_trans])
 apply (subst Vfrom)
 apply (rule subset_trans [THEN subset_trans])
 apply (rule_tac [3] Un_upper2)
 apply (rule_tac [2] succI1 [THEN UN_upper])
 apply (rule Pow_mono)
-apply (unfold Transset_def)
+  unfolding Transset_def
 apply (blast intro: Pair_in_Vfrom)
 done
 
 lemma fun_in_VLimit:
   "\<lbrakk>a \<in> Vfrom(A,i);  b \<in> Vfrom(A,i);  Limit(i);  Transset(A)\<rbrakk>
    \<Longrightarrow> a->b \<in> Vfrom(A,i)"
 apply (erule in_VLimit, assumption+)
 apply (blast intro: fun_in_Vfrom Limit_has_succ)
 done
 
 lemma Pow_in_Vfrom:
     "\<lbrakk>a \<in> Vfrom(A,j);  Transset(A)\<rbrakk> \<Longrightarrow> Pow(a) \<in> Vfrom(A, succ(succ(j)))"
 apply (drule Transset_Vfrom)
 apply (rule subset_mem_Vfrom)
-apply (unfold Transset_def)
+  unfolding Transset_def
 apply (subst Vfrom, blast)
 done
 
 lemma Pow_in_VLimit:
      "\<lbrakk>a \<in> Vfrom(A,i);  Limit(i);  Transset(A)\<rbrakk> \<Longrightarrow> Pow(a) \<in> Vfrom(A,i)"
 by (blast elim: Limit_VfromE intro: Limit_has_succ Pow_in_Vfrom VfromI)
 
 
 subsection\<open>The Set \<^term>\<open>Vset(i)\<close>\<close>
 
 lemma Vset: "Vset(i) = (\<Union>j\<in>i. Pow(Vset(j)))"
 by (subst Vfrom, blast)
 
 lemmas Vset_succ = Transset_0 [THEN Transset_Vfrom_succ]
 lemmas Transset_Vset = Transset_0 [THEN Transset_Vfrom]
 
 subsubsection\<open>Characterisation of the elements of \<^term>\<open>Vset(i)\<close>\<close>
 
 lemma VsetD [rule_format]: "Ord(i) \<Longrightarrow> \<forall>b. b \<in> Vset(i) \<longrightarrow> rank(b) < i"
 apply (erule trans_induct)
 apply (subst Vset, safe)
 apply (subst rank)
 apply (blast intro: ltI UN_succ_least_lt)
 done
 
 lemma VsetI_lemma [rule_format]:
      "Ord(i) \<Longrightarrow> \<forall>b. rank(b) \<in> i \<longrightarrow> b \<in> Vset(i)"
 apply (erule trans_induct)
 apply (rule allI)
 apply (subst Vset)
 apply (blast intro!: rank_lt [THEN ltD])
 done
 
 lemma VsetI: "rank(x)<i \<Longrightarrow> x \<in> Vset(i)"
 by (blast intro: VsetI_lemma elim: ltE)
 
 text\<open>Merely a lemma for the next result\<close>
 lemma Vset_Ord_rank_iff: "Ord(i) \<Longrightarrow> b \<in> Vset(i) \<longleftrightarrow> rank(b) < i"
 by (blast intro: VsetD VsetI)
 
 lemma Vset_rank_iff [simp]: "b \<in> Vset(a) \<longleftrightarrow> rank(b) < rank(a)"
 apply (rule Vfrom_rank_eq [THEN subst])
 apply (rule Ord_rank [THEN Vset_Ord_rank_iff])
 done
 
 text\<open>This is rank(rank(a)) = rank(a)\<close>
 declare Ord_rank [THEN rank_of_Ord, simp]
 
 lemma rank_Vset: "Ord(i) \<Longrightarrow> rank(Vset(i)) = i"
 apply (subst rank)
 apply (rule equalityI, safe)
 apply (blast intro: VsetD [THEN ltD])
 apply (blast intro: VsetD [THEN ltD] Ord_trans)
 apply (blast intro: i_subset_Vfrom [THEN subsetD]
                     Ord_in_Ord [THEN rank_of_Ord, THEN ssubst])
 done
 
 lemma Finite_Vset: "i \<in> nat \<Longrightarrow> Finite(Vset(i))"
 apply (erule nat_induct)
  apply (simp add: Vfrom_0)
 apply (simp add: Vset_succ)
 done
 
 subsubsection\<open>Reasoning about Sets in Terms of Their Elements' Ranks\<close>
 
 lemma arg_subset_Vset_rank: "a \<subseteq> Vset(rank(a))"
 apply (rule subsetI)
 apply (erule rank_lt [THEN VsetI])
 done
 
 lemma Int_Vset_subset:
     "\<lbrakk>\<And>i. Ord(i) \<Longrightarrow> a \<inter> Vset(i) \<subseteq> b\<rbrakk> \<Longrightarrow> a \<subseteq> b"
 apply (rule subset_trans)
 apply (rule Int_greatest [OF subset_refl arg_subset_Vset_rank])
 apply (blast intro: Ord_rank)
 done
 
 subsubsection\<open>Set Up an Environment for Simplification\<close>
 
 lemma rank_Inl: "rank(a) < rank(Inl(a))"
-apply (unfold Inl_def)
+  unfolding Inl_def
 apply (rule rank_pair2)
 done
 
 lemma rank_Inr: "rank(a) < rank(Inr(a))"
-apply (unfold Inr_def)
+  unfolding Inr_def
 apply (rule rank_pair2)
 done
 
 lemmas rank_rls = rank_Inl rank_Inr rank_pair1 rank_pair2
 
 subsubsection\<open>Recursion over Vset Levels!\<close>
 
 text\<open>NOT SUITABLE FOR REWRITING: recursive!\<close>
 lemma Vrec: "Vrec(a,H) = H(a, \<lambda>x\<in>Vset(rank(a)). Vrec(x,H))"
-apply (unfold Vrec_def)
+  unfolding Vrec_def
 apply (subst transrec, simp)
 apply (rule refl [THEN lam_cong, THEN subst_context], simp add: lt_def)
 done
 
 text\<open>This form avoids giant explosions in proofs. NOTE the form of the premise!\<close>
 lemma def_Vrec:
     "\<lbrakk>\<And>x. h(x)\<equiv>Vrec(x,H)\<rbrakk> \<Longrightarrow>
      h(a) = H(a, \<lambda>x\<in>Vset(rank(a)). h(x))"
 apply simp
 apply (rule Vrec)
 done
 
 text\<open>NOT SUITABLE FOR REWRITING: recursive!\<close>
 lemma Vrecursor:
      "Vrecursor(H,a) = H(\<lambda>x\<in>Vset(rank(a)). Vrecursor(H,x),  a)"
-apply (unfold Vrecursor_def)
+  unfolding Vrecursor_def
 apply (subst transrec, simp)
 apply (rule refl [THEN lam_cong, THEN subst_context], simp add: lt_def)
 done
 
 text\<open>This form avoids giant explosions in proofs. NOTE the form of the premise!\<close>
 lemma def_Vrecursor:
      "h \<equiv> Vrecursor(H) \<Longrightarrow> h(a) = H(\<lambda>x\<in>Vset(rank(a)). h(x),  a)"
 apply simp
 apply (rule Vrecursor)
 done
 
 
 subsection\<open>The Datatype Universe: \<^term>\<open>univ(A)\<close>\<close>
 
 lemma univ_mono: "A<=B \<Longrightarrow> univ(A) \<subseteq> univ(B)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (erule Vfrom_mono)
 apply (rule subset_refl)
 done
 
 lemma Transset_univ: "Transset(A) \<Longrightarrow> Transset(univ(A))"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (erule Transset_Vfrom)
 done
 
 subsubsection\<open>The Set \<^term>\<open>univ(A)\<close> as a Limit\<close>
 
 lemma univ_eq_UN: "univ(A) = (\<Union>i\<in>nat. Vfrom(A,i))"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (rule Limit_nat [THEN Limit_Vfrom_eq])
 done
 
 lemma subset_univ_eq_Int: "c \<subseteq> univ(A) \<Longrightarrow> c = (\<Union>i\<in>nat. c \<inter> Vfrom(A,i))"
 apply (rule subset_UN_iff_eq [THEN iffD1])
 apply (erule univ_eq_UN [THEN subst])
 done
 
 lemma univ_Int_Vfrom_subset:
     "\<lbrakk>a \<subseteq> univ(X);
         \<And>i. i:nat \<Longrightarrow> a \<inter> Vfrom(X,i) \<subseteq> b\<rbrakk>
      \<Longrightarrow> a \<subseteq> b"
 apply (subst subset_univ_eq_Int, assumption)
 apply (rule UN_least, simp)
 done
 
 lemma univ_Int_Vfrom_eq:
     "\<lbrakk>a \<subseteq> univ(X);   b \<subseteq> univ(X);
         \<And>i. i:nat \<Longrightarrow> a \<inter> Vfrom(X,i) = b \<inter> Vfrom(X,i)
 \<rbrakk> \<Longrightarrow> a = b"
 apply (rule equalityI)
 apply (rule univ_Int_Vfrom_subset, assumption)
 apply (blast elim: equalityCE)
 apply (rule univ_Int_Vfrom_subset, assumption)
 apply (blast elim: equalityCE)
 done
 
 subsection\<open>Closure Properties for \<^term>\<open>univ(A)\<close>\<close>
 
 lemma zero_in_univ: "0 \<in> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (rule nat_0I [THEN zero_in_Vfrom])
 done
 
 lemma zero_subset_univ: "{0} \<subseteq> univ(A)"
 by (blast intro: zero_in_univ)
 
 lemma A_subset_univ: "A \<subseteq> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (rule A_subset_Vfrom)
 done
 
 lemmas A_into_univ = A_subset_univ [THEN subsetD]
 
 subsubsection\<open>Closure under Unordered and Ordered Pairs\<close>
 
 lemma singleton_in_univ: "a: univ(A) \<Longrightarrow> {a} \<in> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (blast intro: singleton_in_VLimit Limit_nat)
 done
 
 lemma doubleton_in_univ:
     "\<lbrakk>a: univ(A);  b: univ(A)\<rbrakk> \<Longrightarrow> {a,b} \<in> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (blast intro: doubleton_in_VLimit Limit_nat)
 done
 
 lemma Pair_in_univ:
     "\<lbrakk>a: univ(A);  b: univ(A)\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle> \<in> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (blast intro: Pair_in_VLimit Limit_nat)
 done
 
 lemma Union_in_univ:
      "\<lbrakk>X: univ(A);  Transset(A)\<rbrakk> \<Longrightarrow> \<Union>(X) \<in> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (blast intro: Union_in_VLimit Limit_nat)
 done
 
 lemma product_univ: "univ(A)*univ(A) \<subseteq> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (rule Limit_nat [THEN product_VLimit])
 done
 
 
 subsubsection\<open>The Natural Numbers\<close>
 
 lemma nat_subset_univ: "nat \<subseteq> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (rule i_subset_Vfrom)
 done
 
 lemma nat_into_univ: "n \<in> nat \<Longrightarrow> n \<in> univ(A)"
   by (rule nat_subset_univ [THEN subsetD])
 
 subsubsection\<open>Instances for 1 and 2\<close>
 
 lemma one_in_univ: "1 \<in> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (rule Limit_nat [THEN one_in_VLimit])
 done
 
 text\<open>unused!\<close>
 lemma two_in_univ: "2 \<in> univ(A)"
 by (blast intro: nat_into_univ)
 
 lemma bool_subset_univ: "bool \<subseteq> univ(A)"
-apply (unfold bool_def)
+  unfolding bool_def
 apply (blast intro!: zero_in_univ one_in_univ)
 done
 
 lemmas bool_into_univ = bool_subset_univ [THEN subsetD]
 
 
 subsubsection\<open>Closure under Disjoint Union\<close>
 
 lemma Inl_in_univ: "a: univ(A) \<Longrightarrow> Inl(a) \<in> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (erule Inl_in_VLimit [OF _ Limit_nat])
 done
 
 lemma Inr_in_univ: "b: univ(A) \<Longrightarrow> Inr(b) \<in> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (erule Inr_in_VLimit [OF _ Limit_nat])
 done
 
 lemma sum_univ: "univ(C)+univ(C) \<subseteq> univ(C)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (rule Limit_nat [THEN sum_VLimit])
 done
 
 lemmas sum_subset_univ = subset_trans [OF sum_mono sum_univ]
 
 lemma Sigma_subset_univ:
   "\<lbrakk>A \<subseteq> univ(D); \<And>x. x \<in> A \<Longrightarrow> B(x) \<subseteq> univ(D)\<rbrakk> \<Longrightarrow> Sigma(A,B) \<subseteq> univ(D)"
 apply (simp add: univ_def)
 apply (blast intro: Sigma_subset_VLimit del: subsetI)
 done
 
 
 (*Closure under binary union -- use Un_least
   Closure under Collect -- use  Collect_subset [THEN subset_trans]
   Closure under RepFun -- use   RepFun_subset *)
 
 
 subsection\<open>Finite Branching Closure Properties\<close>
 
 subsubsection\<open>Closure under Finite Powerset\<close>
 
 lemma Fin_Vfrom_lemma:
      "\<lbrakk>b: Fin(Vfrom(A,i));  Limit(i)\<rbrakk> \<Longrightarrow> \<exists>j. b \<subseteq> Vfrom(A,j) \<and> j<i"
 apply (erule Fin_induct)
 apply (blast dest!: Limit_has_0, safe)
 apply (erule Limit_VfromE, assumption)
 apply (blast intro!: Un_least_lt intro: Vfrom_UnI1 Vfrom_UnI2)
 done
 
 lemma Fin_VLimit: "Limit(i) \<Longrightarrow> Fin(Vfrom(A,i)) \<subseteq> Vfrom(A,i)"
 apply (rule subsetI)
 apply (drule Fin_Vfrom_lemma, safe)
 apply (rule Vfrom [THEN ssubst])
 apply (blast dest!: ltD)
 done
 
 lemmas Fin_subset_VLimit = subset_trans [OF Fin_mono Fin_VLimit]
 
 lemma Fin_univ: "Fin(univ(A)) \<subseteq> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (rule Limit_nat [THEN Fin_VLimit])
 done
 
 subsubsection\<open>Closure under Finite Powers: Functions from a Natural Number\<close>
 
 lemma nat_fun_VLimit:
      "\<lbrakk>n: nat;  Limit(i)\<rbrakk> \<Longrightarrow> n -> Vfrom(A,i) \<subseteq> Vfrom(A,i)"
 apply (erule nat_fun_subset_Fin [THEN subset_trans])
 apply (blast del: subsetI
     intro: subset_refl Fin_subset_VLimit Sigma_subset_VLimit nat_subset_VLimit)
 done
 
 lemmas nat_fun_subset_VLimit = subset_trans [OF Pi_mono nat_fun_VLimit]
 
 lemma nat_fun_univ: "n: nat \<Longrightarrow> n -> univ(A) \<subseteq> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (erule nat_fun_VLimit [OF _ Limit_nat])
 done
 
 
 subsubsection\<open>Closure under Finite Function Space\<close>
 
 text\<open>General but seldom-used version; normally the domain is fixed\<close>
 lemma FiniteFun_VLimit1:
      "Limit(i) \<Longrightarrow> Vfrom(A,i) -||> Vfrom(A,i) \<subseteq> Vfrom(A,i)"
 apply (rule FiniteFun.dom_subset [THEN subset_trans])
 apply (blast del: subsetI
              intro: Fin_subset_VLimit Sigma_subset_VLimit subset_refl)
 done
 
 lemma FiniteFun_univ1: "univ(A) -||> univ(A) \<subseteq> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (rule Limit_nat [THEN FiniteFun_VLimit1])
 done
 
 text\<open>Version for a fixed domain\<close>
 lemma FiniteFun_VLimit:
      "\<lbrakk>W \<subseteq> Vfrom(A,i); Limit(i)\<rbrakk> \<Longrightarrow> W -||> Vfrom(A,i) \<subseteq> Vfrom(A,i)"
 apply (rule subset_trans)
 apply (erule FiniteFun_mono [OF _ subset_refl])
 apply (erule FiniteFun_VLimit1)
 done
 
 lemma FiniteFun_univ:
     "W \<subseteq> univ(A) \<Longrightarrow> W -||> univ(A) \<subseteq> univ(A)"
-apply (unfold univ_def)
+  unfolding univ_def
 apply (erule FiniteFun_VLimit [OF _ Limit_nat])
 done
 
 lemma FiniteFun_in_univ:
      "\<lbrakk>f: W -||> univ(A);  W \<subseteq> univ(A)\<rbrakk> \<Longrightarrow> f \<in> univ(A)"
 by (erule FiniteFun_univ [THEN subsetD], assumption)
 
 text\<open>Remove \<open>\<subseteq>\<close> from the rule above\<close>
 lemmas FiniteFun_in_univ' = FiniteFun_in_univ [OF _ subsetI]
 
 
 subsection\<open>* For QUniv.  Properties of Vfrom analogous to the "take-lemma" *\<close>
 
 text\<open>Intersecting a*b with Vfrom...\<close>
 
 text\<open>This version says a, b exist one level down, in the smaller set Vfrom(X,i)\<close>
 lemma doubleton_in_Vfrom_D:
      "\<lbrakk>{a,b} \<in> Vfrom(X,succ(i));  Transset(X)\<rbrakk>
       \<Longrightarrow> a \<in> Vfrom(X,i)  \<and>  b \<in> Vfrom(X,i)"
 by (drule Transset_Vfrom_succ [THEN equalityD1, THEN subsetD, THEN PowD],
     assumption, fast)
 
 text\<open>This weaker version says a, b exist at the same level\<close>
 lemmas Vfrom_doubleton_D = Transset_Vfrom [THEN Transset_doubleton_D]
 
 (** Using only the weaker theorem would prove \<langle>a,b\<rangle> \<in> Vfrom(X,i)
       implies a, b \<in> Vfrom(X,i), which is useless for induction.
     Using only the stronger theorem would prove \<langle>a,b\<rangle> \<in> Vfrom(X,succ(succ(i)))
       implies a, b \<in> Vfrom(X,i), leaving the succ(i) case untreated.
     The combination gives a reduction by precisely one level, which is
       most convenient for proofs.
 **)
 
 lemma Pair_in_Vfrom_D:
     "\<lbrakk>\<langle>a,b\<rangle> \<in> Vfrom(X,succ(i));  Transset(X)\<rbrakk>
      \<Longrightarrow> a \<in> Vfrom(X,i)  \<and>  b \<in> Vfrom(X,i)"
-apply (unfold Pair_def)
+  unfolding Pair_def
 apply (blast dest!: doubleton_in_Vfrom_D Vfrom_doubleton_D)
 done
 
 lemma product_Int_Vfrom_subset:
      "Transset(X) \<Longrightarrow>
       (a*b) \<inter> Vfrom(X, succ(i)) \<subseteq> (a \<inter> Vfrom(X,i)) * (b \<inter> Vfrom(X,i))"
 by (blast dest!: Pair_in_Vfrom_D)
 
 
 ML
 \<open>
 val rank_ss =
   simpset_of (\<^context> addsimps [@{thm VsetI}]
     addsimps @{thms rank_rls} @ (@{thms rank_rls} RLN (2, [@{thm lt_trans}])));
 \<close>
 
 end
diff --git a/src/ZF/WF.thy b/src/ZF/WF.thy
--- a/src/ZF/WF.thy
+++ b/src/ZF/WF.thy
@@ -1,372 +1,372 @@
 (*  Title:      ZF/WF.thy
     Author:     Tobias Nipkow and Lawrence C Paulson
     Copyright   1994  University of Cambridge
 
 Derived first for transitive relations, and finally for arbitrary WF relations
 via wf_trancl and trans_trancl.
 
 It is difficult to derive this general case directly, using r^+ instead of
 r.  In is_recfun, the two occurrences of the relation must have the same
 form.  Inserting r^+ in the_recfun or wftrec yields a recursion rule with
 r^+ -`` {a} instead of r-``{a}.  This recursion rule is stronger in
 principle, but harder to use, especially to prove wfrec_eclose_eq in
 epsilon.ML.  Expanding out the definition of wftrec in wfrec would yield
 a mess.
 *)
 
 section\<open>Well-Founded Recursion\<close>
 
 theory WF imports Trancl begin
 
 definition
   wf           :: "i\<Rightarrow>o"  where
     (*r is a well-founded relation*)
     "wf(r) \<equiv> \<forall>Z. Z=0 | (\<exists>x\<in>Z. \<forall>y. \<langle>y,x\<rangle>:r \<longrightarrow> \<not> y \<in> Z)"
 
 definition
   wf_on        :: "[i,i]\<Rightarrow>o"                      (\<open>wf[_]'(_')\<close>)  where
     (*r is well-founded on A*)
     "wf_on(A,r) \<equiv> wf(r \<inter> A*A)"
 
 definition
   is_recfun    :: "[i, i, [i,i]\<Rightarrow>i, i] \<Rightarrow>o"  where
     "is_recfun(r,a,H,f) \<equiv> (f = (\<lambda>x\<in>r-``{a}. H(x, restrict(f, r-``{x}))))"
 
 definition
   the_recfun   :: "[i, i, [i,i]\<Rightarrow>i] \<Rightarrow>i"  where
     "the_recfun(r,a,H) \<equiv> (THE f. is_recfun(r,a,H,f))"
 
 definition
   wftrec :: "[i, i, [i,i]\<Rightarrow>i] \<Rightarrow>i"  where
     "wftrec(r,a,H) \<equiv> H(a, the_recfun(r,a,H))"
 
 definition
   wfrec :: "[i, i, [i,i]\<Rightarrow>i] \<Rightarrow>i"  where
     (*public version.  Does not require r to be transitive*)
     "wfrec(r,a,H) \<equiv> wftrec(r^+, a, \<lambda>x f. H(x, restrict(f,r-``{x})))"
 
 definition
   wfrec_on     :: "[i, i, i, [i,i]\<Rightarrow>i] \<Rightarrow>i"       (\<open>wfrec[_]'(_,_,_')\<close>)  where
     "wfrec[A](r,a,H) \<equiv> wfrec(r \<inter> A*A, a, H)"
 
 
 subsection\<open>Well-Founded Relations\<close>
 
 subsubsection\<open>Equivalences between \<^term>\<open>wf\<close> and \<^term>\<open>wf_on\<close>\<close>
 
 lemma wf_imp_wf_on: "wf(r) \<Longrightarrow> wf[A](r)"
 by (unfold wf_def wf_on_def, force)
 
 lemma wf_on_imp_wf: "\<lbrakk>wf[A](r); r \<subseteq> A*A\<rbrakk> \<Longrightarrow> wf(r)"
 by (simp add: wf_on_def subset_Int_iff)
 
 lemma wf_on_field_imp_wf: "wf[field(r)](r) \<Longrightarrow> wf(r)"
 by (unfold wf_def wf_on_def, fast)
 
 lemma wf_iff_wf_on_field: "wf(r) \<longleftrightarrow> wf[field(r)](r)"
 by (blast intro: wf_imp_wf_on wf_on_field_imp_wf)
 
 lemma wf_on_subset_A: "\<lbrakk>wf[A](r);  B<=A\<rbrakk> \<Longrightarrow> wf[B](r)"
 by (unfold wf_on_def wf_def, fast)
 
 lemma wf_on_subset_r: "\<lbrakk>wf[A](r); s<=r\<rbrakk> \<Longrightarrow> wf[A](s)"
 by (unfold wf_on_def wf_def, fast)
 
 lemma wf_subset: "\<lbrakk>wf(s); r<=s\<rbrakk> \<Longrightarrow> wf(r)"
 by (simp add: wf_def, fast)
 
 subsubsection\<open>Introduction Rules for \<^term>\<open>wf_on\<close>\<close>
 
 text\<open>If every non-empty subset of \<^term>\<open>A\<close> has an \<^term>\<open>r\<close>-minimal element
    then we have \<^term>\<open>wf[A](r)\<close>.\<close>
 lemma wf_onI:
  assumes prem: "\<And>Z u. \<lbrakk>Z<=A;  u \<in> Z;  \<forall>x\<in>Z. \<exists>y\<in>Z. \<langle>y,x\<rangle>:r\<rbrakk> \<Longrightarrow> False"
  shows         "wf[A](r)"
 apply (unfold wf_on_def wf_def)
 apply (rule equals0I [THEN disjCI, THEN allI])
 apply (rule_tac Z = Z in prem, blast+)
 done
 
 text\<open>If \<^term>\<open>r\<close> allows well-founded induction over \<^term>\<open>A\<close>
    then we have \<^term>\<open>wf[A](r)\<close>.   Premise is equivalent to
   \<^prop>\<open>\<And>B. \<forall>x\<in>A. (\<forall>y. \<langle>y,x\<rangle>: r \<longrightarrow> y \<in> B) \<longrightarrow> x \<in> B \<Longrightarrow> A<=B\<close>\<close>
 lemma wf_onI2:
  assumes prem: "\<And>y B. \<lbrakk>\<forall>x\<in>A. (\<forall>y\<in>A. \<langle>y,x\<rangle>:r \<longrightarrow> y \<in> B) \<longrightarrow> x \<in> B;   y \<in> A\<rbrakk>
                        \<Longrightarrow> y \<in> B"
  shows         "wf[A](r)"
 apply (rule wf_onI)
 apply (rule_tac c=u in prem [THEN DiffE])
   prefer 3 apply blast
  apply fast+
 done
 
 
 subsubsection\<open>Well-founded Induction\<close>
 
 text\<open>Consider the least \<^term>\<open>z\<close> in \<^term>\<open>domain(r)\<close> such that
   \<^term>\<open>P(z)\<close> does not hold...\<close>
 lemma wf_induct_raw:
     "\<lbrakk>wf(r);
         \<And>x.\<lbrakk>\<forall>y. \<langle>y,x\<rangle>: r \<longrightarrow> P(y)\<rbrakk> \<Longrightarrow> P(x)\<rbrakk>
      \<Longrightarrow> P(a)"
-apply (unfold wf_def)
+  unfolding wf_def
 apply (erule_tac x = "{z \<in> domain(r). \<not> P(z)}" in allE)
 apply blast
 done
 
 lemmas wf_induct = wf_induct_raw [rule_format, consumes 1, case_names step, induct set: wf]
 
 text\<open>The form of this rule is designed to match \<open>wfI\<close>\<close>
 lemma wf_induct2:
     "\<lbrakk>wf(r);  a \<in> A;  field(r)<=A;
         \<And>x.\<lbrakk>x \<in> A;  \<forall>y. \<langle>y,x\<rangle>: r \<longrightarrow> P(y)\<rbrakk> \<Longrightarrow> P(x)\<rbrakk>
      \<Longrightarrow>  P(a)"
 apply (erule_tac P="a \<in> A" in rev_mp)
 apply (erule_tac a=a in wf_induct, blast)
 done
 
 lemma field_Int_square: "field(r \<inter> A*A) \<subseteq> A"
 by blast
 
 lemma wf_on_induct_raw [consumes 2, induct set: wf_on]:
     "\<lbrakk>wf[A](r);  a \<in> A;
         \<And>x.\<lbrakk>x \<in> A;  \<forall>y\<in>A. \<langle>y,x\<rangle>: r \<longrightarrow> P(y)\<rbrakk> \<Longrightarrow> P(x)
 \<rbrakk>  \<Longrightarrow>  P(a)"
-apply (unfold wf_on_def)
+  unfolding wf_on_def
 apply (erule wf_induct2, assumption)
 apply (rule field_Int_square, blast)
 done
 
 lemma wf_on_induct [consumes 2, case_names step, induct set: wf_on]:
   "wf[A](r) \<Longrightarrow> a \<in> A \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> (\<And>y. y \<in> A \<Longrightarrow> \<langle>y, x\<rangle> \<in> r \<Longrightarrow> P(y)) \<Longrightarrow> P(x)) \<Longrightarrow> P(a)"
   using wf_on_induct_raw [of A r a P] by simp
 
 text\<open>If \<^term>\<open>r\<close> allows well-founded induction
    then we have \<^term>\<open>wf(r)\<close>.\<close>
 lemma wfI:
     "\<lbrakk>field(r)<=A;
         \<And>y B. \<lbrakk>\<forall>x\<in>A. (\<forall>y\<in>A. \<langle>y,x\<rangle>:r \<longrightarrow> y \<in> B) \<longrightarrow> x \<in> B;  y \<in> A\<rbrakk>
                \<Longrightarrow> y \<in> B\<rbrakk>
      \<Longrightarrow>  wf(r)"
 apply (rule wf_on_subset_A [THEN wf_on_field_imp_wf])
 apply (rule wf_onI2)
  prefer 2 apply blast
 apply blast
 done
 
 
 subsection\<open>Basic Properties of Well-Founded Relations\<close>
 
 lemma wf_not_refl: "wf(r) \<Longrightarrow> \<langle>a,a\<rangle> \<notin> r"
 by (erule_tac a=a in wf_induct, blast)
 
 lemma wf_not_sym [rule_format]: "wf(r) \<Longrightarrow> \<forall>x. \<langle>a,x\<rangle>:r \<longrightarrow> \<langle>x,a\<rangle> \<notin> r"
 by (erule_tac a=a in wf_induct, blast)
 
 (* @{term"\<lbrakk>wf(r);  \<langle>a,x\<rangle> \<in> r;  \<not>P \<Longrightarrow> \<langle>x,a\<rangle> \<in> r\<rbrakk> \<Longrightarrow> P"} *)
 lemmas wf_asym = wf_not_sym [THEN swap]
 
 lemma wf_on_not_refl: "\<lbrakk>wf[A](r); a \<in> A\<rbrakk> \<Longrightarrow> \<langle>a,a\<rangle> \<notin> r"
 by (erule_tac a=a in wf_on_induct, assumption, blast)
 
 lemma wf_on_not_sym:
      "\<lbrakk>wf[A](r);  a \<in> A\<rbrakk> \<Longrightarrow> (\<And>b. b\<in>A \<Longrightarrow> \<langle>a,b\<rangle>:r \<Longrightarrow> \<langle>b,a\<rangle>\<notin>r)"
 apply (atomize (full), intro impI)
 apply (erule_tac a=a in wf_on_induct, assumption, blast)
 done
 
 lemma wf_on_asym:
      "\<lbrakk>wf[A](r);  \<not>Z \<Longrightarrow> \<langle>a,b\<rangle> \<in> r;
          \<langle>b,a\<rangle> \<notin> r \<Longrightarrow> Z; \<not>Z \<Longrightarrow> a \<in> A; \<not>Z \<Longrightarrow> b \<in> A\<rbrakk> \<Longrightarrow> Z"
 by (blast dest: wf_on_not_sym)
 
 
 (*Needed to prove well_ordI.  Could also reason that wf[A](r) means
   wf(r \<inter> A*A);  thus wf( (r \<inter> A*A)^+ ) and use wf_not_refl *)
 lemma wf_on_chain3:
      "\<lbrakk>wf[A](r); \<langle>a,b\<rangle>:r; \<langle>b,c\<rangle>:r; \<langle>c,a\<rangle>:r; a \<in> A; b \<in> A; c \<in> A\<rbrakk> \<Longrightarrow> P"
 apply (subgoal_tac "\<forall>y\<in>A. \<forall>z\<in>A. \<langle>a,y\<rangle>:r \<longrightarrow> \<langle>y,z\<rangle>:r \<longrightarrow> \<langle>z,a\<rangle>:r \<longrightarrow> P",
        blast)
 apply (erule_tac a=a in wf_on_induct, assumption, blast)
 done
 
 
 
 text\<open>transitive closure of a WF relation is WF provided
   \<^term>\<open>A\<close> is downward closed\<close>
 lemma wf_on_trancl:
     "\<lbrakk>wf[A](r);  r-``A \<subseteq> A\<rbrakk> \<Longrightarrow> wf[A](r^+)"
 apply (rule wf_onI2)
 apply (frule bspec [THEN mp], assumption+)
 apply (erule_tac a = y in wf_on_induct, assumption)
 apply (blast elim: tranclE, blast)
 done
 
 lemma wf_trancl: "wf(r) \<Longrightarrow> wf(r^+)"
 apply (simp add: wf_iff_wf_on_field)
 apply (rule wf_on_subset_A)
  apply (erule wf_on_trancl)
  apply blast
 apply (rule trancl_type [THEN field_rel_subset])
 done
 
 
 text\<open>\<^term>\<open>r-``{a}\<close> is the set of everything under \<^term>\<open>a\<close> in \<^term>\<open>r\<close>\<close>
 
 lemmas underI = vimage_singleton_iff [THEN iffD2]
 lemmas underD = vimage_singleton_iff [THEN iffD1]
 
 
 subsection\<open>The Predicate \<^term>\<open>is_recfun\<close>\<close>
 
 lemma is_recfun_type: "is_recfun(r,a,H,f) \<Longrightarrow> f \<in> r-``{a} -> range(f)"
-apply (unfold is_recfun_def)
+  unfolding is_recfun_def
 apply (erule ssubst)
 apply (rule lamI [THEN rangeI, THEN lam_type], assumption)
 done
 
 lemmas is_recfun_imp_function = is_recfun_type [THEN fun_is_function]
 
 lemma apply_recfun:
     "\<lbrakk>is_recfun(r,a,H,f); \<langle>x,a\<rangle>:r\<rbrakk> \<Longrightarrow> f`x = H(x, restrict(f,r-``{x}))"
-apply (unfold is_recfun_def)
+  unfolding is_recfun_def
   txt\<open>replace f only on the left-hand side\<close>
 apply (erule_tac P = "\<lambda>x. t(x) = u" for t u in ssubst)
 apply (simp add: underI)
 done
 
 lemma is_recfun_equal [rule_format]:
      "\<lbrakk>wf(r);  trans(r);  is_recfun(r,a,H,f);  is_recfun(r,b,H,g)\<rbrakk>
       \<Longrightarrow> \<langle>x,a\<rangle>:r \<longrightarrow> \<langle>x,b\<rangle>:r \<longrightarrow> f`x=g`x"
 apply (frule_tac f = f in is_recfun_type)
 apply (frule_tac f = g in is_recfun_type)
 apply (simp add: is_recfun_def)
 apply (erule_tac a=x in wf_induct)
 apply (intro impI)
 apply (elim ssubst)
 apply (simp (no_asm_simp) add: vimage_singleton_iff restrict_def)
 apply (rule_tac t = "\<lambda>z. H (x, z)" for x in subst_context)
 apply (subgoal_tac "\<forall>y\<in>r-``{x}. \<forall>z. \<langle>y,z\<rangle>:f \<longleftrightarrow> \<langle>y,z\<rangle>:g")
  apply (blast dest: transD)
 apply (simp add: apply_iff)
 apply (blast dest: transD intro: sym)
 done
 
 lemma is_recfun_cut:
      "\<lbrakk>wf(r);  trans(r);
          is_recfun(r,a,H,f);  is_recfun(r,b,H,g);  \<langle>b,a\<rangle>:r\<rbrakk>
       \<Longrightarrow> restrict(f, r-``{b}) = g"
 apply (frule_tac f = f in is_recfun_type)
 apply (rule fun_extension)
   apply (blast dest: transD intro: restrict_type2)
  apply (erule is_recfun_type, simp)
 apply (blast dest: transD intro: is_recfun_equal)
 done
 
 subsection\<open>Recursion: Main Existence Lemma\<close>
 
 lemma is_recfun_functional:
      "\<lbrakk>wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,a,H,g)\<rbrakk>  \<Longrightarrow>  f=g"
 by (blast intro: fun_extension is_recfun_type is_recfun_equal)
 
 lemma the_recfun_eq:
     "\<lbrakk>is_recfun(r,a,H,f);  wf(r);  trans(r)\<rbrakk> \<Longrightarrow> the_recfun(r,a,H) = f"
-apply (unfold the_recfun_def)
+  unfolding the_recfun_def
 apply (blast intro: is_recfun_functional)
 done
 
 (*If some f satisfies is_recfun(r,a,H,-) then so does the_recfun(r,a,H) *)
 lemma is_the_recfun:
     "\<lbrakk>is_recfun(r,a,H,f);  wf(r);  trans(r)\<rbrakk>
      \<Longrightarrow> is_recfun(r, a, H, the_recfun(r,a,H))"
 by (simp add: the_recfun_eq)
 
 lemma unfold_the_recfun:
      "\<lbrakk>wf(r);  trans(r)\<rbrakk> \<Longrightarrow> is_recfun(r, a, H, the_recfun(r,a,H))"
 apply (rule_tac a=a in wf_induct, assumption)
 apply (rename_tac a1)
 apply (rule_tac f = "\<lambda>y\<in>r-``{a1}. wftrec (r,y,H)" in is_the_recfun)
   apply typecheck
 apply (unfold is_recfun_def wftrec_def)
   \<comment> \<open>Applying the substitution: must keep the quantified assumption!\<close>
 apply (rule lam_cong [OF refl])
 apply (drule underD)
 apply (fold is_recfun_def)
 apply (rule_tac t = "\<lambda>z. H(x, z)" for x in subst_context)
 apply (rule fun_extension)
   apply (blast intro: is_recfun_type)
  apply (rule lam_type [THEN restrict_type2])
   apply blast
  apply (blast dest: transD)
 apply atomize
 apply (frule spec [THEN mp], assumption)
 apply (subgoal_tac "\<langle>xa,a1\<rangle> \<in> r")
  apply (drule_tac x1 = xa in spec [THEN mp], assumption)
 apply (simp add: vimage_singleton_iff
                  apply_recfun is_recfun_cut)
 apply (blast dest: transD)
 done
 
 
 subsection\<open>Unfolding \<^term>\<open>wftrec(r,a,H)\<close>\<close>
 
 lemma the_recfun_cut:
      "\<lbrakk>wf(r);  trans(r);  \<langle>b,a\<rangle>:r\<rbrakk>
       \<Longrightarrow> restrict(the_recfun(r,a,H), r-``{b}) = the_recfun(r,b,H)"
 by (blast intro: is_recfun_cut unfold_the_recfun)
 
 (*NOT SUITABLE FOR REWRITING: it is recursive!*)
 lemma wftrec:
     "\<lbrakk>wf(r);  trans(r)\<rbrakk> \<Longrightarrow>
           wftrec(r,a,H) = H(a, \<lambda>x\<in>r-``{a}. wftrec(r,x,H))"
-apply (unfold wftrec_def)
+  unfolding wftrec_def
 apply (subst unfold_the_recfun [unfolded is_recfun_def])
 apply (simp_all add: vimage_singleton_iff [THEN iff_sym] the_recfun_cut)
 done
 
 
 subsubsection\<open>Removal of the Premise \<^term>\<open>trans(r)\<close>\<close>
 
 (*NOT SUITABLE FOR REWRITING: it is recursive!*)
 lemma wfrec:
     "wf(r) \<Longrightarrow> wfrec(r,a,H) = H(a, \<lambda>x\<in>r-``{a}. wfrec(r,x,H))"
-apply (unfold wfrec_def)
+  unfolding wfrec_def
 apply (erule wf_trancl [THEN wftrec, THEN ssubst])
  apply (rule trans_trancl)
 apply (rule vimage_pair_mono [THEN restrict_lam_eq, THEN subst_context])
  apply (erule r_into_trancl)
 apply (rule subset_refl)
 done
 
 (*This form avoids giant explosions in proofs.  NOTE USE OF \<equiv> *)
 lemma def_wfrec:
     "\<lbrakk>\<And>x. h(x)\<equiv>wfrec(r,x,H);  wf(r)\<rbrakk> \<Longrightarrow>
      h(a) = H(a, \<lambda>x\<in>r-``{a}. h(x))"
 apply simp
 apply (elim wfrec)
 done
 
 lemma wfrec_type:
     "\<lbrakk>wf(r);  a \<in> A;  field(r)<=A;
         \<And>x u. \<lbrakk>x \<in> A;  u \<in> Pi(r-``{x}, B)\<rbrakk> \<Longrightarrow> H(x,u) \<in> B(x)
 \<rbrakk> \<Longrightarrow> wfrec(r,a,H) \<in> B(a)"
 apply (rule_tac a = a in wf_induct2, assumption+)
 apply (subst wfrec, assumption)
 apply (simp add: lam_type underD)
 done
 
 
 lemma wfrec_on:
  "\<lbrakk>wf[A](r);  a \<in> A\<rbrakk> \<Longrightarrow>
          wfrec[A](r,a,H) = H(a, \<lambda>x\<in>(r-``{a}) \<inter> A. wfrec[A](r,x,H))"
 apply (unfold wf_on_def wfrec_on_def)
 apply (erule wfrec [THEN trans])
 apply (simp add: vimage_Int_square cons_subset_iff)
 done
 
 text\<open>Minimal-element characterization of well-foundedness\<close>
 lemma wf_eq_minimal:
      "wf(r) \<longleftrightarrow> (\<forall>Q x. x \<in> Q \<longrightarrow> (\<exists>z\<in>Q. \<forall>y. \<langle>y,z\<rangle>:r \<longrightarrow> y\<notin>Q))"
 by (unfold wf_def, blast)
 
 end
diff --git a/src/ZF/ZF_Base.thy b/src/ZF/ZF_Base.thy
--- a/src/ZF/ZF_Base.thy
+++ b/src/ZF/ZF_Base.thy
@@ -1,650 +1,650 @@
 (*  Title:      ZF/ZF_Base.thy
     Author:     Lawrence C Paulson and Martin D Coen, CU Computer Laboratory
     Copyright   1993  University of Cambridge
 *)
 
 section \<open>Base of Zermelo-Fraenkel Set Theory\<close>
 
 theory ZF_Base
 imports FOL
 begin
 
 subsection \<open>Signature\<close>
 
 declare [[eta_contract = false]]
 
 typedecl i
 instance i :: "term" ..
 
 axiomatization mem :: "[i, i] \<Rightarrow> o"  (infixl \<open>\<in>\<close> 50)  \<comment> \<open>membership relation\<close>
   and zero :: "i"  (\<open>0\<close>)  \<comment> \<open>the empty set\<close>
   and Pow :: "i \<Rightarrow> i"  \<comment> \<open>power sets\<close>
   and Inf :: "i"  \<comment> \<open>infinite set\<close>
   and Union :: "i \<Rightarrow> i"  (\<open>\<Union>_\<close> [90] 90)
   and PrimReplace :: "[i, [i, i] \<Rightarrow> o] \<Rightarrow> i"
 
 abbreviation not_mem :: "[i, i] \<Rightarrow> o"  (infixl \<open>\<notin>\<close> 50)  \<comment> \<open>negated membership relation\<close>
   where "x \<notin> y \<equiv> \<not> (x \<in> y)"
 
 
 subsection \<open>Bounded Quantifiers\<close>
 
 definition Ball :: "[i, i \<Rightarrow> o] \<Rightarrow> o"
   where "Ball(A, P) \<equiv> \<forall>x. x\<in>A \<longrightarrow> P(x)"
 
 definition Bex :: "[i, i \<Rightarrow> o] \<Rightarrow> o"
   where "Bex(A, P) \<equiv> \<exists>x. x\<in>A \<and> P(x)"
 
 syntax
   "_Ball" :: "[pttrn, i, o] \<Rightarrow> o"  (\<open>(3\<forall>_\<in>_./ _)\<close> 10)
   "_Bex" :: "[pttrn, i, o] \<Rightarrow> o"  (\<open>(3\<exists>_\<in>_./ _)\<close> 10)
 translations
   "\<forall>x\<in>A. P" \<rightleftharpoons> "CONST Ball(A, \<lambda>x. P)"
   "\<exists>x\<in>A. P" \<rightleftharpoons> "CONST Bex(A, \<lambda>x. P)"
 
 
 subsection \<open>Variations on Replacement\<close>
 
 (* Derived form of replacement, restricting P to its functional part.
    The resulting set (for functional P) is the same as with
    PrimReplace, but the rules are simpler. *)
 definition Replace :: "[i, [i, i] \<Rightarrow> o] \<Rightarrow> i"
   where "Replace(A,P) \<equiv> PrimReplace(A, \<lambda>x y. (\<exists>!z. P(x,z)) \<and> P(x,y))"
 
 syntax
   "_Replace"  :: "[pttrn, pttrn, i, o] \<Rightarrow> i"  (\<open>(1{_ ./ _ \<in> _, _})\<close>)
 translations
   "{y. x\<in>A, Q}" \<rightleftharpoons> "CONST Replace(A, \<lambda>x y. Q)"
 
 
 (* Functional form of replacement -- analgous to ML's map functional *)
 
 definition RepFun :: "[i, i \<Rightarrow> i] \<Rightarrow> i"
   where "RepFun(A,f) \<equiv> {y . x\<in>A, y=f(x)}"
 
 syntax
   "_RepFun" :: "[i, pttrn, i] \<Rightarrow> i"  (\<open>(1{_ ./ _ \<in> _})\<close> [51,0,51])
 translations
   "{b. x\<in>A}" \<rightleftharpoons> "CONST RepFun(A, \<lambda>x. b)"
 
 
 (* Separation and Pairing can be derived from the Replacement
    and Powerset Axioms using the following definitions. *)
 definition Collect :: "[i, i \<Rightarrow> o] \<Rightarrow> i"
   where "Collect(A,P) \<equiv> {y . x\<in>A, x=y \<and> P(x)}"
 
 syntax
   "_Collect" :: "[pttrn, i, o] \<Rightarrow> i"  (\<open>(1{_ \<in> _ ./ _})\<close>)
 translations
   "{x\<in>A. P}" \<rightleftharpoons> "CONST Collect(A, \<lambda>x. P)"
 
 
 subsection \<open>General union and intersection\<close>
 
 definition Inter :: "i \<Rightarrow> i"  (\<open>\<Inter>_\<close> [90] 90)
   where "\<Inter>(A) \<equiv> { x\<in>\<Union>(A) . \<forall>y\<in>A. x\<in>y}"
 
 syntax
   "_UNION" :: "[pttrn, i, i] \<Rightarrow> i"  (\<open>(3\<Union>_\<in>_./ _)\<close> 10)
   "_INTER" :: "[pttrn, i, i] \<Rightarrow> i"  (\<open>(3\<Inter>_\<in>_./ _)\<close> 10)
 translations
   "\<Union>x\<in>A. B" == "CONST Union({B. x\<in>A})"
   "\<Inter>x\<in>A. B" == "CONST Inter({B. x\<in>A})"
 
 
 subsection \<open>Finite sets and binary operations\<close>
 
 (*Unordered pairs (Upair) express binary union/intersection and cons;
   set enumerations translate as {a,...,z} = cons(a,...,cons(z,0)...)*)
 
 definition Upair :: "[i, i] \<Rightarrow> i"
   where "Upair(a,b) \<equiv> {y. x\<in>Pow(Pow(0)), (x=0 \<and> y=a) | (x=Pow(0) \<and> y=b)}"
 
 definition Subset :: "[i, i] \<Rightarrow> o"  (infixl \<open>\<subseteq>\<close> 50)  \<comment> \<open>subset relation\<close>
   where subset_def: "A \<subseteq> B \<equiv> \<forall>x\<in>A. x\<in>B"
 
 definition Diff :: "[i, i] \<Rightarrow> i"  (infixl \<open>-\<close> 65)  \<comment> \<open>set difference\<close>
   where "A - B \<equiv> { x\<in>A . \<not>(x\<in>B) }"
 
 definition Un :: "[i, i] \<Rightarrow> i"  (infixl \<open>\<union>\<close> 65)  \<comment> \<open>binary union\<close>
   where "A \<union> B \<equiv> \<Union>(Upair(A,B))"
 
 definition Int :: "[i, i] \<Rightarrow> i"  (infixl \<open>\<inter>\<close> 70)  \<comment> \<open>binary intersection\<close>
   where "A \<inter> B \<equiv> \<Inter>(Upair(A,B))"
 
 definition cons :: "[i, i] \<Rightarrow> i"
   where "cons(a,A) \<equiv> Upair(a,a) \<union> A"
 
 definition succ :: "i \<Rightarrow> i"
   where "succ(i) \<equiv> cons(i, i)"
 
 nonterminal "is"
 syntax
   "" :: "i \<Rightarrow> is"  (\<open>_\<close>)
   "_Enum" :: "[i, is] \<Rightarrow> is"  (\<open>_,/ _\<close>)
   "_Finset" :: "is \<Rightarrow> i"  (\<open>{(_)}\<close>)
 translations
   "{x, xs}" == "CONST cons(x, {xs})"
   "{x}" == "CONST cons(x, 0)"
 
 
 subsection \<open>Axioms\<close>
 
 (* ZF axioms -- see Suppes p.238
    Axioms for Union, Pow and Replace state existence only,
    uniqueness is derivable using extensionality. *)
 
 axiomatization
 where
   extension:     "A = B \<longleftrightarrow> A \<subseteq> B \<and> B \<subseteq> A" and
   Union_iff:     "A \<in> \<Union>(C) \<longleftrightarrow> (\<exists>B\<in>C. A\<in>B)" and
   Pow_iff:       "A \<in> Pow(B) \<longleftrightarrow> A \<subseteq> B" and
 
   (*We may name this set, though it is not uniquely defined.*)
   infinity:      "0 \<in> Inf \<and> (\<forall>y\<in>Inf. succ(y) \<in> Inf)" and
 
   (*This formulation facilitates case analysis on A.*)
   foundation:    "A = 0 \<or> (\<exists>x\<in>A. \<forall>y\<in>x. y\<notin>A)" and
 
   (*Schema axiom since predicate P is a higher-order variable*)
   replacement:   "(\<forall>x\<in>A. \<forall>y z. P(x,y) \<and> P(x,z) \<longrightarrow> y = z) \<Longrightarrow>
                          b \<in> PrimReplace(A,P) \<longleftrightarrow> (\<exists>x\<in>A. P(x,b))"
 
 
 subsection \<open>Definite descriptions -- via Replace over the set "1"\<close>
 
 definition The :: "(i \<Rightarrow> o) \<Rightarrow> i"  (binder \<open>THE \<close> 10)
   where the_def: "The(P)    \<equiv> \<Union>({y . x \<in> {0}, P(y)})"
 
 definition If :: "[o, i, i] \<Rightarrow> i"  (\<open>(if (_)/ then (_)/ else (_))\<close> [10] 10)
   where if_def: "if P then a else b \<equiv> THE z. P \<and> z=a | \<not>P \<and> z=b"
 
 abbreviation (input)
   old_if :: "[o, i, i] \<Rightarrow> i"  (\<open>if '(_,_,_')\<close>)
   where "if(P,a,b) \<equiv> If(P,a,b)"
 
 
 subsection \<open>Ordered Pairing\<close>
 
 (* this "symmetric" definition works better than {{a}, {a,b}} *)
 definition Pair :: "[i, i] \<Rightarrow> i"
   where "Pair(a,b) \<equiv> {{a,a}, {a,b}}"
 
 definition fst :: "i \<Rightarrow> i"
   where "fst(p) \<equiv> THE a. \<exists>b. p = Pair(a, b)"
 
 definition snd :: "i \<Rightarrow> i"
   where "snd(p) \<equiv> THE b. \<exists>a. p = Pair(a, b)"
 
 definition split :: "[[i, i] \<Rightarrow> 'a, i] \<Rightarrow> 'a::{}"  \<comment> \<open>for pattern-matching\<close>
   where "split(c) \<equiv> \<lambda>p. c(fst(p), snd(p))"
 
 (* Patterns -- extends pre-defined type "pttrn" used in abstractions *)
 nonterminal patterns
 syntax
   "_pattern"  :: "patterns \<Rightarrow> pttrn"         (\<open>\<langle>_\<rangle>\<close>)
   ""          :: "pttrn \<Rightarrow> patterns"         (\<open>_\<close>)
   "_patterns" :: "[pttrn, patterns] \<Rightarrow> patterns"  (\<open>_,/_\<close>)
   "_Tuple"    :: "[i, is] \<Rightarrow> i"              (\<open>\<langle>(_,/ _)\<rangle>\<close>)
 translations
   "\<langle>x, y, z\<rangle>"   == "\<langle>x, \<langle>y, z\<rangle>\<rangle>"
   "\<langle>x, y\<rangle>"      == "CONST Pair(x, y)"
   "\<lambda>\<langle>x,y,zs\<rangle>.b" == "CONST split(\<lambda>x \<langle>y,zs\<rangle>.b)"
   "\<lambda>\<langle>x,y\<rangle>.b"    == "CONST split(\<lambda>x y. b)"
 
 definition Sigma :: "[i, i \<Rightarrow> i] \<Rightarrow> i"
   where "Sigma(A,B) \<equiv> \<Union>x\<in>A. \<Union>y\<in>B(x). {\<langle>x,y\<rangle>}"
 
 abbreviation cart_prod :: "[i, i] \<Rightarrow> i"  (infixr \<open>\<times>\<close> 80)  \<comment> \<open>Cartesian product\<close>
   where "A \<times> B \<equiv> Sigma(A, \<lambda>_. B)"
 
 
 subsection \<open>Relations and Functions\<close>
 
 (*converse of relation r, inverse of function*)
 definition converse :: "i \<Rightarrow> i"
   where "converse(r) \<equiv> {z. w\<in>r, \<exists>x y. w=\<langle>x,y\<rangle> \<and> z=\<langle>y,x\<rangle>}"
 
 definition domain :: "i \<Rightarrow> i"
   where "domain(r) \<equiv> {x. w\<in>r, \<exists>y. w=\<langle>x,y\<rangle>}"
 
 definition range :: "i \<Rightarrow> i"
   where "range(r) \<equiv> domain(converse(r))"
 
 definition field :: "i \<Rightarrow> i"
   where "field(r) \<equiv> domain(r) \<union> range(r)"
 
 definition relation :: "i \<Rightarrow> o"  \<comment> \<open>recognizes sets of pairs\<close>
   where "relation(r) \<equiv> \<forall>z\<in>r. \<exists>x y. z = \<langle>x,y\<rangle>"
 
 definition "function" :: "i \<Rightarrow> o"  \<comment> \<open>recognizes functions; can have non-pairs\<close>
   where "function(r) \<equiv> \<forall>x y. \<langle>x,y\<rangle> \<in> r \<longrightarrow> (\<forall>y'. \<langle>x,y'\<rangle> \<in> r \<longrightarrow> y = y')"
 
 definition Image :: "[i, i] \<Rightarrow> i"  (infixl \<open>``\<close> 90)  \<comment> \<open>image\<close>
   where image_def: "r `` A  \<equiv> {y \<in> range(r). \<exists>x\<in>A. \<langle>x,y\<rangle> \<in> r}"
 
 definition vimage :: "[i, i] \<Rightarrow> i"  (infixl \<open>-``\<close> 90)  \<comment> \<open>inverse image\<close>
   where vimage_def: "r -`` A \<equiv> converse(r)``A"
 
 (* Restrict the relation r to the domain A *)
 definition restrict :: "[i, i] \<Rightarrow> i"
   where "restrict(r,A) \<equiv> {z \<in> r. \<exists>x\<in>A. \<exists>y. z = \<langle>x,y\<rangle>}"
 
 
 (* Abstraction, application and Cartesian product of a family of sets *)
 
 definition Lambda :: "[i, i \<Rightarrow> i] \<Rightarrow> i"
   where lam_def: "Lambda(A,b) \<equiv> {\<langle>x,b(x)\<rangle>. x\<in>A}"
 
 definition "apply" :: "[i, i] \<Rightarrow> i"  (infixl \<open>`\<close> 90)  \<comment> \<open>function application\<close>
   where "f`a \<equiv> \<Union>(f``{a})"
 
 definition Pi :: "[i, i \<Rightarrow> i] \<Rightarrow> i"
   where "Pi(A,B) \<equiv> {f\<in>Pow(Sigma(A,B)). A\<subseteq>domain(f) \<and> function(f)}"
 
 abbreviation function_space :: "[i, i] \<Rightarrow> i"  (infixr \<open>\<rightarrow>\<close> 60)  \<comment> \<open>function space\<close>
   where "A \<rightarrow> B \<equiv> Pi(A, \<lambda>_. B)"
 
 
 (* binder syntax *)
 
 syntax
   "_PROD"     :: "[pttrn, i, i] \<Rightarrow> i"        (\<open>(3\<Prod>_\<in>_./ _)\<close> 10)
   "_SUM"      :: "[pttrn, i, i] \<Rightarrow> i"        (\<open>(3\<Sum>_\<in>_./ _)\<close> 10)
   "_lam"      :: "[pttrn, i, i] \<Rightarrow> i"        (\<open>(3\<lambda>_\<in>_./ _)\<close> 10)
 translations
   "\<Prod>x\<in>A. B"   == "CONST Pi(A, \<lambda>x. B)"
   "\<Sum>x\<in>A. B"   == "CONST Sigma(A, \<lambda>x. B)"
   "\<lambda>x\<in>A. f"    == "CONST Lambda(A, \<lambda>x. f)"
 
 
 subsection \<open>ASCII syntax\<close>
 
 notation (ASCII)
   cart_prod       (infixr \<open>*\<close> 80) and
   Int             (infixl \<open>Int\<close> 70) and
   Un              (infixl \<open>Un\<close> 65) and
   function_space  (infixr \<open>->\<close> 60) and
   Subset          (infixl \<open><=\<close> 50) and
   mem             (infixl \<open>:\<close> 50) and
   not_mem         (infixl \<open>\<not>:\<close> 50)
 
 syntax (ASCII)
   "_Ball"     :: "[pttrn, i, o] \<Rightarrow> o"        (\<open>(3ALL _:_./ _)\<close> 10)
   "_Bex"      :: "[pttrn, i, o] \<Rightarrow> o"        (\<open>(3EX _:_./ _)\<close> 10)
   "_Collect"  :: "[pttrn, i, o] \<Rightarrow> i"        (\<open>(1{_: _ ./ _})\<close>)
   "_Replace"  :: "[pttrn, pttrn, i, o] \<Rightarrow> i" (\<open>(1{_ ./ _: _, _})\<close>)
   "_RepFun"   :: "[i, pttrn, i] \<Rightarrow> i"        (\<open>(1{_ ./ _: _})\<close> [51,0,51])
   "_UNION"    :: "[pttrn, i, i] \<Rightarrow> i"        (\<open>(3UN _:_./ _)\<close> 10)
   "_INTER"    :: "[pttrn, i, i] \<Rightarrow> i"        (\<open>(3INT _:_./ _)\<close> 10)
   "_PROD"     :: "[pttrn, i, i] \<Rightarrow> i"        (\<open>(3PROD _:_./ _)\<close> 10)
   "_SUM"      :: "[pttrn, i, i] \<Rightarrow> i"        (\<open>(3SUM _:_./ _)\<close> 10)
   "_lam"      :: "[pttrn, i, i] \<Rightarrow> i"        (\<open>(3lam _:_./ _)\<close> 10)
   "_Tuple"    :: "[i, is] \<Rightarrow> i"              (\<open><(_,/ _)>\<close>)
   "_pattern"  :: "patterns \<Rightarrow> pttrn"         (\<open><_>\<close>)
 
 
 subsection \<open>Substitution\<close>
 
 (*Useful examples:  singletonI RS subst_elem,  subst_elem RSN (2,IntI) *)
 lemma subst_elem: "\<lbrakk>b\<in>A;  a=b\<rbrakk> \<Longrightarrow> a\<in>A"
 by (erule ssubst, assumption)
 
 
 subsection\<open>Bounded universal quantifier\<close>
 
 lemma ballI [intro!]: "\<lbrakk>\<And>x. x\<in>A \<Longrightarrow> P(x)\<rbrakk> \<Longrightarrow> \<forall>x\<in>A. P(x)"
 by (simp add: Ball_def)
 
 lemmas strip = impI allI ballI
 
 lemma bspec [dest?]: "\<lbrakk>\<forall>x\<in>A. P(x);  x: A\<rbrakk> \<Longrightarrow> P(x)"
 by (simp add: Ball_def)
 
 (*Instantiates x first: better for automatic theorem proving?*)
 lemma rev_ballE [elim]:
     "\<lbrakk>\<forall>x\<in>A. P(x);  x\<notin>A \<Longrightarrow> Q;  P(x) \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
 by (simp add: Ball_def, blast)
 
 lemma ballE: "\<lbrakk>\<forall>x\<in>A. P(x);  P(x) \<Longrightarrow> Q;  x\<notin>A \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
 by blast
 
 (*Used in the datatype package*)
 lemma rev_bspec: "\<lbrakk>x: A;  \<forall>x\<in>A. P(x)\<rbrakk> \<Longrightarrow> P(x)"
 by (simp add: Ball_def)
 
 (*Trival rewrite rule;   @{term"(\<forall>x\<in>A.P)<->P"} holds only if A is nonempty!*)
 lemma ball_triv [simp]: "(\<forall>x\<in>A. P) <-> ((\<exists>x. x\<in>A) \<longrightarrow> P)"
 by (simp add: Ball_def)
 
 (*Congruence rule for rewriting*)
 lemma ball_cong [cong]:
     "\<lbrakk>A=A';  \<And>x. x\<in>A' \<Longrightarrow> P(x) <-> P'(x)\<rbrakk> \<Longrightarrow> (\<forall>x\<in>A. P(x)) <-> (\<forall>x\<in>A'. P'(x))"
 by (simp add: Ball_def)
 
 lemma atomize_ball:
     "(\<And>x. x \<in> A \<Longrightarrow> P(x)) \<equiv> Trueprop (\<forall>x\<in>A. P(x))"
   by (simp only: Ball_def atomize_all atomize_imp)
 
 lemmas [symmetric, rulify] = atomize_ball
   and [symmetric, defn] = atomize_ball
 
 
 subsection\<open>Bounded existential quantifier\<close>
 
 lemma bexI [intro]: "\<lbrakk>P(x);  x: A\<rbrakk> \<Longrightarrow> \<exists>x\<in>A. P(x)"
 by (simp add: Bex_def, blast)
 
 (*The best argument order when there is only one @{term"x\<in>A"}*)
 lemma rev_bexI: "\<lbrakk>x\<in>A;  P(x)\<rbrakk> \<Longrightarrow> \<exists>x\<in>A. P(x)"
 by blast
 
 (*Not of the general form for such rules. The existential quanitifer becomes universal. *)
 lemma bexCI: "\<lbrakk>\<forall>x\<in>A. \<not>P(x) \<Longrightarrow> P(a);  a: A\<rbrakk> \<Longrightarrow> \<exists>x\<in>A. P(x)"
 by blast
 
 lemma bexE [elim!]: "\<lbrakk>\<exists>x\<in>A. P(x);  \<And>x. \<lbrakk>x\<in>A; P(x)\<rbrakk> \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
 by (simp add: Bex_def, blast)
 
 (*We do not even have @{term"(\<exists>x\<in>A. True) <-> True"} unless @{term"A" is nonempty\<And>*)
 lemma bex_triv [simp]: "(\<exists>x\<in>A. P) <-> ((\<exists>x. x\<in>A) \<and> P)"
 by (simp add: Bex_def)
 
 lemma bex_cong [cong]:
     "\<lbrakk>A=A';  \<And>x. x\<in>A' \<Longrightarrow> P(x) <-> P'(x)\<rbrakk>
      \<Longrightarrow> (\<exists>x\<in>A. P(x)) <-> (\<exists>x\<in>A'. P'(x))"
 by (simp add: Bex_def cong: conj_cong)
 
 
 
 subsection\<open>Rules for subsets\<close>
 
 lemma subsetI [intro!]:
     "(\<And>x. x\<in>A \<Longrightarrow> x\<in>B) \<Longrightarrow> A \<subseteq> B"
 by (simp add: subset_def)
 
 (*Rule in Modus Ponens style [was called subsetE] *)
 lemma subsetD [elim]: "\<lbrakk>A \<subseteq> B;  c\<in>A\<rbrakk> \<Longrightarrow> c\<in>B"
-apply (unfold subset_def)
+  unfolding subset_def
 apply (erule bspec, assumption)
 done
 
 (*Classical elimination rule*)
 lemma subsetCE [elim]:
     "\<lbrakk>A \<subseteq> B;  c\<notin>A \<Longrightarrow> P;  c\<in>B \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (simp add: subset_def, blast)
 
 (*Sometimes useful with premises in this order*)
 lemma rev_subsetD: "\<lbrakk>c\<in>A; A<=B\<rbrakk> \<Longrightarrow> c\<in>B"
 by blast
 
 lemma contra_subsetD: "\<lbrakk>A \<subseteq> B; c \<notin> B\<rbrakk> \<Longrightarrow> c \<notin> A"
 by blast
 
 lemma rev_contra_subsetD: "\<lbrakk>c \<notin> B;  A \<subseteq> B\<rbrakk> \<Longrightarrow> c \<notin> A"
 by blast
 
 lemma subset_refl [simp]: "A \<subseteq> A"
 by blast
 
 lemma subset_trans: "\<lbrakk>A<=B;  B<=C\<rbrakk> \<Longrightarrow> A<=C"
 by blast
 
 (*Useful for proving A<=B by rewriting in some cases*)
 lemma subset_iff:
      "A<=B <-> (\<forall>x. x\<in>A \<longrightarrow> x\<in>B)"
 apply (unfold subset_def Ball_def)
 apply (rule iff_refl)
 done
 
 text\<open>For calculations\<close>
 declare subsetD [trans] rev_subsetD [trans] subset_trans [trans]
 
 
 subsection\<open>Rules for equality\<close>
 
 (*Anti-symmetry of the subset relation*)
 lemma equalityI [intro]: "\<lbrakk>A \<subseteq> B;  B \<subseteq> A\<rbrakk> \<Longrightarrow> A = B"
 by (rule extension [THEN iffD2], rule conjI)
 
 
 lemma equality_iffI: "(\<And>x. x\<in>A <-> x\<in>B) \<Longrightarrow> A = B"
 by (rule equalityI, blast+)
 
 lemmas equalityD1 = extension [THEN iffD1, THEN conjunct1]
 lemmas equalityD2 = extension [THEN iffD1, THEN conjunct2]
 
 lemma equalityE: "\<lbrakk>A = B;  \<lbrakk>A<=B; B<=A\<rbrakk> \<Longrightarrow> P\<rbrakk>  \<Longrightarrow>  P"
 by (blast dest: equalityD1 equalityD2)
 
 lemma equalityCE:
     "\<lbrakk>A = B;  \<lbrakk>c\<in>A; c\<in>B\<rbrakk> \<Longrightarrow> P;  \<lbrakk>c\<notin>A; c\<notin>B\<rbrakk> \<Longrightarrow> P\<rbrakk>  \<Longrightarrow>  P"
 by (erule equalityE, blast)
 
 lemma equality_iffD:
   "A = B \<Longrightarrow> (\<And>x. x \<in> A <-> x \<in> B)"
   by auto
 
 
 subsection\<open>Rules for Replace -- the derived form of replacement\<close>
 
 lemma Replace_iff:
     "b \<in> {y. x\<in>A, P(x,y)}  <->  (\<exists>x\<in>A. P(x,b) \<and> (\<forall>y. P(x,y) \<longrightarrow> y=b))"
-apply (unfold Replace_def)
+  unfolding Replace_def
 apply (rule replacement [THEN iff_trans], blast+)
 done
 
 (*Introduction; there must be a unique y such that P(x,y), namely y=b. *)
 lemma ReplaceI [intro]:
     "\<lbrakk>P(x,b);  x: A;  \<And>y. P(x,y) \<Longrightarrow> y=b\<rbrakk> \<Longrightarrow>
      b \<in> {y. x\<in>A, P(x,y)}"
 by (rule Replace_iff [THEN iffD2], blast)
 
 (*Elimination; may asssume there is a unique y such that P(x,y), namely y=b. *)
 lemma ReplaceE:
     "\<lbrakk>b \<in> {y. x\<in>A, P(x,y)};
         \<And>x. \<lbrakk>x: A;  P(x,b);  \<forall>y. P(x,y)\<longrightarrow>y=b\<rbrakk> \<Longrightarrow> R
 \<rbrakk> \<Longrightarrow> R"
 by (rule Replace_iff [THEN iffD1, THEN bexE], simp+)
 
 (*As above but without the (generally useless) 3rd assumption*)
 lemma ReplaceE2 [elim!]:
     "\<lbrakk>b \<in> {y. x\<in>A, P(x,y)};
         \<And>x. \<lbrakk>x: A;  P(x,b)\<rbrakk> \<Longrightarrow> R
 \<rbrakk> \<Longrightarrow> R"
 by (erule ReplaceE, blast)
 
 lemma Replace_cong [cong]:
     "\<lbrakk>A=B;  \<And>x y. x\<in>B \<Longrightarrow> P(x,y) <-> Q(x,y)\<rbrakk> \<Longrightarrow>
      Replace(A,P) = Replace(B,Q)"
 apply (rule equality_iffI)
 apply (simp add: Replace_iff)
 done
 
 
 subsection\<open>Rules for RepFun\<close>
 
 lemma RepFunI: "a \<in> A \<Longrightarrow> f(a) \<in> {f(x). x\<in>A}"
 by (simp add: RepFun_def Replace_iff, blast)
 
 (*Useful for coinduction proofs*)
 lemma RepFun_eqI [intro]: "\<lbrakk>b=f(a);  a \<in> A\<rbrakk> \<Longrightarrow> b \<in> {f(x). x\<in>A}"
 apply (erule ssubst)
 apply (erule RepFunI)
 done
 
 lemma RepFunE [elim!]:
     "\<lbrakk>b \<in> {f(x). x\<in>A};
         \<And>x.\<lbrakk>x\<in>A;  b=f(x)\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow>
      P"
 by (simp add: RepFun_def Replace_iff, blast)
 
 lemma RepFun_cong [cong]:
     "\<lbrakk>A=B;  \<And>x. x\<in>B \<Longrightarrow> f(x)=g(x)\<rbrakk> \<Longrightarrow> RepFun(A,f) = RepFun(B,g)"
 by (simp add: RepFun_def)
 
 lemma RepFun_iff [simp]: "b \<in> {f(x). x\<in>A} <-> (\<exists>x\<in>A. b=f(x))"
 by (unfold Bex_def, blast)
 
 lemma triv_RepFun [simp]: "{x. x\<in>A} = A"
 by blast
 
 
 subsection\<open>Rules for Collect -- forming a subset by separation\<close>
 
 (*Separation is derivable from Replacement*)
 lemma separation [simp]: "a \<in> {x\<in>A. P(x)} <-> a\<in>A \<and> P(a)"
 by (unfold Collect_def, blast)
 
 lemma CollectI [intro!]: "\<lbrakk>a\<in>A;  P(a)\<rbrakk> \<Longrightarrow> a \<in> {x\<in>A. P(x)}"
 by simp
 
 lemma CollectE [elim!]: "\<lbrakk>a \<in> {x\<in>A. P(x)};  \<lbrakk>a\<in>A; P(a)\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
 by simp
 
 lemma CollectD1: "a \<in> {x\<in>A. P(x)} \<Longrightarrow> a\<in>A"
 by (erule CollectE, assumption)
 
 lemma CollectD2: "a \<in> {x\<in>A. P(x)} \<Longrightarrow> P(a)"
 by (erule CollectE, assumption)
 
 lemma Collect_cong [cong]:
     "\<lbrakk>A=B;  \<And>x. x\<in>B \<Longrightarrow> P(x) <-> Q(x)\<rbrakk>
      \<Longrightarrow> Collect(A, \<lambda>x. P(x)) = Collect(B, \<lambda>x. Q(x))"
 by (simp add: Collect_def)
 
 
 subsection\<open>Rules for Unions\<close>
 
 declare Union_iff [simp]
 
 (*The order of the premises presupposes that C is rigid; A may be flexible*)
 lemma UnionI [intro]: "\<lbrakk>B: C;  A: B\<rbrakk> \<Longrightarrow> A: \<Union>(C)"
 by (simp, blast)
 
 lemma UnionE [elim!]: "\<lbrakk>A \<in> \<Union>(C);  \<And>B.\<lbrakk>A: B;  B: C\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
 by (simp, blast)
 
 
 subsection\<open>Rules for Unions of families\<close>
 (* @{term"\<Union>x\<in>A. B(x)"} abbreviates @{term"\<Union>({B(x). x\<in>A})"} *)
 
 lemma UN_iff [simp]: "b \<in> (\<Union>x\<in>A. B(x)) <-> (\<exists>x\<in>A. b \<in> B(x))"
 by (simp add: Bex_def, blast)
 
 (*The order of the premises presupposes that A is rigid; b may be flexible*)
 lemma UN_I: "\<lbrakk>a: A;  b: B(a)\<rbrakk> \<Longrightarrow> b: (\<Union>x\<in>A. B(x))"
 by (simp, blast)
 
 
 lemma UN_E [elim!]:
     "\<lbrakk>b \<in> (\<Union>x\<in>A. B(x));  \<And>x.\<lbrakk>x: A;  b: B(x)\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
 by blast
 
 lemma UN_cong:
     "\<lbrakk>A=B;  \<And>x. x\<in>B \<Longrightarrow> C(x)=D(x)\<rbrakk> \<Longrightarrow> (\<Union>x\<in>A. C(x)) = (\<Union>x\<in>B. D(x))"
 by simp
 
 
 (*No "Addcongs [UN_cong]" because @{term\<Union>} is a combination of constants*)
 
 (* UN_E appears before UnionE so that it is tried first, to avoid expensive
   calls to hyp_subst_tac.  Cannot include UN_I as it is unsafe: would enlarge
   the search space.*)
 
 
 subsection\<open>Rules for the empty set\<close>
 
 (*The set @{term"{x\<in>0. False}"} is empty; by foundation it equals 0
   See Suppes, page 21.*)
 lemma not_mem_empty [simp]: "a \<notin> 0"
 apply (cut_tac foundation)
 apply (best dest: equalityD2)
 done
 
 lemmas emptyE [elim!] = not_mem_empty [THEN notE]
 
 
 lemma empty_subsetI [simp]: "0 \<subseteq> A"
 by blast
 
 lemma equals0I: "\<lbrakk>\<And>y. y\<in>A \<Longrightarrow> False\<rbrakk> \<Longrightarrow> A=0"
 by blast
 
 lemma equals0D [dest]: "A=0 \<Longrightarrow> a \<notin> A"
 by blast
 
 declare sym [THEN equals0D, dest]
 
 lemma not_emptyI: "a\<in>A \<Longrightarrow> A \<noteq> 0"
 by blast
 
 lemma not_emptyE:  "\<lbrakk>A \<noteq> 0;  \<And>x. x\<in>A \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
 by blast
 
 
 subsection\<open>Rules for Inter\<close>
 
 (*Not obviously useful for proving InterI, InterD, InterE*)
 lemma Inter_iff: "A \<in> \<Inter>(C) <-> (\<forall>x\<in>C. A: x) \<and> C\<noteq>0"
 by (simp add: Inter_def Ball_def, blast)
 
 (* Intersection is well-behaved only if the family is non-empty! *)
 lemma InterI [intro!]:
     "\<lbrakk>\<And>x. x: C \<Longrightarrow> A: x;  C\<noteq>0\<rbrakk> \<Longrightarrow> A \<in> \<Inter>(C)"
 by (simp add: Inter_iff)
 
 (*A "destruct" rule -- every B in C contains A as an element, but
   A\<in>B can hold when B\<in>C does not!  This rule is analogous to "spec". *)
 lemma InterD [elim, Pure.elim]: "\<lbrakk>A \<in> \<Inter>(C);  B \<in> C\<rbrakk> \<Longrightarrow> A \<in> B"
 by (unfold Inter_def, blast)
 
 (*"Classical" elimination rule -- does not require exhibiting @{term"B\<in>C"} *)
 lemma InterE [elim]:
     "\<lbrakk>A \<in> \<Inter>(C);  B\<notin>C \<Longrightarrow> R;  A\<in>B \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
 by (simp add: Inter_def, blast)
 
 
 subsection\<open>Rules for Intersections of families\<close>
 
 (* @{term"\<Inter>x\<in>A. B(x)"} abbreviates @{term"\<Inter>({B(x). x\<in>A})"} *)
 
 lemma INT_iff: "b \<in> (\<Inter>x\<in>A. B(x)) <-> (\<forall>x\<in>A. b \<in> B(x)) \<and> A\<noteq>0"
 by (force simp add: Inter_def)
 
 lemma INT_I: "\<lbrakk>\<And>x. x: A \<Longrightarrow> b: B(x);  A\<noteq>0\<rbrakk> \<Longrightarrow> b: (\<Inter>x\<in>A. B(x))"
 by blast
 
 lemma INT_E: "\<lbrakk>b \<in> (\<Inter>x\<in>A. B(x));  a: A\<rbrakk> \<Longrightarrow> b \<in> B(a)"
 by blast
 
 lemma INT_cong:
     "\<lbrakk>A=B;  \<And>x. x\<in>B \<Longrightarrow> C(x)=D(x)\<rbrakk> \<Longrightarrow> (\<Inter>x\<in>A. C(x)) = (\<Inter>x\<in>B. D(x))"
 by simp
 
 (*No "Addcongs [INT_cong]" because @{term\<Inter>} is a combination of constants*)
 
 
 subsection\<open>Rules for Powersets\<close>
 
 lemma PowI: "A \<subseteq> B \<Longrightarrow> A \<in> Pow(B)"
 by (erule Pow_iff [THEN iffD2])
 
 lemma PowD: "A \<in> Pow(B)  \<Longrightarrow>  A<=B"
 by (erule Pow_iff [THEN iffD1])
 
 declare Pow_iff [iff]
 
 lemmas Pow_bottom = empty_subsetI [THEN PowI]    \<comment> \<open>\<^term>\<open>0 \<in> Pow(B)\<close>\<close>
 lemmas Pow_top = subset_refl [THEN PowI]         \<comment> \<open>\<^term>\<open>A \<in> Pow(A)\<close>\<close>
 
 
 subsection\<open>Cantor's Theorem: There is no surjection from a set to its powerset.\<close>
 
 (*The search is undirected.  Allowing redundant introduction rules may
   make it diverge.  Variable b represents ANY map, such as
   (lam x\<in>A.b(x)): A->Pow(A). *)
 lemma cantor: "\<exists>S \<in> Pow(A). \<forall>x\<in>A. b(x) \<noteq> S"
 by (best elim!: equalityCE del: ReplaceI RepFun_eqI)
 
 end
diff --git a/src/ZF/Zorn.thy b/src/ZF/Zorn.thy
--- a/src/ZF/Zorn.thy
+++ b/src/ZF/Zorn.thy
@@ -1,517 +1,517 @@
 (*  Title:      ZF/Zorn.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1994  University of Cambridge
 *)
 
 section\<open>Zorn's Lemma\<close>
 
 theory Zorn imports OrderArith AC Inductive begin
 
 text\<open>Based upon the unpublished article ``Towards the Mechanization of the
 Proofs of Some Classical Theorems of Set Theory,'' by Abrial and Laffitte.\<close>
 
 definition
   Subset_rel :: "i\<Rightarrow>i"  where
    "Subset_rel(A) \<equiv> {z \<in> A*A . \<exists>x y. z=\<langle>x,y\<rangle> \<and> x<=y \<and> x\<noteq>y}"
 
 definition
   chain      :: "i\<Rightarrow>i"  where
    "chain(A)      \<equiv> {F \<in> Pow(A). \<forall>X\<in>F. \<forall>Y\<in>F. X<=Y | Y<=X}"
 
 definition
   super      :: "[i,i]\<Rightarrow>i"  where
    "super(A,c)    \<equiv> {d \<in> chain(A). c<=d \<and> c\<noteq>d}"
 
 definition
   maxchain   :: "i\<Rightarrow>i"  where
    "maxchain(A)   \<equiv> {c \<in> chain(A). super(A,c)=0}"
 
 definition
   increasing :: "i\<Rightarrow>i"  where
     "increasing(A) \<equiv> {f \<in> Pow(A)->Pow(A). \<forall>x. x<=A \<longrightarrow> x<=f`x}"
 
 
 text\<open>Lemma for the inductive definition below\<close>
 lemma Union_in_Pow: "Y \<in> Pow(Pow(A)) \<Longrightarrow> \<Union>(Y) \<in> Pow(A)"
 by blast
 
 
 text\<open>We could make the inductive definition conditional on
     \<^term>\<open>next \<in> increasing(S)\<close>
     but instead we make this a side-condition of an introduction rule.  Thus
     the induction rule lets us assume that condition!  Many inductive proofs
     are therefore unconditional.\<close>
 consts
   "TFin" :: "[i,i]\<Rightarrow>i"
 
 inductive
   domains       "TFin(S,next)" \<subseteq> "Pow(S)"
   intros
     nextI:       "\<lbrakk>x \<in> TFin(S,next);  next \<in> increasing(S)\<rbrakk>
                   \<Longrightarrow> next`x \<in> TFin(S,next)"
 
     Pow_UnionI: "Y \<in> Pow(TFin(S,next)) \<Longrightarrow> \<Union>(Y) \<in> TFin(S,next)"
 
   monos         Pow_mono
   con_defs      increasing_def
   type_intros   CollectD1 [THEN apply_funtype] Union_in_Pow
 
 
 subsection\<open>Mathematical Preamble\<close>
 
 lemma Union_lemma0: "(\<forall>x\<in>C. x<=A | B<=x) \<Longrightarrow> \<Union>(C)<=A | B<=\<Union>(C)"
 by blast
 
 lemma Inter_lemma0:
      "\<lbrakk>c \<in> C; \<forall>x\<in>C. A<=x | x<=B\<rbrakk> \<Longrightarrow> A \<subseteq> \<Inter>(C) | \<Inter>(C) \<subseteq> B"
 by blast
 
 
 subsection\<open>The Transfinite Construction\<close>
 
 lemma increasingD1: "f \<in> increasing(A) \<Longrightarrow> f \<in> Pow(A)->Pow(A)"
-apply (unfold increasing_def)
+  unfolding increasing_def
 apply (erule CollectD1)
 done
 
 lemma increasingD2: "\<lbrakk>f \<in> increasing(A); x<=A\<rbrakk> \<Longrightarrow> x \<subseteq> f`x"
 by (unfold increasing_def, blast)
 
 lemmas TFin_UnionI = PowI [THEN TFin.Pow_UnionI]
 
 lemmas TFin_is_subset = TFin.dom_subset [THEN subsetD, THEN PowD]
 
 
 text\<open>Structural induction on \<^term>\<open>TFin(S,next)\<close>\<close>
 lemma TFin_induct:
   "\<lbrakk>n \<in> TFin(S,next);
       \<And>x. \<lbrakk>x \<in> TFin(S,next);  P(x);  next \<in> increasing(S)\<rbrakk> \<Longrightarrow> P(next`x);
       \<And>Y. \<lbrakk>Y \<subseteq> TFin(S,next);  \<forall>y\<in>Y. P(y)\<rbrakk> \<Longrightarrow> P(\<Union>(Y))
 \<rbrakk> \<Longrightarrow> P(n)"
 by (erule TFin.induct, blast+)
 
 
 subsection\<open>Some Properties of the Transfinite Construction\<close>
 
 lemmas increasing_trans = subset_trans [OF _ increasingD2,
                                         OF _ _ TFin_is_subset]
 
 text\<open>Lemma 1 of section 3.1\<close>
 lemma TFin_linear_lemma1:
      "\<lbrakk>n \<in> TFin(S,next);  m \<in> TFin(S,next);
          \<forall>x \<in> TFin(S,next) . x<=m \<longrightarrow> x=m | next`x<=m\<rbrakk>
       \<Longrightarrow> n<=m | next`m<=n"
 apply (erule TFin_induct)
 apply (erule_tac [2] Union_lemma0) (*or just Blast_tac*)
 (*downgrade subsetI from intro! to intro*)
 apply (blast dest: increasing_trans)
 done
 
 text\<open>Lemma 2 of section 3.2.  Interesting in its own right!
   Requires \<^term>\<open>next \<in> increasing(S)\<close> in the second induction step.\<close>
 lemma TFin_linear_lemma2:
     "\<lbrakk>m \<in> TFin(S,next);  next \<in> increasing(S)\<rbrakk>
      \<Longrightarrow> \<forall>n \<in> TFin(S,next). n<=m \<longrightarrow> n=m | next`n \<subseteq> m"
 apply (erule TFin_induct)
 apply (rule impI [THEN ballI])
 txt\<open>case split using \<open>TFin_linear_lemma1\<close>\<close>
 apply (rule_tac n1 = n and m1 = x in TFin_linear_lemma1 [THEN disjE],
        assumption+)
 apply (blast del: subsetI
              intro: increasing_trans subsetI, blast)
 txt\<open>second induction step\<close>
 apply (rule impI [THEN ballI])
 apply (rule Union_lemma0 [THEN disjE])
 apply (erule_tac [3] disjI2)
 prefer 2 apply blast
 apply (rule ballI)
 apply (drule bspec, assumption)
 apply (drule subsetD, assumption)
 apply (rule_tac n1 = n and m1 = x in TFin_linear_lemma1 [THEN disjE],
        assumption+, blast)
 apply (erule increasingD2 [THEN subset_trans, THEN disjI1])
 apply (blast dest: TFin_is_subset)+
 done
 
 text\<open>a more convenient form for Lemma 2\<close>
 lemma TFin_subsetD:
      "\<lbrakk>n<=m;  m \<in> TFin(S,next);  n \<in> TFin(S,next);  next \<in> increasing(S)\<rbrakk>
       \<Longrightarrow> n=m | next`n \<subseteq> m"
 by (blast dest: TFin_linear_lemma2 [rule_format])
 
 text\<open>Consequences from section 3.3 -- Property 3.2, the ordering is total\<close>
 lemma TFin_subset_linear:
      "\<lbrakk>m \<in> TFin(S,next);  n \<in> TFin(S,next);  next \<in> increasing(S)\<rbrakk>
       \<Longrightarrow> n \<subseteq> m | m<=n"
 apply (rule disjE)
 apply (rule TFin_linear_lemma1 [OF _ _TFin_linear_lemma2])
 apply (assumption+, erule disjI2)
 apply (blast del: subsetI
              intro: subsetI increasingD2 [THEN subset_trans] TFin_is_subset)
 done
 
 
 text\<open>Lemma 3 of section 3.3\<close>
 lemma equal_next_upper:
      "\<lbrakk>n \<in> TFin(S,next);  m \<in> TFin(S,next);  m = next`m\<rbrakk> \<Longrightarrow> n \<subseteq> m"
 apply (erule TFin_induct)
 apply (drule TFin_subsetD)
 apply (assumption+, force, blast)
 done
 
 text\<open>Property 3.3 of section 3.3\<close>
 lemma equal_next_Union:
      "\<lbrakk>m \<in> TFin(S,next);  next \<in> increasing(S)\<rbrakk>
       \<Longrightarrow> m = next`m <-> m = \<Union>(TFin(S,next))"
 apply (rule iffI)
 apply (rule Union_upper [THEN equalityI])
 apply (rule_tac [2] equal_next_upper [THEN Union_least])
 apply (assumption+)
 apply (erule ssubst)
 apply (rule increasingD2 [THEN equalityI], assumption)
 apply (blast del: subsetI
              intro: subsetI TFin_UnionI TFin.nextI TFin_is_subset)+
 done
 
 
 subsection\<open>Hausdorff's Theorem: Every Set Contains a Maximal Chain\<close>
 
 text\<open>NOTE: We assume the partial ordering is \<open>\<subseteq>\<close>, the subset
 relation!\<close>
 
 text\<open>* Defining the "next" operation for Hausdorff's Theorem *\<close>
 
 lemma chain_subset_Pow: "chain(A) \<subseteq> Pow(A)"
-apply (unfold chain_def)
+  unfolding chain_def
 apply (rule Collect_subset)
 done
 
 lemma super_subset_chain: "super(A,c) \<subseteq> chain(A)"
-apply (unfold super_def)
+  unfolding super_def
 apply (rule Collect_subset)
 done
 
 lemma maxchain_subset_chain: "maxchain(A) \<subseteq> chain(A)"
-apply (unfold maxchain_def)
+  unfolding maxchain_def
 apply (rule Collect_subset)
 done
 
 lemma choice_super:
      "\<lbrakk>ch \<in> (\<Prod>X \<in> Pow(chain(S)) - {0}. X); X \<in> chain(S);  X \<notin> maxchain(S)\<rbrakk>
       \<Longrightarrow> ch ` super(S,X) \<in> super(S,X)"
 apply (erule apply_type)
 apply (unfold super_def maxchain_def, blast)
 done
 
 lemma choice_not_equals:
      "\<lbrakk>ch \<in> (\<Prod>X \<in> Pow(chain(S)) - {0}. X); X \<in> chain(S);  X \<notin> maxchain(S)\<rbrakk>
       \<Longrightarrow> ch ` super(S,X) \<noteq> X"
 apply (rule notI)
 apply (drule choice_super, assumption, assumption)
 apply (simp add: super_def)
 done
 
 text\<open>This justifies Definition 4.4\<close>
 lemma Hausdorff_next_exists:
      "ch \<in> (\<Prod>X \<in> Pow(chain(S))-{0}. X) \<Longrightarrow>
       \<exists>next \<in> increasing(S). \<forall>X \<in> Pow(S).
                    next`X = if(X \<in> chain(S)-maxchain(S), ch`super(S,X), X)"
 apply (rule_tac x="\<lambda>X\<in>Pow(S).
                    if X \<in> chain(S) - maxchain(S) then ch ` super(S, X) else X"
        in bexI)
 apply force
-apply (unfold increasing_def)
+  unfolding increasing_def
 apply (rule CollectI)
 apply (rule lam_type)
 apply (simp (no_asm_simp))
 apply (blast dest: super_subset_chain [THEN subsetD] 
                    chain_subset_Pow [THEN subsetD] choice_super)
 txt\<open>Now, verify that it increases\<close>
 apply (simp (no_asm_simp) add: Pow_iff subset_refl)
 apply safe
 apply (drule choice_super)
 apply (assumption+)
 apply (simp add: super_def, blast)
 done
 
 text\<open>Lemma 4\<close>
 lemma TFin_chain_lemma4:
      "\<lbrakk>c \<in> TFin(S,next);
          ch \<in> (\<Prod>X \<in> Pow(chain(S))-{0}. X);
          next \<in> increasing(S);
          \<forall>X \<in> Pow(S). next`X =
                           if(X \<in> chain(S)-maxchain(S), ch`super(S,X), X)\<rbrakk>
      \<Longrightarrow> c \<in> chain(S)"
 apply (erule TFin_induct)
 apply (simp (no_asm_simp) add: chain_subset_Pow [THEN subsetD, THEN PowD]
             choice_super [THEN super_subset_chain [THEN subsetD]])
-apply (unfold chain_def)
+  unfolding chain_def
 apply (rule CollectI, blast, safe)
 apply (rule_tac m1=B and n1=Ba in TFin_subset_linear [THEN disjE], fast+)
       txt\<open>\<open>Blast_tac's\<close> slow\<close>
 done
 
 theorem Hausdorff: "\<exists>c. c \<in> maxchain(S)"
 apply (rule AC_Pi_Pow [THEN exE])
 apply (rule Hausdorff_next_exists [THEN bexE], assumption)
 apply (rename_tac ch "next")
 apply (subgoal_tac "\<Union>(TFin (S,next)) \<in> chain (S) ")
 prefer 2
  apply (blast intro!: TFin_chain_lemma4 subset_refl [THEN TFin_UnionI])
 apply (rule_tac x = "\<Union>(TFin (S,next))" in exI)
 apply (rule classical)
 apply (subgoal_tac "next ` Union(TFin (S,next)) = \<Union>(TFin (S,next))")
 apply (rule_tac [2] equal_next_Union [THEN iffD2, symmetric])
 apply (rule_tac [2] subset_refl [THEN TFin_UnionI])
 prefer 2 apply assumption
 apply (rule_tac [2] refl)
 apply (simp add: subset_refl [THEN TFin_UnionI,
                               THEN TFin.dom_subset [THEN subsetD, THEN PowD]])
 apply (erule choice_not_equals [THEN notE])
 apply (assumption+)
 done
 
 
 subsection\<open>Zorn's Lemma: If All Chains in S Have Upper Bounds In S,
        then S contains a Maximal Element\<close>
 
 text\<open>Used in the proof of Zorn's Lemma\<close>
 lemma chain_extend:
     "\<lbrakk>c \<in> chain(A);  z \<in> A;  \<forall>x \<in> c. x<=z\<rbrakk> \<Longrightarrow> cons(z,c) \<in> chain(A)"
 by (unfold chain_def, blast)
 
 lemma Zorn: "\<forall>c \<in> chain(S). \<Union>(c) \<in> S \<Longrightarrow> \<exists>y \<in> S. \<forall>z \<in> S. y<=z \<longrightarrow> y=z"
 apply (rule Hausdorff [THEN exE])
 apply (simp add: maxchain_def)
 apply (rename_tac c)
 apply (rule_tac x = "\<Union>(c)" in bexI)
 prefer 2 apply blast
 apply safe
 apply (rename_tac z)
 apply (rule classical)
 apply (subgoal_tac "cons (z,c) \<in> super (S,c) ")
 apply (blast elim: equalityE)
 apply (unfold super_def, safe)
 apply (fast elim: chain_extend)
 apply (fast elim: equalityE)
 done
 
 text \<open>Alternative version of Zorn's Lemma\<close>
 
 theorem Zorn2:
   "\<forall>c \<in> chain(S). \<exists>y \<in> S. \<forall>x \<in> c. x \<subseteq> y \<Longrightarrow> \<exists>y \<in> S. \<forall>z \<in> S. y<=z \<longrightarrow> y=z"
 apply (cut_tac Hausdorff maxchain_subset_chain)
 apply (erule exE)
 apply (drule subsetD, assumption)
 apply (drule bspec, assumption, erule bexE)
 apply (rule_tac x = y in bexI)
   prefer 2 apply assumption
 apply clarify
 apply rule apply assumption
 apply rule
 apply (rule ccontr)
 apply (frule_tac z=z in chain_extend)
   apply (assumption, blast)
 apply (unfold maxchain_def super_def)
 apply (blast elim!: equalityCE)
 done
 
 
 subsection\<open>Zermelo's Theorem: Every Set can be Well-Ordered\<close>
 
 text\<open>Lemma 5\<close>
 lemma TFin_well_lemma5:
      "\<lbrakk>n \<in> TFin(S,next);  Z \<subseteq> TFin(S,next);  z:Z;  \<not> \<Inter>(Z) \<in> Z\<rbrakk>
       \<Longrightarrow> \<forall>m \<in> Z. n \<subseteq> m"
 apply (erule TFin_induct)
 prefer 2 apply blast txt\<open>second induction step is easy\<close>
 apply (rule ballI)
 apply (rule bspec [THEN TFin_subsetD, THEN disjE], auto)
 apply (subgoal_tac "m = \<Inter>(Z) ")
 apply blast+
 done
 
 text\<open>Well-ordering of \<^term>\<open>TFin(S,next)\<close>\<close>
 lemma well_ord_TFin_lemma: "\<lbrakk>Z \<subseteq> TFin(S,next);  z \<in> Z\<rbrakk> \<Longrightarrow> \<Inter>(Z) \<in> Z"
 apply (rule classical)
 apply (subgoal_tac "Z = {\<Union>(TFin (S,next))}")
 apply (simp (no_asm_simp) add: Inter_singleton)
 apply (erule equal_singleton)
 apply (rule Union_upper [THEN equalityI])
 apply (rule_tac [2] subset_refl [THEN TFin_UnionI, THEN TFin_well_lemma5, THEN bspec], blast+)
 done
 
 text\<open>This theorem just packages the previous result\<close>
 lemma well_ord_TFin:
      "next \<in> increasing(S) 
       \<Longrightarrow> well_ord(TFin(S,next), Subset_rel(TFin(S,next)))"
 apply (rule well_ordI)
 apply (unfold Subset_rel_def linear_def)
 txt\<open>Prove the well-foundedness goal\<close>
 apply (rule wf_onI)
 apply (frule well_ord_TFin_lemma, assumption)
 apply (drule_tac x = "\<Inter>(Z) " in bspec, assumption)
 apply blast
 txt\<open>Now prove the linearity goal\<close>
 apply (intro ballI)
 apply (case_tac "x=y")
  apply blast
 txt\<open>The \<^term>\<open>x\<noteq>y\<close> case remains\<close>
 apply (rule_tac n1=x and m1=y in TFin_subset_linear [THEN disjE],
        assumption+, blast+)
 done
 
 text\<open>* Defining the "next" operation for Zermelo's Theorem *\<close>
 
 lemma choice_Diff:
      "\<lbrakk>ch \<in> (\<Prod>X \<in> Pow(S) - {0}. X);  X \<subseteq> S;  X\<noteq>S\<rbrakk> \<Longrightarrow> ch ` (S-X) \<in> S-X"
 apply (erule apply_type)
 apply (blast elim!: equalityE)
 done
 
 text\<open>This justifies Definition 6.1\<close>
 lemma Zermelo_next_exists:
      "ch \<in> (\<Prod>X \<in> Pow(S)-{0}. X) \<Longrightarrow>
            \<exists>next \<in> increasing(S). \<forall>X \<in> Pow(S).
                       next`X = (if X=S then S else cons(ch`(S-X), X))"
 apply (rule_tac x="\<lambda>X\<in>Pow(S). if X=S then S else cons(ch`(S-X), X)"
        in bexI)
 apply force
-apply (unfold increasing_def)
+  unfolding increasing_def
 apply (rule CollectI)
 apply (rule lam_type)
 txt\<open>Type checking is surprisingly hard!\<close>
 apply (simp (no_asm_simp) add: Pow_iff cons_subset_iff subset_refl)
 apply (blast intro!: choice_Diff [THEN DiffD1])
 txt\<open>Verify that it increases\<close>
 apply (intro allI impI)
 apply (simp add: Pow_iff subset_consI subset_refl)
 done
 
 
 text\<open>The construction of the injection\<close>
 lemma choice_imp_injection:
      "\<lbrakk>ch \<in> (\<Prod>X \<in> Pow(S)-{0}. X);
          next \<in> increasing(S);
          \<forall>X \<in> Pow(S). next`X = if(X=S, S, cons(ch`(S-X), X))\<rbrakk>
       \<Longrightarrow> (\<lambda> x \<in> S. \<Union>({y \<in> TFin(S,next). x \<notin> y}))
                \<in> inj(S, TFin(S,next) - {S})"
 apply (rule_tac d = "\<lambda>y. ch` (S-y) " in lam_injective)
 apply (rule DiffI)
 apply (rule Collect_subset [THEN TFin_UnionI])
 apply (blast intro!: Collect_subset [THEN TFin_UnionI] elim: equalityE)
 apply (subgoal_tac "x \<notin> \<Union>({y \<in> TFin (S,next) . x \<notin> y}) ")
 prefer 2 apply (blast elim: equalityE)
 apply (subgoal_tac "\<Union>({y \<in> TFin (S,next) . x \<notin> y}) \<noteq> S")
 prefer 2 apply (blast elim: equalityE)
 txt\<open>For proving \<open>x \<in> next`\<Union>(...)\<close>.
   Abrial and Laffitte's justification appears to be faulty.\<close>
 apply (subgoal_tac "\<not> next ` Union({y \<in> TFin (S,next) . x \<notin> y}) 
                     \<subseteq> \<Union>({y \<in> TFin (S,next) . x \<notin> y}) ")
  prefer 2
  apply (simp del: Union_iff
              add: Collect_subset [THEN TFin_UnionI, THEN TFin_is_subset]
              Pow_iff cons_subset_iff subset_refl choice_Diff [THEN DiffD2])
 apply (subgoal_tac "x \<in> next ` Union({y \<in> TFin (S,next) . x \<notin> y}) ")
  prefer 2
  apply (blast intro!: Collect_subset [THEN TFin_UnionI] TFin.nextI)
 txt\<open>End of the lemmas!\<close>
 apply (simp add: Collect_subset [THEN TFin_UnionI, THEN TFin_is_subset])
 done
 
 text\<open>The wellordering theorem\<close>
 theorem AC_well_ord: "\<exists>r. well_ord(S,r)"
 apply (rule AC_Pi_Pow [THEN exE])
 apply (rule Zermelo_next_exists [THEN bexE], assumption)
 apply (rule exI)
 apply (rule well_ord_rvimage)
 apply (erule_tac [2] well_ord_TFin)
 apply (rule choice_imp_injection [THEN inj_weaken_type], blast+)
 done
 
 
 subsection \<open>Zorn's Lemma for Partial Orders\<close>
 
 text \<open>Reimported from HOL by Clemens Ballarin.\<close>
 
 
 definition Chain :: "i \<Rightarrow> i" where
   "Chain(r) = {A \<in> Pow(field(r)). \<forall>a\<in>A. \<forall>b\<in>A. \<langle>a, b\<rangle> \<in> r | \<langle>b, a\<rangle> \<in> r}"
 
 lemma mono_Chain:
   "r \<subseteq> s \<Longrightarrow> Chain(r) \<subseteq> Chain(s)"
   unfolding Chain_def
   by blast
 
 theorem Zorn_po:
   assumes po: "Partial_order(r)"
     and u: "\<forall>C\<in>Chain(r). \<exists>u\<in>field(r). \<forall>a\<in>C. \<langle>a, u\<rangle> \<in> r"
   shows "\<exists>m\<in>field(r). \<forall>a\<in>field(r). \<langle>m, a\<rangle> \<in> r \<longrightarrow> a = m"
 proof -
   have "Preorder(r)" using po by (simp add: partial_order_on_def)
   \<comment> \<open>Mirror r in the set of subsets below (wrt r) elements of A (?).\<close>
   let ?B = "\<lambda>x\<in>field(r). r -`` {x}" let ?S = "?B `` field(r)"
   have "\<forall>C\<in>chain(?S). \<exists>U\<in>?S. \<forall>A\<in>C. A \<subseteq> U"
   proof (clarsimp simp: chain_def Subset_rel_def bex_image_simp)
     fix C
     assume 1: "C \<subseteq> ?S" and 2: "\<forall>A\<in>C. \<forall>B\<in>C. A \<subseteq> B | B \<subseteq> A"
     let ?A = "{x \<in> field(r). \<exists>M\<in>C. M = ?B`x}"
     have "C = ?B `` ?A" using 1
       apply (auto simp: image_def)
       apply rule
       apply rule
       apply (drule subsetD) apply assumption
       apply (erule CollectE)
       apply rule apply assumption
       apply (erule bexE)
       apply rule prefer 2 apply assumption
       apply rule
       apply (erule lamE) apply simp
       apply assumption
 
       apply (thin_tac "C \<subseteq> X" for X)
       apply (fast elim: lamE)
       done
     have "?A \<in> Chain(r)"
     proof (simp add: Chain_def subsetI, intro conjI ballI impI)
       fix a b
       assume "a \<in> field(r)" "r -`` {a} \<in> C" "b \<in> field(r)" "r -`` {b} \<in> C"
       hence "r -`` {a} \<subseteq> r -`` {b} | r -`` {b} \<subseteq> r -`` {a}" using 2 by auto
       then show "\<langle>a, b\<rangle> \<in> r | \<langle>b, a\<rangle> \<in> r"
         using \<open>Preorder(r)\<close> \<open>a \<in> field(r)\<close> \<open>b \<in> field(r)\<close>
         by (simp add: subset_vimage1_vimage1_iff)
     qed
     then obtain u where uA: "u \<in> field(r)" "\<forall>a\<in>?A. \<langle>a, u\<rangle> \<in> r"
       using u
       apply auto
       apply (drule bspec) apply assumption
       apply auto
       done
     have "\<forall>A\<in>C. A \<subseteq> r -`` {u}"
     proof (auto intro!: vimageI)
       fix a B
       assume aB: "B \<in> C" "a \<in> B"
       with 1 obtain x where "x \<in> field(r)" "B = r -`` {x}"
         apply -
         apply (drule subsetD) apply assumption
         apply (erule imageE)
         apply (erule lamE)
         apply simp
         done
       then show "\<langle>a, u\<rangle> \<in> r" using uA aB \<open>Preorder(r)\<close>
         by (auto simp: preorder_on_def refl_def) (blast dest: trans_onD)+
     qed
     then show "\<exists>U\<in>field(r). \<forall>A\<in>C. A \<subseteq> r -`` {U}"
       using \<open>u \<in> field(r)\<close> ..
   qed
   from Zorn2 [OF this]
   obtain m B where "m \<in> field(r)" "B = r -`` {m}"
     "\<forall>x\<in>field(r). B \<subseteq> r -`` {x} \<longrightarrow> B = r -`` {x}"
     by (auto elim!: lamE simp: ball_image_simp)
   then have "\<forall>a\<in>field(r). \<langle>m, a\<rangle> \<in> r \<longrightarrow> a = m"
     using po \<open>Preorder(r)\<close> \<open>m \<in> field(r)\<close>
     by (auto simp: subset_vimage1_vimage1_iff Partial_order_eq_vimage1_vimage1_iff)
   then show ?thesis using \<open>m \<in> field(r)\<close> by blast
 qed
 
 end
diff --git a/src/ZF/equalities.thy b/src/ZF/equalities.thy
--- a/src/ZF/equalities.thy
+++ b/src/ZF/equalities.thy
@@ -1,984 +1,984 @@
 (*  Title:      ZF/equalities.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1992  University of Cambridge
 *)
 
 section\<open>Basic Equalities and Inclusions\<close>
 
 theory equalities imports pair begin
 
 text\<open>These cover union, intersection, converse, domain, range, etc.  Philippe
 de Groote proved many of the inclusions.\<close>
 
 lemma in_mono: "A\<subseteq>B \<Longrightarrow> x\<in>A \<longrightarrow> x\<in>B"
 by blast
 
 lemma the_eq_0 [simp]: "(THE x. False) = 0"
 by (blast intro: the_0)
 
 subsection\<open>Bounded Quantifiers\<close>
 text \<open>\medskip
 
   The following are not added to the default simpset because
   (a) they duplicate the body and (b) there are no similar rules for \<open>Int\<close>.\<close>
 
 lemma ball_Un: "(\<forall>x \<in> A\<union>B. P(x)) \<longleftrightarrow> (\<forall>x \<in> A. P(x)) \<and> (\<forall>x \<in> B. P(x))"
   by blast
 
 lemma bex_Un: "(\<exists>x \<in> A\<union>B. P(x)) \<longleftrightarrow> (\<exists>x \<in> A. P(x)) | (\<exists>x \<in> B. P(x))"
   by blast
 
 lemma ball_UN: "(\<forall>z \<in> (\<Union>x\<in>A. B(x)). P(z)) \<longleftrightarrow> (\<forall>x\<in>A. \<forall>z \<in> B(x). P(z))"
   by blast
 
 lemma bex_UN: "(\<exists>z \<in> (\<Union>x\<in>A. B(x)). P(z)) \<longleftrightarrow> (\<exists>x\<in>A. \<exists>z\<in>B(x). P(z))"
   by blast
 
 subsection\<open>Converse of a Relation\<close>
 
 lemma converse_iff [simp]: "\<langle>a,b\<rangle>\<in> converse(r) \<longleftrightarrow> \<langle>b,a\<rangle>\<in>r"
 by (unfold converse_def, blast)
 
 lemma converseI [intro!]: "\<langle>a,b\<rangle>\<in>r \<Longrightarrow> \<langle>b,a\<rangle>\<in>converse(r)"
 by (unfold converse_def, blast)
 
 lemma converseD: "\<langle>a,b\<rangle> \<in> converse(r) \<Longrightarrow> \<langle>b,a\<rangle> \<in> r"
 by (unfold converse_def, blast)
 
 lemma converseE [elim!]:
     "\<lbrakk>yx \<in> converse(r);
         \<And>x y. \<lbrakk>yx=\<langle>y,x\<rangle>;  \<langle>x,y\<rangle>\<in>r\<rbrakk> \<Longrightarrow> P\<rbrakk>
      \<Longrightarrow> P"
 by (unfold converse_def, blast)
 
 lemma converse_converse: "r\<subseteq>Sigma(A,B) \<Longrightarrow> converse(converse(r)) = r"
 by blast
 
 lemma converse_type: "r\<subseteq>A*B \<Longrightarrow> converse(r)\<subseteq>B*A"
 by blast
 
 lemma converse_prod [simp]: "converse(A*B) = B*A"
 by blast
 
 lemma converse_empty [simp]: "converse(0) = 0"
 by blast
 
 lemma converse_subset_iff:
      "A \<subseteq> Sigma(X,Y) \<Longrightarrow> converse(A) \<subseteq> converse(B) \<longleftrightarrow> A \<subseteq> B"
 by blast
 
 
 subsection\<open>Finite Set Constructions Using \<^term>\<open>cons\<close>\<close>
 
 lemma cons_subsetI: "\<lbrakk>a\<in>C; B\<subseteq>C\<rbrakk> \<Longrightarrow> cons(a,B) \<subseteq> C"
 by blast
 
 lemma subset_consI: "B \<subseteq> cons(a,B)"
 by blast
 
 lemma cons_subset_iff [iff]: "cons(a,B)\<subseteq>C \<longleftrightarrow> a\<in>C \<and> B\<subseteq>C"
 by blast
 
 (*A safe special case of subset elimination, adding no new variables
   \<lbrakk>cons(a,B) \<subseteq> C; \<lbrakk>a \<in> C; B \<subseteq> C\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R *)
 lemmas cons_subsetE = cons_subset_iff [THEN iffD1, THEN conjE]
 
 lemma subset_empty_iff: "A\<subseteq>0 \<longleftrightarrow> A=0"
 by blast
 
 lemma subset_cons_iff: "C\<subseteq>cons(a,B) \<longleftrightarrow> C\<subseteq>B | (a\<in>C \<and> C-{a} \<subseteq> B)"
 by blast
 
 (* cons_def refers to Upair; reversing the equality LOOPS in rewriting!*)
 lemma cons_eq: "{a} \<union> B = cons(a,B)"
 by blast
 
 lemma cons_commute: "cons(a, cons(b, C)) = cons(b, cons(a, C))"
 by blast
 
 lemma cons_absorb: "a: B \<Longrightarrow> cons(a,B) = B"
 by blast
 
 lemma cons_Diff: "a: B \<Longrightarrow> cons(a, B-{a}) = B"
 by blast
 
 lemma Diff_cons_eq: "cons(a,B) - C = (if a\<in>C then B-C else cons(a,B-C))"
 by auto
 
 lemma equal_singleton: "\<lbrakk>a: C;  \<And>y. y \<in>C \<Longrightarrow> y=b\<rbrakk> \<Longrightarrow> C = {b}"
 by blast
 
 lemma [simp]: "cons(a,cons(a,B)) = cons(a,B)"
 by blast
 
 (** singletons **)
 
 lemma singleton_subsetI: "a\<in>C \<Longrightarrow> {a} \<subseteq> C"
 by blast
 
 lemma singleton_subsetD: "{a} \<subseteq> C  \<Longrightarrow>  a\<in>C"
 by blast
 
 
 (** succ **)
 
 lemma subset_succI: "i \<subseteq> succ(i)"
 by blast
 
 (*But if j is an ordinal or is transitive, then @{term"i\<in>j"} implies @{term"i\<subseteq>j"}!
   See @{text"Ord_succ_subsetI}*)
 lemma succ_subsetI: "\<lbrakk>i\<in>j;  i\<subseteq>j\<rbrakk> \<Longrightarrow> succ(i)\<subseteq>j"
 by (unfold succ_def, blast)
 
 lemma succ_subsetE:
     "\<lbrakk>succ(i) \<subseteq> j;  \<lbrakk>i\<in>j;  i\<subseteq>j\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (unfold succ_def, blast)
 
 lemma succ_subset_iff: "succ(a) \<subseteq> B \<longleftrightarrow> (a \<subseteq> B \<and> a \<in> B)"
 by (unfold succ_def, blast)
 
 
 subsection\<open>Binary Intersection\<close>
 
 (** Intersection is the greatest lower bound of two sets **)
 
 lemma Int_subset_iff: "C \<subseteq> A \<inter> B \<longleftrightarrow> C \<subseteq> A \<and> C \<subseteq> B"
 by blast
 
 lemma Int_lower1: "A \<inter> B \<subseteq> A"
 by blast
 
 lemma Int_lower2: "A \<inter> B \<subseteq> B"
 by blast
 
 lemma Int_greatest: "\<lbrakk>C\<subseteq>A;  C\<subseteq>B\<rbrakk> \<Longrightarrow> C \<subseteq> A \<inter> B"
 by blast
 
 lemma Int_cons: "cons(a,B) \<inter> C \<subseteq> cons(a, B \<inter> C)"
 by blast
 
 lemma Int_absorb [simp]: "A \<inter> A = A"
 by blast
 
 lemma Int_left_absorb: "A \<inter> (A \<inter> B) = A \<inter> B"
 by blast
 
 lemma Int_commute: "A \<inter> B = B \<inter> A"
 by blast
 
 lemma Int_left_commute: "A \<inter> (B \<inter> C) = B \<inter> (A \<inter> C)"
 by blast
 
 lemma Int_assoc: "(A \<inter> B) \<inter> C  =  A \<inter> (B \<inter> C)"
 by blast
 
 (*Intersection is an AC-operator*)
 lemmas Int_ac= Int_assoc Int_left_absorb Int_commute Int_left_commute
 
 lemma Int_absorb1: "B \<subseteq> A \<Longrightarrow> A \<inter> B = B"
   by blast
 
 lemma Int_absorb2: "A \<subseteq> B \<Longrightarrow> A \<inter> B = A"
   by blast
 
 lemma Int_Un_distrib: "A \<inter> (B \<union> C) = (A \<inter> B) \<union> (A \<inter> C)"
 by blast
 
 lemma Int_Un_distrib2: "(B \<union> C) \<inter> A = (B \<inter> A) \<union> (C \<inter> A)"
 by blast
 
 lemma subset_Int_iff: "A\<subseteq>B \<longleftrightarrow> A \<inter> B = A"
 by (blast elim!: equalityE)
 
 lemma subset_Int_iff2: "A\<subseteq>B \<longleftrightarrow> B \<inter> A = A"
 by (blast elim!: equalityE)
 
 lemma Int_Diff_eq: "C\<subseteq>A \<Longrightarrow> (A-B) \<inter> C = C-B"
 by blast
 
 lemma Int_cons_left:
      "cons(a,A) \<inter> B = (if a \<in> B then cons(a, A \<inter> B) else A \<inter> B)"
 by auto
 
 lemma Int_cons_right:
      "A \<inter> cons(a, B) = (if a \<in> A then cons(a, A \<inter> B) else A \<inter> B)"
 by auto
 
 lemma cons_Int_distrib: "cons(x, A \<inter> B) = cons(x, A) \<inter> cons(x, B)"
 by auto
 
 subsection\<open>Binary Union\<close>
 
 (** Union is the least upper bound of two sets *)
 
 lemma Un_subset_iff: "A \<union> B \<subseteq> C \<longleftrightarrow> A \<subseteq> C \<and> B \<subseteq> C"
 by blast
 
 lemma Un_upper1: "A \<subseteq> A \<union> B"
 by blast
 
 lemma Un_upper2: "B \<subseteq> A \<union> B"
 by blast
 
 lemma Un_least: "\<lbrakk>A\<subseteq>C;  B\<subseteq>C\<rbrakk> \<Longrightarrow> A \<union> B \<subseteq> C"
 by blast
 
 lemma Un_cons: "cons(a,B) \<union> C = cons(a, B \<union> C)"
 by blast
 
 lemma Un_absorb [simp]: "A \<union> A = A"
 by blast
 
 lemma Un_left_absorb: "A \<union> (A \<union> B) = A \<union> B"
 by blast
 
 lemma Un_commute: "A \<union> B = B \<union> A"
 by blast
 
 lemma Un_left_commute: "A \<union> (B \<union> C) = B \<union> (A \<union> C)"
 by blast
 
 lemma Un_assoc: "(A \<union> B) \<union> C  =  A \<union> (B \<union> C)"
 by blast
 
 (*Union is an AC-operator*)
 lemmas Un_ac = Un_assoc Un_left_absorb Un_commute Un_left_commute
 
 lemma Un_absorb1: "A \<subseteq> B \<Longrightarrow> A \<union> B = B"
   by blast
 
 lemma Un_absorb2: "B \<subseteq> A \<Longrightarrow> A \<union> B = A"
   by blast
 
 lemma Un_Int_distrib: "(A \<inter> B) \<union> C  =  (A \<union> C) \<inter> (B \<union> C)"
 by blast
 
 lemma subset_Un_iff: "A\<subseteq>B \<longleftrightarrow> A \<union> B = B"
 by (blast elim!: equalityE)
 
 lemma subset_Un_iff2: "A\<subseteq>B \<longleftrightarrow> B \<union> A = B"
 by (blast elim!: equalityE)
 
 lemma Un_empty [iff]: "(A \<union> B = 0) \<longleftrightarrow> (A = 0 \<and> B = 0)"
 by blast
 
 lemma Un_eq_Union: "A \<union> B = \<Union>({A, B})"
 by blast
 
 subsection\<open>Set Difference\<close>
 
 lemma Diff_subset: "A-B \<subseteq> A"
 by blast
 
 lemma Diff_contains: "\<lbrakk>C\<subseteq>A;  C \<inter> B = 0\<rbrakk> \<Longrightarrow> C \<subseteq> A-B"
 by blast
 
 lemma subset_Diff_cons_iff: "B \<subseteq> A - cons(c,C)  \<longleftrightarrow>  B\<subseteq>A-C \<and> c \<notin> B"
 by blast
 
 lemma Diff_cancel: "A - A = 0"
 by blast
 
 lemma Diff_triv: "A  \<inter> B = 0 \<Longrightarrow> A - B = A"
 by blast
 
 lemma empty_Diff [simp]: "0 - A = 0"
 by blast
 
 lemma Diff_0 [simp]: "A - 0 = A"
 by blast
 
 lemma Diff_eq_0_iff: "A - B = 0 \<longleftrightarrow> A \<subseteq> B"
 by (blast elim: equalityE)
 
 (*NOT SUITABLE FOR REWRITING since {a} \<equiv> cons(a,0)*)
 lemma Diff_cons: "A - cons(a,B) = A - B - {a}"
 by blast
 
 (*NOT SUITABLE FOR REWRITING since {a} \<equiv> cons(a,0)*)
 lemma Diff_cons2: "A - cons(a,B) = A - {a} - B"
 by blast
 
 lemma Diff_disjoint: "A \<inter> (B-A) = 0"
 by blast
 
 lemma Diff_partition: "A\<subseteq>B \<Longrightarrow> A \<union> (B-A) = B"
 by blast
 
 lemma subset_Un_Diff: "A \<subseteq> B \<union> (A - B)"
 by blast
 
 lemma double_complement: "\<lbrakk>A\<subseteq>B; B\<subseteq>C\<rbrakk> \<Longrightarrow> B-(C-A) = A"
 by blast
 
 lemma double_complement_Un: "(A \<union> B) - (B-A) = A"
 by blast
 
 lemma Un_Int_crazy:
  "(A \<inter> B) \<union> (B \<inter> C) \<union> (C \<inter> A) = (A \<union> B) \<inter> (B \<union> C) \<inter> (C \<union> A)"
 apply blast
 done
 
 lemma Diff_Un: "A - (B \<union> C) = (A-B) \<inter> (A-C)"
 by blast
 
 lemma Diff_Int: "A - (B \<inter> C) = (A-B) \<union> (A-C)"
 by blast
 
 lemma Un_Diff: "(A \<union> B) - C = (A - C) \<union> (B - C)"
 by blast
 
 lemma Int_Diff: "(A \<inter> B) - C = A \<inter> (B - C)"
 by blast
 
 lemma Diff_Int_distrib: "C \<inter> (A-B) = (C \<inter> A) - (C \<inter> B)"
 by blast
 
 lemma Diff_Int_distrib2: "(A-B) \<inter> C = (A \<inter> C) - (B \<inter> C)"
 by blast
 
 (*Halmos, Naive Set Theory, page 16.*)
 lemma Un_Int_assoc_iff: "(A \<inter> B) \<union> C = A \<inter> (B \<union> C)  \<longleftrightarrow>  C\<subseteq>A"
 by (blast elim!: equalityE)
 
 
 subsection\<open>Big Union and Intersection\<close>
 
 (** Big Union is the least upper bound of a set  **)
 
 lemma Union_subset_iff: "\<Union>(A) \<subseteq> C \<longleftrightarrow> (\<forall>x\<in>A. x \<subseteq> C)"
 by blast
 
 lemma Union_upper: "B\<in>A \<Longrightarrow> B \<subseteq> \<Union>(A)"
 by blast
 
 lemma Union_least: "\<lbrakk>\<And>x. x\<in>A \<Longrightarrow> x\<subseteq>C\<rbrakk> \<Longrightarrow> \<Union>(A) \<subseteq> C"
 by blast
 
 lemma Union_cons [simp]: "\<Union>(cons(a,B)) = a \<union> \<Union>(B)"
 by blast
 
 lemma Union_Un_distrib: "\<Union>(A \<union> B) = \<Union>(A) \<union> \<Union>(B)"
 by blast
 
 lemma Union_Int_subset: "\<Union>(A \<inter> B) \<subseteq> \<Union>(A) \<inter> \<Union>(B)"
 by blast
 
 lemma Union_disjoint: "\<Union>(C) \<inter> A = 0 \<longleftrightarrow> (\<forall>B\<in>C. B \<inter> A = 0)"
 by (blast elim!: equalityE)
 
 lemma Union_empty_iff: "\<Union>(A) = 0 \<longleftrightarrow> (\<forall>B\<in>A. B=0)"
 by blast
 
 lemma Int_Union2: "\<Union>(B) \<inter> A = (\<Union>C\<in>B. C \<inter> A)"
 by blast
 
 (** Big Intersection is the greatest lower bound of a nonempty set **)
 
 lemma Inter_subset_iff: "A\<noteq>0  \<Longrightarrow>  C \<subseteq> \<Inter>(A) \<longleftrightarrow> (\<forall>x\<in>A. C \<subseteq> x)"
 by blast
 
 lemma Inter_lower: "B\<in>A \<Longrightarrow> \<Inter>(A) \<subseteq> B"
 by blast
 
 lemma Inter_greatest: "\<lbrakk>A\<noteq>0;  \<And>x. x\<in>A \<Longrightarrow> C\<subseteq>x\<rbrakk> \<Longrightarrow> C \<subseteq> \<Inter>(A)"
 by blast
 
 (** Intersection of a family of sets  **)
 
 lemma INT_lower: "x\<in>A \<Longrightarrow> (\<Inter>x\<in>A. B(x)) \<subseteq> B(x)"
 by blast
 
 lemma INT_greatest: "\<lbrakk>A\<noteq>0;  \<And>x. x\<in>A \<Longrightarrow> C\<subseteq>B(x)\<rbrakk> \<Longrightarrow> C \<subseteq> (\<Inter>x\<in>A. B(x))"
 by force
 
 lemma Inter_0 [simp]: "\<Inter>(0) = 0"
 by (unfold Inter_def, blast)
 
 lemma Inter_Un_subset:
      "\<lbrakk>z\<in>A; z\<in>B\<rbrakk> \<Longrightarrow> \<Inter>(A) \<union> \<Inter>(B) \<subseteq> \<Inter>(A \<inter> B)"
 by blast
 
 (* A good challenge: Inter is ill-behaved on the empty set *)
 lemma Inter_Un_distrib:
      "\<lbrakk>A\<noteq>0;  B\<noteq>0\<rbrakk> \<Longrightarrow> \<Inter>(A \<union> B) = \<Inter>(A) \<inter> \<Inter>(B)"
 by blast
 
 lemma Union_singleton: "\<Union>({b}) = b"
 by blast
 
 lemma Inter_singleton: "\<Inter>({b}) = b"
 by blast
 
 lemma Inter_cons [simp]:
      "\<Inter>(cons(a,B)) = (if B=0 then a else a \<inter> \<Inter>(B))"
 by force
 
 subsection\<open>Unions and Intersections of Families\<close>
 
 lemma subset_UN_iff_eq: "A \<subseteq> (\<Union>i\<in>I. B(i)) \<longleftrightarrow> A = (\<Union>i\<in>I. A \<inter> B(i))"
 by (blast elim!: equalityE)
 
 lemma UN_subset_iff: "(\<Union>x\<in>A. B(x)) \<subseteq> C \<longleftrightarrow> (\<forall>x\<in>A. B(x) \<subseteq> C)"
 by blast
 
 lemma UN_upper: "x\<in>A \<Longrightarrow> B(x) \<subseteq> (\<Union>x\<in>A. B(x))"
 by (erule RepFunI [THEN Union_upper])
 
 lemma UN_least: "\<lbrakk>\<And>x. x\<in>A \<Longrightarrow> B(x)\<subseteq>C\<rbrakk> \<Longrightarrow> (\<Union>x\<in>A. B(x)) \<subseteq> C"
 by blast
 
 lemma Union_eq_UN: "\<Union>(A) = (\<Union>x\<in>A. x)"
 by blast
 
 lemma Inter_eq_INT: "\<Inter>(A) = (\<Inter>x\<in>A. x)"
 by (unfold Inter_def, blast)
 
 lemma UN_0 [simp]: "(\<Union>i\<in>0. A(i)) = 0"
 by blast
 
 lemma UN_singleton: "(\<Union>x\<in>A. {x}) = A"
 by blast
 
 lemma UN_Un: "(\<Union>i\<in> A \<union> B. C(i)) = (\<Union>i\<in> A. C(i)) \<union> (\<Union>i\<in>B. C(i))"
 by blast
 
 lemma INT_Un: "(\<Inter>i\<in>I \<union> J. A(i)) =
                (if I=0 then \<Inter>j\<in>J. A(j)
                        else if J=0 then \<Inter>i\<in>I. A(i)
                        else ((\<Inter>i\<in>I. A(i)) \<inter>  (\<Inter>j\<in>J. A(j))))"
 by (simp, blast intro!: equalityI)
 
 lemma UN_UN_flatten: "(\<Union>x \<in> (\<Union>y\<in>A. B(y)). C(x)) = (\<Union>y\<in>A. \<Union>x\<in> B(y). C(x))"
 by blast
 
 (*Halmos, Naive Set Theory, page 35.*)
 lemma Int_UN_distrib: "B \<inter> (\<Union>i\<in>I. A(i)) = (\<Union>i\<in>I. B \<inter> A(i))"
 by blast
 
 lemma Un_INT_distrib: "I\<noteq>0 \<Longrightarrow> B \<union> (\<Inter>i\<in>I. A(i)) = (\<Inter>i\<in>I. B \<union> A(i))"
 by auto
 
 lemma Int_UN_distrib2:
      "(\<Union>i\<in>I. A(i)) \<inter> (\<Union>j\<in>J. B(j)) = (\<Union>i\<in>I. \<Union>j\<in>J. A(i) \<inter> B(j))"
 by blast
 
 lemma Un_INT_distrib2: "\<lbrakk>I\<noteq>0;  J\<noteq>0\<rbrakk> \<Longrightarrow>
       (\<Inter>i\<in>I. A(i)) \<union> (\<Inter>j\<in>J. B(j)) = (\<Inter>i\<in>I. \<Inter>j\<in>J. A(i) \<union> B(j))"
 by auto
 
 lemma UN_constant [simp]: "(\<Union>y\<in>A. c) = (if A=0 then 0 else c)"
 by force
 
 lemma INT_constant [simp]: "(\<Inter>y\<in>A. c) = (if A=0 then 0 else c)"
 by force
 
 lemma UN_RepFun [simp]: "(\<Union>y\<in> RepFun(A,f). B(y)) = (\<Union>x\<in>A. B(f(x)))"
 by blast
 
 lemma INT_RepFun [simp]: "(\<Inter>x\<in>RepFun(A,f). B(x))    = (\<Inter>a\<in>A. B(f(a)))"
 by (auto simp add: Inter_def)
 
 lemma INT_Union_eq:
      "0 \<notin> A \<Longrightarrow> (\<Inter>x\<in> \<Union>(A). B(x)) = (\<Inter>y\<in>A. \<Inter>x\<in>y. B(x))"
 apply (subgoal_tac "\<forall>x\<in>A. x\<noteq>0")
    prefer 2 apply blast
 apply (force simp add: Inter_def ball_conj_distrib)
 done
 
 lemma INT_UN_eq:
      "(\<forall>x\<in>A. B(x) \<noteq> 0)
       \<Longrightarrow> (\<Inter>z\<in> (\<Union>x\<in>A. B(x)). C(z)) = (\<Inter>x\<in>A. \<Inter>z\<in> B(x). C(z))"
 apply (subst INT_Union_eq, blast)
 apply (simp add: Inter_def)
 done
 
 
 (** Devlin, Fundamentals of Contemporary Set Theory, page 12, exercise 5:
     Union of a family of unions **)
 
 lemma UN_Un_distrib:
      "(\<Union>i\<in>I. A(i) \<union> B(i)) = (\<Union>i\<in>I. A(i))  \<union>  (\<Union>i\<in>I. B(i))"
 by blast
 
 lemma INT_Int_distrib:
      "I\<noteq>0 \<Longrightarrow> (\<Inter>i\<in>I. A(i) \<inter> B(i)) = (\<Inter>i\<in>I. A(i)) \<inter> (\<Inter>i\<in>I. B(i))"
 by (blast elim!: not_emptyE)
 
 lemma UN_Int_subset:
      "(\<Union>z\<in>I \<inter> J. A(z)) \<subseteq> (\<Union>z\<in>I. A(z)) \<inter> (\<Union>z\<in>J. A(z))"
 by blast
 
 (** Devlin, page 12, exercise 5: Complements **)
 
 lemma Diff_UN: "I\<noteq>0 \<Longrightarrow> B - (\<Union>i\<in>I. A(i)) = (\<Inter>i\<in>I. B - A(i))"
 by (blast elim!: not_emptyE)
 
 lemma Diff_INT: "I\<noteq>0 \<Longrightarrow> B - (\<Inter>i\<in>I. A(i)) = (\<Union>i\<in>I. B - A(i))"
 by (blast elim!: not_emptyE)
 
 
 (** Unions and Intersections with General Sum **)
 
 (*Not suitable for rewriting: LOOPS!*)
 lemma Sigma_cons1: "Sigma(cons(a,B), C) = ({a}*C(a)) \<union> Sigma(B,C)"
 by blast
 
 (*Not suitable for rewriting: LOOPS!*)
 lemma Sigma_cons2: "A * cons(b,B) = A*{b} \<union> A*B"
 by blast
 
 lemma Sigma_succ1: "Sigma(succ(A), B) = ({A}*B(A)) \<union> Sigma(A,B)"
 by blast
 
 lemma Sigma_succ2: "A * succ(B) = A*{B} \<union> A*B"
 by blast
 
 lemma SUM_UN_distrib1:
      "(\<Sum>x \<in> (\<Union>y\<in>A. C(y)). B(x)) = (\<Union>y\<in>A. \<Sum>x\<in>C(y). B(x))"
 by blast
 
 lemma SUM_UN_distrib2:
      "(\<Sum>i\<in>I. \<Union>j\<in>J. C(i,j)) = (\<Union>j\<in>J. \<Sum>i\<in>I. C(i,j))"
 by blast
 
 lemma SUM_Un_distrib1:
      "(\<Sum>i\<in>I \<union> J. C(i)) = (\<Sum>i\<in>I. C(i)) \<union> (\<Sum>j\<in>J. C(j))"
 by blast
 
 lemma SUM_Un_distrib2:
      "(\<Sum>i\<in>I. A(i) \<union> B(i)) = (\<Sum>i\<in>I. A(i)) \<union> (\<Sum>i\<in>I. B(i))"
 by blast
 
 (*First-order version of the above, for rewriting*)
 lemma prod_Un_distrib2: "I * (A \<union> B) = I*A \<union> I*B"
 by (rule SUM_Un_distrib2)
 
 lemma SUM_Int_distrib1:
      "(\<Sum>i\<in>I \<inter> J. C(i)) = (\<Sum>i\<in>I. C(i)) \<inter> (\<Sum>j\<in>J. C(j))"
 by blast
 
 lemma SUM_Int_distrib2:
      "(\<Sum>i\<in>I. A(i) \<inter> B(i)) = (\<Sum>i\<in>I. A(i)) \<inter> (\<Sum>i\<in>I. B(i))"
 by blast
 
 (*First-order version of the above, for rewriting*)
 lemma prod_Int_distrib2: "I * (A \<inter> B) = I*A \<inter> I*B"
 by (rule SUM_Int_distrib2)
 
 (*Cf Aczel, Non-Well-Founded Sets, page 115*)
 lemma SUM_eq_UN: "(\<Sum>i\<in>I. A(i)) = (\<Union>i\<in>I. {i} * A(i))"
 by blast
 
 lemma times_subset_iff:
      "(A'*B' \<subseteq> A*B) \<longleftrightarrow> (A' = 0 | B' = 0 | (A'\<subseteq>A) \<and> (B'\<subseteq>B))"
 by blast
 
 lemma Int_Sigma_eq:
      "(\<Sum>x \<in> A'. B'(x)) \<inter> (\<Sum>x \<in> A. B(x)) = (\<Sum>x \<in> A' \<inter> A. B'(x) \<inter> B(x))"
 by blast
 
 (** Domain **)
 
 lemma domain_iff: "a: domain(r) \<longleftrightarrow> (\<exists>y. \<langle>a,y\<rangle>\<in> r)"
 by (unfold domain_def, blast)
 
 lemma domainI [intro]: "\<langle>a,b\<rangle>\<in> r \<Longrightarrow> a: domain(r)"
 by (unfold domain_def, blast)
 
 lemma domainE [elim!]:
     "\<lbrakk>a \<in> domain(r);  \<And>y. \<langle>a,y\<rangle>\<in> r \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (unfold domain_def, blast)
 
 lemma domain_subset: "domain(Sigma(A,B)) \<subseteq> A"
 by blast
 
 lemma domain_of_prod: "b\<in>B \<Longrightarrow> domain(A*B) = A"
 by blast
 
 lemma domain_0 [simp]: "domain(0) = 0"
 by blast
 
 lemma domain_cons [simp]: "domain(cons(\<langle>a,b\<rangle>,r)) = cons(a, domain(r))"
 by blast
 
 lemma domain_Un_eq [simp]: "domain(A \<union> B) = domain(A) \<union> domain(B)"
 by blast
 
 lemma domain_Int_subset: "domain(A \<inter> B) \<subseteq> domain(A) \<inter> domain(B)"
 by blast
 
 lemma domain_Diff_subset: "domain(A) - domain(B) \<subseteq> domain(A - B)"
 by blast
 
 lemma domain_UN: "domain(\<Union>x\<in>A. B(x)) = (\<Union>x\<in>A. domain(B(x)))"
 by blast
 
 lemma domain_Union: "domain(\<Union>(A)) = (\<Union>x\<in>A. domain(x))"
 by blast
 
 
 (** Range **)
 
 lemma rangeI [intro]: "\<langle>a,b\<rangle>\<in> r \<Longrightarrow> b \<in> range(r)"
-apply (unfold range_def)
+  unfolding range_def
 apply (erule converseI [THEN domainI])
 done
 
 lemma rangeE [elim!]: "\<lbrakk>b \<in> range(r);  \<And>x. \<langle>x,b\<rangle>\<in> r \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (unfold range_def, blast)
 
 lemma range_subset: "range(A*B) \<subseteq> B"
-apply (unfold range_def)
+  unfolding range_def
 apply (subst converse_prod)
 apply (rule domain_subset)
 done
 
 lemma range_of_prod: "a\<in>A \<Longrightarrow> range(A*B) = B"
 by blast
 
 lemma range_0 [simp]: "range(0) = 0"
 by blast
 
 lemma range_cons [simp]: "range(cons(\<langle>a,b\<rangle>,r)) = cons(b, range(r))"
 by blast
 
 lemma range_Un_eq [simp]: "range(A \<union> B) = range(A) \<union> range(B)"
 by blast
 
 lemma range_Int_subset: "range(A \<inter> B) \<subseteq> range(A) \<inter> range(B)"
 by blast
 
 lemma range_Diff_subset: "range(A) - range(B) \<subseteq> range(A - B)"
 by blast
 
 lemma domain_converse [simp]: "domain(converse(r)) = range(r)"
 by blast
 
 lemma range_converse [simp]: "range(converse(r)) = domain(r)"
 by blast
 
 
 (** Field **)
 
 lemma fieldI1: "\<langle>a,b\<rangle>\<in> r \<Longrightarrow> a \<in> field(r)"
 by (unfold field_def, blast)
 
 lemma fieldI2: "\<langle>a,b\<rangle>\<in> r \<Longrightarrow> b \<in> field(r)"
 by (unfold field_def, blast)
 
 lemma fieldCI [intro]:
     "(\<not> \<langle>c,a\<rangle>\<in>r \<Longrightarrow> \<langle>a,b\<rangle>\<in> r) \<Longrightarrow> a \<in> field(r)"
 apply (unfold field_def, blast)
 done
 
 lemma fieldE [elim!]:
      "\<lbrakk>a \<in> field(r);
          \<And>x. \<langle>a,x\<rangle>\<in> r \<Longrightarrow> P;
          \<And>x. \<langle>x,a\<rangle>\<in> r \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (unfold field_def, blast)
 
 lemma field_subset: "field(A*B) \<subseteq> A \<union> B"
 by blast
 
 lemma domain_subset_field: "domain(r) \<subseteq> field(r)"
-apply (unfold field_def)
+  unfolding field_def
 apply (rule Un_upper1)
 done
 
 lemma range_subset_field: "range(r) \<subseteq> field(r)"
-apply (unfold field_def)
+  unfolding field_def
 apply (rule Un_upper2)
 done
 
 lemma domain_times_range: "r \<subseteq> Sigma(A,B) \<Longrightarrow> r \<subseteq> domain(r)*range(r)"
 by blast
 
 lemma field_times_field: "r \<subseteq> Sigma(A,B) \<Longrightarrow> r \<subseteq> field(r)*field(r)"
 by blast
 
 lemma relation_field_times_field: "relation(r) \<Longrightarrow> r \<subseteq> field(r)*field(r)"
 by (simp add: relation_def, blast)
 
 lemma field_of_prod: "field(A*A) = A"
 by blast
 
 lemma field_0 [simp]: "field(0) = 0"
 by blast
 
 lemma field_cons [simp]: "field(cons(\<langle>a,b\<rangle>,r)) = cons(a, cons(b, field(r)))"
 by blast
 
 lemma field_Un_eq [simp]: "field(A \<union> B) = field(A) \<union> field(B)"
 by blast
 
 lemma field_Int_subset: "field(A \<inter> B) \<subseteq> field(A) \<inter> field(B)"
 by blast
 
 lemma field_Diff_subset: "field(A) - field(B) \<subseteq> field(A - B)"
 by blast
 
 lemma field_converse [simp]: "field(converse(r)) = field(r)"
 by blast
 
 (** The Union of a set of relations is a relation -- Lemma for fun_Union **)
 lemma rel_Union: "(\<forall>x\<in>S. \<exists>A B. x \<subseteq> A*B) \<Longrightarrow>
                   \<Union>(S) \<subseteq> domain(\<Union>(S)) * range(\<Union>(S))"
 by blast
 
 (** The Union of 2 relations is a relation (Lemma for fun_Un)  **)
 lemma rel_Un: "\<lbrakk>r \<subseteq> A*B;  s \<subseteq> C*D\<rbrakk> \<Longrightarrow> (r \<union> s) \<subseteq> (A \<union> C) * (B \<union> D)"
 by blast
 
 lemma domain_Diff_eq: "\<lbrakk>\<langle>a,c\<rangle> \<in> r; c\<noteq>b\<rbrakk> \<Longrightarrow> domain(r-{\<langle>a,b\<rangle>}) = domain(r)"
 by blast
 
 lemma range_Diff_eq: "\<lbrakk>\<langle>c,b\<rangle> \<in> r; c\<noteq>a\<rbrakk> \<Longrightarrow> range(r-{\<langle>a,b\<rangle>}) = range(r)"
 by blast
 
 
 subsection\<open>Image of a Set under a Function or Relation\<close>
 
 lemma image_iff: "b \<in> r``A \<longleftrightarrow> (\<exists>x\<in>A. \<langle>x,b\<rangle>\<in>r)"
 by (unfold image_def, blast)
 
 lemma image_singleton_iff: "b \<in> r``{a} \<longleftrightarrow> \<langle>a,b\<rangle>\<in>r"
 by (rule image_iff [THEN iff_trans], blast)
 
 lemma imageI [intro]: "\<lbrakk>\<langle>a,b\<rangle>\<in> r;  a\<in>A\<rbrakk> \<Longrightarrow> b \<in> r``A"
 by (unfold image_def, blast)
 
 lemma imageE [elim!]:
     "\<lbrakk>b: r``A;  \<And>x.\<lbrakk>\<langle>x,b\<rangle>\<in> r;  x\<in>A\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (unfold image_def, blast)
 
 lemma image_subset: "r \<subseteq> A*B \<Longrightarrow> r``C \<subseteq> B"
 by blast
 
 lemma image_0 [simp]: "r``0 = 0"
 by blast
 
 lemma image_Un [simp]: "r``(A \<union> B) = (r``A) \<union> (r``B)"
 by blast
 
 lemma image_UN: "r `` (\<Union>x\<in>A. B(x)) = (\<Union>x\<in>A. r `` B(x))"
 by blast
 
 lemma Collect_image_eq:
      "{z \<in> Sigma(A,B). P(z)} `` C = (\<Union>x \<in> A. {y \<in> B(x). x \<in> C \<and> P(\<langle>x,y\<rangle>)})"
 by blast
 
 lemma image_Int_subset: "r``(A \<inter> B) \<subseteq> (r``A) \<inter> (r``B)"
 by blast
 
 lemma image_Int_square_subset: "(r \<inter> A*A)``B \<subseteq> (r``B) \<inter> A"
 by blast
 
 lemma image_Int_square: "B\<subseteq>A \<Longrightarrow> (r \<inter> A*A)``B = (r``B) \<inter> A"
 by blast
 
 
 (*Image laws for special relations*)
 lemma image_0_left [simp]: "0``A = 0"
 by blast
 
 lemma image_Un_left: "(r \<union> s)``A = (r``A) \<union> (s``A)"
 by blast
 
 lemma image_Int_subset_left: "(r \<inter> s)``A \<subseteq> (r``A) \<inter> (s``A)"
 by blast
 
 
 subsection\<open>Inverse Image of a Set under a Function or Relation\<close>
 
 lemma vimage_iff:
     "a \<in> r-``B \<longleftrightarrow> (\<exists>y\<in>B. \<langle>a,y\<rangle>\<in>r)"
 by (unfold vimage_def image_def converse_def, blast)
 
 lemma vimage_singleton_iff: "a \<in> r-``{b} \<longleftrightarrow> \<langle>a,b\<rangle>\<in>r"
 by (rule vimage_iff [THEN iff_trans], blast)
 
 lemma vimageI [intro]: "\<lbrakk>\<langle>a,b\<rangle>\<in> r;  b\<in>B\<rbrakk> \<Longrightarrow> a \<in> r-``B"
 by (unfold vimage_def, blast)
 
 lemma vimageE [elim!]:
     "\<lbrakk>a: r-``B;  \<And>x.\<lbrakk>\<langle>a,x\<rangle>\<in> r;  x\<in>B\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 apply (unfold vimage_def, blast)
 done
 
 lemma vimage_subset: "r \<subseteq> A*B \<Longrightarrow> r-``C \<subseteq> A"
-apply (unfold vimage_def)
+  unfolding vimage_def
 apply (erule converse_type [THEN image_subset])
 done
 
 lemma vimage_0 [simp]: "r-``0 = 0"
 by blast
 
 lemma vimage_Un [simp]: "r-``(A \<union> B) = (r-``A) \<union> (r-``B)"
 by blast
 
 lemma vimage_Int_subset: "r-``(A \<inter> B) \<subseteq> (r-``A) \<inter> (r-``B)"
 by blast
 
 (*NOT suitable for rewriting*)
 lemma vimage_eq_UN: "f -``B = (\<Union>y\<in>B. f-``{y})"
 by blast
 
 lemma function_vimage_Int:
      "function(f) \<Longrightarrow> f-``(A \<inter> B) = (f-``A)  \<inter>  (f-``B)"
 by (unfold function_def, blast)
 
 lemma function_vimage_Diff: "function(f) \<Longrightarrow> f-``(A-B) = (f-``A) - (f-``B)"
 by (unfold function_def, blast)
 
 lemma function_image_vimage: "function(f) \<Longrightarrow> f `` (f-`` A) \<subseteq> A"
 by (unfold function_def, blast)
 
 lemma vimage_Int_square_subset: "(r \<inter> A*A)-``B \<subseteq> (r-``B) \<inter> A"
 by blast
 
 lemma vimage_Int_square: "B\<subseteq>A \<Longrightarrow> (r \<inter> A*A)-``B = (r-``B) \<inter> A"
 by blast
 
 
 
 (*Invese image laws for special relations*)
 lemma vimage_0_left [simp]: "0-``A = 0"
 by blast
 
 lemma vimage_Un_left: "(r \<union> s)-``A = (r-``A) \<union> (s-``A)"
 by blast
 
 lemma vimage_Int_subset_left: "(r \<inter> s)-``A \<subseteq> (r-``A) \<inter> (s-``A)"
 by blast
 
 
 (** Converse **)
 
 lemma converse_Un [simp]: "converse(A \<union> B) = converse(A) \<union> converse(B)"
 by blast
 
 lemma converse_Int [simp]: "converse(A \<inter> B) = converse(A) \<inter> converse(B)"
 by blast
 
 lemma converse_Diff [simp]: "converse(A - B) = converse(A) - converse(B)"
 by blast
 
 lemma converse_UN [simp]: "converse(\<Union>x\<in>A. B(x)) = (\<Union>x\<in>A. converse(B(x)))"
 by blast
 
 (*Unfolding Inter avoids using excluded middle on A=0*)
 lemma converse_INT [simp]:
      "converse(\<Inter>x\<in>A. B(x)) = (\<Inter>x\<in>A. converse(B(x)))"
 apply (unfold Inter_def, blast)
 done
 
 
 subsection\<open>Powerset Operator\<close>
 
 lemma Pow_0 [simp]: "Pow(0) = {0}"
 by blast
 
 lemma Pow_insert: "Pow (cons(a,A)) = Pow(A) \<union> {cons(a,X) . X: Pow(A)}"
 apply (rule equalityI, safe)
 apply (erule swap)
 apply (rule_tac a = "x-{a}" in RepFun_eqI, auto)
 done
 
 lemma Un_Pow_subset: "Pow(A) \<union> Pow(B) \<subseteq> Pow(A \<union> B)"
 by blast
 
 lemma UN_Pow_subset: "(\<Union>x\<in>A. Pow(B(x))) \<subseteq> Pow(\<Union>x\<in>A. B(x))"
 by blast
 
 lemma subset_Pow_Union: "A \<subseteq> Pow(\<Union>(A))"
 by blast
 
 lemma Union_Pow_eq [simp]: "\<Union>(Pow(A)) = A"
 by blast
 
 lemma Union_Pow_iff: "\<Union>(A) \<in> Pow(B) \<longleftrightarrow> A \<in> Pow(Pow(B))"
 by blast
 
 lemma Pow_Int_eq [simp]: "Pow(A \<inter> B) = Pow(A) \<inter> Pow(B)"
 by blast
 
 lemma Pow_INT_eq: "A\<noteq>0 \<Longrightarrow> Pow(\<Inter>x\<in>A. B(x)) = (\<Inter>x\<in>A. Pow(B(x)))"
 by (blast elim!: not_emptyE)
 
 
 subsection\<open>RepFun\<close>
 
 lemma RepFun_subset: "\<lbrakk>\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> B\<rbrakk> \<Longrightarrow> {f(x). x\<in>A} \<subseteq> B"
 by blast
 
 lemma RepFun_eq_0_iff [simp]: "{f(x).x\<in>A}=0 \<longleftrightarrow> A=0"
 by blast
 
 lemma RepFun_constant [simp]: "{c. x\<in>A} = (if A=0 then 0 else {c})"
 by force
 
 
 subsection\<open>Collect\<close>
 
 lemma Collect_subset: "Collect(A,P) \<subseteq> A"
 by blast
 
 lemma Collect_Un: "Collect(A \<union> B, P) = Collect(A,P) \<union> Collect(B,P)"
 by blast
 
 lemma Collect_Int: "Collect(A \<inter> B, P) = Collect(A,P) \<inter> Collect(B,P)"
 by blast
 
 lemma Collect_Diff: "Collect(A - B, P) = Collect(A,P) - Collect(B,P)"
 by blast
 
 lemma Collect_cons: "{x\<in>cons(a,B). P(x)} =
       (if P(a) then cons(a, {x\<in>B. P(x)}) else {x\<in>B. P(x)})"
 by (simp, blast)
 
 lemma Int_Collect_self_eq: "A \<inter> Collect(A,P) = Collect(A,P)"
 by blast
 
 lemma Collect_Collect_eq [simp]:
      "Collect(Collect(A,P), Q) = Collect(A, \<lambda>x. P(x) \<and> Q(x))"
 by blast
 
 lemma Collect_Int_Collect_eq:
      "Collect(A,P) \<inter> Collect(A,Q) = Collect(A, \<lambda>x. P(x) \<and> Q(x))"
 by blast
 
 lemma Collect_Union_eq [simp]:
      "Collect(\<Union>x\<in>A. B(x), P) = (\<Union>x\<in>A. Collect(B(x), P))"
 by blast
 
 lemma Collect_Int_left: "{x\<in>A. P(x)} \<inter> B = {x \<in> A \<inter> B. P(x)}"
 by blast
 
 lemma Collect_Int_right: "A \<inter> {x\<in>B. P(x)} = {x \<in> A \<inter> B. P(x)}"
 by blast
 
 lemma Collect_disj_eq: "{x\<in>A. P(x) | Q(x)} = Collect(A, P) \<union> Collect(A, Q)"
 by blast
 
 lemma Collect_conj_eq: "{x\<in>A. P(x) \<and> Q(x)} = Collect(A, P) \<inter> Collect(A, Q)"
 by blast
 
 lemmas subset_SIs = subset_refl cons_subsetI subset_consI
                     Union_least UN_least Un_least
                     Inter_greatest Int_greatest RepFun_subset
                     Un_upper1 Un_upper2 Int_lower1 Int_lower2
 
 ML \<open>
 val subset_cs =
   claset_of (\<^context>
     delrules [@{thm subsetI}, @{thm subsetCE}]
     addSIs @{thms subset_SIs}
     addIs  [@{thm Union_upper}, @{thm Inter_lower}]
     addSEs [@{thm cons_subsetE}]);
 
 val ZF_cs = claset_of (\<^context> delrules [@{thm equalityI}]);
 \<close>
 
 end
 
diff --git a/src/ZF/ex/Commutation.thy b/src/ZF/ex/Commutation.thy
--- a/src/ZF/ex/Commutation.thy
+++ b/src/ZF/ex/Commutation.thy
@@ -1,142 +1,142 @@
 (*  Title:      ZF/ex/Commutation.thy
     Author:     Tobias Nipkow \<and> Sidi Ould Ehmety
     Copyright   1995  TU Muenchen
 
 Commutation theory for proving the Church Rosser theorem.
 *)
 
 theory Commutation imports ZF begin
 
 definition
   square  :: "[i, i, i, i] \<Rightarrow> o" where
   "square(r,s,t,u) \<equiv>
     (\<forall>a b. \<langle>a,b\<rangle> \<in> r \<longrightarrow> (\<forall>c. \<langle>a, c\<rangle> \<in> s \<longrightarrow> (\<exists>x. \<langle>b,x\<rangle> \<in> t \<and> \<langle>c,x\<rangle> \<in> u)))"
 
 definition
   commute :: "[i, i] \<Rightarrow> o" where
   "commute(r,s) \<equiv> square(r,s,s,r)"
 
 definition
   diamond :: "i\<Rightarrow>o" where
   "diamond(r)   \<equiv> commute(r, r)"
 
 definition
   strip :: "i\<Rightarrow>o" where
   "strip(r) \<equiv> commute(r^*, r)"
 
 definition
   Church_Rosser :: "i \<Rightarrow> o" where
   "Church_Rosser(r) \<equiv> (\<forall>x y. \<langle>x,y\<rangle> \<in>  (r \<union> converse(r))^* \<longrightarrow>
                         (\<exists>z. \<langle>x,z\<rangle> \<in> r^* \<and> \<langle>y,z\<rangle> \<in> r^*))"
 
 definition
   confluent :: "i\<Rightarrow>o" where
   "confluent(r) \<equiv> diamond(r^*)"
 
 
 lemma square_sym: "square(r,s,t,u) \<Longrightarrow> square(s,r,u,t)"
   unfolding square_def by blast
 
 lemma square_subset: "\<lbrakk>square(r,s,t,u); t \<subseteq> t'\<rbrakk> \<Longrightarrow> square(r,s,t',u)"
   unfolding square_def by blast
 
 
 lemma square_rtrancl:
   "square(r,s,s,t) \<Longrightarrow> field(s)<=field(t) \<Longrightarrow> square(r^*,s,s,t^*)"
 apply (unfold square_def, clarify)
 apply (erule rtrancl_induct)
 apply (blast intro: rtrancl_refl)
 apply (blast intro: rtrancl_into_rtrancl)
 done
 
 (* A special case of square_rtrancl_on *)
 lemma diamond_strip:
   "diamond(r) \<Longrightarrow> strip(r)"
 apply (unfold diamond_def commute_def strip_def)
 apply (rule square_rtrancl, simp_all)
 done
 
 (*** commute ***)
 
 lemma commute_sym: "commute(r,s) \<Longrightarrow> commute(s,r)"
   unfolding commute_def by (blast intro: square_sym)
 
 lemma commute_rtrancl:
   "commute(r,s) \<Longrightarrow> field(r)=field(s) \<Longrightarrow> commute(r^*,s^*)"
-apply (unfold commute_def)
+  unfolding commute_def
 apply (rule square_rtrancl)
 apply (rule square_sym [THEN square_rtrancl, THEN square_sym])
 apply (simp_all add: rtrancl_field)
 done
 
 
 lemma confluentD: "confluent(r) \<Longrightarrow> diamond(r^*)"
 by (simp add: confluent_def)
 
 lemma strip_confluent: "strip(r) \<Longrightarrow> confluent(r)"
 apply (unfold strip_def confluent_def diamond_def)
 apply (drule commute_rtrancl)
 apply (simp_all add: rtrancl_field)
 done
 
 lemma commute_Un: "\<lbrakk>commute(r,t); commute(s,t)\<rbrakk> \<Longrightarrow> commute(r \<union> s, t)"
   unfolding commute_def square_def by blast
 
 lemma diamond_Un:
      "\<lbrakk>diamond(r); diamond(s); commute(r, s)\<rbrakk> \<Longrightarrow> diamond(r \<union> s)"
   unfolding diamond_def by (blast intro: commute_Un commute_sym)
 
 lemma diamond_confluent:
     "diamond(r) \<Longrightarrow> confluent(r)"
 apply (unfold diamond_def confluent_def)
 apply (erule commute_rtrancl, simp)
 done
 
 lemma confluent_Un:
  "\<lbrakk>confluent(r); confluent(s); commute(r^*, s^*);
      relation(r); relation(s)\<rbrakk> \<Longrightarrow> confluent(r \<union> s)"
-apply (unfold confluent_def)
+  unfolding confluent_def
 apply (rule rtrancl_Un_rtrancl [THEN subst], auto)
 apply (blast dest: diamond_Un intro: diamond_confluent [THEN confluentD])
 done
 
 
 lemma diamond_to_confluence:
      "\<lbrakk>diamond(r); s \<subseteq> r; r<= s^*\<rbrakk> \<Longrightarrow> confluent(s)"
 apply (drule rtrancl_subset [symmetric], assumption)
 apply (simp_all add: confluent_def)
 apply (blast intro: diamond_confluent [THEN confluentD])
 done
 
 
 (*** Church_Rosser ***)
 
 lemma Church_Rosser1:
      "Church_Rosser(r) \<Longrightarrow> confluent(r)"
 apply (unfold confluent_def Church_Rosser_def square_def
               commute_def diamond_def, auto)
 apply (drule converseI)
 apply (simp (no_asm_use) add: rtrancl_converse [symmetric])
 apply (drule_tac x = b in spec)
 apply (drule_tac x1 = c in spec [THEN mp])
 apply (rule_tac b = a in rtrancl_trans)
 apply (blast intro: rtrancl_mono [THEN subsetD])+
 done
 
 
 lemma Church_Rosser2:
      "confluent(r) \<Longrightarrow> Church_Rosser(r)"
 apply (unfold confluent_def Church_Rosser_def square_def
               commute_def diamond_def, auto)
 apply (frule fieldI1)
 apply (simp add: rtrancl_field)
 apply (erule rtrancl_induct, auto)
 apply (blast intro: rtrancl_refl)
 apply (blast del: rtrancl_refl intro: r_into_rtrancl rtrancl_trans)+
 done
 
 
 lemma Church_Rosser: "Church_Rosser(r) \<longleftrightarrow> confluent(r)"
   by (blast intro: Church_Rosser1 Church_Rosser2)
 
 end
diff --git a/src/ZF/ex/Limit.thy b/src/ZF/ex/Limit.thy
--- a/src/ZF/ex/Limit.thy
+++ b/src/ZF/ex/Limit.thy
@@ -1,2306 +1,2306 @@
 (*  Title:      ZF/ex/Limit.thy
     Author:     Sten Agerholm
     Author:     Lawrence C Paulson
 
 A formalization of the inverse limit construction of domain theory.
 
 The following paper comments on the formalization:
 
 "A Comparison of HOL-ST and Isabelle/ZF" by Sten Agerholm
 In Proceedings of the First Isabelle Users Workshop, Technical
 Report No. 379, University of Cambridge Computer Laboratory, 1995.
 
 This is a condensed version of:
 
 "A Comparison of HOL-ST and Isabelle/ZF" by Sten Agerholm
 Technical Report No. 369, University of Cambridge Computer
 Laboratory, 1995.
 *)
 
 theory Limit  imports  ZF begin
 
 definition
   rel :: "[i,i,i]\<Rightarrow>o"  where
     "rel(D,x,y) \<equiv> \<langle>x,y\<rangle>:snd(D)"
 
 definition
   set :: "i\<Rightarrow>i"  where
     "set(D) \<equiv> fst(D)"
 
 definition
   po  :: "i\<Rightarrow>o"  where
     "po(D) \<equiv>
      (\<forall>x \<in> set(D). rel(D,x,x)) \<and>
      (\<forall>x \<in> set(D). \<forall>y \<in> set(D). \<forall>z \<in> set(D).
        rel(D,x,y) \<longrightarrow> rel(D,y,z) \<longrightarrow> rel(D,x,z)) \<and>
      (\<forall>x \<in> set(D). \<forall>y \<in> set(D). rel(D,x,y) \<longrightarrow> rel(D,y,x) \<longrightarrow> x = y)"
 
 definition
   chain :: "[i,i]\<Rightarrow>o"  where
     (* Chains are object level functions nat->set(D) *)
     "chain(D,X) \<equiv> X \<in> nat->set(D) \<and> (\<forall>n \<in> nat. rel(D,X`n,X`(succ(n))))"
 
 definition
   isub :: "[i,i,i]\<Rightarrow>o"  where
     "isub(D,X,x) \<equiv> x \<in> set(D) \<and> (\<forall>n \<in> nat. rel(D,X`n,x))"
 
 definition
   islub :: "[i,i,i]\<Rightarrow>o"  where
     "islub(D,X,x) \<equiv> isub(D,X,x) \<and> (\<forall>y. isub(D,X,y) \<longrightarrow> rel(D,x,y))"
 
 definition
   lub :: "[i,i]\<Rightarrow>i"  where
     "lub(D,X) \<equiv> THE x. islub(D,X,x)"
 
 definition
   cpo :: "i\<Rightarrow>o"  where
     "cpo(D) \<equiv> po(D) \<and> (\<forall>X. chain(D,X) \<longrightarrow> (\<exists>x. islub(D,X,x)))"
 
 definition
   pcpo :: "i\<Rightarrow>o"  where
     "pcpo(D) \<equiv> cpo(D) \<and> (\<exists>x \<in> set(D). \<forall>y \<in> set(D). rel(D,x,y))"
 
 definition
   bot :: "i\<Rightarrow>i"  where
     "bot(D) \<equiv> THE x. x \<in> set(D) \<and> (\<forall>y \<in> set(D). rel(D,x,y))"
 
 definition
   mono :: "[i,i]\<Rightarrow>i"  where
     "mono(D,E) \<equiv>
      {f \<in> set(D)->set(E).
       \<forall>x \<in> set(D). \<forall>y \<in> set(D). rel(D,x,y) \<longrightarrow> rel(E,f`x,f`y)}"
 
 definition
   cont :: "[i,i]\<Rightarrow>i"  where
     "cont(D,E) \<equiv>
      {f \<in> mono(D,E).
       \<forall>X. chain(D,X) \<longrightarrow> f`(lub(D,X)) = lub(E,\<lambda>n \<in> nat. f`(X`n))}"
 
 definition
   cf :: "[i,i]\<Rightarrow>i"  where
     "cf(D,E) \<equiv>
      <cont(D,E),
       {y \<in> cont(D,E)*cont(D,E). \<forall>x \<in> set(D). rel(E,(fst(y))`x,(snd(y))`x)}>"
 
 definition
   suffix :: "[i,i]\<Rightarrow>i"  where
     "suffix(X,n) \<equiv> \<lambda>m \<in> nat. X`(n #+ m)"
 
 definition
   subchain :: "[i,i]\<Rightarrow>o"  where
     "subchain(X,Y) \<equiv> \<forall>m \<in> nat. \<exists>n \<in> nat. X`m = Y`(m #+ n)"
 
 definition
   dominate :: "[i,i,i]\<Rightarrow>o"  where
     "dominate(D,X,Y) \<equiv> \<forall>m \<in> nat. \<exists>n \<in> nat. rel(D,X`m,Y`n)"
 
 definition
   matrix :: "[i,i]\<Rightarrow>o"  where
     "matrix(D,M) \<equiv>
      M \<in> nat -> (nat -> set(D)) \<and>
      (\<forall>n \<in> nat. \<forall>m \<in> nat. rel(D,M`n`m,M`succ(n)`m)) \<and>
      (\<forall>n \<in> nat. \<forall>m \<in> nat. rel(D,M`n`m,M`n`succ(m))) \<and>
      (\<forall>n \<in> nat. \<forall>m \<in> nat. rel(D,M`n`m,M`succ(n)`succ(m)))"
 
 definition
   projpair  :: "[i,i,i,i]\<Rightarrow>o"  where
     "projpair(D,E,e,p) \<equiv>
      e \<in> cont(D,E) \<and> p \<in> cont(E,D) \<and>
      p O e = id(set(D)) \<and> rel(cf(E,E),e O p,id(set(E)))"
 
 definition
   emb       :: "[i,i,i]\<Rightarrow>o"  where
     "emb(D,E,e) \<equiv> \<exists>p. projpair(D,E,e,p)"
 
 definition
   Rp        :: "[i,i,i]\<Rightarrow>i"  where
     "Rp(D,E,e) \<equiv> THE p. projpair(D,E,e,p)"
 
 definition
   (* Twice, constructions on cpos are more difficult. *)
   iprod     :: "i\<Rightarrow>i"  where
     "iprod(DD) \<equiv>
      <(\<Prod>n \<in> nat. set(DD`n)),
       {x:(\<Prod>n \<in> nat. set(DD`n))*(\<Prod>n \<in> nat. set(DD`n)).
        \<forall>n \<in> nat. rel(DD`n,fst(x)`n,snd(x)`n)}>"
 
 definition
   mkcpo     :: "[i,i\<Rightarrow>o]\<Rightarrow>i"  where
     (* Cannot use rel(D), is meta fun, need two more args *)
     "mkcpo(D,P) \<equiv>
      <{x \<in> set(D). P(x)},{x \<in> set(D)*set(D). rel(D,fst(x),snd(x))}>"
 
 definition
   subcpo    :: "[i,i]\<Rightarrow>o"  where
     "subcpo(D,E) \<equiv>
      set(D) \<subseteq> set(E) \<and>
      (\<forall>x \<in> set(D). \<forall>y \<in> set(D). rel(D,x,y) \<longleftrightarrow> rel(E,x,y)) \<and>
      (\<forall>X. chain(D,X) \<longrightarrow> lub(E,X):set(D))"
 
 definition
   subpcpo   :: "[i,i]\<Rightarrow>o"  where
     "subpcpo(D,E) \<equiv> subcpo(D,E) \<and> bot(E):set(D)"
 
 definition
   emb_chain :: "[i,i]\<Rightarrow>o"  where
     "emb_chain(DD,ee) \<equiv>
      (\<forall>n \<in> nat. cpo(DD`n)) \<and> (\<forall>n \<in> nat. emb(DD`n,DD`succ(n),ee`n))"
 
 definition
   Dinf      :: "[i,i]\<Rightarrow>i"  where
     "Dinf(DD,ee) \<equiv>
      mkcpo(iprod(DD))
      (\<lambda>x. \<forall>n \<in> nat. Rp(DD`n,DD`succ(n),ee`n)`(x`succ(n)) = x`n)"
 
 definition
   e_less    :: "[i,i,i,i]\<Rightarrow>i"  where
   (* Valid for m \<le> n only. *)
     "e_less(DD,ee,m,n) \<equiv> rec(n#-m,id(set(DD`m)),\<lambda>x y. ee`(m#+x) O y)"
 
 
 definition
   e_gr      :: "[i,i,i,i]\<Rightarrow>i"  where
   (* Valid for n \<le> m only. *)
     "e_gr(DD,ee,m,n) \<equiv>
      rec(m#-n,id(set(DD`n)),
          \<lambda>x y. y O Rp(DD`(n#+x),DD`(succ(n#+x)),ee`(n#+x)))"
 
 
 definition
   eps       :: "[i,i,i,i]\<Rightarrow>i"  where
     "eps(DD,ee,m,n) \<equiv> if(m \<le> n,e_less(DD,ee,m,n),e_gr(DD,ee,m,n))"
 
 definition
   rho_emb   :: "[i,i,i]\<Rightarrow>i"  where
     "rho_emb(DD,ee,n) \<equiv> \<lambda>x \<in> set(DD`n). \<lambda>m \<in> nat. eps(DD,ee,n,m)`x"
 
 definition
   rho_proj  :: "[i,i,i]\<Rightarrow>i"  where
     "rho_proj(DD,ee,n) \<equiv> \<lambda>x \<in> set(Dinf(DD,ee)). x`n"
 
 definition
   commute   :: "[i,i,i,i\<Rightarrow>i]\<Rightarrow>o"  where
     "commute(DD,ee,E,r) \<equiv>
      (\<forall>n \<in> nat. emb(DD`n,E,r(n))) \<and>
      (\<forall>m \<in> nat. \<forall>n \<in> nat. m \<le> n \<longrightarrow> r(n) O eps(DD,ee,m,n) = r(m))"
 
 definition
   mediating :: "[i,i,i\<Rightarrow>i,i\<Rightarrow>i,i]\<Rightarrow>o"  where
     "mediating(E,G,r,f,t) \<equiv> emb(E,G,t) \<and> (\<forall>n \<in> nat. f(n) = t O r(n))"
 
 
 lemmas nat_linear_le = Ord_linear_le [OF nat_into_Ord nat_into_Ord]
 
 
 (*----------------------------------------------------------------------*)
 (* Basic results.                                                       *)
 (*----------------------------------------------------------------------*)
 
 lemma set_I: "x \<in> fst(D) \<Longrightarrow> x \<in> set(D)"
 by (simp add: set_def)
 
 lemma rel_I: "\<langle>x,y\<rangle>:snd(D) \<Longrightarrow> rel(D,x,y)"
 by (simp add: rel_def)
 
 lemma rel_E: "rel(D,x,y) \<Longrightarrow> \<langle>x,y\<rangle>:snd(D)"
 by (simp add: rel_def)
 
 (*----------------------------------------------------------------------*)
 (* I/E/D rules for po and cpo.                                          *)
 (*----------------------------------------------------------------------*)
 
 lemma po_refl: "\<lbrakk>po(D); x \<in> set(D)\<rbrakk> \<Longrightarrow> rel(D,x,x)"
 by (unfold po_def, blast)
 
 lemma po_trans: "\<lbrakk>po(D); rel(D,x,y); rel(D,y,z); x \<in> set(D);
                   y \<in> set(D); z \<in> set(D)\<rbrakk> \<Longrightarrow> rel(D,x,z)"
 by (unfold po_def, blast)
 
 lemma po_antisym:
     "\<lbrakk>po(D); rel(D,x,y); rel(D,y,x); x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> x = y"
 by (unfold po_def, blast)
 
 lemma poI:
   "\<lbrakk>\<And>x. x \<in> set(D) \<Longrightarrow> rel(D,x,x);
       \<And>x y z. \<lbrakk>rel(D,x,y); rel(D,y,z); x \<in> set(D); y \<in> set(D); z \<in> set(D)\<rbrakk>
                \<Longrightarrow> rel(D,x,z);
       \<And>x y. \<lbrakk>rel(D,x,y); rel(D,y,x); x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> x=y\<rbrakk>
    \<Longrightarrow> po(D)"
 by (unfold po_def, blast)
 
 lemma cpoI: "\<lbrakk>po(D); \<And>X. chain(D,X) \<Longrightarrow> islub(D,X,x(D,X))\<rbrakk> \<Longrightarrow> cpo(D)"
 by (simp add: cpo_def, blast)
 
 lemma cpo_po: "cpo(D) \<Longrightarrow> po(D)"
 by (simp add: cpo_def)
 
 lemma cpo_refl [simp,intro!,TC]: "\<lbrakk>cpo(D); x \<in> set(D)\<rbrakk> \<Longrightarrow> rel(D,x,x)"
 by (blast intro: po_refl cpo_po)
 
 lemma cpo_trans:
      "\<lbrakk>cpo(D); rel(D,x,y); rel(D,y,z); x \<in> set(D);
         y \<in> set(D); z \<in> set(D)\<rbrakk> \<Longrightarrow> rel(D,x,z)"
 by (blast intro: cpo_po po_trans)
 
 lemma cpo_antisym:
      "\<lbrakk>cpo(D); rel(D,x,y); rel(D,y,x); x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> x = y"
 by (blast intro: cpo_po po_antisym)
 
 lemma cpo_islub: "\<lbrakk>cpo(D); chain(D,X);  \<And>x. islub(D,X,x) \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
 by (simp add: cpo_def, blast)
 
 (*----------------------------------------------------------------------*)
 (* Theorems about isub and islub.                                       *)
 (*----------------------------------------------------------------------*)
 
 lemma islub_isub: "islub(D,X,x) \<Longrightarrow> isub(D,X,x)"
 by (simp add: islub_def)
 
 lemma islub_in: "islub(D,X,x) \<Longrightarrow> x \<in> set(D)"
 by (simp add: islub_def isub_def)
 
 lemma islub_ub: "\<lbrakk>islub(D,X,x); n \<in> nat\<rbrakk> \<Longrightarrow> rel(D,X`n,x)"
 by (simp add: islub_def isub_def)
 
 lemma islub_least: "\<lbrakk>islub(D,X,x); isub(D,X,y)\<rbrakk> \<Longrightarrow> rel(D,x,y)"
 by (simp add: islub_def)
 
 lemma islubI:
     "\<lbrakk>isub(D,X,x); \<And>y. isub(D,X,y) \<Longrightarrow> rel(D,x,y)\<rbrakk> \<Longrightarrow> islub(D,X,x)"
 by (simp add: islub_def)
 
 lemma isubI:
     "\<lbrakk>x \<in> set(D);  \<And>n. n \<in> nat \<Longrightarrow> rel(D,X`n,x)\<rbrakk> \<Longrightarrow> isub(D,X,x)"
 by (simp add: isub_def)
 
 lemma isubE:
     "\<lbrakk>isub(D,X,x); \<lbrakk>x \<in> set(D);  \<And>n. n \<in> nat\<Longrightarrow>rel(D,X`n,x)\<rbrakk> \<Longrightarrow> P
 \<rbrakk> \<Longrightarrow> P"
 by (simp add: isub_def)
 
 lemma isubD1: "isub(D,X,x) \<Longrightarrow> x \<in> set(D)"
 by (simp add: isub_def)
 
 lemma isubD2: "\<lbrakk>isub(D,X,x); n \<in> nat\<rbrakk>\<Longrightarrow>rel(D,X`n,x)"
 by (simp add: isub_def)
 
 lemma islub_unique: "\<lbrakk>islub(D,X,x); islub(D,X,y); cpo(D)\<rbrakk> \<Longrightarrow> x = y"
 by (blast intro: cpo_antisym islub_least islub_isub islub_in)
 
 (*----------------------------------------------------------------------*)
 (* lub gives the least upper bound of chains.                           *)
 (*----------------------------------------------------------------------*)
 
 lemma cpo_lub: "\<lbrakk>chain(D,X); cpo(D)\<rbrakk> \<Longrightarrow> islub(D,X,lub(D,X))"
 apply (simp add: lub_def)
 apply (best elim: cpo_islub intro: theI islub_unique)
 done
 
 (*----------------------------------------------------------------------*)
 (* Theorems about chains.                                               *)
 (*----------------------------------------------------------------------*)
 
 lemma chainI:
   "\<lbrakk>X \<in> nat->set(D);  \<And>n. n \<in> nat \<Longrightarrow> rel(D,X`n,X`succ(n))\<rbrakk> \<Longrightarrow> chain(D,X)"
 by (simp add: chain_def)
 
 lemma chain_fun: "chain(D,X) \<Longrightarrow> X \<in> nat -> set(D)"
 by (simp add: chain_def)
 
 lemma chain_in [simp,TC]: "\<lbrakk>chain(D,X); n \<in> nat\<rbrakk> \<Longrightarrow> X`n \<in> set(D)"
 apply (simp add: chain_def)
 apply (blast dest: apply_type)
 done
 
 lemma chain_rel [simp,TC]:
      "\<lbrakk>chain(D,X); n \<in> nat\<rbrakk> \<Longrightarrow> rel(D, X ` n, X ` succ(n))"
 by (simp add: chain_def)
 
 lemma chain_rel_gen_add:
      "\<lbrakk>chain(D,X); cpo(D); n \<in> nat; m \<in> nat\<rbrakk> \<Longrightarrow> rel(D,X`n,(X`(m #+ n)))"
 apply (induct_tac m)
 apply (auto intro: cpo_trans)
 done
 
 lemma chain_rel_gen:
     "\<lbrakk>n \<le> m; chain(D,X); cpo(D); m \<in> nat\<rbrakk> \<Longrightarrow> rel(D,X`n,X`m)"
 apply (frule lt_nat_in_nat, erule nat_succI)
 apply (erule rev_mp) (*prepare the induction*)
 apply (induct_tac m)
 apply (auto intro: cpo_trans simp add: le_iff)
 done
 
 (*----------------------------------------------------------------------*)
 (* Theorems about pcpos and bottom.                                     *)
 (*----------------------------------------------------------------------*)
 
 lemma pcpoI:
     "\<lbrakk>\<And>y. y \<in> set(D)\<Longrightarrow>rel(D,x,y); x \<in> set(D); cpo(D)\<rbrakk>\<Longrightarrow>pcpo(D)"
 by (simp add: pcpo_def, auto)
 
 lemma pcpo_cpo [TC]: "pcpo(D) \<Longrightarrow> cpo(D)"
 by (simp add: pcpo_def)
 
 lemma pcpo_bot_ex1:
     "pcpo(D) \<Longrightarrow> \<exists>! x. x \<in> set(D) \<and> (\<forall>y \<in> set(D). rel(D,x,y))"
 apply (simp add: pcpo_def)
 apply (blast intro: cpo_antisym)
 done
 
 lemma bot_least [TC]:
     "\<lbrakk>pcpo(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> rel(D,bot(D),y)"
 apply (simp add: bot_def)
 apply (best intro: pcpo_bot_ex1 [THEN theI2])
 done
 
 lemma bot_in [TC]:
     "pcpo(D) \<Longrightarrow> bot(D):set(D)"
 apply (simp add: bot_def)
 apply (best intro: pcpo_bot_ex1 [THEN theI2])
 done
 
 lemma bot_unique:
     "\<lbrakk>pcpo(D); x \<in> set(D); \<And>y. y \<in> set(D) \<Longrightarrow> rel(D,x,y)\<rbrakk> \<Longrightarrow> x = bot(D)"
 by (blast intro: cpo_antisym pcpo_cpo bot_in bot_least)
 
 (*----------------------------------------------------------------------*)
 (* Constant chains and lubs and cpos.                                   *)
 (*----------------------------------------------------------------------*)
 
 lemma chain_const: "\<lbrakk>x \<in> set(D); cpo(D)\<rbrakk> \<Longrightarrow> chain(D,(\<lambda>n \<in> nat. x))"
 by (simp add: chain_def)
 
 lemma islub_const:
    "\<lbrakk>x \<in> set(D); cpo(D)\<rbrakk> \<Longrightarrow> islub(D,(\<lambda>n \<in> nat. x),x)"
 by (simp add: islub_def isub_def, blast)
 
 lemma lub_const: "\<lbrakk>x \<in> set(D); cpo(D)\<rbrakk> \<Longrightarrow> lub(D,\<lambda>n \<in> nat. x) = x"
 by (blast intro: islub_unique cpo_lub chain_const islub_const)
 
 (*----------------------------------------------------------------------*)
 (* Taking the suffix of chains has no effect on ub's.                   *)
 (*----------------------------------------------------------------------*)
 
 lemma isub_suffix:
     "\<lbrakk>chain(D,X); cpo(D)\<rbrakk> \<Longrightarrow> isub(D,suffix(X,n),x) \<longleftrightarrow> isub(D,X,x)"
 apply (simp add: isub_def suffix_def, safe)
 apply (drule_tac x = na in bspec)
 apply (auto intro: cpo_trans chain_rel_gen_add)
 done
 
 lemma islub_suffix:
   "\<lbrakk>chain(D,X); cpo(D)\<rbrakk> \<Longrightarrow> islub(D,suffix(X,n),x) \<longleftrightarrow> islub(D,X,x)"
 by (simp add: islub_def isub_suffix)
 
 lemma lub_suffix:
     "\<lbrakk>chain(D,X); cpo(D)\<rbrakk> \<Longrightarrow> lub(D,suffix(X,n)) = lub(D,X)"
 by (simp add: lub_def islub_suffix)
 
 (*----------------------------------------------------------------------*)
 (* Dominate and subchain.                                               *)
 (*----------------------------------------------------------------------*)
 
 lemma dominateI:
   "\<lbrakk>\<And>m. m \<in> nat \<Longrightarrow> n(m):nat; \<And>m. m \<in> nat \<Longrightarrow> rel(D,X`m,Y`n(m))\<rbrakk>
    \<Longrightarrow> dominate(D,X,Y)"
 by (simp add: dominate_def, blast)
 
 lemma dominate_isub:
   "\<lbrakk>dominate(D,X,Y); isub(D,Y,x); cpo(D);
      X \<in> nat->set(D); Y \<in> nat->set(D)\<rbrakk> \<Longrightarrow> isub(D,X,x)"
 apply (simp add: isub_def dominate_def)
 apply (blast intro: cpo_trans intro!: apply_funtype)
 done
 
 lemma dominate_islub:
   "\<lbrakk>dominate(D,X,Y); islub(D,X,x); islub(D,Y,y); cpo(D);
      X \<in> nat->set(D); Y \<in> nat->set(D)\<rbrakk> \<Longrightarrow> rel(D,x,y)"
 apply (simp add: islub_def)
 apply (blast intro: dominate_isub)
 done
 
 lemma subchain_isub:
      "\<lbrakk>subchain(Y,X); isub(D,X,x)\<rbrakk> \<Longrightarrow> isub(D,Y,x)"
 by (simp add: isub_def subchain_def, force)
 
 lemma dominate_islub_eq:
      "\<lbrakk>dominate(D,X,Y); subchain(Y,X); islub(D,X,x); islub(D,Y,y); cpo(D);
         X \<in> nat->set(D); Y \<in> nat->set(D)\<rbrakk> \<Longrightarrow> x = y"
 by (blast intro: cpo_antisym dominate_islub islub_least subchain_isub
                  islub_isub islub_in)
 
 
 (*----------------------------------------------------------------------*)
 (* Matrix.                                                              *)
 (*----------------------------------------------------------------------*)
 
 lemma matrix_fun: "matrix(D,M) \<Longrightarrow> M \<in> nat -> (nat -> set(D))"
 by (simp add: matrix_def)
 
 lemma matrix_in_fun: "\<lbrakk>matrix(D,M); n \<in> nat\<rbrakk> \<Longrightarrow> M`n \<in> nat -> set(D)"
 by (blast intro: apply_funtype matrix_fun)
 
 lemma matrix_in: "\<lbrakk>matrix(D,M); n \<in> nat; m \<in> nat\<rbrakk> \<Longrightarrow> M`n`m \<in> set(D)"
 by (blast intro: apply_funtype matrix_in_fun)
 
 lemma matrix_rel_1_0:
     "\<lbrakk>matrix(D,M); n \<in> nat; m \<in> nat\<rbrakk> \<Longrightarrow> rel(D,M`n`m,M`succ(n)`m)"
 by (simp add: matrix_def)
 
 lemma matrix_rel_0_1:
     "\<lbrakk>matrix(D,M); n \<in> nat; m \<in> nat\<rbrakk> \<Longrightarrow> rel(D,M`n`m,M`n`succ(m))"
 by (simp add: matrix_def)
 
 lemma matrix_rel_1_1:
     "\<lbrakk>matrix(D,M); n \<in> nat; m \<in> nat\<rbrakk> \<Longrightarrow> rel(D,M`n`m,M`succ(n)`succ(m))"
 by (simp add: matrix_def)
 
 lemma fun_swap: "f \<in> X->Y->Z \<Longrightarrow> (\<lambda>y \<in> Y. \<lambda>x \<in> X. f`x`y):Y->X->Z"
 by (blast intro: lam_type apply_funtype)
 
 lemma matrix_sym_axis:
     "matrix(D,M) \<Longrightarrow> matrix(D,\<lambda>m \<in> nat. \<lambda>n \<in> nat. M`n`m)"
 by (simp add: matrix_def fun_swap)
 
 lemma matrix_chain_diag:
     "matrix(D,M) \<Longrightarrow> chain(D,\<lambda>n \<in> nat. M`n`n)"
 apply (simp add: chain_def)
 apply (auto intro: lam_type matrix_in matrix_rel_1_1)
 done
 
 lemma matrix_chain_left:
     "\<lbrakk>matrix(D,M); n \<in> nat\<rbrakk> \<Longrightarrow> chain(D,M`n)"
-apply (unfold chain_def)
+  unfolding chain_def
 apply (auto intro: matrix_fun [THEN apply_type] matrix_in matrix_rel_0_1)
 done
 
 lemma matrix_chain_right:
     "\<lbrakk>matrix(D,M); m \<in> nat\<rbrakk> \<Longrightarrow> chain(D,\<lambda>n \<in> nat. M`n`m)"
 apply (simp add: chain_def)
 apply (auto intro: lam_type matrix_in matrix_rel_1_0)
 done
 
 lemma matrix_chainI:
   assumes xprem: "\<And>x. x \<in> nat\<Longrightarrow>chain(D,M`x)"
       and yprem: "\<And>y. y \<in> nat\<Longrightarrow>chain(D,\<lambda>x \<in> nat. M`x`y)"
       and Mfun:  "M \<in> nat->nat->set(D)"
       and cpoD:  "cpo(D)"
   shows "matrix(D,M)"
 proof -
   {
     fix n m assume "n \<in> nat" "m \<in> nat"
     with chain_rel [OF yprem]
     have "rel(D, M ` n ` m, M ` succ(n) ` m)" by simp
   } note rel_succ = this
   show "matrix(D,M)"
   proof (simp add: matrix_def Mfun rel_succ, intro conjI ballI)
     fix n m assume n: "n \<in> nat" and m: "m \<in> nat"
     thus "rel(D, M ` n ` m, M ` n ` succ(m))"
       by (simp add: chain_rel xprem)
   next
     fix n m assume n: "n \<in> nat" and m: "m \<in> nat"
     thus "rel(D, M ` n ` m, M ` succ(n) ` succ(m))"
       by (rule cpo_trans [OF cpoD rel_succ],
           simp_all add: chain_fun [THEN apply_type] xprem)
   qed
 qed
 
 lemma lemma2:
      "\<lbrakk>x \<in> nat; m \<in> nat; rel(D,(\<lambda>n \<in> nat. M`n`m1)`x,(\<lambda>n \<in> nat. M`n`m1)`m)\<rbrakk>
       \<Longrightarrow> rel(D,M`x`m1,M`m`m1)"
 by simp
 
 lemma isub_lemma:
     "\<lbrakk>isub(D, \<lambda>n \<in> nat. M`n`n, y); matrix(D,M); cpo(D)\<rbrakk>
      \<Longrightarrow> isub(D, \<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m), y)"
 proof (simp add: isub_def, safe)
   fix n
   assume DM: "matrix(D, M)" and D: "cpo(D)" and n: "n \<in> nat" and y: "y \<in> set(D)"
      and rel: "\<forall>n\<in>nat. rel(D, M ` n ` n, y)"
   have "rel(D, lub(D, M ` n), y)"
   proof (rule matrix_chain_left [THEN cpo_lub, THEN islub_least], simp_all add: n D DM)
     show "isub(D, M ` n, y)"
       proof (unfold isub_def, intro conjI ballI y)
         fix k assume k: "k \<in> nat"
         show "rel(D, M ` n ` k, y)"
           proof (cases "n \<le> k")
             case True
             hence yy: "rel(D, M`n`k, M`k`k)"
               by (blast intro: lemma2 n k y DM D chain_rel_gen matrix_chain_right)
             show "?thesis"
               by (rule cpo_trans [OF D yy],
                   simp_all add: k rel n y DM matrix_in)
           next
             case False
             hence le: "k \<le> n"
               by (blast intro: not_le_iff_lt [THEN iffD1, THEN leI] nat_into_Ord n k)
             show "?thesis"
               by (rule cpo_trans [OF D chain_rel_gen [OF le]],
                   simp_all add: n y k rel DM D matrix_chain_left)
           qed
         qed
   qed
   moreover
   have "M ` n \<in> nat \<rightarrow> set(D)" by (blast intro: DM n matrix_fun [THEN apply_type])
   ultimately show "rel(D, lub(D, Lambda(nat, (`)(M ` n))), y)"  by simp
 qed
 
 lemma matrix_chain_lub:
     "\<lbrakk>matrix(D,M); cpo(D)\<rbrakk> \<Longrightarrow> chain(D,\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m))"
 proof (simp add: chain_def, intro conjI ballI)
   assume "matrix(D, M)" "cpo(D)"
   thus "(\<lambda>x\<in>nat. lub(D, Lambda(nat, (`)(M ` x)))) \<in> nat \<rightarrow> set(D)"
     by (force intro: islub_in cpo_lub chainI lam_type matrix_in matrix_rel_0_1)
 next
   fix n
   assume DD: "matrix(D, M)" "cpo(D)" "n \<in> nat"
   hence "dominate(D, M ` n, M ` succ(n))"
     by (force simp add: dominate_def intro: matrix_rel_1_0)
   with DD show "rel(D, lub(D, Lambda(nat, (`)(M ` n))),
                lub(D, Lambda(nat, (`)(M ` succ(n)))))"
     by (simp add: matrix_chain_left [THEN chain_fun, THEN eta]
       dominate_islub cpo_lub matrix_chain_left chain_fun)
 qed
 
 lemma isub_eq:
   assumes DM: "matrix(D, M)" and D: "cpo(D)"
   shows "isub(D,(\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m)),y) \<longleftrightarrow> isub(D,(\<lambda>n \<in> nat. M`n`n),y)"
 proof
   assume isub: "isub(D, \<lambda>n\<in>nat. lub(D, Lambda(nat, (`)(M ` n))), y)"
   hence dom: "dominate(D, \<lambda>n\<in>nat. M ` n ` n, \<lambda>n\<in>nat. lub(D, Lambda(nat, (`)(M ` n))))"
     using DM D
     by (simp add: dominate_def, intro ballI bexI,
         simp_all add: matrix_chain_left [THEN chain_fun, THEN eta] islub_ub cpo_lub matrix_chain_left)
   thus "isub(D, \<lambda>n\<in>nat. M ` n ` n, y)" using DM D
     by - (rule dominate_isub [OF dom isub],
           simp_all add: matrix_chain_diag chain_fun matrix_chain_lub)
 next
   assume isub: "isub(D, \<lambda>n\<in>nat. M ` n ` n, y)"
   thus "isub(D, \<lambda>n\<in>nat. lub(D, Lambda(nat, (`)(M ` n))), y)"  using DM D
     by (simp add: isub_lemma)
 qed
 
 lemma lub_matrix_diag_aux1:
     "lub(D,(\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m))) =
      (THE x. islub(D, (\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m)), x))"
 by (simp add: lub_def)
 
 lemma lub_matrix_diag_aux2:
     "lub(D,(\<lambda>n \<in> nat. M`n`n)) =
      (THE x. islub(D, (\<lambda>n \<in> nat. M`n`n), x))"
 by (simp add: lub_def)
 
 lemma lub_matrix_diag:
     "\<lbrakk>matrix(D,M); cpo(D)\<rbrakk>
      \<Longrightarrow> lub(D,(\<lambda>n \<in> nat. lub(D,\<lambda>m \<in> nat. M`n`m))) =
          lub(D,(\<lambda>n \<in> nat. M`n`n))"
 apply (simp (no_asm) add: lub_matrix_diag_aux1 lub_matrix_diag_aux2)
 apply (simp add: islub_def isub_eq)
 done
 
 lemma lub_matrix_diag_sym:
     "\<lbrakk>matrix(D,M); cpo(D)\<rbrakk>
      \<Longrightarrow> lub(D,(\<lambda>m \<in> nat. lub(D,\<lambda>n \<in> nat. M`n`m))) =
          lub(D,(\<lambda>n \<in> nat. M`n`n))"
 by (drule matrix_sym_axis [THEN lub_matrix_diag], auto)
 
 (*----------------------------------------------------------------------*)
 (* I/E/D rules for mono and cont.                                       *)
 (*----------------------------------------------------------------------*)
 
 lemma monoI:
     "\<lbrakk>f \<in> set(D)->set(E);
        \<And>x y. \<lbrakk>rel(D,x,y); x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> rel(E,f`x,f`y)\<rbrakk>
      \<Longrightarrow> f \<in> mono(D,E)"
 by (simp add: mono_def)
 
 lemma mono_fun: "f \<in> mono(D,E) \<Longrightarrow> f \<in> set(D)->set(E)"
 by (simp add: mono_def)
 
 lemma mono_map: "\<lbrakk>f \<in> mono(D,E); x \<in> set(D)\<rbrakk> \<Longrightarrow> f`x \<in> set(E)"
 by (blast intro!: mono_fun [THEN apply_type])
 
 lemma mono_mono:
     "\<lbrakk>f \<in> mono(D,E); rel(D,x,y); x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> rel(E,f`x,f`y)"
 by (simp add: mono_def)
 
 lemma contI:
     "\<lbrakk>f \<in> set(D)->set(E);
        \<And>x y. \<lbrakk>rel(D,x,y); x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> rel(E,f`x,f`y);
        \<And>X. chain(D,X) \<Longrightarrow> f`lub(D,X) = lub(E,\<lambda>n \<in> nat. f`(X`n))\<rbrakk>
      \<Longrightarrow> f \<in> cont(D,E)"
 by (simp add: cont_def mono_def)
 
 lemma cont2mono: "f \<in> cont(D,E) \<Longrightarrow> f \<in> mono(D,E)"
 by (simp add: cont_def)
 
 lemma cont_fun [TC]: "f \<in> cont(D,E) \<Longrightarrow> f \<in> set(D)->set(E)"
 apply (simp add: cont_def)
 apply (rule mono_fun, blast)
 done
 
 lemma cont_map [TC]: "\<lbrakk>f \<in> cont(D,E); x \<in> set(D)\<rbrakk> \<Longrightarrow> f`x \<in> set(E)"
 by (blast intro!: cont_fun [THEN apply_type])
 
 declare comp_fun [TC]
 
 lemma cont_mono:
     "\<lbrakk>f \<in> cont(D,E); rel(D,x,y); x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> rel(E,f`x,f`y)"
 apply (simp add: cont_def)
 apply (blast intro!: mono_mono)
 done
 
 lemma cont_lub:
    "\<lbrakk>f \<in> cont(D,E); chain(D,X)\<rbrakk> \<Longrightarrow> f`(lub(D,X)) = lub(E,\<lambda>n \<in> nat. f`(X`n))"
 by (simp add: cont_def)
 
 (*----------------------------------------------------------------------*)
 (* Continuity and chains.                                               *)
 (*----------------------------------------------------------------------*)
 
 lemma mono_chain:
      "\<lbrakk>f \<in> mono(D,E); chain(D,X)\<rbrakk> \<Longrightarrow> chain(E,\<lambda>n \<in> nat. f`(X`n))"
 apply (simp (no_asm) add: chain_def)
 apply (blast intro: lam_type mono_map chain_in mono_mono chain_rel)
 done
 
 lemma cont_chain:
      "\<lbrakk>f \<in> cont(D,E); chain(D,X)\<rbrakk> \<Longrightarrow> chain(E,\<lambda>n \<in> nat. f`(X`n))"
 by (blast intro: mono_chain cont2mono)
 
 (*----------------------------------------------------------------------*)
 (* I/E/D rules about (set+rel) cf, the continuous function space.       *)
 (*----------------------------------------------------------------------*)
 
 (* The following development more difficult with cpo-as-relation approach. *)
 
 lemma cf_cont: "f \<in> set(cf(D,E)) \<Longrightarrow> f \<in> cont(D,E)"
 by (simp add: set_def cf_def)
 
 lemma cont_cf: (* Non-trivial with relation *)
     "f \<in> cont(D,E) \<Longrightarrow> f \<in> set(cf(D,E))"
 by (simp add: set_def cf_def)
 
 (* rel_cf originally an equality. Now stated as two rules. Seemed easiest. *)
 
 lemma rel_cfI:
     "\<lbrakk>\<And>x. x \<in> set(D) \<Longrightarrow> rel(E,f`x,g`x); f \<in> cont(D,E); g \<in> cont(D,E)\<rbrakk>
      \<Longrightarrow> rel(cf(D,E),f,g)"
 by (simp add: rel_I cf_def)
 
 lemma rel_cf: "\<lbrakk>rel(cf(D,E),f,g); x \<in> set(D)\<rbrakk> \<Longrightarrow> rel(E,f`x,g`x)"
 by (simp add: rel_def cf_def)
 
 (*----------------------------------------------------------------------*)
 (* Theorems about the continuous function space.                        *)
 (*----------------------------------------------------------------------*)
 
 lemma chain_cf:
     "\<lbrakk>chain(cf(D,E),X); x \<in> set(D)\<rbrakk> \<Longrightarrow> chain(E,\<lambda>n \<in> nat. X`n`x)"
 apply (rule chainI)
 apply (blast intro: lam_type apply_funtype cont_fun cf_cont chain_in, simp)
 apply (blast intro: rel_cf chain_rel)
 done
 
 lemma matrix_lemma:
     "\<lbrakk>chain(cf(D,E),X); chain(D,Xa); cpo(D); cpo(E)\<rbrakk>
      \<Longrightarrow> matrix(E,\<lambda>x \<in> nat. \<lambda>xa \<in> nat. X`x`(Xa`xa))"
 apply (rule matrix_chainI, auto)
 apply (force intro: chainI lam_type apply_funtype cont_fun cf_cont cont_mono)
 apply (force intro: chainI lam_type apply_funtype cont_fun cf_cont rel_cf)
 apply (blast intro: lam_type apply_funtype cont_fun cf_cont chain_in)
 done
 
 lemma chain_cf_lub_cont:
   assumes ch: "chain(cf(D,E),X)" and D: "cpo(D)" and E: "cpo(E)"
   shows   "(\<lambda>x \<in> set(D). lub(E, \<lambda>n \<in> nat. X ` n ` x)) \<in> cont(D, E)"
 proof (rule contI)
   show "(\<lambda>x\<in>set(D). lub(E, \<lambda>n\<in>nat. X ` n ` x)) \<in> set(D) \<rightarrow> set(E)"
     by (blast intro: lam_type chain_cf [THEN cpo_lub, THEN islub_in] ch E)
 next
   fix x y
   assume xy: "rel(D, x, y)" "x \<in> set(D)" "y \<in> set(D)"
   hence dom: "dominate(E, \<lambda>n\<in>nat. X ` n ` x, \<lambda>n\<in>nat. X ` n ` y)"
     by (force intro: dominateI  chain_in [OF ch, THEN cf_cont, THEN cont_mono])
   note chE = chain_cf [OF ch]
   from xy show "rel(E, (\<lambda>x\<in>set(D). lub(E, \<lambda>n\<in>nat. X ` n ` x)) ` x,
                        (\<lambda>x\<in>set(D). lub(E, \<lambda>n\<in>nat. X ` n ` x)) ` y)"
     by (simp add: dominate_islub [OF dom] cpo_lub [OF chE] E chain_fun [OF chE])
 next
   fix Y
   assume chDY: "chain(D,Y)"
   have "lub(E, \<lambda>x\<in>nat. lub(E, \<lambda>y\<in>nat. X ` x ` (Y ` y))) =
         lub(E, \<lambda>x\<in>nat. X ` x ` (Y ` x))"
     using matrix_lemma [THEN lub_matrix_diag, OF ch chDY]
     by (simp add: D E)
    also have "... =  lub(E, \<lambda>x\<in>nat. lub(E, \<lambda>n\<in>nat. X ` n ` (Y ` x)))"
     using  matrix_lemma [THEN lub_matrix_diag_sym, OF ch chDY]
     by (simp add: D E)
   finally have "lub(E, \<lambda>x\<in>nat. lub(E, \<lambda>n\<in>nat. X ` x ` (Y ` n))) =
                 lub(E, \<lambda>x\<in>nat. lub(E, \<lambda>n\<in>nat. X ` n ` (Y ` x)))" .
   thus "(\<lambda>x\<in>set(D). lub(E, \<lambda>n\<in>nat. X ` n ` x)) ` lub(D, Y) =
         lub(E, \<lambda>n\<in>nat. (\<lambda>x\<in>set(D). lub(E, \<lambda>n\<in>nat. X ` n ` x)) ` (Y ` n))"
     by (simp add: cpo_lub [THEN islub_in]  D chDY
                   chain_in [THEN cf_cont, THEN cont_lub, OF ch])
   qed
 
 lemma islub_cf:
     "\<lbrakk>chain(cf(D,E),X); cpo(D); cpo(E)\<rbrakk>
      \<Longrightarrow> islub(cf(D,E), X, \<lambda>x \<in> set(D). lub(E,\<lambda>n \<in> nat. X`n`x))"
 apply (rule islubI)
 apply (rule isubI)
 apply (rule chain_cf_lub_cont [THEN cont_cf], assumption+)
 apply (rule rel_cfI)
 apply (force dest!: chain_cf [THEN cpo_lub, THEN islub_ub])
 apply (blast intro: cf_cont chain_in)
 apply (blast intro: cont_cf chain_cf_lub_cont)
 apply (rule rel_cfI, simp)
 apply (force intro: chain_cf [THEN cpo_lub, THEN islub_least]
                    cf_cont [THEN cont_fun, THEN apply_type] isubI
             elim: isubD2 [THEN rel_cf] isubD1)
 apply (blast intro: chain_cf_lub_cont isubD1 cf_cont)+
 done
 
 lemma cpo_cf [TC]:
     "\<lbrakk>cpo(D); cpo(E)\<rbrakk> \<Longrightarrow> cpo(cf(D,E))"
 apply (rule poI [THEN cpoI])
 apply (rule rel_cfI)
 apply (assumption | rule cpo_refl cf_cont [THEN cont_fun, THEN apply_type]
                          cf_cont)+
 apply (rule rel_cfI)
 apply (rule cpo_trans, assumption)
 apply (erule rel_cf, assumption)
 apply (rule rel_cf, assumption)
 apply (assumption | rule cf_cont [THEN cont_fun, THEN apply_type] cf_cont)+
 apply (rule fun_extension)
 apply (assumption | rule cf_cont [THEN cont_fun])+
 apply (blast intro: cpo_antisym rel_cf
                     cf_cont [THEN cont_fun, THEN apply_type])
 apply (fast intro: islub_cf)
 done
 
 lemma lub_cf:
      "\<lbrakk>chain(cf(D,E),X); cpo(D); cpo(E)\<rbrakk>
       \<Longrightarrow> lub(cf(D,E), X) = (\<lambda>x \<in> set(D). lub(E,\<lambda>n \<in> nat. X`n`x))"
 by (blast intro: islub_unique cpo_lub islub_cf cpo_cf)
 
 
 lemma const_cont [TC]:
      "\<lbrakk>y \<in> set(E); cpo(D); cpo(E)\<rbrakk> \<Longrightarrow> (\<lambda>x \<in> set(D).y) \<in> cont(D,E)"
 apply (rule contI)
 prefer 2 apply simp
 apply (blast intro: lam_type)
 apply (simp add: chain_in cpo_lub [THEN islub_in] lub_const)
 done
 
 lemma cf_least:
     "\<lbrakk>cpo(D); pcpo(E); y \<in> cont(D,E)\<rbrakk>\<Longrightarrow>rel(cf(D,E),(\<lambda>x \<in> set(D).bot(E)),y)"
 apply (rule rel_cfI, simp, typecheck)
 done
 
 lemma pcpo_cf:
     "\<lbrakk>cpo(D); pcpo(E)\<rbrakk> \<Longrightarrow> pcpo(cf(D,E))"
 apply (rule pcpoI)
 apply (assumption |
        rule cf_least bot_in const_cont [THEN cont_cf] cf_cont cpo_cf pcpo_cpo)+
 done
 
 lemma bot_cf:
     "\<lbrakk>cpo(D); pcpo(E)\<rbrakk> \<Longrightarrow> bot(cf(D,E)) = (\<lambda>x \<in> set(D).bot(E))"
 by (blast intro: bot_unique [symmetric] pcpo_cf cf_least
                  bot_in [THEN const_cont, THEN cont_cf] cf_cont pcpo_cpo)
 
 (*----------------------------------------------------------------------*)
 (* Identity and composition.                                            *)
 (*----------------------------------------------------------------------*)
 
 lemma id_cont [TC,intro!]:
     "cpo(D) \<Longrightarrow> id(set(D)) \<in> cont(D,D)"
 by (simp add: id_type contI cpo_lub [THEN islub_in] chain_fun [THEN eta])
 
 lemmas comp_cont_apply =  cont_fun [THEN comp_fun_apply]
 
 lemma comp_pres_cont [TC]:
     "\<lbrakk>f \<in> cont(D',E); g \<in> cont(D,D'); cpo(D)\<rbrakk> \<Longrightarrow> f O g \<in> cont(D,E)"
 apply (rule contI)
 apply (rule_tac [2] comp_cont_apply [THEN ssubst])
 apply (rule_tac [4] comp_cont_apply [THEN ssubst])
 apply (rule_tac [6] cont_mono)
 apply (rule_tac [7] cont_mono) (* 13 subgoals *)
 apply typecheck (* proves all but the lub case *)
 apply (subst comp_cont_apply)
 apply (rule_tac [3] cont_lub [THEN ssubst])
 apply (rule_tac [5] cont_lub [THEN ssubst])
 prefer 7 apply (simp add: comp_cont_apply chain_in)
 apply (auto intro: cpo_lub [THEN islub_in] cont_chain)
 done
 
 
 lemma comp_mono:
     "\<lbrakk>f \<in> cont(D',E); g \<in> cont(D,D'); f':cont(D',E); g':cont(D,D');
         rel(cf(D',E),f,f'); rel(cf(D,D'),g,g'); cpo(D); cpo(E)\<rbrakk>
      \<Longrightarrow> rel(cf(D,E),f O g,f' O g')"
 apply (rule rel_cfI)
 apply (subst comp_cont_apply)
 apply (rule_tac [3] comp_cont_apply [THEN ssubst])
 apply (rule_tac [5] cpo_trans)
 apply (assumption | rule rel_cf cont_mono cont_map comp_pres_cont)+
 done
 
 lemma chain_cf_comp:
     "\<lbrakk>chain(cf(D',E),X); chain(cf(D,D'),Y); cpo(D); cpo(E)\<rbrakk>
      \<Longrightarrow> chain(cf(D,E),\<lambda>n \<in> nat. X`n O Y`n)"
 apply (rule chainI)
 defer 1
 apply simp
 apply (rule rel_cfI)
 apply (rule comp_cont_apply [THEN ssubst])
 apply (rule_tac [3] comp_cont_apply [THEN ssubst])
 apply (rule_tac [5] cpo_trans)
 apply (rule_tac [6] rel_cf)
 apply (rule_tac [8] cont_mono)
 apply (blast intro: lam_type comp_pres_cont cont_cf chain_in [THEN cf_cont]
                     cont_map chain_rel rel_cf)+
 done
 
 lemma comp_lubs:
     "\<lbrakk>chain(cf(D',E),X); chain(cf(D,D'),Y); cpo(D); cpo(D'); cpo(E)\<rbrakk>
      \<Longrightarrow> lub(cf(D',E),X) O lub(cf(D,D'),Y) = lub(cf(D,E),\<lambda>n \<in> nat. X`n O Y`n)"
 apply (rule fun_extension)
 apply (rule_tac [3] lub_cf [THEN ssubst])
 apply (assumption |
        rule comp_fun cf_cont [THEN cont_fun]  cpo_lub [THEN islub_in]
             cpo_cf chain_cf_comp)+
 apply (simp add: chain_in [THEN cf_cont, THEN comp_cont_apply])
 apply (subst comp_cont_apply)
 apply (assumption | rule cpo_lub [THEN islub_in, THEN cf_cont]  cpo_cf)+
 apply (simp add: lub_cf chain_cf chain_in [THEN cf_cont, THEN cont_lub]
                  chain_cf [THEN cpo_lub, THEN islub_in])
 apply (cut_tac M = "\<lambda>xa \<in> nat. \<lambda>xb \<in> nat. X`xa` (Y`xb`x)" in lub_matrix_diag)
 prefer 3 apply simp
 apply (rule matrix_chainI, simp_all)
 apply (drule chain_in [THEN cf_cont], assumption)
 apply (force dest: cont_chain [OF _ chain_cf])
 apply (rule chain_cf)
 apply (assumption |
        rule cont_fun [THEN apply_type] chain_in [THEN cf_cont] lam_type)+
 done
 
 (*----------------------------------------------------------------------*)
 (* Theorems about projpair.                                             *)
 (*----------------------------------------------------------------------*)
 
 lemma projpairI:
     "\<lbrakk>e \<in> cont(D,E); p \<in> cont(E,D); p O e = id(set(D));
         rel(cf(E,E))(e O p)(id(set(E)))\<rbrakk> \<Longrightarrow> projpair(D,E,e,p)"
 by (simp add: projpair_def)
 
 lemma projpair_e_cont: "projpair(D,E,e,p) \<Longrightarrow> e \<in> cont(D,E)"
 by (simp add: projpair_def)
 
 lemma projpair_p_cont: "projpair(D,E,e,p) \<Longrightarrow> p \<in> cont(E,D)"
 by (simp add: projpair_def)
 
 lemma projpair_ep_cont: "projpair(D,E,e,p) \<Longrightarrow> e \<in> cont(D,E) \<and> p \<in> cont(E,D)"
 by (simp add: projpair_def)
 
 lemma projpair_eq: "projpair(D,E,e,p) \<Longrightarrow> p O e = id(set(D))"
 by (simp add: projpair_def)
 
 lemma projpair_rel: "projpair(D,E,e,p) \<Longrightarrow> rel(cf(E,E))(e O p)(id(set(E)))"
 by (simp add: projpair_def)
 
 
 (*----------------------------------------------------------------------*)
 (* NB! projpair_e_cont and projpair_p_cont cannot be used repeatedly    *)
 (*   at the same time since both match a goal of the form f \<in> cont(X,Y).*)
 (*----------------------------------------------------------------------*)
 
 (*----------------------------------------------------------------------*)
 (* Uniqueness of embedding projection pairs.                            *)
 (*----------------------------------------------------------------------*)
 
 lemmas id_comp = fun_is_rel [THEN left_comp_id]
 and    comp_id = fun_is_rel [THEN right_comp_id]
 
 lemma projpair_unique_aux1:
     "\<lbrakk>cpo(D); cpo(E); projpair(D,E,e,p); projpair(D,E,e',p');
        rel(cf(D,E),e,e')\<rbrakk> \<Longrightarrow> rel(cf(E,D),p',p)"
 apply (rule_tac b=p' in
        projpair_p_cont [THEN cont_fun, THEN id_comp, THEN subst], assumption)
 apply (rule projpair_eq [THEN subst], assumption)
 apply (rule cpo_trans)
 apply (assumption | rule cpo_cf)+
 (* The following corresponds to EXISTS_TAC, non-trivial instantiation. *)
 apply (rule_tac [4] f = "p O (e' O p')" in cont_cf)
 apply (subst comp_assoc)
 apply (blast intro:  cpo_cf cont_cf comp_mono comp_pres_cont
              dest: projpair_ep_cont)
 apply (rule_tac P = "\<lambda>x. rel (cf (E,D),p O e' O p',x)"
          in projpair_p_cont [THEN cont_fun, THEN comp_id, THEN subst],
        assumption)
 apply (rule comp_mono)
 apply (blast intro: cpo_cf cont_cf comp_pres_cont projpair_rel
              dest: projpair_ep_cont)+
 done
 
 text\<open>Proof's very like the previous one.  Is there a pattern that
       could be exploited?\<close>
 lemma projpair_unique_aux2:
     "\<lbrakk>cpo(D); cpo(E); projpair(D,E,e,p); projpair(D,E,e',p');
        rel(cf(E,D),p',p)\<rbrakk> \<Longrightarrow> rel(cf(D,E),e,e')"
 apply (rule_tac b=e
          in projpair_e_cont [THEN cont_fun, THEN comp_id, THEN subst],
        assumption)
 apply (rule_tac e1=e' in projpair_eq [THEN subst], assumption)
 apply (rule cpo_trans)
 apply (assumption | rule cpo_cf)+
 apply (rule_tac [4] f = "(e O p) O e'" in cont_cf)
 apply (subst comp_assoc)
 apply (blast intro:  cpo_cf cont_cf comp_mono comp_pres_cont
              dest: projpair_ep_cont)
 apply (rule_tac P = "\<lambda>x. rel (cf (D,E), (e O p) O e',x)"
          in projpair_e_cont [THEN cont_fun, THEN id_comp, THEN subst],
        assumption)
 apply (blast intro: cpo_cf cont_cf comp_pres_cont projpair_rel comp_mono
              dest: projpair_ep_cont)+
 done
 
 
 lemma projpair_unique:
     "\<lbrakk>cpo(D); cpo(E); projpair(D,E,e,p); projpair(D,E,e',p')\<rbrakk>
      \<Longrightarrow> (e=e')\<longleftrightarrow>(p=p')"
 by (blast intro: cpo_antisym projpair_unique_aux1 projpair_unique_aux2 cpo_cf cont_cf
           dest: projpair_ep_cont)
 
 (* Slightly different, more asms, since THE chooses the unique element. *)
 
 lemma embRp:
     "\<lbrakk>emb(D,E,e); cpo(D); cpo(E)\<rbrakk> \<Longrightarrow> projpair(D,E,e,Rp(D,E,e))"
 apply (simp add: emb_def Rp_def)
 apply (blast intro: theI2 projpair_unique [THEN iffD1])
 done
 
 lemma embI: "projpair(D,E,e,p) \<Longrightarrow> emb(D,E,e)"
 by (simp add: emb_def, auto)
 
 lemma Rp_unique: "\<lbrakk>projpair(D,E,e,p); cpo(D); cpo(E)\<rbrakk> \<Longrightarrow> Rp(D,E,e) = p"
 by (blast intro: embRp embI projpair_unique [THEN iffD1])
 
 lemma emb_cont [TC]: "emb(D,E,e) \<Longrightarrow> e \<in> cont(D,E)"
 apply (simp add: emb_def)
 apply (blast intro: projpair_e_cont)
 done
 
 (* The following three theorems have cpo asms due to THE (uniqueness). *)
 
 lemmas Rp_cont [TC] = embRp [THEN projpair_p_cont]
 lemmas embRp_eq = embRp [THEN projpair_eq]
 lemmas embRp_rel = embRp [THEN projpair_rel]
 
 
 lemma embRp_eq_thm:
     "\<lbrakk>emb(D,E,e); x \<in> set(D); cpo(D); cpo(E)\<rbrakk> \<Longrightarrow> Rp(D,E,e)`(e`x) = x"
 apply (rule comp_fun_apply [THEN subst])
 apply (assumption | rule Rp_cont emb_cont cont_fun)+
 apply (subst embRp_eq)
 apply (auto intro: id_conv)
 done
 
 
 (*----------------------------------------------------------------------*)
 (* The identity embedding.                                              *)
 (*----------------------------------------------------------------------*)
 
 lemma projpair_id:
     "cpo(D) \<Longrightarrow> projpair(D,D,id(set(D)),id(set(D)))"
 apply (simp add: projpair_def)
 apply (blast intro: cpo_cf cont_cf)
 done
 
 lemma emb_id:
     "cpo(D) \<Longrightarrow> emb(D,D,id(set(D)))"
 by (auto intro: embI projpair_id)
 
 lemma Rp_id:
     "cpo(D) \<Longrightarrow> Rp(D,D,id(set(D))) = id(set(D))"
 by (auto intro: Rp_unique projpair_id)
 
 
 (*----------------------------------------------------------------------*)
 (* Composition preserves embeddings.                                    *)
 (*----------------------------------------------------------------------*)
 
 (* Considerably shorter, only partly due to a simpler comp_assoc. *)
 (* Proof in HOL-ST: 70 lines (minus 14 due to comp_assoc complication). *)
 (* Proof in Isa/ZF: 23 lines (compared to 56: 60% reduction). *)
 
 lemma comp_lemma:
     "\<lbrakk>emb(D,D',e); emb(D',E,e'); cpo(D); cpo(D'); cpo(E)\<rbrakk>
      \<Longrightarrow> projpair(D,E,e' O e,(Rp(D,D',e)) O (Rp(D',E,e')))"
 apply (simp add: projpair_def, safe)
 apply (assumption | rule comp_pres_cont Rp_cont emb_cont)+
 apply (rule comp_assoc [THEN subst])
 apply (rule_tac t1 = e' in comp_assoc [THEN ssubst])
 apply (subst embRp_eq) (* Matches everything due to subst/ssubst. *)
 apply assumption+
 apply (subst comp_id)
 apply (assumption | rule cont_fun Rp_cont embRp_eq)+
 apply (rule comp_assoc [THEN subst])
 apply (rule_tac t1 = "Rp (D,D',e)" in comp_assoc [THEN ssubst])
 apply (rule cpo_trans)
 apply (assumption | rule cpo_cf)+
 apply (rule comp_mono)
 apply (rule_tac [6] cpo_refl)
 apply (erule_tac [7] asm_rl | rule_tac [7] cont_cf Rp_cont)+
 prefer 6 apply (blast intro: cpo_cf)
 apply (rule_tac [5] comp_mono)
 apply (rule_tac [10] embRp_rel)
 apply (rule_tac [9] cpo_cf [THEN cpo_refl])
 apply (simp_all add: comp_id embRp_rel comp_pres_cont Rp_cont
                      id_cont emb_cont cont_fun cont_cf)
 done
 
 (* The use of THEN is great in places like the following, both ugly in HOL. *)
 
 lemmas emb_comp = comp_lemma [THEN embI]
 lemmas Rp_comp = comp_lemma [THEN Rp_unique]
 
 (*----------------------------------------------------------------------*)
 (* Infinite cartesian product.                                          *)
 (*----------------------------------------------------------------------*)
 
 lemma iprodI:
     "x:(\<Prod>n \<in> nat. set(DD`n)) \<Longrightarrow> x \<in> set(iprod(DD))"
 by (simp add: set_def iprod_def)
 
 lemma iprodE:
     "x \<in> set(iprod(DD)) \<Longrightarrow> x:(\<Prod>n \<in> nat. set(DD`n))"
 by (simp add: set_def iprod_def)
 
 (* Contains typing conditions in contrast to HOL-ST *)
 
 lemma rel_iprodI:
     "\<lbrakk>\<And>n. n \<in> nat \<Longrightarrow> rel(DD`n,f`n,g`n); f:(\<Prod>n \<in> nat. set(DD`n));
        g:(\<Prod>n \<in> nat. set(DD`n))\<rbrakk> \<Longrightarrow> rel(iprod(DD),f,g)"
 by (simp add: iprod_def rel_I)
 
 lemma rel_iprodE:
     "\<lbrakk>rel(iprod(DD),f,g); n \<in> nat\<rbrakk> \<Longrightarrow> rel(DD`n,f`n,g`n)"
 by (simp add: iprod_def rel_def)
 
 lemma chain_iprod:
     "\<lbrakk>chain(iprod(DD),X);  \<And>n. n \<in> nat \<Longrightarrow> cpo(DD`n); n \<in> nat\<rbrakk>
      \<Longrightarrow> chain(DD`n,\<lambda>m \<in> nat. X`m`n)"
 apply (unfold chain_def, safe)
 apply (rule lam_type)
 apply (rule apply_type)
 apply (rule iprodE)
 apply (blast intro: apply_funtype, assumption)
 apply (simp add: rel_iprodE)
 done
 
 lemma islub_iprod:
     "\<lbrakk>chain(iprod(DD),X);  \<And>n. n \<in> nat \<Longrightarrow> cpo(DD`n)\<rbrakk>
      \<Longrightarrow> islub(iprod(DD),X,\<lambda>n \<in> nat. lub(DD`n,\<lambda>m \<in> nat. X`m`n))"
 apply (simp add: islub_def isub_def, safe)
 apply (rule iprodI)
 apply (blast intro: lam_type chain_iprod [THEN cpo_lub, THEN islub_in])
 apply (rule rel_iprodI, simp)
 (*looks like something should be inserted into the assumptions!*)
 apply (rule_tac P = "\<lambda>t. rel (DD`na,t,lub (DD`na,\<lambda>x \<in> nat. X`x`na))"
             and b1 = "\<lambda>n. X`n`na" in beta [THEN subst])
 apply (simp del: beta_if
             add: chain_iprod [THEN cpo_lub, THEN islub_ub] iprodE
                 chain_in)+
 apply (blast intro: iprodI lam_type chain_iprod [THEN cpo_lub, THEN islub_in])
 apply (rule rel_iprodI)
 apply (simp | rule islub_least chain_iprod [THEN cpo_lub])+
 apply (simp add: isub_def, safe)
 apply (erule iprodE [THEN apply_type])
 apply (simp_all add: rel_iprodE lam_type iprodE
                      chain_iprod [THEN cpo_lub, THEN islub_in])
 done
 
 lemma cpo_iprod [TC]:
     "(\<And>n. n \<in> nat \<Longrightarrow> cpo(DD`n)) \<Longrightarrow> cpo(iprod(DD))"
 apply (assumption | rule cpoI poI)+
 apply (rule rel_iprodI) (*not repeated: want to solve 1, leave 2 unchanged *)
 apply (simp | rule cpo_refl iprodE [THEN apply_type] iprodE)+
 apply (rule rel_iprodI)
 apply (drule rel_iprodE)
 apply (drule_tac [2] rel_iprodE)
 apply (simp | rule cpo_trans iprodE [THEN apply_type] iprodE)+
 apply (rule fun_extension)
 apply (blast intro: iprodE)
 apply (blast intro: iprodE)
 apply (blast intro: cpo_antisym rel_iprodE iprodE [THEN apply_type])+
 apply (auto intro: islub_iprod)
 done
 
 
 lemma lub_iprod:
     "\<lbrakk>chain(iprod(DD),X);  \<And>n. n \<in> nat \<Longrightarrow> cpo(DD`n)\<rbrakk>
      \<Longrightarrow> lub(iprod(DD),X) = (\<lambda>n \<in> nat. lub(DD`n,\<lambda>m \<in> nat. X`m`n))"
 by (blast intro: cpo_lub [THEN islub_unique] islub_iprod cpo_iprod)
 
 
 (*----------------------------------------------------------------------*)
 (* The notion of subcpo.                                                *)
 (*----------------------------------------------------------------------*)
 
 lemma subcpoI:
     "\<lbrakk>set(D)<=set(E);
        \<And>x y. \<lbrakk>x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> rel(D,x,y)\<longleftrightarrow>rel(E,x,y);
        \<And>X. chain(D,X) \<Longrightarrow> lub(E,X) \<in> set(D)\<rbrakk> \<Longrightarrow> subcpo(D,E)"
 by (simp add: subcpo_def)
 
 lemma subcpo_subset: "subcpo(D,E) \<Longrightarrow> set(D)<=set(E)"
 by (simp add: subcpo_def)
 
 lemma subcpo_rel_eq:
     "\<lbrakk>subcpo(D,E); x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> rel(D,x,y)\<longleftrightarrow>rel(E,x,y)"
 by (simp add: subcpo_def)
 
 lemmas subcpo_relD1 = subcpo_rel_eq [THEN iffD1]
 lemmas subcpo_relD2 = subcpo_rel_eq [THEN iffD2]
 
 lemma subcpo_lub: "\<lbrakk>subcpo(D,E); chain(D,X)\<rbrakk> \<Longrightarrow> lub(E,X) \<in> set(D)"
 by (simp add: subcpo_def)
 
 lemma chain_subcpo: "\<lbrakk>subcpo(D,E); chain(D,X)\<rbrakk> \<Longrightarrow> chain(E,X)"
 by (blast intro: Pi_type [THEN chainI] chain_fun subcpo_relD1
                     subcpo_subset [THEN subsetD]
                     chain_in chain_rel)
 
 lemma ub_subcpo: "\<lbrakk>subcpo(D,E); chain(D,X); isub(D,X,x)\<rbrakk> \<Longrightarrow> isub(E,X,x)"
 by (blast intro: isubI subcpo_relD1 subcpo_relD1 chain_in isubD1 isubD2
                     subcpo_subset [THEN subsetD] chain_in chain_rel)
 
 lemma islub_subcpo:
      "\<lbrakk>subcpo(D,E); cpo(E); chain(D,X)\<rbrakk> \<Longrightarrow> islub(D,X,lub(E,X))"
 by (blast intro: islubI isubI subcpo_lub subcpo_relD2 chain_in islub_ub
                  islub_least cpo_lub chain_subcpo isubD1 ub_subcpo)
 
 lemma subcpo_cpo: "\<lbrakk>subcpo(D,E); cpo(E)\<rbrakk> \<Longrightarrow> cpo(D)"
 apply (assumption | rule cpoI poI)+
 apply (simp add: subcpo_rel_eq)
 apply (assumption | rule cpo_refl subcpo_subset [THEN subsetD])+
 apply (simp add: subcpo_rel_eq)
 apply (blast intro: subcpo_subset [THEN subsetD] cpo_trans)
 apply (simp add: subcpo_rel_eq)
 apply (blast intro: cpo_antisym subcpo_subset [THEN subsetD])
 apply (fast intro: islub_subcpo)
 done
 
 lemma lub_subcpo: "\<lbrakk>subcpo(D,E); cpo(E); chain(D,X)\<rbrakk> \<Longrightarrow> lub(D,X) = lub(E,X)"
 by (blast intro: cpo_lub [THEN islub_unique] islub_subcpo subcpo_cpo)
 
 (*----------------------------------------------------------------------*)
 (* Making subcpos using mkcpo.                                          *)
 (*----------------------------------------------------------------------*)
 
 lemma mkcpoI: "\<lbrakk>x \<in> set(D); P(x)\<rbrakk> \<Longrightarrow> x \<in> set(mkcpo(D,P))"
 by (simp add: set_def mkcpo_def)
 
 lemma mkcpoD1: "x \<in> set(mkcpo(D,P))\<Longrightarrow> x \<in> set(D)"
 by (simp add: set_def mkcpo_def)
 
 lemma mkcpoD2: "x \<in> set(mkcpo(D,P))\<Longrightarrow> P(x)"
 by (simp add: set_def mkcpo_def)
 
 lemma rel_mkcpoE: "rel(mkcpo(D,P),x,y) \<Longrightarrow> rel(D,x,y)"
 by (simp add: rel_def mkcpo_def)
 
 lemma rel_mkcpo:
     "\<lbrakk>x \<in> set(D); y \<in> set(D)\<rbrakk> \<Longrightarrow> rel(mkcpo(D,P),x,y) \<longleftrightarrow> rel(D,x,y)"
 by (simp add: mkcpo_def rel_def set_def)
 
 lemma chain_mkcpo:
     "chain(mkcpo(D,P),X) \<Longrightarrow> chain(D,X)"
 apply (rule chainI)
 apply (blast intro: Pi_type chain_fun chain_in [THEN mkcpoD1])
 apply (blast intro: rel_mkcpo [THEN iffD1] chain_rel mkcpoD1 chain_in)
 done
 
 lemma subcpo_mkcpo:
      "\<lbrakk>\<And>X. chain(mkcpo(D,P),X) \<Longrightarrow> P(lub(D,X)); cpo(D)\<rbrakk>
       \<Longrightarrow> subcpo(mkcpo(D,P),D)"
 apply (intro subcpoI subsetI rel_mkcpo)
 apply (erule mkcpoD1)+
 apply (blast intro: mkcpoI cpo_lub [THEN islub_in] chain_mkcpo)
 done
 
 (*----------------------------------------------------------------------*)
 (* Embedding projection chains of cpos.                                 *)
 (*----------------------------------------------------------------------*)
 
 lemma emb_chainI:
     "\<lbrakk>\<And>n. n \<in> nat \<Longrightarrow> cpo(DD`n);
        \<And>n. n \<in> nat \<Longrightarrow> emb(DD`n,DD`succ(n),ee`n)\<rbrakk> \<Longrightarrow> emb_chain(DD,ee)"
 by (simp add: emb_chain_def)
 
 lemma emb_chain_cpo [TC]: "\<lbrakk>emb_chain(DD,ee); n \<in> nat\<rbrakk> \<Longrightarrow> cpo(DD`n)"
 by (simp add: emb_chain_def)
 
 lemma emb_chain_emb:
     "\<lbrakk>emb_chain(DD,ee); n \<in> nat\<rbrakk> \<Longrightarrow> emb(DD`n,DD`succ(n),ee`n)"
 by (simp add: emb_chain_def)
 
 (*----------------------------------------------------------------------*)
 (* Dinf, the inverse Limit.                                             *)
 (*----------------------------------------------------------------------*)
 
 lemma DinfI:
     "\<lbrakk>x:(\<Prod>n \<in> nat. set(DD`n));
        \<And>n. n \<in> nat \<Longrightarrow> Rp(DD`n,DD`succ(n),ee`n)`(x`succ(n)) = x`n\<rbrakk>
      \<Longrightarrow> x \<in> set(Dinf(DD,ee))"
 apply (simp add: Dinf_def)
 apply (blast intro: mkcpoI iprodI)
 done
 
 lemma Dinf_prod: "x \<in> set(Dinf(DD,ee)) \<Longrightarrow> x:(\<Prod>n \<in> nat. set(DD`n))"
 apply (simp add: Dinf_def)
 apply (erule mkcpoD1 [THEN iprodE])
 done
 
 lemma Dinf_eq:
     "\<lbrakk>x \<in> set(Dinf(DD,ee)); n \<in> nat\<rbrakk>
      \<Longrightarrow> Rp(DD`n,DD`succ(n),ee`n)`(x`succ(n)) = x`n"
 apply (simp add: Dinf_def)
 apply (blast dest: mkcpoD2)
 done
 
 lemma rel_DinfI:
     "\<lbrakk>\<And>n. n \<in> nat \<Longrightarrow> rel(DD`n,x`n,y`n);
        x:(\<Prod>n \<in> nat. set(DD`n)); y:(\<Prod>n \<in> nat. set(DD`n))\<rbrakk>
      \<Longrightarrow> rel(Dinf(DD,ee),x,y)"
 apply (simp add: Dinf_def)
 apply (blast intro: rel_mkcpo [THEN iffD2] rel_iprodI iprodI)
 done
 
 lemma rel_Dinf: "\<lbrakk>rel(Dinf(DD,ee),x,y); n \<in> nat\<rbrakk> \<Longrightarrow> rel(DD`n,x`n,y`n)"
 apply (simp add: Dinf_def)
 apply (erule rel_mkcpoE [THEN rel_iprodE], assumption)
 done
 
 lemma chain_Dinf: "chain(Dinf(DD,ee),X) \<Longrightarrow> chain(iprod(DD),X)"
 apply (simp add: Dinf_def)
 apply (erule chain_mkcpo)
 done
 
 lemma subcpo_Dinf: "emb_chain(DD,ee) \<Longrightarrow> subcpo(Dinf(DD,ee),iprod(DD))"
 apply (simp add: Dinf_def)
 apply (rule subcpo_mkcpo)
 apply (simp add: Dinf_def [symmetric])
 apply (rule ballI)
 apply (simplesubst lub_iprod)
   \<comment> \<open>Subst would rewrite the lhs. We want to change the rhs.\<close>
 apply (assumption | rule chain_Dinf emb_chain_cpo)+
 apply simp
 apply (subst Rp_cont [THEN cont_lub])
 apply (assumption |
        rule emb_chain_cpo emb_chain_emb nat_succI chain_iprod chain_Dinf)+
 (* Useful simplification, ugly in HOL. *)
 apply (simp add: Dinf_eq chain_in)
 apply (auto intro: cpo_iprod emb_chain_cpo)
 done
 
 (* Simple example of existential reasoning in Isabelle versus HOL. *)
 
 lemma cpo_Dinf: "emb_chain(DD,ee) \<Longrightarrow> cpo(Dinf(DD,ee))"
 apply (rule subcpo_cpo)
 apply (erule subcpo_Dinf)
 apply (auto intro: cpo_iprod emb_chain_cpo)
 done
 
 (* Again and again the proofs are much easier to WRITE in Isabelle, but
   the proof steps are essentially the same (I think). *)
 
 lemma lub_Dinf:
     "\<lbrakk>chain(Dinf(DD,ee),X); emb_chain(DD,ee)\<rbrakk>
      \<Longrightarrow> lub(Dinf(DD,ee),X) = (\<lambda>n \<in> nat. lub(DD`n,\<lambda>m \<in> nat. X`m`n))"
 apply (subst subcpo_Dinf [THEN lub_subcpo])
 apply (auto intro: cpo_iprod emb_chain_cpo lub_iprod chain_Dinf)
 done
 
 (*----------------------------------------------------------------------*)
 (* Generalising embedddings D_m -> D_{m+1} to embeddings D_m -> D_n,    *)
 (* defined as eps(DD,ee,m,n), via e_less and e_gr.                      *)
 (*----------------------------------------------------------------------*)
 
 lemma e_less_eq:
     "m \<in> nat \<Longrightarrow> e_less(DD,ee,m,m) = id(set(DD`m))"
 by (simp add: e_less_def)
 
 lemma lemma_succ_sub: "succ(m#+n)#-m = succ(natify(n))"
 by simp
 
 lemma e_less_add:
      "e_less(DD,ee,m,succ(m#+k)) = (ee`(m#+k))O(e_less(DD,ee,m,m#+k))"
 by (simp add: e_less_def)
 
 lemma le_exists:
     "\<lbrakk>m \<le> n;  \<And>x. \<lbrakk>n=m#+x; x \<in> nat\<rbrakk> \<Longrightarrow> Q;  n \<in> nat\<rbrakk> \<Longrightarrow> Q"
 apply (drule less_imp_succ_add, auto)
 done
 
 lemma e_less_le: "\<lbrakk>m \<le> n;  n \<in> nat\<rbrakk>
      \<Longrightarrow> e_less(DD,ee,m,succ(n)) = ee`n O e_less(DD,ee,m,n)"
 apply (rule le_exists, assumption)
 apply (simp add: e_less_add, assumption)
 done
 
 (* All theorems assume variables m and n are natural numbers. *)
 
 lemma e_less_succ:
      "m \<in> nat \<Longrightarrow> e_less(DD,ee,m,succ(m)) = ee`m O id(set(DD`m))"
 by (simp add: e_less_le e_less_eq)
 
 lemma e_less_succ_emb:
     "\<lbrakk>\<And>n. n \<in> nat \<Longrightarrow> emb(DD`n,DD`succ(n),ee`n); m \<in> nat\<rbrakk>
      \<Longrightarrow> e_less(DD,ee,m,succ(m)) = ee`m"
 apply (simp add: e_less_succ)
 apply (blast intro: emb_cont cont_fun comp_id)
 done
 
 (* Compare this proof with the HOL one, here we do type checking. *)
 (* In any case the one below was very easy to write. *)
 
 lemma emb_e_less_add:
      "\<lbrakk>emb_chain(DD,ee); m \<in> nat\<rbrakk>
       \<Longrightarrow> emb(DD`m, DD`(m#+k), e_less(DD,ee,m,m#+k))"
 apply (subgoal_tac "emb (DD`m, DD` (m#+natify (k)),
                          e_less (DD,ee,m,m#+natify (k))) ")
 apply (rule_tac [2] n = "natify (k) " in nat_induct)
 apply (simp_all add: e_less_eq)
 apply (assumption | rule emb_id emb_chain_cpo)+
 apply (simp add: e_less_add)
 apply (auto intro: emb_comp emb_chain_emb emb_chain_cpo)
 done
 
 lemma emb_e_less:
      "\<lbrakk>m \<le> n;  emb_chain(DD,ee);  n \<in> nat\<rbrakk>
       \<Longrightarrow> emb(DD`m, DD`n, e_less(DD,ee,m,n))"
 apply (frule lt_nat_in_nat)
 apply (erule nat_succI)
 (* same proof as e_less_le *)
 apply (rule le_exists, assumption)
 apply (simp add: emb_e_less_add, assumption)
 done
 
 lemma comp_mono_eq: "\<lbrakk>f=f'; g=g'\<rbrakk> \<Longrightarrow> f O g = f' O g'"
 by simp
 
 (* Note the object-level implication for induction on k. This
    must be removed later to allow the theorems to be used for simp.
    Therefore this theorem is only a lemma. *)
 
 lemma e_less_split_add_lemma [rule_format]:
     "\<lbrakk>emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> n \<le> k \<longrightarrow>
          e_less(DD,ee,m,m#+k) = e_less(DD,ee,m#+n,m#+k) O e_less(DD,ee,m,m#+n)"
 apply (induct_tac k)
 apply (simp add: e_less_eq id_type [THEN id_comp])
 apply (simp add: le_succ_iff)
 apply (rule impI)
 apply (erule disjE)
 apply (erule impE, assumption)
 apply (simp add: e_less_add)
 apply (subst e_less_le)
 apply (assumption | rule add_le_mono nat_le_refl add_type nat_succI)+
 apply (subst comp_assoc)
 apply (assumption | rule comp_mono_eq refl)+
 apply (simp del: add_succ_right add: add_succ_right [symmetric]
             add: e_less_eq add_type nat_succI)
 apply (subst id_comp) (* simp cannot unify/inst right, use brr below (?) . *)
 apply (assumption |
        rule emb_e_less_add [THEN emb_cont, THEN cont_fun] refl nat_succI)+
 done
 
 lemma e_less_split_add:
     "\<lbrakk>n \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> e_less(DD,ee,m,m#+k) = e_less(DD,ee,m#+n,m#+k) O e_less(DD,ee,m,m#+n)"
 by (blast intro: e_less_split_add_lemma)
 
 lemma e_gr_eq:
     "m \<in> nat \<Longrightarrow> e_gr(DD,ee,m,m) = id(set(DD`m))"
 by (simp add: e_gr_def)
 
 lemma e_gr_add:
     "\<lbrakk>n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> e_gr(DD,ee,succ(n#+k),n) =
          e_gr(DD,ee,n#+k,n) O Rp(DD`(n#+k),DD`succ(n#+k),ee`(n#+k))"
 by (simp add: e_gr_def)
 
 lemma e_gr_le:
      "\<lbrakk>n \<le> m; m \<in> nat; n \<in> nat\<rbrakk>
       \<Longrightarrow> e_gr(DD,ee,succ(m),n) = e_gr(DD,ee,m,n) O Rp(DD`m,DD`succ(m),ee`m)"
 apply (erule le_exists)
 apply (simp add: e_gr_add, assumption+)
 done
 
 lemma e_gr_succ:
  "m \<in> nat \<Longrightarrow> e_gr(DD,ee,succ(m),m) = id(set(DD`m)) O Rp(DD`m,DD`succ(m),ee`m)"
 by (simp add: e_gr_le e_gr_eq)
 
 (* Cpo asm's due to THE uniqueness. *)
 lemma e_gr_succ_emb: "\<lbrakk>emb_chain(DD,ee); m \<in> nat\<rbrakk>
      \<Longrightarrow> e_gr(DD,ee,succ(m),m) = Rp(DD`m,DD`succ(m),ee`m)"
 apply (simp add: e_gr_succ)
 apply (blast intro: id_comp Rp_cont cont_fun emb_chain_cpo emb_chain_emb)
 done
 
 lemma e_gr_fun_add:
     "\<lbrakk>emb_chain(DD,ee); n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> e_gr(DD,ee,n#+k,n): set(DD`(n#+k))->set(DD`n)"
 apply (induct_tac k)
 apply (simp add: e_gr_eq id_type)
 apply (simp add: e_gr_add)
 apply (blast intro: comp_fun Rp_cont cont_fun emb_chain_emb emb_chain_cpo)
 done
 
 lemma e_gr_fun:
     "\<lbrakk>n \<le> m; emb_chain(DD,ee); m \<in> nat; n \<in> nat\<rbrakk>
      \<Longrightarrow> e_gr(DD,ee,m,n): set(DD`m)->set(DD`n)"
 apply (rule le_exists, assumption)
 apply (simp add: e_gr_fun_add, assumption+)
 done
 
 lemma e_gr_split_add_lemma:
     "\<lbrakk>emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> m \<le> k \<longrightarrow>
          e_gr(DD,ee,n#+k,n) = e_gr(DD,ee,n#+m,n) O e_gr(DD,ee,n#+k,n#+m)"
 apply (induct_tac k)
 apply (rule impI)
 apply (simp add: le0_iff e_gr_eq id_type [THEN comp_id])
 apply (simp add: le_succ_iff)
 apply (rule impI)
 apply (erule disjE)
 apply (erule impE, assumption)
 apply (simp add: e_gr_add)
 apply (subst e_gr_le)
 apply (assumption | rule add_le_mono nat_le_refl add_type nat_succI)+
 apply (subst comp_assoc)
 apply (assumption | rule comp_mono_eq refl)+
 (* New direct subgoal *)
 apply (simp del: add_succ_right add: add_succ_right [symmetric]
             add: e_gr_eq)
 apply (subst comp_id) (* simp cannot unify/inst right, use brr below (?) . *)
 apply (assumption | rule e_gr_fun add_type refl add_le_self nat_succI)+
 done
 
 lemma e_gr_split_add:
      "\<lbrakk>m \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
       \<Longrightarrow> e_gr(DD,ee,n#+k,n) = e_gr(DD,ee,n#+m,n) O e_gr(DD,ee,n#+k,n#+m)"
 apply (blast intro: e_gr_split_add_lemma [THEN mp])
 done
 
 lemma e_less_cont:
      "\<lbrakk>m \<le> n; emb_chain(DD,ee); m \<in> nat; n \<in> nat\<rbrakk>
       \<Longrightarrow> e_less(DD,ee,m,n):cont(DD`m,DD`n)"
 apply (blast intro: emb_cont emb_e_less)
 done
 
 lemma e_gr_cont:
     "\<lbrakk>n \<le> m; emb_chain(DD,ee); m \<in> nat; n \<in> nat\<rbrakk>
      \<Longrightarrow> e_gr(DD,ee,m,n):cont(DD`m,DD`n)"
 apply (erule rev_mp)
 apply (induct_tac m)
 apply (simp add: le0_iff e_gr_eq nat_0I)
 apply (assumption | rule impI id_cont emb_chain_cpo nat_0I)+
 apply (simp add: le_succ_iff)
 apply (erule disjE)
 apply (erule impE, assumption)
 apply (simp add: e_gr_le)
 apply (blast intro: comp_pres_cont Rp_cont emb_chain_cpo emb_chain_emb)
 apply (simp add: e_gr_eq)
 done
 
 (* Considerably shorter.... 57 against 26 *)
 
 lemma e_less_e_gr_split_add:
     "\<lbrakk>n \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> e_less(DD,ee,m,m#+n) = e_gr(DD,ee,m#+k,m#+n) O e_less(DD,ee,m,m#+k)"
 (* Use mp to prepare for induction. *)
 apply (erule rev_mp)
 apply (induct_tac k)
 apply (simp add: e_gr_eq e_less_eq id_type [THEN id_comp])
 apply (simp add: le_succ_iff)
 apply (rule impI)
 apply (erule disjE)
 apply (erule impE, assumption)
 apply (simp add: e_gr_le e_less_le add_le_mono)
 apply (subst comp_assoc)
 apply (rule_tac s1 = "ee` (m#+x)" in comp_assoc [THEN subst])
 apply (subst embRp_eq)
 apply (assumption | rule emb_chain_emb add_type emb_chain_cpo nat_succI)+
 apply (subst id_comp)
 apply (blast intro: e_less_cont [THEN cont_fun] add_le_self)
 apply (rule refl)
 apply (simp del: add_succ_right add: add_succ_right [symmetric]
             add: e_gr_eq)
 apply (blast intro: id_comp [symmetric] e_less_cont [THEN cont_fun]
                     add_le_self)
 done
 
 (* Again considerably shorter, and easy to obtain from the previous thm. *)
 
 lemma e_gr_e_less_split_add:
     "\<lbrakk>m \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> e_gr(DD,ee,n#+m,n) = e_gr(DD,ee,n#+k,n) O e_less(DD,ee,n#+m,n#+k)"
 (* Use mp to prepare for induction. *)
 apply (erule rev_mp)
 apply (induct_tac k)
 apply (simp add: e_gr_eq e_less_eq id_type [THEN id_comp])
 apply (simp add: le_succ_iff)
 apply (rule impI)
 apply (erule disjE)
 apply (erule impE, assumption)
 apply (simp add: e_gr_le e_less_le add_le_self nat_le_refl add_le_mono)
 apply (subst comp_assoc)
 apply (rule_tac s1 = "ee` (n#+x)" in comp_assoc [THEN subst])
 apply (subst embRp_eq)
 apply (assumption | rule emb_chain_emb add_type emb_chain_cpo nat_succI)+
 apply (subst id_comp)
 apply (blast intro!: e_less_cont [THEN cont_fun] add_le_mono nat_le_refl)
 apply (rule refl)
 apply (simp del: add_succ_right add: add_succ_right [symmetric]
             add: e_less_eq)
 apply (blast intro: comp_id [symmetric] e_gr_cont [THEN cont_fun] add_le_self)
 done
 
 
 lemma emb_eps:
     "\<lbrakk>m \<le> n; emb_chain(DD,ee); m \<in> nat; n \<in> nat\<rbrakk>
      \<Longrightarrow> emb(DD`m,DD`n,eps(DD,ee,m,n))"
 apply (simp add: eps_def)
 apply (blast intro: emb_e_less)
 done
 
 lemma eps_fun:
     "\<lbrakk>emb_chain(DD,ee); m \<in> nat; n \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,n): set(DD`m)->set(DD`n)"
 apply (simp add: eps_def)
 apply (auto intro: e_less_cont [THEN cont_fun]
                    not_le_iff_lt [THEN iffD1, THEN leI]
                    e_gr_fun nat_into_Ord)
 done
 
 lemma eps_id: "n \<in> nat \<Longrightarrow> eps(DD,ee,n,n) = id(set(DD`n))"
 by (simp add: eps_def e_less_eq)
 
 lemma eps_e_less_add:
     "\<lbrakk>m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> eps(DD,ee,m,m#+n) = e_less(DD,ee,m,m#+n)"
 by (simp add: eps_def add_le_self)
 
 lemma eps_e_less:
     "\<lbrakk>m \<le> n; m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> eps(DD,ee,m,n) = e_less(DD,ee,m,n)"
 by (simp add: eps_def)
 
 lemma eps_e_gr_add:
     "\<lbrakk>n \<in> nat; k \<in> nat\<rbrakk> \<Longrightarrow> eps(DD,ee,n#+k,n) = e_gr(DD,ee,n#+k,n)"
 by (simp add: eps_def e_less_eq e_gr_eq)
 
 lemma eps_e_gr:
     "\<lbrakk>n \<le> m; m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> eps(DD,ee,m,n) = e_gr(DD,ee,m,n)"
 apply (erule le_exists)
 apply (simp_all add: eps_e_gr_add)
 done
 
 lemma eps_succ_ee:
     "\<lbrakk>\<And>n. n \<in> nat \<Longrightarrow> emb(DD`n,DD`succ(n),ee`n); m \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,succ(m)) = ee`m"
 by (simp add: eps_e_less le_succ_iff e_less_succ_emb)
 
 lemma eps_succ_Rp:
     "\<lbrakk>emb_chain(DD,ee); m \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,succ(m),m) = Rp(DD`m,DD`succ(m),ee`m)"
 by (simp add: eps_e_gr le_succ_iff e_gr_succ_emb)
 
 lemma eps_cont:
   "\<lbrakk>emb_chain(DD,ee); m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> eps(DD,ee,m,n): cont(DD`m,DD`n)"
 apply (rule_tac i = m and j = n in nat_linear_le)
 apply (simp_all add: eps_e_less e_less_cont eps_e_gr e_gr_cont)
 done
 
 (* Theorems about splitting. *)
 
 lemma eps_split_add_left:
     "\<lbrakk>n \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,m#+k) = eps(DD,ee,m#+n,m#+k) O eps(DD,ee,m,m#+n)"
 apply (simp add: eps_e_less add_le_self add_le_mono)
 apply (auto intro: e_less_split_add)
 done
 
 lemma eps_split_add_left_rev:
     "\<lbrakk>n \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,m#+n) = eps(DD,ee,m#+k,m#+n) O eps(DD,ee,m,m#+k)"
 apply (simp add: eps_e_less_add eps_e_gr add_le_self add_le_mono)
 apply (auto intro: e_less_e_gr_split_add)
 done
 
 lemma eps_split_add_right:
     "\<lbrakk>m \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,n#+k,n) = eps(DD,ee,n#+m,n) O eps(DD,ee,n#+k,n#+m)"
 apply (simp add: eps_e_gr add_le_self add_le_mono)
 apply (auto intro: e_gr_split_add)
 done
 
 lemma eps_split_add_right_rev:
     "\<lbrakk>m \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,n#+m,n) = eps(DD,ee,n#+k,n) O eps(DD,ee,n#+m,n#+k)"
 apply (simp add: eps_e_gr_add eps_e_less add_le_self add_le_mono)
 apply (auto intro: e_gr_e_less_split_add)
 done
 
 (* Arithmetic *)
 
 lemma le_exists_lemma:
     "\<lbrakk>n \<le> k; k \<le> m;
         \<And>p q. \<lbrakk>p \<le> q; k=n#+p; m=n#+q; p \<in> nat; q \<in> nat\<rbrakk> \<Longrightarrow> R;
         m \<in> nat\<rbrakk>\<Longrightarrow>R"
 apply (rule le_exists, assumption)
 prefer 2 apply (simp add: lt_nat_in_nat)
 apply (rule le_trans [THEN le_exists], assumption+, force+)
 done
 
 lemma eps_split_left_le:
     "\<lbrakk>m \<le> k; k \<le> n; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
 apply (rule le_exists_lemma, assumption+)
 apply (auto intro: eps_split_add_left)
 done
 
 lemma eps_split_left_le_rev:
     "\<lbrakk>m \<le> n; n \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
 apply (rule le_exists_lemma, assumption+)
 apply (auto intro: eps_split_add_left_rev)
 done
 
 lemma eps_split_right_le:
     "\<lbrakk>n \<le> k; k \<le> m; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
 apply (rule le_exists_lemma, assumption+)
 apply (auto intro: eps_split_add_right)
 done
 
 lemma eps_split_right_le_rev:
     "\<lbrakk>n \<le> m; m \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
 apply (rule le_exists_lemma, assumption+)
 apply (auto intro: eps_split_add_right_rev)
 done
 
 (* The desired two theorems about `splitting'. *)
 
 lemma eps_split_left:
     "\<lbrakk>m \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
 apply (rule nat_linear_le)
 apply (rule_tac [4] eps_split_right_le_rev)
 prefer 4 apply assumption
 apply (rule_tac [3] nat_linear_le)
 apply (rule_tac [5] eps_split_left_le)
 prefer 6 apply assumption
 apply (simp_all add: eps_split_left_le_rev)
 done
 
 lemma eps_split_right:
     "\<lbrakk>n \<le> k; emb_chain(DD,ee); m \<in> nat; n \<in> nat; k \<in> nat\<rbrakk>
      \<Longrightarrow> eps(DD,ee,m,n) = eps(DD,ee,k,n) O eps(DD,ee,m,k)"
 apply (rule nat_linear_le)
 apply (rule_tac [3] eps_split_left_le_rev)
 prefer 3 apply assumption
 apply (rule_tac [8] nat_linear_le)
 apply (rule_tac [10] eps_split_right_le)
 prefer 11 apply assumption
 apply (simp_all add: eps_split_right_le_rev)
 done
 
 (*----------------------------------------------------------------------*)
 (* That was eps: D_m -> D_n, NEXT rho_emb: D_n -> Dinf.                 *)
 (*----------------------------------------------------------------------*)
 
 (* Considerably shorter. *)
 
 lemma rho_emb_fun:
     "\<lbrakk>emb_chain(DD,ee); n \<in> nat\<rbrakk>
      \<Longrightarrow> rho_emb(DD,ee,n): set(DD`n) -> set(Dinf(DD,ee))"
 apply (simp add: rho_emb_def)
 apply (assumption |
        rule lam_type DinfI eps_cont [THEN cont_fun, THEN apply_type])+
 apply simp
 apply (rule_tac i = "succ (na) " and j = n in nat_linear_le)
    apply blast
   apply assumption
  apply (simplesubst eps_split_right_le)
     \<comment> \<open>Subst would rewrite the lhs. We want to change the rhs.\<close>
        prefer 2 apply assumption
       apply simp
      apply (assumption | rule add_le_self nat_0I nat_succI)+
  apply (simp add: eps_succ_Rp)
  apply (subst comp_fun_apply)
     apply (assumption |
            rule eps_fun nat_succI Rp_cont [THEN cont_fun]
                 emb_chain_emb emb_chain_cpo refl)+
 (* Now the second part of the proof. Slightly different than HOL. *)
 apply (simp add: eps_e_less nat_succI)
 apply (erule le_iff [THEN iffD1, THEN disjE])
 apply (simp add: e_less_le)
 apply (subst comp_fun_apply)
 apply (assumption | rule e_less_cont cont_fun emb_chain_emb emb_cont)+
 apply (subst embRp_eq_thm)
 apply (assumption |
        rule emb_chain_emb e_less_cont [THEN cont_fun, THEN apply_type]
             emb_chain_cpo nat_succI)+
  apply (simp add: eps_e_less)
 apply (simp add: eps_succ_Rp e_less_eq id_conv nat_succI)
 done
 
 lemma rho_emb_apply1:
     "x \<in> set(DD`n) \<Longrightarrow> rho_emb(DD,ee,n)`x = (\<lambda>m \<in> nat. eps(DD,ee,n,m)`x)"
 by (simp add: rho_emb_def)
 
 lemma rho_emb_apply2:
     "\<lbrakk>x \<in> set(DD`n); m \<in> nat\<rbrakk> \<Longrightarrow> rho_emb(DD,ee,n)`x`m = eps(DD,ee,n,m)`x"
 by (simp add: rho_emb_def)
 
 lemma rho_emb_id: "\<lbrakk>x \<in> set(DD`n); n \<in> nat\<rbrakk> \<Longrightarrow> rho_emb(DD,ee,n)`x`n = x"
 by (simp add: rho_emb_apply2 eps_id)
 
 (* Shorter proof, 23 against 62. *)
 
 lemma rho_emb_cont:
     "\<lbrakk>emb_chain(DD,ee); n \<in> nat\<rbrakk>
      \<Longrightarrow> rho_emb(DD,ee,n): cont(DD`n,Dinf(DD,ee))"
 apply (rule contI)
 apply (assumption | rule rho_emb_fun)+
 apply (rule rel_DinfI)
 apply (simp add: rho_emb_def)
 apply (assumption |
        rule eps_cont [THEN cont_mono]  Dinf_prod apply_type rho_emb_fun)+
 (* Continuity, different order, slightly different proofs. *)
 apply (subst lub_Dinf)
 apply (rule chainI)
 apply (assumption | rule lam_type rho_emb_fun [THEN apply_type]  chain_in)+
 apply simp
 apply (rule rel_DinfI)
 apply (simp add: rho_emb_apply2 chain_in)
 apply (assumption |
        rule eps_cont [THEN cont_mono]  chain_rel Dinf_prod
             rho_emb_fun [THEN apply_type]  chain_in nat_succI)+
 (* Now, back to the result of applying lub_Dinf *)
 apply (simp add: rho_emb_apply2 chain_in)
 apply (subst rho_emb_apply1)
 apply (assumption | rule cpo_lub [THEN islub_in]  emb_chain_cpo)+
 apply (rule fun_extension)
 apply (assumption |
        rule lam_type eps_cont [THEN cont_fun, THEN apply_type]
             cpo_lub [THEN islub_in]  emb_chain_cpo)+
 apply (assumption | rule cont_chain eps_cont emb_chain_cpo)+
 apply simp
 apply (simp add: eps_cont [THEN cont_lub])
 done
 
 (* 32 vs 61, using safe_tac with imp in asm would be unfortunate (5steps) *)
 
 lemma eps1_aux1:
     "\<lbrakk>m \<le> n; emb_chain(DD,ee); x \<in> set(Dinf(DD,ee)); m \<in> nat; n \<in> nat\<rbrakk>
      \<Longrightarrow> rel(DD`n,e_less(DD,ee,m,n)`(x`m),x`n)"
 apply (erule rev_mp) (* For induction proof *)
 apply (induct_tac n)
 apply (rule impI)
 apply (simp add: e_less_eq)
 apply (subst id_conv)
 apply (assumption | rule apply_type Dinf_prod cpo_refl emb_chain_cpo nat_0I)+
 apply (simp add: le_succ_iff)
 apply (rule impI)
 apply (erule disjE)
 apply (drule mp, assumption)
 apply (rule cpo_trans)
 apply (rule_tac [2] e_less_le [THEN ssubst])
 apply (assumption | rule emb_chain_cpo nat_succI)+
 apply (subst comp_fun_apply)
 apply (assumption |
        rule emb_chain_emb [THEN emb_cont]  e_less_cont cont_fun apply_type
             Dinf_prod)+
 apply (rule_tac y = "x`xa" in emb_chain_emb [THEN emb_cont, THEN cont_mono])
 apply (assumption | rule e_less_cont [THEN cont_fun]  apply_type Dinf_prod)+
 apply (rule_tac x1 = x and n1 = xa in Dinf_eq [THEN subst])
 apply (rule_tac [3] comp_fun_apply [THEN subst])
 apply (rename_tac [5] y)
 apply (rule_tac [5] P =
          "\<lambda>z. rel(DD`succ(y),
                   (ee`y O Rp(DD'(y)`y,DD'(y)`succ(y),ee'(y)`y)) ` (x`succ(y)),
                   z)" for DD' ee'
        in id_conv [THEN subst])
 apply (rule_tac [6] rel_cf)
 (* Dinf and cont_fun doesn't go well together, both Pi(_,\<lambda>x._). *)
 (* solves 10 of 11 subgoals *)
 apply (assumption |
        rule Dinf_prod [THEN apply_type] cont_fun Rp_cont e_less_cont
             emb_cont emb_chain_emb emb_chain_cpo apply_type embRp_rel
             disjI1 [THEN le_succ_iff [THEN iffD2]]  nat_succI)+
 apply (simp add: e_less_eq)
 apply (subst id_conv)
 apply (auto intro: apply_type Dinf_prod emb_chain_cpo)
 done
 
 (* 18 vs 40 *)
 
 lemma eps1_aux2:
     "\<lbrakk>n \<le> m; emb_chain(DD,ee); x \<in> set(Dinf(DD,ee)); m \<in> nat; n \<in> nat\<rbrakk>
      \<Longrightarrow> rel(DD`n,e_gr(DD,ee,m,n)`(x`m),x`n)"
 apply (erule rev_mp) (* For induction proof *)
 apply (induct_tac m)
 apply (rule impI)
 apply (simp add: e_gr_eq)
 apply (subst id_conv)
 apply (assumption | rule apply_type Dinf_prod cpo_refl emb_chain_cpo nat_0I)+
 apply (simp add: le_succ_iff)
 apply (rule impI)
 apply (erule disjE)
 apply (drule mp, assumption)
 apply (subst e_gr_le)
 apply (rule_tac [4] comp_fun_apply [THEN ssubst])
 apply (rule_tac [6] Dinf_eq [THEN ssubst])
 apply (assumption |
        rule emb_chain_emb emb_chain_cpo Rp_cont e_gr_cont cont_fun emb_cont
             apply_type Dinf_prod nat_succI)+
 apply (simp add: e_gr_eq)
 apply (subst id_conv)
 apply (auto intro: apply_type Dinf_prod emb_chain_cpo)
 done
 
 lemma eps1:
     "\<lbrakk>emb_chain(DD,ee); x \<in> set(Dinf(DD,ee)); m \<in> nat; n \<in> nat\<rbrakk>
      \<Longrightarrow> rel(DD`n,eps(DD,ee,m,n)`(x`m),x`n)"
 apply (simp add: eps_def)
 apply (blast intro: eps1_aux1 not_le_iff_lt [THEN iffD1, THEN leI, THEN eps1_aux2]
                     nat_into_Ord)
 done
 
 (* The following theorem is needed/useful due to type check for rel_cfI,
    but also elsewhere.
    Look for occurrences of rel_cfI, rel_DinfI, etc to evaluate the problem. *)
 
 lemma lam_Dinf_cont:
   "\<lbrakk>emb_chain(DD,ee); n \<in> nat\<rbrakk>
      \<Longrightarrow> (\<lambda>x \<in> set(Dinf(DD,ee)). x`n) \<in> cont(Dinf(DD,ee),DD`n)"
 apply (rule contI)
 apply (assumption | rule lam_type apply_type Dinf_prod)+
 apply simp
 apply (assumption | rule rel_Dinf)+
 apply (subst beta)
 apply (auto intro: cpo_Dinf islub_in cpo_lub)
 apply (simp add: chain_in lub_Dinf)
 done
 
 lemma rho_projpair:
     "\<lbrakk>emb_chain(DD,ee); n \<in> nat\<rbrakk>
      \<Longrightarrow> projpair(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n),rho_proj(DD,ee,n))"
 apply (simp add: rho_proj_def)
 apply (rule projpairI)
 apply (assumption | rule rho_emb_cont)+
 (* lemma used, introduced because same fact needed below due to rel_cfI. *)
 apply (assumption | rule lam_Dinf_cont)+
 (*-----------------------------------------------*)
 (* This part is 7 lines, but 30 in HOL (75% reduction!) *)
 apply (rule fun_extension)
 apply (rule_tac [3] id_conv [THEN ssubst])
 apply (rule_tac [4] comp_fun_apply [THEN ssubst])
 apply (rule_tac [6] beta [THEN ssubst])
 apply (rule_tac [7] rho_emb_id [THEN ssubst])
 apply (assumption |
        rule comp_fun id_type lam_type rho_emb_fun Dinf_prod [THEN apply_type]
             apply_type refl)+
 (*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
 apply (rule rel_cfI) (* ----------------\<longrightarrow>>>Yields type cond, not in HOL *)
 apply (subst id_conv)
 apply (rule_tac [2] comp_fun_apply [THEN ssubst])
 apply (rule_tac [4] beta [THEN ssubst])
 apply (rule_tac [5] rho_emb_apply1 [THEN ssubst])
 apply (rule_tac [6] rel_DinfI)
 apply (rule_tac [6] beta [THEN ssubst])
 (* Dinf_prod bad with lam_type *)
 apply (assumption |
        rule eps1 lam_type rho_emb_fun eps_fun
             Dinf_prod [THEN apply_type] refl)+
 apply (assumption |
        rule apply_type eps_fun Dinf_prod comp_pres_cont rho_emb_cont
             lam_Dinf_cont id_cont cpo_Dinf emb_chain_cpo)+
 done
 
 lemma emb_rho_emb:
   "\<lbrakk>emb_chain(DD,ee); n \<in> nat\<rbrakk> \<Longrightarrow> emb(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n))"
 by (auto simp add: emb_def intro: exI rho_projpair)
 
 lemma rho_proj_cont: "\<lbrakk>emb_chain(DD,ee); n \<in> nat\<rbrakk>
      \<Longrightarrow> rho_proj(DD,ee,n) \<in> cont(Dinf(DD,ee),DD`n)"
 by (auto intro: rho_projpair projpair_p_cont)
 
 (*----------------------------------------------------------------------*)
 (* Commutivity and universality.                                        *)
 (*----------------------------------------------------------------------*)
 
 lemma commuteI:
   "\<lbrakk>\<And>n. n \<in> nat \<Longrightarrow> emb(DD`n,E,r(n));
       \<And>m n. \<lbrakk>m \<le> n; m \<in> nat; n \<in> nat\<rbrakk> \<Longrightarrow> r(n) O eps(DD,ee,m,n) = r(m)\<rbrakk>
      \<Longrightarrow> commute(DD,ee,E,r)"
 by (simp add: commute_def)
 
 lemma commute_emb [TC]:
   "\<lbrakk>commute(DD,ee,E,r); n \<in> nat\<rbrakk> \<Longrightarrow> emb(DD`n,E,r(n))"
 by (simp add: commute_def)
 
 lemma commute_eq:
   "\<lbrakk>commute(DD,ee,E,r); m \<le> n; m \<in> nat; n \<in> nat\<rbrakk>
      \<Longrightarrow> r(n) O eps(DD,ee,m,n) = r(m) "
 by (simp add: commute_def)
 
 (* Shorter proof: 11 vs 46 lines. *)
 
 lemma rho_emb_commute:
   "emb_chain(DD,ee) \<Longrightarrow> commute(DD,ee,Dinf(DD,ee),rho_emb(DD,ee))"
 apply (rule commuteI)
 apply (assumption | rule emb_rho_emb)+
 apply (rule fun_extension) (* Manual instantiation in HOL. *)
 apply (rule_tac [3] comp_fun_apply [THEN ssubst])
 apply (rule_tac [5] fun_extension) (*Next, clean up and instantiate unknowns *)
 apply (assumption | rule comp_fun rho_emb_fun eps_fun Dinf_prod apply_type)+
 apply (simp add: rho_emb_apply2 eps_fun [THEN apply_type])
 apply (rule comp_fun_apply [THEN subst])
 apply (rule_tac [3] eps_split_left [THEN subst])
 apply (auto intro: eps_fun)
 done
 
 lemma le_succ: "n \<in> nat \<Longrightarrow> n \<le> succ(n)"
 by (simp add: le_succ_iff)
 
 (* Shorter proof: 21 vs 83 (106 - 23, due to OAssoc complication) *)
 
 lemma commute_chain:
     "\<lbrakk>commute(DD,ee,E,r); emb_chain(DD,ee); cpo(E)\<rbrakk>
      \<Longrightarrow> chain(cf(E,E),\<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n)))"
 apply (rule chainI)
 apply (blast intro: lam_type cont_cf comp_pres_cont commute_emb Rp_cont
                     emb_cont emb_chain_cpo,
        simp)
 apply (rule_tac r1 = r and m1 = n in commute_eq [THEN subst])
 apply (assumption | rule le_succ nat_succI)+
 apply (subst Rp_comp)
 apply (assumption | rule emb_eps commute_emb emb_chain_cpo le_succ nat_succI)+
 apply (rule comp_assoc [THEN subst]) (* comp_assoc is simpler in Isa *)
 apply (rule_tac r1 = "r (succ (n))" in comp_assoc [THEN ssubst])
 apply (rule comp_mono)
 apply (blast intro: comp_pres_cont eps_cont emb_eps commute_emb Rp_cont
                     emb_cont emb_chain_cpo le_succ)+
 apply (rule_tac b="r(succ(n))" in comp_id [THEN subst]) (* 1 subst too much *)
 apply (rule_tac [2] comp_mono)
 apply (blast intro: comp_pres_cont eps_cont emb_eps emb_id commute_emb
                     Rp_cont emb_cont cont_fun emb_chain_cpo le_succ)+
 apply (subst comp_id) (* Undoes "1 subst too much", typing next anyway *)
 apply (blast intro: cont_fun Rp_cont emb_cont commute_emb cont_cf cpo_cf
                     emb_chain_cpo embRp_rel emb_eps le_succ)+
 done
 
 lemma rho_emb_chain:
   "emb_chain(DD,ee) \<Longrightarrow>
    chain(cf(Dinf(DD,ee),Dinf(DD,ee)),
          \<lambda>n \<in> nat. rho_emb(DD,ee,n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n)))"
 by (auto intro: commute_chain rho_emb_commute cpo_Dinf)
 
 lemma rho_emb_chain_apply1:
      "\<lbrakk>emb_chain(DD,ee); x \<in> set(Dinf(DD,ee))\<rbrakk>
       \<Longrightarrow> chain(Dinf(DD,ee),
                 \<lambda>n \<in> nat.
                  (rho_emb(DD,ee,n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n)))`x)"
 by (drule rho_emb_chain [THEN chain_cf], assumption, simp)
 
 lemma chain_iprod_emb_chain:
      "\<lbrakk>chain(iprod(DD),X); emb_chain(DD,ee); n \<in> nat\<rbrakk>
       \<Longrightarrow> chain(DD`n,\<lambda>m \<in> nat. X `m `n)"
 by (auto intro: chain_iprod emb_chain_cpo)
 
 lemma rho_emb_chain_apply2:
   "\<lbrakk>emb_chain(DD,ee); x \<in> set(Dinf(DD,ee)); n \<in> nat\<rbrakk> \<Longrightarrow>
    chain
     (DD`n,
      \<lambda>xa \<in> nat.
       (rho_emb(DD, ee, xa) O Rp(DD ` xa, Dinf(DD, ee),rho_emb(DD, ee, xa))) `
        x ` n)"
 by (frule rho_emb_chain_apply1 [THEN chain_Dinf, THEN chain_iprod_emb_chain],
     auto)
 
 (* Shorter proof: 32 vs 72 (roughly), Isabelle proof has lemmas. *)
 
 lemma rho_emb_lub:
   "emb_chain(DD,ee) \<Longrightarrow>
    lub(cf(Dinf(DD,ee),Dinf(DD,ee)),
        \<lambda>n \<in> nat. rho_emb(DD,ee,n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n))) =
    id(set(Dinf(DD,ee)))"
 apply (rule cpo_antisym)
 apply (rule cpo_cf) (*Instantiate variable, continued below (loops otherwise)*)
 apply (assumption | rule cpo_Dinf)+
 apply (rule islub_least)
 apply (assumption |
        rule cpo_lub rho_emb_chain cpo_cf cpo_Dinf isubI cont_cf id_cont)+
 apply simp
 apply (assumption | rule embRp_rel emb_rho_emb emb_chain_cpo cpo_Dinf)+
 apply (rule rel_cfI)
 apply (simp add: lub_cf rho_emb_chain cpo_Dinf)
 apply (rule rel_DinfI) (* Additional assumptions *)
 apply (subst lub_Dinf)
 apply (assumption | rule rho_emb_chain_apply1)+
 defer 1
 apply (assumption |
        rule Dinf_prod cpo_lub [THEN islub_in]  id_cont cpo_Dinf cpo_cf cf_cont
             rho_emb_chain rho_emb_chain_apply1 id_cont [THEN cont_cf])+
 apply simp
 apply (rule dominate_islub)
 apply (rule_tac [3] cpo_lub)
 apply (rule_tac [6] x1 = "x`n" in chain_const [THEN chain_fun])
 defer 1
 apply (assumption |
        rule rho_emb_chain_apply2 emb_chain_cpo islub_const apply_type
             Dinf_prod emb_chain_cpo chain_fun rho_emb_chain_apply2)+
 apply (rule dominateI, assumption, simp)
 apply (subst comp_fun_apply)
 apply (assumption |
        rule cont_fun Rp_cont emb_cont emb_rho_emb cpo_Dinf emb_chain_cpo)+
 apply (subst rho_projpair [THEN Rp_unique])
 prefer 5
 apply (simp add: rho_proj_def)
 apply (rule rho_emb_id [THEN ssubst])
 apply (auto intro: cpo_Dinf apply_type Dinf_prod emb_chain_cpo)
 done
 
 lemma theta_chain: (* almost same proof as commute_chain *)
     "\<lbrakk>commute(DD,ee,E,r); commute(DD,ee,G,f);
         emb_chain(DD,ee); cpo(E); cpo(G)\<rbrakk>
      \<Longrightarrow> chain(cf(E,G),\<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n)))"
 apply (rule chainI)
 apply (blast intro: lam_type cont_cf comp_pres_cont commute_emb Rp_cont
                     emb_cont emb_chain_cpo,
        simp)
 apply (rule_tac r1 = r and m1 = n in commute_eq [THEN subst])
 apply (rule_tac [5] r1 = f and m1 = n in commute_eq [THEN subst])
 apply (assumption | rule le_succ nat_succI)+
 apply (subst Rp_comp)
 apply (assumption | rule emb_eps commute_emb emb_chain_cpo le_succ nat_succI)+
 apply (rule comp_assoc [THEN subst])
 apply (rule_tac r1 = "f (succ (n))" in comp_assoc [THEN ssubst])
 apply (rule comp_mono)
 apply (blast intro: comp_pres_cont eps_cont emb_eps commute_emb Rp_cont
                      emb_cont emb_chain_cpo le_succ)+
 apply (rule_tac b="f(succ(n))" in comp_id [THEN subst]) (* 1 subst too much *)
 apply (rule_tac [2] comp_mono)
 apply (blast intro: comp_pres_cont eps_cont emb_eps emb_id commute_emb
                     Rp_cont emb_cont cont_fun emb_chain_cpo le_succ)+
 apply (subst comp_id) (* Undoes "1 subst too much", typing next anyway *)
 apply (blast intro: cont_fun Rp_cont emb_cont commute_emb cont_cf cpo_cf
                     emb_chain_cpo embRp_rel emb_eps le_succ)+
 done
 
 lemma theta_proj_chain: (* similar proof to theta_chain *)
   "\<lbrakk>commute(DD,ee,E,r); commute(DD,ee,G,f);
       emb_chain(DD,ee); cpo(E); cpo(G)\<rbrakk>
      \<Longrightarrow> chain(cf(G,E),\<lambda>n \<in> nat. r(n) O Rp(DD`n,G,f(n)))"
 apply (rule chainI)
 apply (blast intro: lam_type cont_cf comp_pres_cont commute_emb Rp_cont
                     emb_cont emb_chain_cpo, simp)
 apply (rule_tac r1 = r and m1 = n in commute_eq [THEN subst])
 apply (rule_tac [5] r1 = f and m1 = n in commute_eq [THEN subst])
 apply (assumption | rule le_succ nat_succI)+
 apply (subst Rp_comp)
 apply (assumption | rule emb_eps commute_emb emb_chain_cpo le_succ nat_succI)+
 apply (rule comp_assoc [THEN subst]) (* comp_assoc is simpler in Isa *)
 apply (rule_tac r1 = "r (succ (n))" in comp_assoc [THEN ssubst])
 apply (rule comp_mono)
 apply (blast intro: comp_pres_cont eps_cont emb_eps commute_emb Rp_cont
                     emb_cont emb_chain_cpo le_succ)+
 apply (rule_tac b="r(succ(n))" in comp_id [THEN subst]) (* 1 subst too much *)
 apply (rule_tac [2] comp_mono)
 apply (blast intro: comp_pres_cont eps_cont emb_eps emb_id commute_emb
                     Rp_cont emb_cont cont_fun emb_chain_cpo le_succ)+
 apply (subst comp_id) (* Undoes "1 subst too much", typing next anyway *)
 apply (blast intro: cont_fun Rp_cont emb_cont commute_emb cont_cf cpo_cf
                     emb_chain_cpo embRp_rel emb_eps le_succ)+
 done
 
 (* Simplification with comp_assoc is possible inside a \<lambda>-abstraction,
    because it does not have assumptions. If it had, as the HOL-ST theorem
    too strongly has, we would be in deep trouble due to HOL's lack of proper
    conditional rewriting (a HOL contrib provides something that works). *)
 
 (* Controlled simplification inside lambda: introduce lemmas *)
 
 lemma commute_O_lemma:
      "\<lbrakk>commute(DD,ee,E,r); commute(DD,ee,G,f);
          emb_chain(DD,ee); cpo(E); cpo(G); x \<in> nat\<rbrakk>
       \<Longrightarrow> r(x) O Rp(DD ` x, G, f(x)) O f(x) O Rp(DD ` x, E, r(x)) =
           r(x) O Rp(DD ` x, E, r(x))"
 apply (rule_tac s1 = "f (x) " in comp_assoc [THEN subst])
 apply (subst embRp_eq)
 apply (rule_tac [4] id_comp [THEN ssubst])
 apply (auto intro: cont_fun Rp_cont commute_emb emb_chain_cpo)
 done
 
 
 (* Shorter proof (but lemmas): 19 vs 79 (103 - 24, due to OAssoc)  *)
 
 lemma theta_projpair:
   "\<lbrakk>lub(cf(E,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));
       commute(DD,ee,E,r); commute(DD,ee,G,f);
       emb_chain(DD,ee); cpo(E); cpo(G)\<rbrakk>
    \<Longrightarrow> projpair
         (E,G,
          lub(cf(E,G), \<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n))),
          lub(cf(G,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,G,f(n))))"
 apply (simp add: projpair_def rho_proj_def, safe)
 apply (rule_tac [3] comp_lubs [THEN ssubst])
 (* The following one line is 15 lines in HOL, and includes existentials. *)
 apply (assumption |
        rule cf_cont islub_in cpo_lub cpo_cf theta_chain theta_proj_chain)+
 apply (simp (no_asm) add: comp_assoc)
 apply (simp add: commute_O_lemma)
 apply (subst comp_lubs)
 apply (assumption |
        rule cf_cont islub_in cpo_lub cpo_cf theta_chain theta_proj_chain)+
 apply (simp (no_asm) add: comp_assoc)
 apply (simp add: commute_O_lemma)
 apply (rule dominate_islub)
 defer 1
 apply (rule cpo_lub)
 apply (assumption |
        rule commute_chain commute_emb islub_const cont_cf id_cont
     cpo_cf chain_fun chain_const)+
 apply (rule dominateI, assumption, simp)
 apply (blast intro: embRp_rel commute_emb emb_chain_cpo)
 done
 
 lemma emb_theta:
     "\<lbrakk>lub(cf(E,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));
         commute(DD,ee,E,r); commute(DD,ee,G,f);
         emb_chain(DD,ee); cpo(E); cpo(G)\<rbrakk>
      \<Longrightarrow> emb(E,G,lub(cf(E,G), \<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n))))"
 apply (simp add: emb_def)
 apply (blast intro: theta_projpair)
 done
 
 lemma mono_lemma:
     "\<lbrakk>g \<in> cont(D,D'); cpo(D); cpo(D'); cpo(E)\<rbrakk>
      \<Longrightarrow> (\<lambda>f \<in> cont(D',E). f O g) \<in> mono(cf(D',E),cf(D,E))"
 apply (rule monoI)
 apply (simp add: set_def cf_def)
 apply (drule cf_cont)+
 apply simp
 apply (blast intro: comp_mono lam_type comp_pres_cont cpo_cf cont_cf)
 done
 
 lemma commute_lam_lemma:
      "\<lbrakk>commute(DD,ee,E,r); commute(DD,ee,G,f);
          emb_chain(DD,ee); cpo(E); cpo(G); n \<in> nat\<rbrakk>
       \<Longrightarrow> (\<lambda>na \<in> nat. (\<lambda>f \<in> cont(E, G). f O r(n)) `
            ((\<lambda>n \<in> nat. f(n) O Rp(DD ` n, E, r(n))) ` na))  =
           (\<lambda>na \<in> nat. (f(na) O Rp(DD ` na, E, r(na))) O r(n))"
 apply (rule fun_extension)
 (*something wrong here*)
 apply (auto simp del: beta_if simp add: beta intro: lam_type)
 done
 
 lemma chain_lemma:
      "\<lbrakk>commute(DD,ee,E,r); commute(DD,ee,G,f);
          emb_chain(DD,ee); cpo(E); cpo(G); n \<in> nat\<rbrakk>
       \<Longrightarrow> chain(cf(DD`n,G),\<lambda>x \<in> nat. (f(x) O Rp(DD ` x, E, r(x))) O r(n))"
 apply (rule commute_lam_lemma [THEN subst])
 apply (blast intro: theta_chain emb_chain_cpo
                commute_emb [THEN emb_cont, THEN mono_lemma, THEN mono_chain])+
 done
 
 lemma suffix_lemma:
     "\<lbrakk>commute(DD,ee,E,r); commute(DD,ee,G,f);
         emb_chain(DD,ee); cpo(E); cpo(G); cpo(DD`x); x \<in> nat\<rbrakk>
      \<Longrightarrow> suffix(\<lambda>n \<in> nat. (f(n) O Rp(DD`n,E,r(n))) O r(x),x) =
          (\<lambda>n \<in> nat. f(x))"
 apply (simp add: suffix_def)
 apply (rule lam_type [THEN fun_extension])
 apply (blast intro: lam_type comp_fun cont_fun Rp_cont emb_cont
                     commute_emb emb_chain_cpo)+
 apply simp
 apply (rename_tac y)
 apply (subgoal_tac
        "f(x#+y) O (Rp(DD`(x#+y), E, r(x#+y)) O r (x#+y)) O eps(DD, ee, x, x#+y)
         = f(x)")
 apply (simp add: comp_assoc commute_eq add_le_self)
 apply (simp add: embRp_eq eps_fun [THEN id_comp] commute_emb emb_chain_cpo)
 apply (blast intro: commute_eq add_le_self)
 done
 
 
 lemma mediatingI:
   "\<lbrakk>emb(E,G,t);  \<And>n. n \<in> nat \<Longrightarrow> f(n) = t O r(n)\<rbrakk>\<Longrightarrow>mediating(E,G,r,f,t)"
 by (simp add: mediating_def)
 
 lemma mediating_emb: "mediating(E,G,r,f,t) \<Longrightarrow> emb(E,G,t)"
 by (simp add: mediating_def)
 
 lemma mediating_eq: "\<lbrakk>mediating(E,G,r,f,t); n \<in> nat\<rbrakk> \<Longrightarrow> f(n) = t O r(n)"
 by (simp add: mediating_def)
 
 lemma lub_universal_mediating:
   "\<lbrakk>lub(cf(E,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));
       commute(DD,ee,E,r); commute(DD,ee,G,f);
       emb_chain(DD,ee); cpo(E); cpo(G)\<rbrakk>
      \<Longrightarrow> mediating(E,G,r,f,lub(cf(E,G), \<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n))))"
 apply (assumption | rule mediatingI emb_theta)+
 apply (rule_tac b = "r (n) " in lub_const [THEN subst])
 apply (rule_tac [3] comp_lubs [THEN ssubst])
 apply (blast intro: cont_cf emb_cont commute_emb cpo_cf theta_chain
                     chain_const emb_chain_cpo)+
 apply (simp (no_asm))
 apply (rule_tac n1 = n in lub_suffix [THEN subst])
 apply (assumption | rule chain_lemma cpo_cf emb_chain_cpo)+
 apply (simp add: suffix_lemma lub_const cont_cf emb_cont commute_emb cpo_cf
                  emb_chain_cpo)
 done
 
 lemma lub_universal_unique:
     "\<lbrakk>mediating(E,G,r,f,t);
         lub(cf(E,E), \<lambda>n \<in> nat. r(n) O Rp(DD`n,E,r(n))) = id(set(E));
         commute(DD,ee,E,r); commute(DD,ee,G,f);
         emb_chain(DD,ee); cpo(E); cpo(G)\<rbrakk>
      \<Longrightarrow> t = lub(cf(E,G), \<lambda>n \<in> nat. f(n) O Rp(DD`n,E,r(n)))"
 apply (rule_tac b = t in comp_id [THEN subst])
 apply (erule_tac [2] subst)
 apply (rule_tac [2] b = t in lub_const [THEN subst])
 apply (rule_tac [4] comp_lubs [THEN ssubst])
 prefer 9 apply (simp add: comp_assoc mediating_eq)
 apply (assumption |
        rule cont_fun emb_cont mediating_emb cont_cf cpo_cf chain_const
             commute_chain emb_chain_cpo)+
 done
 
 (*---------------------------------------------------------------------*)
 (* Dinf yields the inverse_limit, stated as rho_emb_commute and        *)
 (* Dinf_universal.                                                     *)
 (*---------------------------------------------------------------------*)
 
 theorem Dinf_universal:
   "\<lbrakk>commute(DD,ee,G,f); emb_chain(DD,ee); cpo(G)\<rbrakk> \<Longrightarrow>
    mediating
     (Dinf(DD,ee),G,rho_emb(DD,ee),f,
      lub(cf(Dinf(DD,ee),G),
          \<lambda>n \<in> nat. f(n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n)))) \<and>
    (\<forall>t. mediating(Dinf(DD,ee),G,rho_emb(DD,ee),f,t) \<longrightarrow>
      t = lub(cf(Dinf(DD,ee),G),
          \<lambda>n \<in> nat. f(n) O Rp(DD`n,Dinf(DD,ee),rho_emb(DD,ee,n))))"
 apply safe
 apply (assumption |
        rule lub_universal_mediating rho_emb_commute rho_emb_lub cpo_Dinf)+
 apply (auto intro: lub_universal_unique rho_emb_commute rho_emb_lub cpo_Dinf)
 done
 
 end
diff --git a/src/ZF/ex/Ramsey.thy b/src/ZF/ex/Ramsey.thy
--- a/src/ZF/ex/Ramsey.thy
+++ b/src/ZF/ex/Ramsey.thy
@@ -1,197 +1,197 @@
 (*  Title:      ZF/ex/Ramsey.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1992  University of Cambridge
 
 Ramsey's Theorem (finite exponent 2 version)
 
 Based upon the article
     D Basin and M Kaufmann,
     The Boyer-Moore Prover and Nuprl: An Experimental Comparison.
     In G Huet and G Plotkin, editors, Logical Frameworks.
     (CUP, 1991), pages 89-119
 
 See also
     M Kaufmann,
     An example in NQTHM: Ramsey's Theorem
     Internal Note, Computational Logic, Inc., Austin, Texas 78703
     Available from the author: kaufmann@cli.com
 
 This function compute Ramsey numbers according to the proof given below
 (which, does not constrain the base case values at all.
 
 fun ram 0 j = 1
   | ram i 0 = 1
   | ram i j = ram (i-1) j + ram i (j-1)
 *)
 
 theory Ramsey imports ZF begin
 
 definition
   Symmetric :: "i\<Rightarrow>o" where
     "Symmetric(E) \<equiv> (\<forall>x y. \<langle>x,y\<rangle>:E \<longrightarrow> \<langle>y,x\<rangle>:E)"
 
 definition
   Atleast :: "[i,i]\<Rightarrow>o" where \<comment> \<open>not really necessary: ZF defines cardinality\<close>
     "Atleast(n,S) \<equiv> (\<exists>f. f \<in> inj(n,S))"
 
 definition
   Clique  :: "[i,i,i]\<Rightarrow>o" where
     "Clique(C,V,E) \<equiv> (C \<subseteq> V) \<and> (\<forall>x \<in> C. \<forall>y \<in> C. x\<noteq>y \<longrightarrow> \<langle>x,y\<rangle> \<in> E)"
 
 definition
   Indept  :: "[i,i,i]\<Rightarrow>o" where
     "Indept(I,V,E) \<equiv> (I \<subseteq> V) \<and> (\<forall>x \<in> I. \<forall>y \<in> I. x\<noteq>y \<longrightarrow> \<langle>x,y\<rangle> \<notin> E)"
   
 definition
   Ramsey  :: "[i,i,i]\<Rightarrow>o" where
     "Ramsey(n,i,j) \<equiv> \<forall>V E. Symmetric(E) \<and> Atleast(n,V) \<longrightarrow>  
          (\<exists>C. Clique(C,V,E) \<and> Atleast(i,C)) |       
          (\<exists>I. Indept(I,V,E) \<and> Atleast(j,I))"
 
 (*** Cliques and Independent sets ***)
 
 lemma Clique0 [intro]: "Clique(0,V,E)"
 by (unfold Clique_def, blast)
 
 lemma Clique_superset: "\<lbrakk>Clique(C,V',E);  V'<=V\<rbrakk> \<Longrightarrow> Clique(C,V,E)"
 by (unfold Clique_def, blast)
 
 lemma Indept0 [intro]: "Indept(0,V,E)"
 by (unfold Indept_def, blast)
 
 lemma Indept_superset: "\<lbrakk>Indept(I,V',E);  V'<=V\<rbrakk> \<Longrightarrow> Indept(I,V,E)"
 by (unfold Indept_def, blast)
 
 (*** Atleast ***)
 
 lemma Atleast0 [intro]: "Atleast(0,A)"
 by (unfold Atleast_def inj_def Pi_def function_def, blast)
 
 lemma Atleast_succD: 
     "Atleast(succ(m),A) \<Longrightarrow> \<exists>x \<in> A. Atleast(m, A-{x})"
-apply (unfold Atleast_def)
+  unfolding Atleast_def
 apply (blast dest: inj_is_fun [THEN apply_type] inj_succ_restrict)
 done
 
 lemma Atleast_superset: 
     "\<lbrakk>Atleast(n,A);  A \<subseteq> B\<rbrakk> \<Longrightarrow> Atleast(n,B)"
 by (unfold Atleast_def, blast intro: inj_weaken_type)
 
 lemma Atleast_succI: 
     "\<lbrakk>Atleast(m,B);  b\<notin> B\<rbrakk> \<Longrightarrow> Atleast(succ(m), cons(b,B))"
 apply (unfold Atleast_def succ_def)
 apply (blast intro: inj_extend elim: mem_irrefl) 
 done
 
 lemma Atleast_Diff_succI:
      "\<lbrakk>Atleast(m, B-{x});  x \<in> B\<rbrakk> \<Longrightarrow> Atleast(succ(m), B)"
 by (blast intro: Atleast_succI [THEN Atleast_superset]) 
 
 (*** Main Cardinality Lemma ***)
 
 (*The #-succ(0) strengthens the original theorem statement, but precisely
   the same proof could be used\<And>*)
 lemma pigeon2 [rule_format]:
      "m \<in> nat \<Longrightarrow>  
           \<forall>n \<in> nat. \<forall>A B. Atleast((m#+n) #- succ(0), A \<union> B) \<longrightarrow>    
                            Atleast(m,A) | Atleast(n,B)"
 apply (induct_tac "m")
 apply (blast intro!: Atleast0, simp)
 apply (rule ballI)
 apply (rename_tac m' n) (*simplifier does NOT preserve bound names!*)
 apply (induct_tac "n", auto)
 apply (erule Atleast_succD [THEN bexE])
 apply (rename_tac n' A B z)
 apply (erule UnE)
 (**case z \<in> B.  Instantiate the '\<forall>A B' induction hypothesis. **)
 apply (drule_tac [2] x1 = A and x = "B-{z}" in spec [THEN spec])
 apply (erule_tac [2] mp [THEN disjE])
 (*cases Atleast(succ(m1),A) and Atleast(succ(k),B)*)
 apply (erule_tac [3] asm_rl notE Atleast_Diff_succI)+
 (*proving the condition*)
 prefer 2 apply (blast intro: Atleast_superset)
 (**case z \<in> A.  Instantiate the '\<forall>n \<in> nat. \<forall>A B' induction hypothesis. **)
 apply (drule_tac x2="succ(n')" and x1="A-{z}" and x=B
        in bspec [THEN spec, THEN spec])
 apply (erule nat_succI)
 apply (erule mp [THEN disjE])
 (*cases Atleast(succ(m1),A) and Atleast(succ(k),B)*)
 apply (erule_tac [2] asm_rl Atleast_Diff_succI notE)+
 (*proving the condition*)
 apply simp
 apply (blast intro: Atleast_superset)
 done
 
 
 (**** Ramsey's Theorem ****)
 
 (** Base cases of induction; they now admit ANY Ramsey number **)
 
 lemma Ramsey0j: "Ramsey(n,0,j)"
 by (unfold Ramsey_def, blast)
 
 lemma Ramseyi0: "Ramsey(n,i,0)"
 by (unfold Ramsey_def, blast)
 
 (** Lemmas for induction step **)
 
 (*The use of succ(m) here, rather than #-succ(0), simplifies the proof of 
   Ramsey_step_lemma.*)
 lemma Atleast_partition: "\<lbrakk>Atleast(m #+ n, A);  m \<in> nat;  n \<in> nat\<rbrakk>   
       \<Longrightarrow> Atleast(succ(m), {x \<in> A. \<not>P(x)}) | Atleast(n, {x \<in> A. P(x)})"
 apply (rule nat_succI [THEN pigeon2], assumption+)
 apply (rule Atleast_superset, auto)
 done
 
 (*For the Atleast part, proves \<not>(a \<in> I) from the second premise!*)
 lemma Indept_succ: 
     "\<lbrakk>Indept(I, {z \<in> V-{a}. \<langle>a,z\<rangle> \<notin> E}, E);  Symmetric(E);  a \<in> V;   
         Atleast(j,I)\<rbrakk> \<Longrightarrow>    
      Indept(cons(a,I), V, E) \<and> Atleast(succ(j), cons(a,I))"
 apply (unfold Symmetric_def Indept_def)
 apply (blast intro!: Atleast_succI)
 done
 
 
 lemma Clique_succ: 
     "\<lbrakk>Clique(C, {z \<in> V-{a}. \<langle>a,z\<rangle>:E}, E);  Symmetric(E);  a \<in> V;   
         Atleast(j,C)\<rbrakk> \<Longrightarrow>    
      Clique(cons(a,C), V, E) \<and> Atleast(succ(j), cons(a,C))"
 apply (unfold Symmetric_def Clique_def)
 apply (blast intro!: Atleast_succI)
 done
 
 (** Induction step **)
 
 (*Published proofs gloss over the need for Ramsey numbers to be POSITIVE.*)
 lemma Ramsey_step_lemma:
    "\<lbrakk>Ramsey(succ(m), succ(i), j);  Ramsey(n, i, succ(j));   
        m \<in> nat;  n \<in> nat\<rbrakk> \<Longrightarrow> Ramsey(succ(m#+n), succ(i), succ(j))"
 apply (unfold Ramsey_def, clarify)
 apply (erule Atleast_succD [THEN bexE])
 apply (erule_tac P1 = "\<lambda>z.\<langle>x,z\<rangle>:E" in Atleast_partition [THEN disjE],
        assumption+)
 (*case m*)
 apply (fast dest!: Indept_succ elim: Clique_superset)
 (*case n*)
 apply (fast dest!: Clique_succ elim: Indept_superset)
 done
 
 
 (** The actual proof **)
 
 (*Again, the induction requires Ramsey numbers to be positive.*)
 lemma ramsey_lemma: "i \<in> nat \<Longrightarrow> \<forall>j \<in> nat. \<exists>n \<in> nat. Ramsey(succ(n), i, j)"
 apply (induct_tac "i")
 apply (blast intro!: Ramsey0j)
 apply (rule ballI)
 apply (induct_tac "j")
 apply (blast intro!: Ramseyi0)
 apply (blast intro!: add_type Ramsey_step_lemma)
 done
 
 (*Final statement in a tidy form, without succ(...) *)
 lemma ramsey: "\<lbrakk>i \<in> nat;  j \<in> nat\<rbrakk> \<Longrightarrow> \<exists>n \<in> nat. Ramsey(n,i,j)"
 by (blast dest: ramsey_lemma)
 
 end
diff --git a/src/ZF/func.thy b/src/ZF/func.thy
--- a/src/ZF/func.thy
+++ b/src/ZF/func.thy
@@ -1,611 +1,611 @@
 (*  Title:      ZF/func.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1991  University of Cambridge
 *)
 
 section\<open>Functions, Function Spaces, Lambda-Abstraction\<close>
 
 theory func imports equalities Sum begin
 
 subsection\<open>The Pi Operator: Dependent Function Space\<close>
 
 lemma subset_Sigma_imp_relation: "r \<subseteq> Sigma(A,B) \<Longrightarrow> relation(r)"
 by (simp add: relation_def, blast)
 
 lemma relation_converse_converse [simp]:
      "relation(r) \<Longrightarrow> converse(converse(r)) = r"
 by (simp add: relation_def, blast)
 
 lemma relation_restrict [simp]:  "relation(restrict(r,A))"
 by (simp add: restrict_def relation_def, blast)
 
 lemma Pi_iff:
     "f \<in> Pi(A,B) \<longleftrightarrow> function(f) \<and> f<=Sigma(A,B) \<and> A<=domain(f)"
 by (unfold Pi_def, blast)
 
 (*For upward compatibility with the former definition*)
 lemma Pi_iff_old:
     "f \<in> Pi(A,B) \<longleftrightarrow> f<=Sigma(A,B) \<and> (\<forall>x\<in>A. \<exists>!y. \<langle>x,y\<rangle>: f)"
 by (unfold Pi_def function_def, blast)
 
 lemma fun_is_function: "f \<in> Pi(A,B) \<Longrightarrow> function(f)"
 by (simp only: Pi_iff)
 
 lemma function_imp_Pi:
      "\<lbrakk>function(f); relation(f)\<rbrakk> \<Longrightarrow> f \<in> domain(f) -> range(f)"
 by (simp add: Pi_iff relation_def, blast)
 
 lemma functionI:
      "\<lbrakk>\<And>x y y'. \<lbrakk>\<langle>x,y\<rangle>:r; <x,y'>:r\<rbrakk> \<Longrightarrow> y=y'\<rbrakk> \<Longrightarrow> function(r)"
 by (simp add: function_def, blast)
 
 (*Functions are relations*)
 lemma fun_is_rel: "f \<in> Pi(A,B) \<Longrightarrow> f \<subseteq> Sigma(A,B)"
 by (unfold Pi_def, blast)
 
 lemma Pi_cong:
     "\<lbrakk>A=A';  \<And>x. x \<in> A' \<Longrightarrow> B(x)=B'(x)\<rbrakk> \<Longrightarrow> Pi(A,B) = Pi(A',B')"
 by (simp add: Pi_def cong add: Sigma_cong)
 
 (*Sigma_cong, Pi_cong NOT given to Addcongs: they cause
   flex-flex pairs and the "Check your prover" error.  Most
   Sigmas and Pis are abbreviated as * or -> *)
 
 (*Weakening one function type to another; see also Pi_type*)
 lemma fun_weaken_type: "\<lbrakk>f \<in> A->B;  B<=D\<rbrakk> \<Longrightarrow> f \<in> A->D"
 by (unfold Pi_def, best)
 
 subsection\<open>Function Application\<close>
 
 lemma apply_equality2: "\<lbrakk>\<langle>a,b\<rangle>: f;  \<langle>a,c\<rangle>: f;  f \<in> Pi(A,B)\<rbrakk> \<Longrightarrow> b=c"
 by (unfold Pi_def function_def, blast)
 
 lemma function_apply_equality: "\<lbrakk>\<langle>a,b\<rangle>: f;  function(f)\<rbrakk> \<Longrightarrow> f`a = b"
 by (unfold apply_def function_def, blast)
 
 lemma apply_equality: "\<lbrakk>\<langle>a,b\<rangle>: f;  f \<in> Pi(A,B)\<rbrakk> \<Longrightarrow> f`a = b"
-apply (unfold Pi_def)
+  unfolding Pi_def
 apply (blast intro: function_apply_equality)
 done
 
 (*Applying a function outside its domain yields 0*)
 lemma apply_0: "a \<notin> domain(f) \<Longrightarrow> f`a = 0"
 by (unfold apply_def, blast)
 
 lemma Pi_memberD: "\<lbrakk>f \<in> Pi(A,B);  c \<in> f\<rbrakk> \<Longrightarrow> \<exists>x\<in>A.  c = <x,f`x>"
 apply (frule fun_is_rel)
 apply (blast dest: apply_equality)
 done
 
 lemma function_apply_Pair: "\<lbrakk>function(f);  a \<in> domain(f)\<rbrakk> \<Longrightarrow> <a,f`a>: f"
 apply (simp add: function_def, clarify)
 apply (subgoal_tac "f`a = y", blast)
 apply (simp add: apply_def, blast)
 done
 
 lemma apply_Pair: "\<lbrakk>f \<in> Pi(A,B);  a \<in> A\<rbrakk> \<Longrightarrow> <a,f`a>: f"
 apply (simp add: Pi_iff)
 apply (blast intro: function_apply_Pair)
 done
 
 (*Conclusion is flexible -- use rule_tac or else apply_funtype below!*)
 lemma apply_type [TC]: "\<lbrakk>f \<in> Pi(A,B);  a \<in> A\<rbrakk> \<Longrightarrow> f`a \<in> B(a)"
 by (blast intro: apply_Pair dest: fun_is_rel)
 
 (*This version is acceptable to the simplifier*)
 lemma apply_funtype: "\<lbrakk>f \<in> A->B;  a \<in> A\<rbrakk> \<Longrightarrow> f`a \<in> B"
 by (blast dest: apply_type)
 
 lemma apply_iff: "f \<in> Pi(A,B) \<Longrightarrow> \<langle>a,b\<rangle>: f \<longleftrightarrow> a \<in> A \<and> f`a = b"
 apply (frule fun_is_rel)
 apply (blast intro!: apply_Pair apply_equality)
 done
 
 (*Refining one Pi type to another*)
 lemma Pi_type: "\<lbrakk>f \<in> Pi(A,C);  \<And>x. x \<in> A \<Longrightarrow> f`x \<in> B(x)\<rbrakk> \<Longrightarrow> f \<in> Pi(A,B)"
 apply (simp only: Pi_iff)
 apply (blast dest: function_apply_equality)
 done
 
 (*Such functions arise in non-standard datatypes, ZF/ex/Ntree for instance*)
 lemma Pi_Collect_iff:
      "(f \<in> Pi(A, \<lambda>x. {y \<in> B(x). P(x,y)}))
       \<longleftrightarrow>  f \<in> Pi(A,B) \<and> (\<forall>x\<in>A. P(x, f`x))"
 by (blast intro: Pi_type dest: apply_type)
 
 lemma Pi_weaken_type:
         "\<lbrakk>f \<in> Pi(A,B);  \<And>x. x \<in> A \<Longrightarrow> B(x)<=C(x)\<rbrakk> \<Longrightarrow> f \<in> Pi(A,C)"
 by (blast intro: Pi_type dest: apply_type)
 
 
 (** Elimination of membership in a function **)
 
 lemma domain_type: "\<lbrakk>\<langle>a,b\<rangle> \<in> f;  f \<in> Pi(A,B)\<rbrakk> \<Longrightarrow> a \<in> A"
 by (blast dest: fun_is_rel)
 
 lemma range_type: "\<lbrakk>\<langle>a,b\<rangle> \<in> f;  f \<in> Pi(A,B)\<rbrakk> \<Longrightarrow> b \<in> B(a)"
 by (blast dest: fun_is_rel)
 
 lemma Pair_mem_PiD: "\<lbrakk>\<langle>a,b\<rangle>: f;  f \<in> Pi(A,B)\<rbrakk> \<Longrightarrow> a \<in> A \<and> b \<in> B(a) \<and> f`a = b"
 by (blast intro: domain_type range_type apply_equality)
 
 subsection\<open>Lambda Abstraction\<close>
 
 lemma lamI: "a \<in> A \<Longrightarrow> <a,b(a)> \<in> (\<lambda>x\<in>A. b(x))"
-apply (unfold lam_def)
+  unfolding lam_def
 apply (erule RepFunI)
 done
 
 lemma lamE:
     "\<lbrakk>p: (\<lambda>x\<in>A. b(x));  \<And>x.\<lbrakk>x \<in> A; p=<x,b(x)>\<rbrakk> \<Longrightarrow> P
 \<rbrakk> \<Longrightarrow>  P"
 by (simp add: lam_def, blast)
 
 lemma lamD: "\<lbrakk>\<langle>a,c\<rangle>: (\<lambda>x\<in>A. b(x))\<rbrakk> \<Longrightarrow> c = b(a)"
 by (simp add: lam_def)
 
 lemma lam_type [TC]:
     "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> b(x): B(x)\<rbrakk> \<Longrightarrow> (\<lambda>x\<in>A. b(x)) \<in> Pi(A,B)"
 by (simp add: lam_def Pi_def function_def, blast)
 
 lemma lam_funtype: "(\<lambda>x\<in>A. b(x)) \<in> A -> {b(x). x \<in> A}"
 by (blast intro: lam_type)
 
 lemma function_lam: "function (\<lambda>x\<in>A. b(x))"
 by (simp add: function_def lam_def)
 
 lemma relation_lam: "relation (\<lambda>x\<in>A. b(x))"
 by (simp add: relation_def lam_def)
 
 lemma beta_if [simp]: "(\<lambda>x\<in>A. b(x)) ` a = (if a \<in> A then b(a) else 0)"
 by (simp add: apply_def lam_def, blast)
 
 lemma beta: "a \<in> A \<Longrightarrow> (\<lambda>x\<in>A. b(x)) ` a = b(a)"
 by (simp add: apply_def lam_def, blast)
 
 lemma lam_empty [simp]: "(\<lambda>x\<in>0. b(x)) = 0"
 by (simp add: lam_def)
 
 lemma domain_lam [simp]: "domain(Lambda(A,b)) = A"
 by (simp add: lam_def, blast)
 
 (*congruence rule for lambda abstraction*)
 lemma lam_cong [cong]:
     "\<lbrakk>A=A';  \<And>x. x \<in> A' \<Longrightarrow> b(x)=b'(x)\<rbrakk> \<Longrightarrow> Lambda(A,b) = Lambda(A',b')"
 by (simp only: lam_def cong add: RepFun_cong)
 
 lemma lam_theI:
     "(\<And>x. x \<in> A \<Longrightarrow> \<exists>!y. Q(x,y)) \<Longrightarrow> \<exists>f. \<forall>x\<in>A. Q(x, f`x)"
 apply (rule_tac x = "\<lambda>x\<in>A. THE y. Q (x,y)" in exI)
 apply simp
 apply (blast intro: theI)
 done
 
 lemma lam_eqE: "\<lbrakk>(\<lambda>x\<in>A. f(x)) = (\<lambda>x\<in>A. g(x));  a \<in> A\<rbrakk> \<Longrightarrow> f(a)=g(a)"
 by (fast intro!: lamI elim: equalityE lamE)
 
 
 (*Empty function spaces*)
 lemma Pi_empty1 [simp]: "Pi(0,A) = {0}"
 by (unfold Pi_def function_def, blast)
 
 (*The singleton function*)
 lemma singleton_fun [simp]: "{\<langle>a,b\<rangle>} \<in> {a} -> {b}"
 by (unfold Pi_def function_def, blast)
 
 lemma Pi_empty2 [simp]: "(A->0) = (if A=0 then {0} else 0)"
 by (unfold Pi_def function_def, force)
 
 lemma  fun_space_empty_iff [iff]: "(A->X)=0 \<longleftrightarrow> X=0 \<and> (A \<noteq> 0)"
 apply auto
 apply (fast intro!: equals0I intro: lam_type)
 done
 
 
 subsection\<open>Extensionality\<close>
 
 (*Semi-extensionality!*)
 
 lemma fun_subset:
     "\<lbrakk>f \<in> Pi(A,B);  g \<in> Pi(C,D);  A<=C;
         \<And>x. x \<in> A \<Longrightarrow> f`x = g`x\<rbrakk> \<Longrightarrow> f<=g"
 by (force dest: Pi_memberD intro: apply_Pair)
 
 lemma fun_extension:
     "\<lbrakk>f \<in> Pi(A,B);  g \<in> Pi(A,D);
         \<And>x. x \<in> A \<Longrightarrow> f`x = g`x\<rbrakk> \<Longrightarrow> f=g"
 by (blast del: subsetI intro: subset_refl sym fun_subset)
 
 lemma eta [simp]: "f \<in> Pi(A,B) \<Longrightarrow> (\<lambda>x\<in>A. f`x) = f"
 apply (rule fun_extension)
 apply (auto simp add: lam_type apply_type beta)
 done
 
 lemma fun_extension_iff:
      "\<lbrakk>f \<in> Pi(A,B); g \<in> Pi(A,C)\<rbrakk> \<Longrightarrow> (\<forall>a\<in>A. f`a = g`a) \<longleftrightarrow> f=g"
 by (blast intro: fun_extension)
 
 (*thm by Mark Staples, proof by lcp*)
 lemma fun_subset_eq: "\<lbrakk>f \<in> Pi(A,B); g \<in> Pi(A,C)\<rbrakk> \<Longrightarrow> f \<subseteq> g \<longleftrightarrow> (f = g)"
 by (blast dest: apply_Pair
           intro: fun_extension apply_equality [symmetric])
 
 
 (*Every element of Pi(A,B) may be expressed as a lambda abstraction!*)
 lemma Pi_lamE:
   assumes major: "f \<in> Pi(A,B)"
       and minor: "\<And>b. \<lbrakk>\<forall>x\<in>A. b(x):B(x);  f = (\<lambda>x\<in>A. b(x))\<rbrakk> \<Longrightarrow> P"
   shows "P"
 apply (rule minor)
 apply (rule_tac [2] eta [symmetric])
 apply (blast intro: major apply_type)+
 done
 
 
 subsection\<open>Images of Functions\<close>
 
 lemma image_lam: "C \<subseteq> A \<Longrightarrow> (\<lambda>x\<in>A. b(x)) `` C = {b(x). x \<in> C}"
 by (unfold lam_def, blast)
 
 lemma Repfun_function_if:
      "function(f)
       \<Longrightarrow> {f`x. x \<in> C} = (if C \<subseteq> domain(f) then f``C else cons(0,f``C))"
 apply simp
 apply (intro conjI impI)
  apply (blast dest: function_apply_equality intro: function_apply_Pair)
 apply (rule equalityI)
  apply (blast intro!: function_apply_Pair apply_0)
 apply (blast dest: function_apply_equality intro: apply_0 [symmetric])
 done
 
 (*For this lemma and the next, the right-hand side could equivalently
   be written \<Union>x\<in>C. {f`x} *)
 lemma image_function:
      "\<lbrakk>function(f);  C \<subseteq> domain(f)\<rbrakk> \<Longrightarrow> f``C = {f`x. x \<in> C}"
 by (simp add: Repfun_function_if)
 
 lemma image_fun: "\<lbrakk>f \<in> Pi(A,B);  C \<subseteq> A\<rbrakk> \<Longrightarrow> f``C = {f`x. x \<in> C}"
 apply (simp add: Pi_iff)
 apply (blast intro: image_function)
 done
 
 lemma image_eq_UN:
   assumes f: "f \<in> Pi(A,B)" "C \<subseteq> A" shows "f``C = (\<Union>x\<in>C. {f ` x})"
 by (auto simp add: image_fun [OF f])
 
 lemma Pi_image_cons:
      "\<lbrakk>f \<in> Pi(A,B);  x \<in> A\<rbrakk> \<Longrightarrow> f `` cons(x,y) = cons(f`x, f``y)"
 by (blast dest: apply_equality apply_Pair)
 
 
 subsection\<open>Properties of \<^term>\<open>restrict(f,A)\<close>\<close>
 
 lemma restrict_subset: "restrict(f,A) \<subseteq> f"
 by (unfold restrict_def, blast)
 
 lemma function_restrictI:
     "function(f) \<Longrightarrow> function(restrict(f,A))"
 by (unfold restrict_def function_def, blast)
 
 lemma restrict_type2: "\<lbrakk>f \<in> Pi(C,B);  A<=C\<rbrakk> \<Longrightarrow> restrict(f,A) \<in> Pi(A,B)"
 by (simp add: Pi_iff function_def restrict_def, blast)
 
 lemma restrict: "restrict(f,A) ` a = (if a \<in> A then f`a else 0)"
 by (simp add: apply_def restrict_def, blast)
 
 lemma restrict_empty [simp]: "restrict(f,0) = 0"
 by (unfold restrict_def, simp)
 
 lemma restrict_iff: "z \<in> restrict(r,A) \<longleftrightarrow> z \<in> r \<and> (\<exists>x\<in>A. \<exists>y. z = \<langle>x, y\<rangle>)"
 by (simp add: restrict_def)
 
 lemma restrict_restrict [simp]:
      "restrict(restrict(r,A),B) = restrict(r, A \<inter> B)"
 by (unfold restrict_def, blast)
 
 lemma domain_restrict [simp]: "domain(restrict(f,C)) = domain(f) \<inter> C"
-apply (unfold restrict_def)
+  unfolding restrict_def
 apply (auto simp add: domain_def)
 done
 
 lemma restrict_idem: "f \<subseteq> Sigma(A,B) \<Longrightarrow> restrict(f,A) = f"
 by (simp add: restrict_def, blast)
 
 
 (*converse probably holds too*)
 lemma domain_restrict_idem:
      "\<lbrakk>domain(r) \<subseteq> A; relation(r)\<rbrakk> \<Longrightarrow> restrict(r,A) = r"
 by (simp add: restrict_def relation_def, blast)
 
 lemma domain_restrict_lam [simp]: "domain(restrict(Lambda(A,f),C)) = A \<inter> C"
 apply (unfold restrict_def lam_def)
 apply (rule equalityI)
 apply (auto simp add: domain_iff)
 done
 
 lemma restrict_if [simp]: "restrict(f,A) ` a = (if a \<in> A then f`a else 0)"
 by (simp add: restrict apply_0)
 
 lemma restrict_lam_eq:
     "A<=C \<Longrightarrow> restrict(\<lambda>x\<in>C. b(x), A) = (\<lambda>x\<in>A. b(x))"
 by (unfold restrict_def lam_def, auto)
 
 lemma fun_cons_restrict_eq:
      "f \<in> cons(a, b) -> B \<Longrightarrow> f = cons(<a, f ` a>, restrict(f, b))"
 apply (rule equalityI)
  prefer 2 apply (blast intro: apply_Pair restrict_subset [THEN subsetD])
 apply (auto dest!: Pi_memberD simp add: restrict_def lam_def)
 done
 
 
 subsection\<open>Unions of Functions\<close>
 
 (** The Union of a set of COMPATIBLE functions is a function **)
 
 lemma function_Union:
     "\<lbrakk>\<forall>x\<in>S. function(x);
         \<forall>x\<in>S. \<forall>y\<in>S. x<=y | y<=x\<rbrakk>
      \<Longrightarrow> function(\<Union>(S))"
 by (unfold function_def, blast)
 
 lemma fun_Union:
     "\<lbrakk>\<forall>f\<in>S. \<exists>C D. f \<in> C->D;
              \<forall>f\<in>S. \<forall>y\<in>S. f<=y | y<=f\<rbrakk> \<Longrightarrow>
           \<Union>(S) \<in> domain(\<Union>(S)) -> range(\<Union>(S))"
-apply (unfold Pi_def)
+  unfolding Pi_def
 apply (blast intro!: rel_Union function_Union)
 done
 
 lemma gen_relation_Union:
      "(\<And>f. f\<in>F \<Longrightarrow> relation(f)) \<Longrightarrow> relation(\<Union>(F))"
 by (simp add: relation_def)
 
 
 (** The Union of 2 disjoint functions is a function **)
 
 lemmas Un_rls = Un_subset_iff SUM_Un_distrib1 prod_Un_distrib2
                 subset_trans [OF _ Un_upper1]
                 subset_trans [OF _ Un_upper2]
 
 lemma fun_disjoint_Un:
      "\<lbrakk>f \<in> A->B;  g \<in> C->D;  A \<inter> C = 0\<rbrakk>
       \<Longrightarrow> (f \<union> g) \<in> (A \<union> C) -> (B \<union> D)"
 (*Prove the product and domain subgoals using distributive laws*)
 apply (simp add: Pi_iff extension Un_rls)
 apply (unfold function_def, blast)
 done
 
 lemma fun_disjoint_apply1: "a \<notin> domain(g) \<Longrightarrow> (f \<union> g)`a = f`a"
 by (simp add: apply_def, blast)
 
 lemma fun_disjoint_apply2: "c \<notin> domain(f) \<Longrightarrow> (f \<union> g)`c = g`c"
 by (simp add: apply_def, blast)
 
 subsection\<open>Domain and Range of a Function or Relation\<close>
 
 lemma domain_of_fun: "f \<in> Pi(A,B) \<Longrightarrow> domain(f)=A"
 by (unfold Pi_def, blast)
 
 lemma apply_rangeI: "\<lbrakk>f \<in> Pi(A,B);  a \<in> A\<rbrakk> \<Longrightarrow> f`a \<in> range(f)"
 by (erule apply_Pair [THEN rangeI], assumption)
 
 lemma range_of_fun: "f \<in> Pi(A,B) \<Longrightarrow> f \<in> A->range(f)"
 by (blast intro: Pi_type apply_rangeI)
 
 subsection\<open>Extensions of Functions\<close>
 
 lemma fun_extend:
      "\<lbrakk>f \<in> A->B;  c\<notin>A\<rbrakk> \<Longrightarrow> cons(\<langle>c,b\<rangle>,f) \<in> cons(c,A) -> cons(b,B)"
 apply (frule singleton_fun [THEN fun_disjoint_Un], blast)
 apply (simp add: cons_eq)
 done
 
 lemma fun_extend3:
      "\<lbrakk>f \<in> A->B;  c\<notin>A;  b \<in> B\<rbrakk> \<Longrightarrow> cons(\<langle>c,b\<rangle>,f) \<in> cons(c,A) -> B"
 by (blast intro: fun_extend [THEN fun_weaken_type])
 
 lemma extend_apply:
      "c \<notin> domain(f) \<Longrightarrow> cons(\<langle>c,b\<rangle>,f)`a = (if a=c then b else f`a)"
 by (auto simp add: apply_def)
 
 lemma fun_extend_apply [simp]:
      "\<lbrakk>f \<in> A->B;  c\<notin>A\<rbrakk> \<Longrightarrow> cons(\<langle>c,b\<rangle>,f)`a = (if a=c then b else f`a)"
 apply (rule extend_apply)
 apply (simp add: Pi_def, blast)
 done
 
 lemmas singleton_apply = apply_equality [OF singletonI singleton_fun, simp]
 
 (*For Finite.ML.  Inclusion of right into left is easy*)
 lemma cons_fun_eq:
      "c \<notin> A \<Longrightarrow> cons(c,A) -> B = (\<Union>f \<in> A->B. \<Union>b\<in>B. {cons(\<langle>c,b\<rangle>, f)})"
 apply (rule equalityI)
 apply (safe elim!: fun_extend3)
 (*Inclusion of left into right*)
 apply (subgoal_tac "restrict (x, A) \<in> A -> B")
  prefer 2 apply (blast intro: restrict_type2)
 apply (rule UN_I, assumption)
 apply (rule apply_funtype [THEN UN_I])
   apply assumption
  apply (rule consI1)
 apply (simp (no_asm))
 apply (rule fun_extension)
   apply assumption
  apply (blast intro: fun_extend)
 apply (erule consE, simp_all)
 done
 
 lemma succ_fun_eq: "succ(n) -> B = (\<Union>f \<in> n->B. \<Union>b\<in>B. {cons(\<langle>n,b\<rangle>, f)})"
 by (simp add: succ_def mem_not_refl cons_fun_eq)
 
 
 subsection\<open>Function Updates\<close>
 
 definition
   update  :: "[i,i,i] \<Rightarrow> i"  where
    "update(f,a,b) \<equiv> \<lambda>x\<in>cons(a, domain(f)). if(x=a, b, f`x)"
 
 nonterminal updbinds and updbind
 
 syntax
 
   (* Let expressions *)
 
   "_updbind"    :: "[i, i] \<Rightarrow> updbind"               (\<open>(2_ :=/ _)\<close>)
   ""            :: "updbind \<Rightarrow> updbinds"             (\<open>_\<close>)
   "_updbinds"   :: "[updbind, updbinds] \<Rightarrow> updbinds" (\<open>_,/ _\<close>)
   "_Update"     :: "[i, updbinds] \<Rightarrow> i"              (\<open>_/'((_)')\<close> [900,0] 900)
 
 translations
   "_Update (f, _updbinds(b,bs))"  == "_Update (_Update(f,b), bs)"
   "f(x:=y)"                       == "CONST update(f,x,y)"
 
 
 lemma update_apply [simp]: "f(x:=y) ` z = (if z=x then y else f`z)"
 apply (simp add: update_def)
 apply (case_tac "z \<in> domain(f)")
 apply (simp_all add: apply_0)
 done
 
 lemma update_idem: "\<lbrakk>f`x = y;  f \<in> Pi(A,B);  x \<in> A\<rbrakk> \<Longrightarrow> f(x:=y) = f"
-apply (unfold update_def)
+  unfolding update_def
 apply (simp add: domain_of_fun cons_absorb)
 apply (rule fun_extension)
 apply (best intro: apply_type if_type lam_type, assumption, simp)
 done
 
 
 (* \<lbrakk>f \<in> Pi(A, B); x \<in> A\<rbrakk> \<Longrightarrow> f(x := f`x) = f *)
 declare refl [THEN update_idem, simp]
 
 lemma domain_update [simp]: "domain(f(x:=y)) = cons(x, domain(f))"
 by (unfold update_def, simp)
 
 lemma update_type: "\<lbrakk>f \<in> Pi(A,B);  x \<in> A;  y \<in> B(x)\<rbrakk> \<Longrightarrow> f(x:=y) \<in> Pi(A, B)"
-apply (unfold update_def)
+  unfolding update_def
 apply (simp add: domain_of_fun cons_absorb apply_funtype lam_type)
 done
 
 
 subsection\<open>Monotonicity Theorems\<close>
 
 subsubsection\<open>Replacement in its Various Forms\<close>
 
 (*Not easy to express monotonicity in P, since any "bigger" predicate
   would have to be single-valued*)
 lemma Replace_mono: "A<=B \<Longrightarrow> Replace(A,P) \<subseteq> Replace(B,P)"
 by (blast elim!: ReplaceE)
 
 lemma RepFun_mono: "A<=B \<Longrightarrow> {f(x). x \<in> A} \<subseteq> {f(x). x \<in> B}"
 by blast
 
 lemma Pow_mono: "A<=B \<Longrightarrow> Pow(A) \<subseteq> Pow(B)"
 by blast
 
 lemma Union_mono: "A<=B \<Longrightarrow> \<Union>(A) \<subseteq> \<Union>(B)"
 by blast
 
 lemma UN_mono:
     "\<lbrakk>A<=C;  \<And>x. x \<in> A \<Longrightarrow> B(x)<=D(x)\<rbrakk> \<Longrightarrow> (\<Union>x\<in>A. B(x)) \<subseteq> (\<Union>x\<in>C. D(x))"
 by blast
 
 (*Intersection is ANTI-monotonic.  There are TWO premises! *)
 lemma Inter_anti_mono: "\<lbrakk>A<=B;  A\<noteq>0\<rbrakk> \<Longrightarrow> \<Inter>(B) \<subseteq> \<Inter>(A)"
 by blast
 
 lemma cons_mono: "C<=D \<Longrightarrow> cons(a,C) \<subseteq> cons(a,D)"
 by blast
 
 lemma Un_mono: "\<lbrakk>A<=C;  B<=D\<rbrakk> \<Longrightarrow> A \<union> B \<subseteq> C \<union> D"
 by blast
 
 lemma Int_mono: "\<lbrakk>A<=C;  B<=D\<rbrakk> \<Longrightarrow> A \<inter> B \<subseteq> C \<inter> D"
 by blast
 
 lemma Diff_mono: "\<lbrakk>A<=C;  D<=B\<rbrakk> \<Longrightarrow> A-B \<subseteq> C-D"
 by blast
 
 subsubsection\<open>Standard Products, Sums and Function Spaces\<close>
 
 lemma Sigma_mono [rule_format]:
      "\<lbrakk>A<=C;  \<And>x. x \<in> A \<longrightarrow> B(x) \<subseteq> D(x)\<rbrakk> \<Longrightarrow> Sigma(A,B) \<subseteq> Sigma(C,D)"
 by blast
 
 lemma sum_mono: "\<lbrakk>A<=C;  B<=D\<rbrakk> \<Longrightarrow> A+B \<subseteq> C+D"
 by (unfold sum_def, blast)
 
 (*Note that B->A and C->A are typically disjoint!*)
 lemma Pi_mono: "B<=C \<Longrightarrow> A->B \<subseteq> A->C"
 by (blast intro: lam_type elim: Pi_lamE)
 
 lemma lam_mono: "A<=B \<Longrightarrow> Lambda(A,c) \<subseteq> Lambda(B,c)"
-apply (unfold lam_def)
+  unfolding lam_def
 apply (erule RepFun_mono)
 done
 
 subsubsection\<open>Converse, Domain, Range, Field\<close>
 
 lemma converse_mono: "r<=s \<Longrightarrow> converse(r) \<subseteq> converse(s)"
 by blast
 
 lemma domain_mono: "r<=s \<Longrightarrow> domain(r)<=domain(s)"
 by blast
 
 lemmas domain_rel_subset = subset_trans [OF domain_mono domain_subset]
 
 lemma range_mono: "r<=s \<Longrightarrow> range(r)<=range(s)"
 by blast
 
 lemmas range_rel_subset = subset_trans [OF range_mono range_subset]
 
 lemma field_mono: "r<=s \<Longrightarrow> field(r)<=field(s)"
 by blast
 
 lemma field_rel_subset: "r \<subseteq> A*A \<Longrightarrow> field(r) \<subseteq> A"
 by (erule field_mono [THEN subset_trans], blast)
 
 
 subsubsection\<open>Images\<close>
 
 lemma image_pair_mono:
     "\<lbrakk>\<And>x y. \<langle>x,y\<rangle>:r \<Longrightarrow> \<langle>x,y\<rangle>:s;  A<=B\<rbrakk> \<Longrightarrow> r``A \<subseteq> s``B"
 by blast
 
 lemma vimage_pair_mono:
     "\<lbrakk>\<And>x y. \<langle>x,y\<rangle>:r \<Longrightarrow> \<langle>x,y\<rangle>:s;  A<=B\<rbrakk> \<Longrightarrow> r-``A \<subseteq> s-``B"
 by blast
 
 lemma image_mono: "\<lbrakk>r<=s;  A<=B\<rbrakk> \<Longrightarrow> r``A \<subseteq> s``B"
 by blast
 
 lemma vimage_mono: "\<lbrakk>r<=s;  A<=B\<rbrakk> \<Longrightarrow> r-``A \<subseteq> s-``B"
 by blast
 
 lemma Collect_mono:
     "\<lbrakk>A<=B;  \<And>x. x \<in> A \<Longrightarrow> P(x) \<longrightarrow> Q(x)\<rbrakk> \<Longrightarrow> Collect(A,P) \<subseteq> Collect(B,Q)"
 by blast
 
 (*Used in intr_elim.ML and in individual datatype definitions*)
 lemmas basic_monos = subset_refl imp_refl disj_mono conj_mono ex_mono
                      Collect_mono Part_mono in_mono
 
 (* Useful with simp; contributed by Clemens Ballarin. *)
 
 lemma bex_image_simp:
   "\<lbrakk>f \<in> Pi(X, Y); A \<subseteq> X\<rbrakk>  \<Longrightarrow> (\<exists>x\<in>f``A. P(x)) \<longleftrightarrow> (\<exists>x\<in>A. P(f`x))"
   apply safe
    apply rule
     prefer 2 apply assumption
    apply (simp add: apply_equality)
   apply (blast intro: apply_Pair)
   done
 
 lemma ball_image_simp:
   "\<lbrakk>f \<in> Pi(X, Y); A \<subseteq> X\<rbrakk>  \<Longrightarrow> (\<forall>x\<in>f``A. P(x)) \<longleftrightarrow> (\<forall>x\<in>A. P(f`x))"
   apply safe
    apply (blast intro: apply_Pair)
   apply (drule bspec) apply assumption
   apply (simp add: apply_equality)
   done
 
 end
diff --git a/src/ZF/pair.thy b/src/ZF/pair.thy
--- a/src/ZF/pair.thy
+++ b/src/ZF/pair.thy
@@ -1,185 +1,185 @@
 (*  Title:      ZF/pair.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1992  University of Cambridge
 *)
 
 section\<open>Ordered Pairs\<close>
 
 theory pair imports upair
 begin
 
 ML_file \<open>simpdata.ML\<close>
 
 setup \<open>
   map_theory_simpset
     (Simplifier.set_mksimps (fn ctxt => map mk_eq o ZF_atomize o Variable.gen_all ctxt)
       #> Simplifier.add_cong @{thm if_weak_cong})
 \<close>
 
 ML \<open>val ZF_ss = simpset_of \<^context>\<close>
 
 simproc_setup defined_Bex ("\<exists>x\<in>A. P(x) \<and> Q(x)") = \<open>
   fn _ => Quantifier1.rearrange_Bex
     (fn ctxt => unfold_tac ctxt @{thms Bex_def})
 \<close>
 
 simproc_setup defined_Ball ("\<forall>x\<in>A. P(x) \<longrightarrow> Q(x)") = \<open>
   fn _ => Quantifier1.rearrange_Ball
     (fn ctxt => unfold_tac ctxt @{thms Ball_def})
 \<close>
 
 
 (** Lemmas for showing that \<langle>a,b\<rangle> uniquely determines a and b **)
 
 lemma singleton_eq_iff [iff]: "{a} = {b} \<longleftrightarrow> a=b"
 by (rule extension [THEN iff_trans], blast)
 
 lemma doubleton_eq_iff: "{a,b} = {c,d} \<longleftrightarrow> (a=c \<and> b=d) | (a=d \<and> b=c)"
 by (rule extension [THEN iff_trans], blast)
 
 lemma Pair_iff [simp]: "\<langle>a,b\<rangle> = \<langle>c,d\<rangle> \<longleftrightarrow> a=c \<and> b=d"
 by (simp add: Pair_def doubleton_eq_iff, blast)
 
 lemmas Pair_inject = Pair_iff [THEN iffD1, THEN conjE, elim!]
 
 lemmas Pair_inject1 = Pair_iff [THEN iffD1, THEN conjunct1]
 lemmas Pair_inject2 = Pair_iff [THEN iffD1, THEN conjunct2]
 
 lemma Pair_not_0: "\<langle>a,b\<rangle> \<noteq> 0"
-apply (unfold Pair_def)
+  unfolding Pair_def
 apply (blast elim: equalityE)
 done
 
 lemmas Pair_neq_0 = Pair_not_0 [THEN notE, elim!]
 
 declare sym [THEN Pair_neq_0, elim!]
 
 lemma Pair_neq_fst: "\<langle>a,b\<rangle>=a \<Longrightarrow> P"
 proof (unfold Pair_def)
   assume eq: "{{a, a}, {a, b}} = a"
   have  "{a, a} \<in> {{a, a}, {a, b}}" by (rule consI1)
   hence "{a, a} \<in> a" by (simp add: eq)
   moreover have "a \<in> {a, a}" by (rule consI1)
   ultimately show "P" by (rule mem_asym)
 qed
 
 lemma Pair_neq_snd: "\<langle>a,b\<rangle>=b \<Longrightarrow> P"
 proof (unfold Pair_def)
   assume eq: "{{a, a}, {a, b}} = b"
   have  "{a, b} \<in> {{a, a}, {a, b}}" by blast
   hence "{a, b} \<in> b" by (simp add: eq)
   moreover have "b \<in> {a, b}" by blast
   ultimately show "P" by (rule mem_asym)
 qed
 
 
 subsection\<open>Sigma: Disjoint Union of a Family of Sets\<close>
 
 text\<open>Generalizes Cartesian product\<close>
 
 lemma Sigma_iff [simp]: "\<langle>a,b\<rangle>: Sigma(A,B) \<longleftrightarrow> a \<in> A \<and> b \<in> B(a)"
 by (simp add: Sigma_def)
 
 lemma SigmaI [TC,intro!]: "\<lbrakk>a \<in> A;  b \<in> B(a)\<rbrakk> \<Longrightarrow> \<langle>a,b\<rangle> \<in> Sigma(A,B)"
 by simp
 
 lemmas SigmaD1 = Sigma_iff [THEN iffD1, THEN conjunct1]
 lemmas SigmaD2 = Sigma_iff [THEN iffD1, THEN conjunct2]
 
 (*The general elimination rule*)
 lemma SigmaE [elim!]:
     "\<lbrakk>c \<in> Sigma(A,B);
         \<And>x y.\<lbrakk>x \<in> A;  y \<in> B(x);  c=\<langle>x,y\<rangle>\<rbrakk> \<Longrightarrow> P
 \<rbrakk> \<Longrightarrow> P"
 by (unfold Sigma_def, blast)
 
 lemma SigmaE2 [elim!]:
     "\<lbrakk>\<langle>a,b\<rangle> \<in> Sigma(A,B);
         \<lbrakk>a \<in> A;  b \<in> B(a)\<rbrakk> \<Longrightarrow> P
 \<rbrakk> \<Longrightarrow> P"
 by (unfold Sigma_def, blast)
 
 lemma Sigma_cong:
     "\<lbrakk>A=A';  \<And>x. x \<in> A' \<Longrightarrow> B(x)=B'(x)\<rbrakk> \<Longrightarrow>
      Sigma(A,B) = Sigma(A',B')"
 by (simp add: Sigma_def)
 
 (*Sigma_cong, Pi_cong NOT given to Addcongs: they cause
   flex-flex pairs and the "Check your prover" error.  Most
   Sigmas and Pis are abbreviated as * or -> *)
 
 lemma Sigma_empty1 [simp]: "Sigma(0,B) = 0"
 by blast
 
 lemma Sigma_empty2 [simp]: "A*0 = 0"
 by blast
 
 lemma Sigma_empty_iff: "A*B=0 \<longleftrightarrow> A=0 | B=0"
 by blast
 
 
 subsection\<open>Projections \<^term>\<open>fst\<close> and \<^term>\<open>snd\<close>\<close>
 
 lemma fst_conv [simp]: "fst(\<langle>a,b\<rangle>) = a"
 by (simp add: fst_def)
 
 lemma snd_conv [simp]: "snd(\<langle>a,b\<rangle>) = b"
 by (simp add: snd_def)
 
 lemma fst_type [TC]: "p \<in> Sigma(A,B) \<Longrightarrow> fst(p) \<in> A"
 by auto
 
 lemma snd_type [TC]: "p \<in> Sigma(A,B) \<Longrightarrow> snd(p) \<in> B(fst(p))"
 by auto
 
 lemma Pair_fst_snd_eq: "a \<in> Sigma(A,B) \<Longrightarrow> <fst(a),snd(a)> = a"
 by auto
 
 
 subsection\<open>The Eliminator, \<^term>\<open>split\<close>\<close>
 
 (*A META-equality, so that it applies to higher types as well...*)
 lemma split [simp]: "split(\<lambda>x y. c(x,y), \<langle>a,b\<rangle>) \<equiv> c(a,b)"
 by (simp add: split_def)
 
 lemma split_type [TC]:
     "\<lbrakk>p \<in> Sigma(A,B);
          \<And>x y.\<lbrakk>x \<in> A; y \<in> B(x)\<rbrakk> \<Longrightarrow> c(x,y):C(\<langle>x,y\<rangle>)
 \<rbrakk> \<Longrightarrow> split(\<lambda>x y. c(x,y), p) \<in> C(p)"
 by (erule SigmaE, auto)
 
 lemma expand_split:
   "u \<in> A*B \<Longrightarrow>
         R(split(c,u)) \<longleftrightarrow> (\<forall>x\<in>A. \<forall>y\<in>B. u = \<langle>x,y\<rangle> \<longrightarrow> R(c(x,y)))"
 by (auto simp add: split_def)
 
 
 subsection\<open>A version of \<^term>\<open>split\<close> for Formulae: Result Type \<^typ>\<open>o\<close>\<close>
 
 lemma splitI: "R(a,b) \<Longrightarrow> split(R, \<langle>a,b\<rangle>)"
 by (simp add: split_def)
 
 lemma splitE:
     "\<lbrakk>split(R,z);  z \<in> Sigma(A,B);
         \<And>x y. \<lbrakk>z = \<langle>x,y\<rangle>;  R(x,y)\<rbrakk> \<Longrightarrow> P
 \<rbrakk> \<Longrightarrow> P"
 by (auto simp add: split_def)
 
 lemma splitD: "split(R,\<langle>a,b\<rangle>) \<Longrightarrow> R(a,b)"
 by (simp add: split_def)
 
 text \<open>
   \bigskip Complex rules for Sigma.
 \<close>
 
 lemma split_paired_Bex_Sigma [simp]:
      "(\<exists>z \<in> Sigma(A,B). P(z)) \<longleftrightarrow> (\<exists>x \<in> A. \<exists>y \<in> B(x). P(\<langle>x,y\<rangle>))"
 by blast
 
 lemma split_paired_Ball_Sigma [simp]:
      "(\<forall>z \<in> Sigma(A,B). P(z)) \<longleftrightarrow> (\<forall>x \<in> A. \<forall>y \<in> B(x). P(\<langle>x,y\<rangle>))"
 by blast
 
 end
 
 
diff --git a/src/ZF/upair.thy b/src/ZF/upair.thy
--- a/src/ZF/upair.thy
+++ b/src/ZF/upair.thy
@@ -1,528 +1,528 @@
 (*  Title:      ZF/upair.thy
     Author:     Lawrence C Paulson and Martin D Coen, CU Computer Laboratory
     Copyright   1993  University of Cambridge
 
 Observe the order of dependence:
     Upair is defined in terms of Replace
     \<union> is defined in terms of Upair and \<Union>(similarly for Int)
     cons is defined in terms of Upair and Un
     Ordered pairs and descriptions are defined using cons ("set notation")
 *)
 
 section\<open>Unordered Pairs\<close>
 
 theory upair
 imports ZF_Base
 keywords "print_tcset" :: diag
 begin
 
 ML_file \<open>Tools/typechk.ML\<close>
 
 lemma atomize_ball [symmetric, rulify]:
      "(\<And>x. x \<in> A \<Longrightarrow> P(x)) \<equiv> Trueprop (\<forall>x\<in>A. P(x))"
 by (simp add: Ball_def atomize_all atomize_imp)
 
 
 subsection\<open>Unordered Pairs: constant \<^term>\<open>Upair\<close>\<close>
 
 lemma Upair_iff [simp]: "c \<in> Upair(a,b) \<longleftrightarrow> (c=a | c=b)"
 by (unfold Upair_def, blast)
 
 lemma UpairI1: "a \<in> Upair(a,b)"
 by simp
 
 lemma UpairI2: "b \<in> Upair(a,b)"
 by simp
 
 lemma UpairE: "\<lbrakk>a \<in> Upair(b,c);  a=b \<Longrightarrow> P;  a=c \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (simp, blast)
 
 subsection\<open>Rules for Binary Union, Defined via \<^term>\<open>Upair\<close>\<close>
 
 lemma Un_iff [simp]: "c \<in> A \<union> B \<longleftrightarrow> (c \<in> A | c \<in> B)"
 apply (simp add: Un_def)
 apply (blast intro: UpairI1 UpairI2 elim: UpairE)
 done
 
 lemma UnI1: "c \<in> A \<Longrightarrow> c \<in> A \<union> B"
 by simp
 
 lemma UnI2: "c \<in> B \<Longrightarrow> c \<in> A \<union> B"
 by simp
 
 declare UnI1 [elim?]  UnI2 [elim?]
 
 lemma UnE [elim!]: "\<lbrakk>c \<in> A \<union> B;  c \<in> A \<Longrightarrow> P;  c \<in> B \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (simp, blast)
 
 (*Stronger version of the rule above*)
 lemma UnE': "\<lbrakk>c \<in> A \<union> B;  c \<in> A \<Longrightarrow> P;  \<lbrakk>c \<in> B;  c\<notin>A\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (simp, blast)
 
 (*Classical introduction rule: no commitment to A vs B*)
 lemma UnCI [intro!]: "(c \<notin> B \<Longrightarrow> c \<in> A) \<Longrightarrow> c \<in> A \<union> B"
 by (simp, blast)
 
 subsection\<open>Rules for Binary Intersection, Defined via \<^term>\<open>Upair\<close>\<close>
 
 lemma Int_iff [simp]: "c \<in> A \<inter> B \<longleftrightarrow> (c \<in> A \<and> c \<in> B)"
-apply (unfold Int_def)
+  unfolding Int_def
 apply (blast intro: UpairI1 UpairI2 elim: UpairE)
 done
 
 lemma IntI [intro!]: "\<lbrakk>c \<in> A;  c \<in> B\<rbrakk> \<Longrightarrow> c \<in> A \<inter> B"
 by simp
 
 lemma IntD1: "c \<in> A \<inter> B \<Longrightarrow> c \<in> A"
 by simp
 
 lemma IntD2: "c \<in> A \<inter> B \<Longrightarrow> c \<in> B"
 by simp
 
 lemma IntE [elim!]: "\<lbrakk>c \<in> A \<inter> B;  \<lbrakk>c \<in> A; c \<in> B\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by simp
 
 
 subsection\<open>Rules for Set Difference, Defined via \<^term>\<open>Upair\<close>\<close>
 
 lemma Diff_iff [simp]: "c \<in> A-B \<longleftrightarrow> (c \<in> A \<and> c\<notin>B)"
 by (unfold Diff_def, blast)
 
 lemma DiffI [intro!]: "\<lbrakk>c \<in> A;  c \<notin> B\<rbrakk> \<Longrightarrow> c \<in> A - B"
 by simp
 
 lemma DiffD1: "c \<in> A - B \<Longrightarrow> c \<in> A"
 by simp
 
 lemma DiffD2: "c \<in> A - B \<Longrightarrow> c \<notin> B"
 by simp
 
 lemma DiffE [elim!]: "\<lbrakk>c \<in> A - B;  \<lbrakk>c \<in> A; c\<notin>B\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by simp
 
 
 subsection\<open>Rules for \<^term>\<open>cons\<close>\<close>
 
 lemma cons_iff [simp]: "a \<in> cons(b,A) \<longleftrightarrow> (a=b | a \<in> A)"
-apply (unfold cons_def)
+  unfolding cons_def
 apply (blast intro: UpairI1 UpairI2 elim: UpairE)
 done
 
 (*risky as a typechecking rule, but solves otherwise unconstrained goals of
 the form x \<in> ?A*)
 lemma consI1 [simp,TC]: "a \<in> cons(a,B)"
 by simp
 
 
 lemma consI2: "a \<in> B \<Longrightarrow> a \<in> cons(b,B)"
 by simp
 
 lemma consE [elim!]: "\<lbrakk>a \<in> cons(b,A);  a=b \<Longrightarrow> P;  a \<in> A \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (simp, blast)
 
 (*Stronger version of the rule above*)
 lemma consE':
     "\<lbrakk>a \<in> cons(b,A);  a=b \<Longrightarrow> P;  \<lbrakk>a \<in> A;  a\<noteq>b\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 by (simp, blast)
 
 (*Classical introduction rule*)
 lemma consCI [intro!]: "(a\<notin>B \<Longrightarrow> a=b) \<Longrightarrow> a \<in> cons(b,B)"
 by (simp, blast)
 
 lemma cons_not_0 [simp]: "cons(a,B) \<noteq> 0"
 by (blast elim: equalityE)
 
 lemmas cons_neq_0 = cons_not_0 [THEN notE]
 
 declare cons_not_0 [THEN not_sym, simp]
 
 
 subsection\<open>Singletons\<close>
 
 lemma singleton_iff: "a \<in> {b} \<longleftrightarrow> a=b"
 by simp
 
 lemma singletonI [intro!]: "a \<in> {a}"
 by (rule consI1)
 
 lemmas singletonE = singleton_iff [THEN iffD1, elim_format, elim!]
 
 
 subsection\<open>Descriptions\<close>
 
 lemma the_equality [intro]:
     "\<lbrakk>P(a);  \<And>x. P(x) \<Longrightarrow> x=a\<rbrakk> \<Longrightarrow> (THE x. P(x)) = a"
-apply (unfold the_def)
+  unfolding the_def
 apply (fast dest: subst)
 done
 
 (* Only use this if you already know \<exists>!x. P(x) *)
 lemma the_equality2: "\<lbrakk>\<exists>!x. P(x);  P(a)\<rbrakk> \<Longrightarrow> (THE x. P(x)) = a"
 by blast
 
 lemma theI: "\<exists>!x. P(x) \<Longrightarrow> P(THE x. P(x))"
 apply (erule ex1E)
 apply (subst the_equality)
 apply (blast+)
 done
 
 (*No congruence rule is necessary: if @{term"\<forall>y.P(y)\<longleftrightarrow>Q(y)"} then
   @{term "THE x.P(x)"}  rewrites to @{term "THE x.Q(x)"} *)
 
 (*If it's "undefined", it's zero!*)
 lemma the_0: "\<not> (\<exists>!x. P(x)) \<Longrightarrow> (THE x. P(x))=0"
-apply (unfold the_def)
+  unfolding the_def
 apply (blast elim!: ReplaceE)
 done
 
 (*Easier to apply than theI: conclusion has only one occurrence of P*)
 lemma theI2:
     assumes p1: "\<not> Q(0) \<Longrightarrow> \<exists>!x. P(x)"
         and p2: "\<And>x. P(x) \<Longrightarrow> Q(x)"
     shows "Q(THE x. P(x))"
 apply (rule classical)
 apply (rule p2)
 apply (rule theI)
 apply (rule classical)
 apply (rule p1)
 apply (erule the_0 [THEN subst], assumption)
 done
 
 lemma the_eq_trivial [simp]: "(THE x. x = a) = a"
 by blast
 
 lemma the_eq_trivial2 [simp]: "(THE x. a = x) = a"
 by blast
 
 
 subsection\<open>Conditional Terms: \<open>if-then-else\<close>\<close>
 
 lemma if_true [simp]: "(if True then a else b) = a"
 by (unfold if_def, blast)
 
 lemma if_false [simp]: "(if False then a else b) = b"
 by (unfold if_def, blast)
 
 (*Never use with case splitting, or if P is known to be true or false*)
 lemma if_cong:
     "\<lbrakk>P\<longleftrightarrow>Q;  Q \<Longrightarrow> a=c;  \<not>Q \<Longrightarrow> b=d\<rbrakk>
      \<Longrightarrow> (if P then a else b) = (if Q then c else d)"
 by (simp add: if_def cong add: conj_cong)
 
 (*Prevents simplification of x and y \<in> faster and allows the execution
   of functional programs. NOW THE DEFAULT.*)
 lemma if_weak_cong: "P\<longleftrightarrow>Q \<Longrightarrow> (if P then x else y) = (if Q then x else y)"
 by simp
 
 (*Not needed for rewriting, since P would rewrite to True anyway*)
 lemma if_P: "P \<Longrightarrow> (if P then a else b) = a"
 by (unfold if_def, blast)
 
 (*Not needed for rewriting, since P would rewrite to False anyway*)
 lemma if_not_P: "\<not>P \<Longrightarrow> (if P then a else b) = b"
 by (unfold if_def, blast)
 
 lemma split_if [split]:
      "P(if Q then x else y) \<longleftrightarrow> ((Q \<longrightarrow> P(x)) \<and> (\<not>Q \<longrightarrow> P(y)))"
 by (case_tac Q, simp_all)
 
 (** Rewrite rules for boolean case-splitting: faster than split_if [split]
 **)
 
 lemmas split_if_eq1 = split_if [of "\<lambda>x. x = b"] for b
 lemmas split_if_eq2 = split_if [of "\<lambda>x. a = x"] for a
 
 lemmas split_if_mem1 = split_if [of "\<lambda>x. x \<in> b"] for b
 lemmas split_if_mem2 = split_if [of "\<lambda>x. a \<in> x"] for a
 
 lemmas split_ifs = split_if_eq1 split_if_eq2 split_if_mem1 split_if_mem2
 
 (*Logically equivalent to split_if_mem2*)
 lemma if_iff: "a: (if P then x else y) \<longleftrightarrow> P \<and> a \<in> x | \<not>P \<and> a \<in> y"
 by simp
 
 lemma if_type [TC]:
     "\<lbrakk>P \<Longrightarrow> a \<in> A;  \<not>P \<Longrightarrow> b \<in> A\<rbrakk> \<Longrightarrow> (if P then a else b): A"
 by simp
 
 (** Splitting IFs in the assumptions **)
 
 lemma split_if_asm: "P(if Q then x else y) \<longleftrightarrow> (\<not>((Q \<and> \<not>P(x)) | (\<not>Q \<and> \<not>P(y))))"
 by simp
 
 lemmas if_splits = split_if split_if_asm
 
 
 subsection\<open>Consequences of Foundation\<close>
 
 (*was called mem_anti_sym*)
 lemma mem_asym: "\<lbrakk>a \<in> b;  \<not>P \<Longrightarrow> b \<in> a\<rbrakk> \<Longrightarrow> P"
 apply (rule classical)
 apply (rule_tac A1 = "{a,b}" in foundation [THEN disjE])
 apply (blast elim!: equalityE)+
 done
 
 (*was called mem_anti_refl*)
 lemma mem_irrefl: "a \<in> a \<Longrightarrow> P"
 by (blast intro: mem_asym)
 
 (*mem_irrefl should NOT be added to default databases:
       it would be tried on most goals, making proofs slower!*)
 
 lemma mem_not_refl: "a \<notin> a"
 apply (rule notI)
 apply (erule mem_irrefl)
 done
 
 (*Good for proving inequalities by rewriting*)
 lemma mem_imp_not_eq: "a \<in> A \<Longrightarrow> a \<noteq> A"
 by (blast elim!: mem_irrefl)
 
 lemma eq_imp_not_mem: "a=A \<Longrightarrow> a \<notin> A"
 by (blast intro: elim: mem_irrefl)
 
 subsection\<open>Rules for Successor\<close>
 
 lemma succ_iff: "i \<in> succ(j) \<longleftrightarrow> i=j | i \<in> j"
 by (unfold succ_def, blast)
 
 lemma succI1 [simp]: "i \<in> succ(i)"
 by (simp add: succ_iff)
 
 lemma succI2: "i \<in> j \<Longrightarrow> i \<in> succ(j)"
 by (simp add: succ_iff)
 
 lemma succE [elim!]:
     "\<lbrakk>i \<in> succ(j);  i=j \<Longrightarrow> P;  i \<in> j \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
 apply (simp add: succ_iff, blast)
 done
 
 (*Classical introduction rule*)
 lemma succCI [intro!]: "(i\<notin>j \<Longrightarrow> i=j) \<Longrightarrow> i \<in> succ(j)"
 by (simp add: succ_iff, blast)
 
 lemma succ_not_0 [simp]: "succ(n) \<noteq> 0"
 by (blast elim!: equalityE)
 
 lemmas succ_neq_0 = succ_not_0 [THEN notE, elim!]
 
 declare succ_not_0 [THEN not_sym, simp]
 declare sym [THEN succ_neq_0, elim!]
 
 (* @{term"succ(c) \<subseteq> B \<Longrightarrow> c \<in> B"} *)
 lemmas succ_subsetD = succI1 [THEN [2] subsetD]
 
 (* @{term"succ(b) \<noteq> b"} *)
 lemmas succ_neq_self = succI1 [THEN mem_imp_not_eq, THEN not_sym]
 
 lemma succ_inject_iff [simp]: "succ(m) = succ(n) \<longleftrightarrow> m=n"
 by (blast elim: mem_asym elim!: equalityE)
 
 lemmas succ_inject = succ_inject_iff [THEN iffD1, dest!]
 
 
 subsection\<open>Miniscoping of the Bounded Universal Quantifier\<close>
 
 lemma ball_simps1:
      "(\<forall>x\<in>A. P(x) \<and> Q)   \<longleftrightarrow> (\<forall>x\<in>A. P(x)) \<and> (A=0 | Q)"
      "(\<forall>x\<in>A. P(x) | Q)   \<longleftrightarrow> ((\<forall>x\<in>A. P(x)) | Q)"
      "(\<forall>x\<in>A. P(x) \<longrightarrow> Q) \<longleftrightarrow> ((\<exists>x\<in>A. P(x)) \<longrightarrow> Q)"
      "(\<not>(\<forall>x\<in>A. P(x))) \<longleftrightarrow> (\<exists>x\<in>A. \<not>P(x))"
      "(\<forall>x\<in>0.P(x)) \<longleftrightarrow> True"
      "(\<forall>x\<in>succ(i).P(x)) \<longleftrightarrow> P(i) \<and> (\<forall>x\<in>i. P(x))"
      "(\<forall>x\<in>cons(a,B).P(x)) \<longleftrightarrow> P(a) \<and> (\<forall>x\<in>B. P(x))"
      "(\<forall>x\<in>RepFun(A,f). P(x)) \<longleftrightarrow> (\<forall>y\<in>A. P(f(y)))"
      "(\<forall>x\<in>\<Union>(A).P(x)) \<longleftrightarrow> (\<forall>y\<in>A. \<forall>x\<in>y. P(x))"
 by blast+
 
 lemma ball_simps2:
      "(\<forall>x\<in>A. P \<and> Q(x))   \<longleftrightarrow> (A=0 | P) \<and> (\<forall>x\<in>A. Q(x))"
      "(\<forall>x\<in>A. P | Q(x))   \<longleftrightarrow> (P | (\<forall>x\<in>A. Q(x)))"
      "(\<forall>x\<in>A. P \<longrightarrow> Q(x)) \<longleftrightarrow> (P \<longrightarrow> (\<forall>x\<in>A. Q(x)))"
 by blast+
 
 lemma ball_simps3:
      "(\<forall>x\<in>Collect(A,Q).P(x)) \<longleftrightarrow> (\<forall>x\<in>A. Q(x) \<longrightarrow> P(x))"
 by blast+
 
 lemmas ball_simps [simp] = ball_simps1 ball_simps2 ball_simps3
 
 lemma ball_conj_distrib:
     "(\<forall>x\<in>A. P(x) \<and> Q(x)) \<longleftrightarrow> ((\<forall>x\<in>A. P(x)) \<and> (\<forall>x\<in>A. Q(x)))"
 by blast
 
 
 subsection\<open>Miniscoping of the Bounded Existential Quantifier\<close>
 
 lemma bex_simps1:
      "(\<exists>x\<in>A. P(x) \<and> Q) \<longleftrightarrow> ((\<exists>x\<in>A. P(x)) \<and> Q)"
      "(\<exists>x\<in>A. P(x) | Q) \<longleftrightarrow> (\<exists>x\<in>A. P(x)) | (A\<noteq>0 \<and> Q)"
      "(\<exists>x\<in>A. P(x) \<longrightarrow> Q) \<longleftrightarrow> ((\<forall>x\<in>A. P(x)) \<longrightarrow> (A\<noteq>0 \<and> Q))"
      "(\<exists>x\<in>0.P(x)) \<longleftrightarrow> False"
      "(\<exists>x\<in>succ(i).P(x)) \<longleftrightarrow> P(i) | (\<exists>x\<in>i. P(x))"
      "(\<exists>x\<in>cons(a,B).P(x)) \<longleftrightarrow> P(a) | (\<exists>x\<in>B. P(x))"
      "(\<exists>x\<in>RepFun(A,f). P(x)) \<longleftrightarrow> (\<exists>y\<in>A. P(f(y)))"
      "(\<exists>x\<in>\<Union>(A).P(x)) \<longleftrightarrow> (\<exists>y\<in>A. \<exists>x\<in>y.  P(x))"
      "(\<not>(\<exists>x\<in>A. P(x))) \<longleftrightarrow> (\<forall>x\<in>A. \<not>P(x))"
 by blast+
 
 lemma bex_simps2:
      "(\<exists>x\<in>A. P \<and> Q(x)) \<longleftrightarrow> (P \<and> (\<exists>x\<in>A. Q(x)))"
      "(\<exists>x\<in>A. P | Q(x)) \<longleftrightarrow> (A\<noteq>0 \<and> P) | (\<exists>x\<in>A. Q(x))"
      "(\<exists>x\<in>A. P \<longrightarrow> Q(x)) \<longleftrightarrow> ((A=0 | P) \<longrightarrow> (\<exists>x\<in>A. Q(x)))"
 by blast+
 
 lemma bex_simps3:
      "(\<exists>x\<in>Collect(A,Q).P(x)) \<longleftrightarrow> (\<exists>x\<in>A. Q(x) \<and> P(x))"
 by blast
 
 lemmas bex_simps [simp] = bex_simps1 bex_simps2 bex_simps3
 
 lemma bex_disj_distrib:
     "(\<exists>x\<in>A. P(x) | Q(x)) \<longleftrightarrow> ((\<exists>x\<in>A. P(x)) | (\<exists>x\<in>A. Q(x)))"
 by blast
 
 
 (** One-point rule for bounded quantifiers: see HOL/Set.ML **)
 
 lemma bex_triv_one_point1 [simp]: "(\<exists>x\<in>A. x=a) \<longleftrightarrow> (a \<in> A)"
 by blast
 
 lemma bex_triv_one_point2 [simp]: "(\<exists>x\<in>A. a=x) \<longleftrightarrow> (a \<in> A)"
 by blast
 
 lemma bex_one_point1 [simp]: "(\<exists>x\<in>A. x=a \<and> P(x)) \<longleftrightarrow> (a \<in> A \<and> P(a))"
 by blast
 
 lemma bex_one_point2 [simp]: "(\<exists>x\<in>A. a=x \<and> P(x)) \<longleftrightarrow> (a \<in> A \<and> P(a))"
 by blast
 
 lemma ball_one_point1 [simp]: "(\<forall>x\<in>A. x=a \<longrightarrow> P(x)) \<longleftrightarrow> (a \<in> A \<longrightarrow> P(a))"
 by blast
 
 lemma ball_one_point2 [simp]: "(\<forall>x\<in>A. a=x \<longrightarrow> P(x)) \<longleftrightarrow> (a \<in> A \<longrightarrow> P(a))"
 by blast
 
 
 subsection\<open>Miniscoping of the Replacement Operator\<close>
 
 text\<open>These cover both \<^term>\<open>Replace\<close> and \<^term>\<open>Collect\<close>\<close>
 lemma Rep_simps [simp]:
      "{x. y \<in> 0, R(x,y)} = 0"
      "{x \<in> 0. P(x)} = 0"
      "{x \<in> A. Q} = (if Q then A else 0)"
      "RepFun(0,f) = 0"
      "RepFun(succ(i),f) = cons(f(i), RepFun(i,f))"
      "RepFun(cons(a,B),f) = cons(f(a), RepFun(B,f))"
 by (simp_all, blast+)
 
 
 subsection\<open>Miniscoping of Unions\<close>
 
 lemma UN_simps1:
      "(\<Union>x\<in>C. cons(a, B(x))) = (if C=0 then 0 else cons(a, \<Union>x\<in>C. B(x)))"
      "(\<Union>x\<in>C. A(x) \<union> B')   = (if C=0 then 0 else (\<Union>x\<in>C. A(x)) \<union> B')"
      "(\<Union>x\<in>C. A' \<union> B(x))   = (if C=0 then 0 else A' \<union> (\<Union>x\<in>C. B(x)))"
      "(\<Union>x\<in>C. A(x) \<inter> B')  = ((\<Union>x\<in>C. A(x)) \<inter> B')"
      "(\<Union>x\<in>C. A' \<inter> B(x))  = (A' \<inter> (\<Union>x\<in>C. B(x)))"
      "(\<Union>x\<in>C. A(x) - B')    = ((\<Union>x\<in>C. A(x)) - B')"
      "(\<Union>x\<in>C. A' - B(x))    = (if C=0 then 0 else A' - (\<Inter>x\<in>C. B(x)))"
 apply (simp_all add: Inter_def)
 apply (blast intro!: equalityI )+
 done
 
 lemma UN_simps2:
       "(\<Union>x\<in>\<Union>(A). B(x)) = (\<Union>y\<in>A. \<Union>x\<in>y. B(x))"
       "(\<Union>z\<in>(\<Union>x\<in>A. B(x)). C(z)) = (\<Union>x\<in>A. \<Union>z\<in>B(x). C(z))"
       "(\<Union>x\<in>RepFun(A,f). B(x))     = (\<Union>a\<in>A. B(f(a)))"
 by blast+
 
 lemmas UN_simps [simp] = UN_simps1 UN_simps2
 
 text\<open>Opposite of miniscoping: pull the operator out\<close>
 
 lemma UN_extend_simps1:
      "(\<Union>x\<in>C. A(x)) \<union> B   = (if C=0 then B else (\<Union>x\<in>C. A(x) \<union> B))"
      "((\<Union>x\<in>C. A(x)) \<inter> B) = (\<Union>x\<in>C. A(x) \<inter> B)"
      "((\<Union>x\<in>C. A(x)) - B) = (\<Union>x\<in>C. A(x) - B)"
 apply simp_all
 apply blast+
 done
 
 lemma UN_extend_simps2:
      "cons(a, \<Union>x\<in>C. B(x)) = (if C=0 then {a} else (\<Union>x\<in>C. cons(a, B(x))))"
      "A \<union> (\<Union>x\<in>C. B(x))   = (if C=0 then A else (\<Union>x\<in>C. A \<union> B(x)))"
      "(A \<inter> (\<Union>x\<in>C. B(x))) = (\<Union>x\<in>C. A \<inter> B(x))"
      "A - (\<Inter>x\<in>C. B(x))    = (if C=0 then A else (\<Union>x\<in>C. A - B(x)))"
      "(\<Union>y\<in>A. \<Union>x\<in>y. B(x)) = (\<Union>x\<in>\<Union>(A). B(x))"
      "(\<Union>a\<in>A. B(f(a))) = (\<Union>x\<in>RepFun(A,f). B(x))"
 apply (simp_all add: Inter_def)
 apply (blast intro!: equalityI)+
 done
 
 lemma UN_UN_extend:
      "(\<Union>x\<in>A. \<Union>z\<in>B(x). C(z)) = (\<Union>z\<in>(\<Union>x\<in>A. B(x)). C(z))"
 by blast
 
 lemmas UN_extend_simps = UN_extend_simps1 UN_extend_simps2 UN_UN_extend
 
 
 subsection\<open>Miniscoping of Intersections\<close>
 
 lemma INT_simps1:
      "(\<Inter>x\<in>C. A(x) \<inter> B) = (\<Inter>x\<in>C. A(x)) \<inter> B"
      "(\<Inter>x\<in>C. A(x) - B)   = (\<Inter>x\<in>C. A(x)) - B"
      "(\<Inter>x\<in>C. A(x) \<union> B)  = (if C=0 then 0 else (\<Inter>x\<in>C. A(x)) \<union> B)"
 by (simp_all add: Inter_def, blast+)
 
 lemma INT_simps2:
      "(\<Inter>x\<in>C. A \<inter> B(x)) = A \<inter> (\<Inter>x\<in>C. B(x))"
      "(\<Inter>x\<in>C. A - B(x))   = (if C=0 then 0 else A - (\<Union>x\<in>C. B(x)))"
      "(\<Inter>x\<in>C. cons(a, B(x))) = (if C=0 then 0 else cons(a, \<Inter>x\<in>C. B(x)))"
      "(\<Inter>x\<in>C. A \<union> B(x))  = (if C=0 then 0 else A \<union> (\<Inter>x\<in>C. B(x)))"
 apply (simp_all add: Inter_def)
 apply (blast intro!: equalityI)+
 done
 
 lemmas INT_simps [simp] = INT_simps1 INT_simps2
 
 text\<open>Opposite of miniscoping: pull the operator out\<close>
 
 
 lemma INT_extend_simps1:
      "(\<Inter>x\<in>C. A(x)) \<inter> B = (\<Inter>x\<in>C. A(x) \<inter> B)"
      "(\<Inter>x\<in>C. A(x)) - B = (\<Inter>x\<in>C. A(x) - B)"
      "(\<Inter>x\<in>C. A(x)) \<union> B  = (if C=0 then B else (\<Inter>x\<in>C. A(x) \<union> B))"
 apply (simp_all add: Inter_def, blast+)
 done
 
 lemma INT_extend_simps2:
      "A \<inter> (\<Inter>x\<in>C. B(x)) = (\<Inter>x\<in>C. A \<inter> B(x))"
      "A - (\<Union>x\<in>C. B(x))   = (if C=0 then A else (\<Inter>x\<in>C. A - B(x)))"
      "cons(a, \<Inter>x\<in>C. B(x)) = (if C=0 then {a} else (\<Inter>x\<in>C. cons(a, B(x))))"
      "A \<union> (\<Inter>x\<in>C. B(x))  = (if C=0 then A else (\<Inter>x\<in>C. A \<union> B(x)))"
 apply (simp_all add: Inter_def)
 apply (blast intro!: equalityI)+
 done
 
 lemmas INT_extend_simps = INT_extend_simps1 INT_extend_simps2
 
 
 subsection\<open>Other simprules\<close>
 
 
 (*** Miniscoping: pushing in big Unions, Intersections, quantifiers, etc. ***)
 
 lemma misc_simps [simp]:
      "0 \<union> A = A"
      "A \<union> 0 = A"
      "0 \<inter> A = 0"
      "A \<inter> 0 = 0"
      "0 - A = 0"
      "A - 0 = A"
      "\<Union>(0) = 0"
      "\<Union>(cons(b,A)) = b \<union> \<Union>(A)"
      "\<Inter>({b}) = b"
 by blast+
 
 end