diff --git a/thys/Delta_System_Lemma/Cardinal_Library.thy b/thys/Delta_System_Lemma/Cardinal_Library.thy
--- a/thys/Delta_System_Lemma/Cardinal_Library.thy
+++ b/thys/Delta_System_Lemma/Cardinal_Library.thy
@@ -1,708 +1,691 @@
 section\<open>Cardinal Arithmetic under Choice\label{sec:cardinal-lib}\<close>
 
 theory Cardinal_Library
   imports
     ZF_Library
     ZF.Cardinal_AC
 
 begin
 
 text\<open>This theory includes results on cardinalities that depend on $\AC$\<close>
 
 
 subsection\<open>Results on cardinal exponentiation\<close>
 
 text\<open>Non trivial instances of cardinal exponentiation require that
      the relevant function spaces are well-ordered, hence this 
      implies a strong use of choice.\<close>
 
 lemma cexp_eqpoll_cong:
   assumes
     "A \<approx> A'" "B \<approx> B'"
   shows
     "A\<^bsup>\<up>B\<^esup> = A'\<^bsup>\<up>B'\<^esup>"
   unfolding cexp_def using cardinal_eqpoll_iff
     function_space_eqpoll_cong assms
   by simp
 
 lemma cexp_cexp_cmult: "(\<kappa>\<^bsup>\<up>\<nu>1\<^esup>)\<^bsup>\<up>\<nu>2\<^esup> = \<kappa>\<^bsup>\<up>\<nu>2 \<otimes> \<nu>1\<^esup>"
 proof -
   have "(\<kappa>\<^bsup>\<up>\<nu>1\<^esup>)\<^bsup>\<up>\<nu>2\<^esup> = (\<nu>1 \<rightarrow> \<kappa>)\<^bsup>\<up>\<nu>2\<^esup>"
     using cardinal_eqpoll
     by (intro cexp_eqpoll_cong) (simp_all add:cexp_def)
   also
   have " \<dots> = \<kappa>\<^bsup>\<up>\<nu>2 \<times> \<nu>1\<^esup>"
     unfolding cexp_def using curry_eqpoll cardinal_cong by blast
   also
   have " \<dots> = \<kappa>\<^bsup>\<up>\<nu>2 \<otimes> \<nu>1\<^esup>"
     using cardinal_eqpoll[THEN eqpoll_sym]
     unfolding cmult_def by (intro cexp_eqpoll_cong) (simp)
   finally
   show ?thesis  .
 qed
 
 lemma cardinal_Pow: "|Pow(X)| = 2\<^bsup>\<up>X\<^esup>" \<comment> \<open>Perhaps it's better with |X|\<close>
   using cardinal_eqpoll_iff[THEN iffD2, OF Pow_eqpoll_function_space]
   unfolding cexp_def by simp
 
 lemma cantor_cexp:
   assumes "Card(\<nu>)"
   shows "\<nu> < 2\<^bsup>\<up>\<nu>\<^esup>"
   using assms Card_is_Ord Card_cexp
 proof (intro not_le_iff_lt[THEN iffD1] notI)
   assume "2\<^bsup>\<up>\<nu>\<^esup> \<le> \<nu>"
   then
   have "|Pow(\<nu>)| \<le> \<nu>"
     using cardinal_Pow by simp
   with assms
   have "Pow(\<nu>) \<lesssim> \<nu>"
     using cardinal_eqpoll_iff Card_le_imp_lepoll Card_cardinal_eq
     by auto
   then
   obtain g where "g \<in> inj(Pow(\<nu>), \<nu>)"
     by blast
   then
   show "False"
     using cantor_inj by simp
 qed simp
 
 lemma cexp_left_mono:
   assumes "\<kappa>1 \<le> \<kappa>2"
   shows "\<kappa>1\<^bsup>\<up>\<nu>\<^esup> \<le> \<kappa>2\<^bsup>\<up>\<nu>\<^esup>"
     (* \<comment> \<open>short, unreadable proof: \<close>
   unfolding cexp_def
   using subset_imp_lepoll[THEN lepoll_imp_cardinal_le]
     assms le_subset_iff[THEN iffD1, OF assms]
     Pi_weaken_type[of _ _ "\<lambda>_. \<kappa>1" "\<lambda>_. \<kappa>2"] by auto *)
 proof -
   from assms
   have "\<kappa>1 \<subseteq> \<kappa>2"
     using le_subset_iff by simp
   then
   have "\<nu> \<rightarrow> \<kappa>1  \<subseteq> \<nu> \<rightarrow> \<kappa>2"
     using Pi_weaken_type by auto
   then
   show ?thesis unfolding cexp_def
     using lepoll_imp_cardinal_le subset_imp_lepoll by simp
 qed
 
 lemma cantor_cexp':
   assumes "2 \<le> \<kappa>" "Card(\<nu>)"
   shows "\<nu> < \<kappa>\<^bsup>\<up>\<nu>\<^esup>"
   using cexp_left_mono assms cantor_cexp lt_trans2 by blast
 
 lemma InfCard_cexp:
   assumes "2 \<le> \<kappa>" "InfCard(\<nu>)"
   shows "InfCard(\<kappa>\<^bsup>\<up>\<nu>\<^esup>)"
   using assms cantor_cexp'[THEN leI] le_trans Card_cexp
   unfolding InfCard_def by auto
 
 lemmas InfCard_cexp' = InfCard_cexp[OF nats_le_InfCard, simplified]
   \<comment> \<open>\<^term>\<open>InfCard(\<kappa>) \<Longrightarrow> InfCard(\<nu>) \<Longrightarrow> InfCard(\<kappa>\<^bsup>\<up>\<nu>\<^esup>)\<close>\<close>
 
 
 subsection\<open>Miscellaneous\<close>
 
 lemma cardinal_RepFun_le: "|{f(a) . a\<in>A}| \<le> |A|"
 proof -
   have "(\<lambda>x\<in>A. f(x)) \<in> surj(A, {f(a) . a\<in>A})"
     unfolding surj_def using lam_funtype by auto
   then
   show ?thesis
     using  surj_implies_cardinal_le by blast
 qed
 
 lemma subset_imp_le_cardinal: "A \<subseteq> B \<Longrightarrow> |A| \<le> |B|"
   using subset_imp_lepoll[THEN lepoll_imp_cardinal_le] .
 
 lemma lt_cardinal_imp_not_subset: "|A| < |B| \<Longrightarrow> \<not> B \<subseteq> A"
   using subset_imp_le_cardinal le_imp_not_lt by blast
 
 lemma cardinal_lt_csucc_iff: "Card(K) \<Longrightarrow> |K'| < K\<^sup>+ \<longleftrightarrow> |K'| \<le> K"
   by (simp add: Card_lt_csucc_iff)
 
 lemma cardinal_UN_le_nat:
   "(\<And>i. i\<in>\<omega> \<Longrightarrow> |X(i)| \<le> \<omega>) \<Longrightarrow> |\<Union>i\<in>\<omega>. X(i)| \<le> \<omega>"
   by (simp add: cardinal_UN_le InfCard_nat)
 
-lemma leqpoll_imp_cardinal_UN_le:
+lemma lepoll_imp_cardinal_UN_le:
   notes [dest] = InfCard_is_Card Card_is_Ord
   assumes "InfCard(K)" "J \<lesssim> K" "\<And>i. i\<in>J \<Longrightarrow> |X(i)| \<le> K"
   shows "|\<Union>i\<in>J. X(i)| \<le> K"
 proof -
   from \<open>J \<lesssim> K\<close>
   obtain f where "f \<in> inj(J,K)" by blast
   define Y where "Y(k) \<equiv> if k\<in>range(f) then X(converse(f)`k) else 0" for k
   have "i\<in>J \<Longrightarrow> f`i \<in> K" for i
     using inj_is_fun[OF \<open>f \<in> inj(J,K)\<close>] by auto
   have "(\<Union>i\<in>J. X(i)) \<subseteq> (\<Union>i\<in>K. Y(i))"
   proof (standard, elim UN_E)
     fix x i
     assume "i\<in>J" "x\<in>X(i)"
     with \<open>f \<in> inj(J,K)\<close> \<open>i\<in>J \<Longrightarrow> f`i \<in> K\<close>
     have "x \<in> Y(f`i)" "f`i \<in> K"
       unfolding Y_def
       using inj_is_fun[OF \<open>f \<in> inj(J,K)\<close>]
         right_inverse apply_rangeI by auto
     then
     show "x \<in> (\<Union>i\<in>K. Y(i))" by auto
   qed
   then
   have "|\<Union>i\<in>J. X(i)| \<le> |\<Union>i\<in>K. Y(i)|"
     unfolding Y_def using subset_imp_le_cardinal by simp
   with assms \<open>\<And>i. i\<in>J \<Longrightarrow> f`i \<in> K\<close>
   show "|\<Union>i\<in>J. X(i)| \<le> K"
     using inj_converse_fun[OF \<open>f \<in> inj(J,K)\<close>] unfolding Y_def
     by (rule_tac le_trans[OF _ cardinal_UN_le]) (auto intro:Ord_0_le)+
 qed
 
+\<comment> \<open>For backwards compatibility\<close>
+lemmas leqpoll_imp_cardinal_UN_le = lepoll_imp_cardinal_UN_le
+
 lemma cardinal_lt_csucc_iff':
   includes Ord_dests
   assumes "Card(\<kappa>)"
   shows "\<kappa> < |X| \<longleftrightarrow> \<kappa>\<^sup>+ \<le> |X|"
   using assms cardinal_lt_csucc_iff[of \<kappa> X] Card_csucc[of \<kappa>]
     not_le_iff_lt[of "\<kappa>\<^sup>+" "|X|"] not_le_iff_lt[of "|X|" \<kappa>]
   by blast
 
 lemma lepoll_imp_subset_bij: "X \<lesssim> Y \<longleftrightarrow> (\<exists>Z. Z \<subseteq> Y \<and> Z \<approx> X)"
 proof
   assume "X \<lesssim> Y"
   then
   obtain j where  "j \<in> inj(X,Y)"
     by blast
   then
   have "range(j) \<subseteq> Y" "j \<in> bij(X,range(j))"
     using inj_bij_range inj_is_fun range_fun_subset_codomain
     by blast+
   then
   show "\<exists>Z. Z \<subseteq> Y \<and> Z \<approx> X"
     using eqpoll_sym unfolding eqpoll_def
     by force
 next
   assume "\<exists>Z. Z \<subseteq> Y \<and> Z \<approx> X"
   then
   obtain Z f where "f \<in> bij(Z,X)" "Z \<subseteq> Y"
     unfolding eqpoll_def by force
   then
   have "converse(f) \<in> inj(X,Y)"
     using bij_is_inj inj_weaken_type bij_converse_bij by blast
   then
   show "X \<lesssim> Y" by blast
 qed
 
 text\<open>The following result proves to be very useful when combining
      \<^term>\<open>cardinal\<close> and \<^term>\<open>eqpoll\<close> in a calculation.\<close>
 
 lemma cardinal_Card_eqpoll_iff: "Card(\<kappa>) \<Longrightarrow> |X| = \<kappa> \<longleftrightarrow> X \<approx> \<kappa>"
   using Card_cardinal_eq[of \<kappa>] cardinal_eqpoll_iff[of X \<kappa>] by auto
     \<comment> \<open>Compare @{thm "le_Card_iff"}\<close>
 
 lemma lepoll_imp_lepoll_cardinal: assumes "X \<lesssim> Y" shows "X \<lesssim> |Y|"
   using assms cardinal_Card_eqpoll_iff[of "|Y|" Y]
     lepoll_eq_trans[of _ _ "|Y|"] by simp
 
 lemma lepoll_Un:
   assumes "InfCard(\<kappa>)" "A \<lesssim> \<kappa>" "B \<lesssim> \<kappa>"
   shows "A \<union> B \<lesssim> \<kappa>"
 proof -
   have "A \<union> B \<lesssim> sum(A,B)"
     using Un_lepoll_sum .
   moreover
   note assms
   moreover from this
   have "|sum(A,B)| \<le> \<kappa> \<oplus> \<kappa>"
     using sum_lepoll_mono[of A \<kappa> B \<kappa>] lepoll_imp_cardinal_le
     unfolding cadd_def by auto
   ultimately
   show ?thesis
     using InfCard_cdouble_eq Card_cardinal_eq
       InfCard_is_Card Card_le_imp_lepoll[of "sum(A,B)" \<kappa>]
       lepoll_trans[of "A\<union>B"]
     by auto
 qed
 
 lemma cardinal_Un_le:
   assumes "InfCard(\<kappa>)" "|A| \<le> \<kappa>" "|B| \<le> \<kappa>"
   shows "|A \<union> B| \<le> \<kappa>"
   using assms lepoll_Un le_Card_iff InfCard_is_Card by auto
 
 text\<open>This is the unconditional version under choice of 
      @{thm Cardinal.Finite_cardinal_iff}.\<close>
 lemma Finite_cardinal_iff': "Finite(|i|) \<longleftrightarrow> Finite(i)"
   using cardinal_eqpoll_iff eqpoll_imp_Finite_iff by fastforce
 
 lemma cardinal_subset_of_Card:
   assumes "Card(\<gamma>)" "a \<subseteq> \<gamma>"
   shows "|a| < \<gamma> \<or> |a| = \<gamma>"
 proof -
   from assms
   have "|a| < |\<gamma>| \<or> |a| = |\<gamma>|"
     using subset_imp_le_cardinal le_iff by simp
   with assms
   show ?thesis
     using Card_cardinal_eq by simp
 qed
 
 lemma cardinal_cases:
   includes Ord_dests
   shows "Card(\<gamma>) \<Longrightarrow> |X| < \<gamma> \<longleftrightarrow> \<not> |X| \<ge> \<gamma>"
   using not_le_iff_lt
   by auto
 
 
 subsection\<open>Countable and uncountable sets\<close>
 
 \<comment> \<open>Kunen's Definition I.10.5\<close>
 definition
   countable :: "i\<Rightarrow>o" where
   "countable(X) \<equiv> X \<lesssim> \<omega>"
 
 lemma countableI[intro]: "X \<lesssim> \<omega> \<Longrightarrow> countable(X)"
   unfolding countable_def by simp
 
 lemma countableD[dest]: "countable(X) \<Longrightarrow> X \<lesssim> \<omega>"
   unfolding countable_def by simp
 
 lemma countable_iff_cardinal_le_nat: "countable(X) \<longleftrightarrow> |X| \<le> \<omega>"
   using le_Card_iff[of \<omega> X] Card_nat
   unfolding countable_def by simp
 
 lemma lepoll_countable: "X \<lesssim> Y \<Longrightarrow> countable(Y) \<Longrightarrow> countable(X)"
   using lepoll_trans[of X Y] by blast
 
 \<comment> \<open>Next lemma can be proved without using AC\<close>
 lemma surj_countable: "countable(X) \<Longrightarrow> f \<in> surj(X,Y) \<Longrightarrow> countable(Y)"
   using surj_implies_cardinal_le[of f X Y, THEN le_trans]
     countable_iff_cardinal_le_nat by simp
 
 lemma Finite_imp_countable: "Finite(X) \<Longrightarrow> countable(X)"
   unfolding Finite_def
   by (auto intro:InfCard_nat nats_le_InfCard[of _ \<omega>,
         THEN le_imp_lepoll] dest!:eq_lepoll_trans[of X _ \<omega>])
 
 lemma countable_imp_countable_UN:
   assumes "countable(J)" "\<And>i. i\<in>J \<Longrightarrow> countable(X(i))"
   shows "countable(\<Union>i\<in>J. X(i))"
-  using assms leqpoll_imp_cardinal_UN_le[of \<omega> J X] InfCard_nat
+  using assms lepoll_imp_cardinal_UN_le[of \<omega> J X] InfCard_nat
     countable_iff_cardinal_le_nat
   by auto
 
 lemma countable_union_countable:
   assumes "\<And>x. x \<in> C \<Longrightarrow> countable(x)" "countable(C)"
   shows "countable(\<Union>C)"
   using assms countable_imp_countable_UN[of C "\<lambda>x. x"] by simp
 
 abbreviation
   uncountable :: "i\<Rightarrow>o" where
   "uncountable(X) \<equiv> \<not> countable(X)"
 
 lemma uncountable_iff_nat_lt_cardinal:
   "uncountable(X) \<longleftrightarrow> \<omega> < |X|"
   using countable_iff_cardinal_le_nat not_le_iff_lt by simp
 
 lemma uncountable_not_empty: "uncountable(X) \<Longrightarrow> X \<noteq> 0"
   using empty_lepollI by auto
 
 lemma uncountable_imp_Infinite: "uncountable(X) \<Longrightarrow> Infinite(X)"
   using uncountable_iff_nat_lt_cardinal[of X] lepoll_nat_imp_Infinite[of X]
     cardinal_le_imp_lepoll[of \<omega> X] leI
   by simp
 
 lemma uncountable_not_subset_countable:
   assumes "countable(X)" "uncountable(Y)"
   shows "\<not> (Y \<subseteq> X)"
   using assms lepoll_trans subset_imp_lepoll[of Y X]
   by blast
 
 
 subsection\<open>Results on Alephs\<close>
 
 lemma nat_lt_Aleph1: "\<omega> < \<aleph>\<^bsub>1\<^esub>"
   by (simp add: Aleph_def lt_csucc)
 
 lemma zero_lt_Aleph1: "0 < \<aleph>\<^bsub>1\<^esub>"
   by (rule lt_trans[of _ "\<omega>"], auto simp add: ltI nat_lt_Aleph1)
 
 lemma le_aleph1_nat: "Card(k) \<Longrightarrow> k<\<aleph>\<^bsub>1\<^esub> \<Longrightarrow> k \<le> \<omega>"
   by (simp add: Aleph_def Card_lt_csucc_iff Card_nat)
 
 lemma Aleph_succ: "\<aleph>\<^bsub>succ(\<alpha>)\<^esub> = \<aleph>\<^bsub>\<alpha>\<^esub>\<^sup>+"
   unfolding Aleph_def by simp
 
 lemma lesspoll_aleph_plus_one:
   assumes "Ord(\<alpha>)"
   shows "d \<prec> \<aleph>\<^bsub>succ(\<alpha>)\<^esub> \<longleftrightarrow> d \<lesssim> \<aleph>\<^bsub>\<alpha>\<^esub>"
   using assms lesspoll_csucc Aleph_succ Card_is_Ord by simp
 
 lemma cardinal_Aleph [simp]: "Ord(\<alpha>) \<Longrightarrow> |\<aleph>\<^bsub>\<alpha>\<^esub>| = \<aleph>\<^bsub>\<alpha>\<^esub>"
   using Card_cardinal_eq by simp
 
 \<comment> \<open>Could be proved without using AC\<close>
 lemma Aleph_lesspoll_increasing:
   includes Aleph_intros
   shows "a < b \<Longrightarrow> \<aleph>\<^bsub>a\<^esub> \<prec> \<aleph>\<^bsub>b\<^esub>"
   using cardinal_lt_iff_lesspoll[of "\<aleph>\<^bsub>a\<^esub>" "\<aleph>\<^bsub>b\<^esub>"] Card_cardinal_eq[of "\<aleph>\<^bsub>b\<^esub>"]
     lt_Ord lt_Ord2 Card_Aleph[THEN Card_is_Ord] by auto
 
 lemma uncountable_iff_subset_eqpoll_Aleph1:
   includes Ord_dests
   notes Aleph_zero_eq_nat[simp] Card_nat[simp] Aleph_succ[simp]
   shows "uncountable(X) \<longleftrightarrow> (\<exists>S. S \<subseteq> X \<and> S \<approx> \<aleph>\<^bsub>1\<^esub>)"
 proof
   assume "uncountable(X)"
   then
   have "\<aleph>\<^bsub>1\<^esub> \<lesssim> X"
     using uncountable_iff_nat_lt_cardinal cardinal_lt_csucc_iff'
       cardinal_le_imp_lepoll by force
   then
   obtain S where "S \<subseteq> X" "S \<approx> \<aleph>\<^bsub>1\<^esub>"
     using lepoll_imp_subset_bij by auto
   then
   show "\<exists>S. S \<subseteq> X \<and> S \<approx> \<aleph>\<^bsub>1\<^esub>"
     using cardinal_cong Card_csucc[of \<omega>] Card_cardinal_eq by auto
 next
   assume "\<exists>S. S \<subseteq> X \<and> S \<approx> \<aleph>\<^bsub>1\<^esub>"
   then
   have "\<aleph>\<^bsub>1\<^esub> \<lesssim> X"
     using subset_imp_lepoll[THEN [2] eq_lepoll_trans, of "\<aleph>\<^bsub>1\<^esub>" _ X,
         OF eqpoll_sym] by auto
   then
   show "uncountable(X)"
     using Aleph_lesspoll_increasing[of 0 1, THEN [2] lesspoll_trans1,
         of "\<aleph>\<^bsub>1\<^esub>"] lepoll_trans[of "\<aleph>\<^bsub>1\<^esub>" X \<omega>]
     by auto
 qed
 
 lemma lt_Aleph_imp_cardinal_UN_le_nat: "function(G) \<Longrightarrow> domain(G) \<lesssim> \<omega> \<Longrightarrow>
    \<forall>n\<in>domain(G). |G`n|<\<aleph>\<^bsub>1\<^esub> \<Longrightarrow> |\<Union>n\<in>domain(G). G`n|\<le>\<omega>"
 proof -
   assume "function(G)"
   let ?N="domain(G)" and ?R="\<Union>n\<in>domain(G). G`n"
   assume "?N \<lesssim> \<omega>"
   assume Eq1: "\<forall>n\<in>?N. |G`n|<\<aleph>\<^bsub>1\<^esub>"
   {
     fix n
     assume "n\<in>?N"
     with Eq1 have "|G`n| \<le> \<omega>"
       using le_aleph1_nat by simp
   }
   then
   have "n\<in>?N \<Longrightarrow> |G`n| \<le> \<omega>" for n .
   with \<open>?N \<lesssim> \<omega>\<close>
   show ?thesis
-    using InfCard_nat leqpoll_imp_cardinal_UN_le by simp
+    using InfCard_nat lepoll_imp_cardinal_UN_le by simp
 qed
 
 lemma Aleph1_eq_cardinal_vimage: "f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega> \<Longrightarrow> \<exists>n\<in>\<omega>. |f-``{n}| = \<aleph>\<^bsub>1\<^esub>"
 proof -
   assume "f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega>"
   then
   have "function(f)" "domain(f) = \<aleph>\<^bsub>1\<^esub>" "range(f)\<subseteq>\<omega>"
     by (simp_all add: domain_of_fun fun_is_function range_fun_subset_codomain)
   let ?G="\<lambda>n\<in>range(f). f-``{n}"
   from \<open>f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega>\<close>
   have "range(f) \<subseteq> \<omega>" by (simp add: range_fun_subset_codomain)
   then
   have "domain(?G) \<lesssim> \<omega>"
     using subset_imp_lepoll by simp
   have "function(?G)" by (simp add:function_lam)
   from \<open>f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega>\<close>
   have "n\<in>\<omega> \<Longrightarrow> f-``{n} \<subseteq> \<aleph>\<^bsub>1\<^esub>" for n
     using Pi_vimage_subset by simp
   with \<open>range(f) \<subseteq> \<omega>\<close>
   have "\<aleph>\<^bsub>1\<^esub> = (\<Union>n\<in>range(f). f-``{n})"
   proof (intro equalityI, intro subsetI)
     fix x
     assume "x \<in> \<aleph>\<^bsub>1\<^esub>"
     with \<open>f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega>\<close> \<open>function(f)\<close> \<open>domain(f) = \<aleph>\<^bsub>1\<^esub>\<close>
     have "x \<in> f-``{f`x}" "f`x \<in> range(f)"
       using function_apply_Pair vimage_iff apply_rangeI by simp_all
     then
     show "x \<in> (\<Union>n\<in>range(f). f-``{n})" by auto
   qed auto
   {
     assume "\<forall>n\<in>range(f). |f-``{n}| < \<aleph>\<^bsub>1\<^esub>"
     then
     have "\<forall>n\<in>domain(?G). |?G`n| < \<aleph>\<^bsub>1\<^esub>"
       using zero_lt_Aleph1 by (auto)
     with \<open>function(?G)\<close> \<open>domain(?G) \<lesssim> \<omega>\<close>
     have "|\<Union>n\<in>domain(?G). ?G`n|\<le>\<omega>"
       using lt_Aleph_imp_cardinal_UN_le_nat by blast
     then
     have "|\<Union>n\<in>range(f). f-``{n}|\<le>\<omega>" by simp
     with \<open>\<aleph>\<^bsub>1\<^esub> = _\<close>
     have "|\<aleph>\<^bsub>1\<^esub>| \<le> \<omega>" by simp
     then
     have "\<aleph>\<^bsub>1\<^esub> \<le> \<omega>"
       using Card_Aleph Card_cardinal_eq
       by simp
     then
     have "False"
       using nat_lt_Aleph1 by (blast dest:lt_trans2)
   }
   with \<open>range(f)\<subseteq>\<omega>\<close>
   obtain n where "n\<in>\<omega>" "\<not>(|f -`` {n}| < \<aleph>\<^bsub>1\<^esub>)"
     by blast
   moreover from this
   have "\<aleph>\<^bsub>1\<^esub> \<le> |f-``{n}|"
     using not_lt_iff_le Card_is_Ord by auto
   moreover
   note \<open>n\<in>\<omega> \<Longrightarrow> f-``{n} \<subseteq> \<aleph>\<^bsub>1\<^esub>\<close>
   ultimately
   show ?thesis
     using subset_imp_le_cardinal[THEN le_anti_sym, of _ "\<aleph>\<^bsub>1\<^esub>"]
       Card_Aleph Card_cardinal_eq by auto
 qed
 
 \<comment> \<open>There is some asymmetry between assumptions and conclusion
     (\<^term>\<open>(\<approx>)\<close> versus \<^term>\<open>cardinal\<close>)\<close>
 lemma eqpoll_Aleph1_cardinal_vimage:
   assumes "X \<approx> \<aleph>\<^bsub>1\<^esub>" "f : X \<rightarrow> \<omega>"
   shows "\<exists>n\<in>\<omega>. |f-``{n}| = \<aleph>\<^bsub>1\<^esub>"
 proof -
   from assms
   obtain g where "g\<in>bij(\<aleph>\<^bsub>1\<^esub>,X)"
     using eqpoll_sym by blast
   with \<open>f : X \<rightarrow> \<omega>\<close>
   have "f O g : \<aleph>\<^bsub>1\<^esub> \<rightarrow> \<omega>" "converse(g) \<in> bij(X, \<aleph>\<^bsub>1\<^esub>)"
     using bij_is_fun comp_fun bij_converse_bij by blast+
   then
   obtain n where "n\<in>\<omega>" "|(f O g)-``{n}| = \<aleph>\<^bsub>1\<^esub>"
     using Aleph1_eq_cardinal_vimage by auto
   then
   have "\<aleph>\<^bsub>1\<^esub> = |converse(g) `` (f -``{n})|"
     using image_comp converse_comp
     unfolding vimage_def by simp
   also from \<open>converse(g) \<in> bij(X, \<aleph>\<^bsub>1\<^esub>)\<close> \<open>f: X\<rightarrow> \<omega>\<close>
   have "\<dots> = |f -``{n}|"
     using range_of_subset_eqpoll[of "converse(g)" X  _ "f -``{n}"]
       bij_is_inj cardinal_cong bij_is_fun eqpoll_sym Pi_vimage_subset
     by fastforce
   finally
   show ?thesis using \<open>n\<in>\<omega>\<close> by auto
 qed
 
 
 subsection\<open>Applications of transfinite recursive constructions\<close>
 
-definition
-  rec_constr :: "[i,i] \<Rightarrow> i" where
-  "rec_constr(f,\<alpha>) \<equiv> transrec(\<alpha>,\<lambda>a g. f`(g``a))"
-
-text\<open>The function \<^term>\<open>rec_constr\<close> allows to perform \<^emph>\<open>recursive
-     constructions\<close>: given a choice function on the powerset of some
-     set, a transfinite sequence is created by successively choosing
-     some new element.
-
-     The next result explains its use.\<close>
-
-lemma rec_constr_unfold: "rec_constr(f,\<alpha>) = f`({rec_constr(f,\<beta>). \<beta>\<in>\<alpha>})"
-  using def_transrec[OF rec_constr_def, of f \<alpha>] image_lam by simp
-
-lemma rec_constr_type: assumes "f:Pow(G)\<rightarrow> G" "Ord(\<alpha>)"
-  shows "rec_constr(f,\<alpha>) \<in> G"
-  using assms(2,1)
-  by (induct rule:trans_induct)
-    (subst rec_constr_unfold, rule apply_type[of f "Pow(G)" "\<lambda>_. G"], auto)
-
 text\<open>The next lemma is an application of recursive constructions.
      It works under the assumption that whenever the already constructed
      subsequence is small enough, another element can be added.\<close>
 
 lemma bounded_cardinal_selection:
   includes Ord_dests
   assumes
     "\<And>X. |X| < \<gamma> \<Longrightarrow> X \<subseteq> G \<Longrightarrow> \<exists>a\<in>G. \<forall>s\<in>X. Q(s,a)" "b\<in>G" "Card(\<gamma>)"
   shows
     "\<exists>S. S : \<gamma> \<rightarrow> G \<and> (\<forall>\<alpha> \<in> \<gamma>. \<forall>\<beta> \<in> \<gamma>.  \<alpha><\<beta> \<longrightarrow> Q(S`\<alpha>,S`\<beta>))"
 proof -
   let ?cdlt\<gamma>="{X\<in>Pow(G) . |X|<\<gamma>}" \<comment> \<open>``cardinal less than \<^term>\<open>\<gamma>\<close>''\<close>
     and ?inQ="\<lambda>Y.{a\<in>G. \<forall>s\<in>Y. Q(s,a)}"
   from assms
   have "\<forall>Y \<in> ?cdlt\<gamma>. \<exists>a. a \<in> ?inQ(Y)"
     by blast
   then
   have "\<exists>f. f \<in> Pi(?cdlt\<gamma>,?inQ)"
     using AC_ball_Pi[of ?cdlt\<gamma> ?inQ] by simp
   then
   obtain f where f_type:"f \<in> Pi(?cdlt\<gamma>,?inQ)"
     by auto
   moreover
   define Cb where "Cb \<equiv> \<lambda>_\<in>Pow(G)-?cdlt\<gamma>. b"
   moreover from \<open>b\<in>G\<close>
   have "Cb \<in> Pow(G)-?cdlt\<gamma> \<rightarrow> G"
     unfolding Cb_def by simp
   moreover
   note \<open>Card(\<gamma>)\<close>
   ultimately
   have "f \<union> Cb : (\<Prod>x\<in>Pow(G). ?inQ(x) \<union> G)" using
       fun_Pi_disjoint_Un[ of f ?cdlt\<gamma>  ?inQ Cb "Pow(G)-?cdlt\<gamma>" "\<lambda>_.G"]
       Diff_partition[of "{X\<in>Pow(G). |X|<\<gamma>}" "Pow(G)", OF Collect_subset]
     by auto
   moreover
   have "?inQ(x) \<union> G = G" for x by auto
   ultimately
   have "f \<union> Cb : Pow(G) \<rightarrow> G" by simp
   define S where "S\<equiv>\<lambda>\<alpha>\<in>\<gamma>. rec_constr(f \<union> Cb, \<alpha>)"
   from \<open>f \<union> Cb: Pow(G) \<rightarrow> G\<close> \<open>Card(\<gamma>)\<close>
   have "S : \<gamma> \<rightarrow> G"
     using Ord_in_Ord unfolding S_def
     by (intro lam_type rec_constr_type) auto
   moreover
   have "\<forall>\<alpha>\<in>\<gamma>. \<forall>\<beta>\<in>\<gamma>. \<alpha> < \<beta> \<longrightarrow> Q(S ` \<alpha>, S ` \<beta>)"
   proof (intro ballI impI)
     fix \<alpha> \<beta>
     assume "\<beta>\<in>\<gamma>"
     with \<open>Card(\<gamma>)\<close>
     have "{rec_constr(f \<union> Cb, x) . x\<in>\<beta>} = {S`x . x \<in> \<beta>}"
       using Ord_trans[OF _ _ Card_is_Ord, of _ \<beta> \<gamma>]
       unfolding S_def
       by auto
     moreover from \<open>\<beta>\<in>\<gamma>\<close> \<open>S : \<gamma> \<rightarrow> G\<close> \<open>Card(\<gamma>)\<close>
     have "{S`x . x \<in> \<beta>} \<subseteq> G"
       using Ord_trans[OF _ _ Card_is_Ord, of _ \<beta> \<gamma>]
         apply_type[of S \<gamma> "\<lambda>_. G"] by auto
     moreover from \<open>Card(\<gamma>)\<close> \<open>\<beta>\<in>\<gamma>\<close>
     have "|{S`x . x \<in> \<beta>}| < \<gamma>"
       using cardinal_RepFun_le[of \<beta>]  Ord_in_Ord
         lt_trans1[of "|{S`x . x \<in> \<beta>}|" "|\<beta>|" \<gamma>]
         Card_lt_iff[THEN iffD2, of \<beta> \<gamma>, OF _ _ ltI]
       by force
     moreover
     have "\<forall>x\<in>\<beta>. Q(S`x, f ` {S`x . x \<in> \<beta>})"
     proof -
       from calculation and f_type
       have "f ` {S`x . x \<in> \<beta>} \<in> {a\<in>G. \<forall>x\<in>\<beta>. Q(S`x,a)}"
         using apply_type[of f ?cdlt\<gamma> ?inQ "{S`x . x \<in> \<beta>}"]
         by blast
       then
       show ?thesis by simp
     qed
     moreover
     assume "\<alpha>\<in>\<gamma>" "\<alpha> < \<beta>"
     moreover
     note \<open>\<beta>\<in>\<gamma>\<close> \<open>Cb \<in> Pow(G)-?cdlt\<gamma> \<rightarrow> G\<close>
     ultimately
     show "Q(S ` \<alpha>, S ` \<beta>)"
       using fun_disjoint_apply1[of "{S`x . x \<in> \<beta>}" Cb f]
         domain_of_fun[of Cb] ltD[of \<alpha> \<beta>]
       by (subst (2) S_def, auto) (subst rec_constr_unfold, auto)
   qed
   ultimately
   show ?thesis by blast
 qed
 
 text\<open>The following basic result can, in turn, be proved by a
      bounded-cardinal selection.\<close>
 lemma Infinite_iff_lepoll_nat: "Infinite(X) \<longleftrightarrow> \<omega> \<lesssim> X"
 proof
   assume "Infinite(X)"
   then
   obtain b where "b\<in>X"
     using Infinite_not_empty by auto
   {
     fix Y
     assume "|Y| < \<omega>"
     then
     have "Finite(Y)"
       using Finite_cardinal_iff' ltD nat_into_Finite by blast
     with \<open>Infinite(X)\<close>
     have "X \<noteq> Y" by auto
   }
   with \<open>b\<in>X\<close>
   obtain S where "S : \<omega> \<rightarrow> X"  "\<forall>\<alpha>\<in>\<omega>. \<forall>\<beta>\<in>\<omega>. \<alpha> < \<beta> \<longrightarrow> S`\<alpha> \<noteq> S`\<beta>"
     using bounded_cardinal_selection[of \<omega> X "\<lambda>x y. x\<noteq>y"]
       Card_nat by blast
   moreover from this
   have "\<alpha> \<in> \<omega> \<Longrightarrow> \<beta> \<in> \<omega> \<Longrightarrow> \<alpha>\<noteq>\<beta> \<Longrightarrow> S`\<alpha> \<noteq> S`\<beta>" for \<alpha> \<beta>
     by (rule_tac lt_neq_symmetry[of "\<omega>" "\<lambda>\<alpha> \<beta>. S`\<alpha> \<noteq> S`\<beta>"])
       auto
   ultimately
   show "\<omega> \<lesssim> X"
     unfolding lepoll_def inj_def by blast
 qed (intro lepoll_nat_imp_Infinite)
 
 lemma Infinite_InfCard_cardinal: "Infinite(X) \<Longrightarrow> InfCard(|X|)"
   using lepoll_eq_trans eqpoll_sym lepoll_nat_imp_Infinite
     Infinite_iff_lepoll_nat Inf_Card_is_InfCard cardinal_eqpoll
   by simp
 
 lemma Finite_to_one_surj_imp_cardinal_eq:
   assumes "F \<in> Finite_to_one(X,Y) \<inter> surj(X,Y)" "Infinite(X)"
   shows "|Y| = |X|"
 proof -
   from \<open>F \<in> Finite_to_one(X,Y) \<inter> surj(X,Y)\<close>
   have "X = (\<Union>y\<in>Y. {x\<in>X . F`x = y})"
     using apply_type by fastforce
   show ?thesis
   proof (cases "Finite(Y)")
     case True
     with \<open>X = (\<Union>y\<in>Y. {x\<in>X . F`x = y})\<close> and assms
     show ?thesis
       using Finite_RepFun[THEN [2] Finite_Union, of Y "\<lambda>y. {x\<in>X . F`x = y}"]
       by auto
   next
     case False
     moreover from this
     have "Y \<lesssim> |Y|"
       using cardinal_eqpoll eqpoll_sym eqpoll_imp_lepoll by simp
     moreover
     note assms
     moreover from calculation
     have "y \<in> Y \<Longrightarrow> |{x\<in>X . F`x = y}| \<le> |Y|" for y
       using Infinite_imp_nats_lepoll[THEN lepoll_imp_cardinal_le, of Y
           "|{x\<in>X . F`x = y}|"] cardinal_idem by auto
     ultimately
     have "|\<Union>y\<in>Y. {x\<in>X . F`x = y}| \<le> |Y|"
-      using leqpoll_imp_cardinal_UN_le[of "|Y|" Y]
+      using lepoll_imp_cardinal_UN_le[of "|Y|" Y]
         Infinite_InfCard_cardinal[of Y] by simp
     moreover from \<open>F \<in> Finite_to_one(X,Y) \<inter> surj(X,Y)\<close>
     have "|Y| \<le> |X|"
       using surj_implies_cardinal_le by auto
     moreover
     note \<open>X = (\<Union>y\<in>Y. {x\<in>X . F`x = y})\<close>
     ultimately
     show ?thesis
       using le_anti_sym by auto
   qed
 qed
 
 lemma cardinal_map_Un:
   assumes "Infinite(X)" "Finite(b)"
   shows "|{a \<union> b . a \<in> X}| = |X|"
 proof -
   have "(\<lambda>a\<in>X. a \<union> b) \<in> Finite_to_one(X,{a \<union> b . a \<in> X})"
     "(\<lambda>a\<in>X. a \<union> b) \<in>  surj(X,{a \<union> b . a \<in> X})"
     unfolding surj_def
   proof
     fix d
     have "Finite({a \<in> X . a \<union> b = d})" (is "Finite(?Y(b,d))")
       using \<open>Finite(b)\<close>
     proof (induct arbitrary:d)
       case 0
       have "{a \<in> X . a \<union> 0 = d} = (if d\<in>X then {d} else 0)"
         by auto
       then
       show ?case by simp
     next
       case (cons c b)
       from \<open>c \<notin> b\<close>
       have "?Y(cons(c,b),d) \<subseteq> (if c\<in>d then ?Y(b,d) \<union> ?Y(b,d-{c}) else 0)"
         by auto
       with cons
       show ?case
         using subset_Finite
         by simp
     qed
     moreover
     assume "d \<in> {x \<union> b . x \<in> X}"
     ultimately
     show "Finite({a \<in> X . (\<lambda>x\<in>X. x \<union> b) ` a = d})"
       by simp
   qed (auto intro:lam_funtype)
   with assms
   show ?thesis
     using Finite_to_one_surj_imp_cardinal_eq by fast
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Delta_System_Lemma/Cofinality.thy b/thys/Delta_System_Lemma/Cofinality.thy
--- a/thys/Delta_System_Lemma/Cofinality.thy
+++ b/thys/Delta_System_Lemma/Cofinality.thy
@@ -1,1205 +1,1205 @@
 section\<open>Cofinality\label{sec:cofinality}\<close>
 
 theory Cofinality
   imports
     ZF_Library
 begin
 
 
 subsection\<open>Basic results and definitions\<close>
 
 text\<open>A set \<^term>\<open>X\<close> is \<^emph>\<open>cofinal\<close> in \<^term>\<open>A\<close> (with respect to the relation
     \<^term>\<open>r\<close>) if every element of \<^term>\<open>A\<close> is ``bounded
     above'' by some element of \<^term>\<open>X\<close>. Note that \<^term>\<open>X\<close> does not need 
     to be a subset of \<^term>\<open>A\<close>.\<close>
 definition
   cofinal :: "[i,i,i] \<Rightarrow> o" where
   "cofinal(X,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>X. \<langle>a,x\<rangle>\<in>r \<or> a = x"
 
 (*
 (* Alternative definitions *)
 definition
   cofinal_predic :: "[i,i,[i,i]\<Rightarrow>o] \<Rightarrow> o" where
   "cofinal_predic(X,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>X. r(a,x) \<or> a = x"
 
 definition
   f_cofinal :: "[i\<Rightarrow>i,i,i,i] \<Rightarrow> o" where
   "f_cofinal(f,C,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>C. \<langle>a,f(x)\<rangle>\<in>r \<or> a = f(x)"
 
 (* The next definition doesn't work if 0 is the top element of A.
    But it works for limit ordinals. *)
 definition
   cofinal_fun' :: "[i,i,i] \<Rightarrow> o" where
   "cofinal_fun'(f,A,r) == f_cofinal(\<lambda>x. f`x,domain(f),A, r)"
 *)
 
 text\<open>A function is cofinal if it range is.\<close>
 definition
   cofinal_fun :: "[i,i,i] \<Rightarrow> o" where
   "cofinal_fun(f,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>domain(f). \<langle>a,f`x\<rangle>\<in>r \<or> a = f`x"
 
 lemma cofinal_funI:
   assumes "\<And>a. a\<in>A \<Longrightarrow> \<exists>x\<in>domain(f). \<langle>a,f`x\<rangle>\<in>r \<or> a = f`x"
   shows "cofinal_fun(f,A,r)"
   using assms unfolding cofinal_fun_def by simp
 
 lemma cofinal_funD:
   assumes "cofinal_fun(f,A,r)" "a\<in>A"
   shows "\<exists>x\<in>domain(f). \<langle>a,f`x\<rangle>\<in>r \<or> a = f`x"
   using assms unfolding cofinal_fun_def by simp
 
 lemma cofinal_in_cofinal:
   assumes
     "trans(r)" "cofinal(Y,X,r)" "cofinal(X,A,r)"
   shows
     "cofinal(Y,A,r)"
   unfolding cofinal_def
 proof
   fix a
   assume "a\<in>A"
   moreover from \<open>cofinal(X,A,r)\<close>
   have "b\<in>A\<Longrightarrow>\<exists>x\<in>X. \<langle>b,x\<rangle>\<in>r \<or> b=x" for b
     unfolding cofinal_def by simp
   ultimately
   obtain y where "y\<in>X" "\<langle>a,y\<rangle>\<in>r \<or> a=y" by auto
   moreover from \<open>cofinal(Y,X,r)\<close>
   have "c\<in>X\<Longrightarrow>\<exists>y\<in>Y. \<langle>c,y\<rangle>\<in>r \<or> c=y" for c
     unfolding cofinal_def by simp
   ultimately
   obtain x where "x\<in>Y" "\<langle>y,x\<rangle>\<in>r \<or> y=x" by auto
   with \<open>a\<in>A\<close> \<open>y\<in>X\<close> \<open>\<langle>a,y\<rangle>\<in>r \<or> a=y\<close> \<open>trans(r)\<close>
   show "\<exists>x\<in>Y. \<langle>a,x\<rangle>\<in>r \<or> a=x" unfolding trans_def by auto
 qed
 
 lemma codomain_is_cofinal:
   assumes "cofinal_fun(f,A,r)" "f:C \<rightarrow> D"
   shows "cofinal(D,A,r)"
   unfolding cofinal_def
 proof
   fix b
   assume "b \<in> A"
   moreover from assms
   have "a\<in>A \<Longrightarrow> \<exists>x\<in>domain(f). \<langle>a, f ` x\<rangle> \<in> r \<or> a = f`x" for a
     unfolding cofinal_fun_def by simp
   ultimately
   obtain x where "x\<in>domain(f)" "\<langle>b, f ` x\<rangle> \<in> r \<or> b = f`x"
     by blast
   moreover from \<open>f:C \<rightarrow> D\<close>  \<open>x\<in>domain(f)\<close>
   have "f`x\<in>D"
     using domain_of_fun apply_rangeI by simp
   ultimately
   show  "\<exists>y\<in>D. \<langle>b, y\<rangle> \<in> r \<or> b = y" by auto
 qed
 
 lemma cofinal_range_iff_cofinal_fun:
   assumes "function(f)"
   shows "cofinal(range(f),A,r) \<longleftrightarrow> cofinal_fun(f,A,r)"
   unfolding cofinal_fun_def
 proof (intro iffI ballI)
   fix a
   assume "a\<in>A" \<open>cofinal(range(f),A,r)\<close>
   then
   obtain y where "y\<in>range(f)" "\<langle>a,y\<rangle> \<in> r \<or> a = y"
     unfolding cofinal_def by blast
   moreover from this
   obtain x where "\<langle>x,y\<rangle>\<in>f"
     unfolding range_def domain_def converse_def by blast
   moreover
   note \<open>function(f)\<close>
   ultimately
   have "\<langle>a, f ` x\<rangle> \<in> r \<or> a = f ` x"
     using function_apply_equality by blast
   with \<open>\<langle>x,y\<rangle>\<in>f\<close>
   show "\<exists>x\<in>domain(f). \<langle>a, f ` x\<rangle> \<in> r \<or> a = f ` x"  by blast
 next
   assume "\<forall>a\<in>A. \<exists>x\<in>domain(f). \<langle>a, f ` x\<rangle> \<in> r \<or> a = f ` x"
   with assms
   show "cofinal(range(f), A, r)"
     using function_apply_Pair[of f] unfolding cofinal_def by fast
 qed
 
 lemma cofinal_comp:
   assumes
     "f\<in> mono_map(C,s,D,r)" "cofinal_fun(f,D,r)" "h:B \<rightarrow> C"  "cofinal_fun(h,C,s)"
     "trans(r)"
   shows "cofinal_fun(f O h,D,r)"
   unfolding cofinal_fun_def
 proof
   fix a
   from \<open>f\<in> mono_map(C,s,D,r)\<close>
   have "f:C \<rightarrow> D"
     using mono_map_is_fun by simp
   with \<open>h:B \<rightarrow> C\<close>
   have "domain(f) = C" "domain(h) = B"
     using domain_of_fun by simp_all
   moreover
   assume "a \<in> D"
   moreover
   note \<open>cofinal_fun(f,D,r)\<close>
   ultimately
   obtain c where "c\<in>C"  "\<langle>a, f ` c\<rangle> \<in> r \<or> a = f ` c"
     unfolding cofinal_fun_def by blast
   with \<open>cofinal_fun(h,C,s)\<close> \<open>domain(h) = B\<close>
   obtain b where "b \<in> B"  "\<langle>c, h ` b\<rangle> \<in> s \<or> c = h ` b"
     unfolding cofinal_fun_def by blast
   moreover from this and \<open>h:B \<rightarrow> C\<close>
   have "h`b \<in> C" by simp
   moreover
   note \<open>f \<in> mono_map(C,s,D,r)\<close>  \<open>c\<in>C\<close>
   ultimately
   have "\<langle>f`c, f` (h ` b)\<rangle> \<in> r \<or> f`c = f` (h ` b)"
     unfolding mono_map_def by blast
   with \<open>\<langle>a, f ` c\<rangle> \<in> r \<or> a = f ` c\<close> \<open>trans(r)\<close> \<open>h:B \<rightarrow> C\<close> \<open>b\<in>B\<close>
   have "\<langle>a, (f O h) ` b\<rangle> \<in> r \<or> a = (f O h) ` b"
     using transD by auto
   moreover from \<open>h:B \<rightarrow> C\<close> \<open>domain(f) = C\<close> \<open>domain(h) = B\<close>
   have "domain(f O h) = B"
     using range_fun_subset_codomain by blast
   moreover
   note \<open>b\<in>B\<close>
   ultimately
   show "\<exists>x\<in>domain(f O h). \<langle>a, (f O h) ` x\<rangle> \<in> r \<or> a = (f O h) ` x"  by blast
 qed
 
 definition
   cf_fun :: "[i,i] \<Rightarrow> o" where
   "cf_fun(f,\<alpha>) \<equiv> cofinal_fun(f,\<alpha>,Memrel(\<alpha>))"
 
 lemma cf_funI[intro!]: "cofinal_fun(f,\<alpha>,Memrel(\<alpha>)) \<Longrightarrow> cf_fun(f,\<alpha>)"
   unfolding cf_fun_def by simp
 
 lemma cf_funD[dest!]: "cf_fun(f,\<alpha>) \<Longrightarrow> cofinal_fun(f,\<alpha>,Memrel(\<alpha>))"
   unfolding cf_fun_def by simp
 
 lemma cf_fun_comp:
   assumes
     "Ord(\<alpha>)" "f\<in> mono_map(C,s,\<alpha>,Memrel(\<alpha>))" "cf_fun(f,\<alpha>)"
     "h:B \<rightarrow> C" "cofinal_fun(h,C,s)"
   shows "cf_fun(f O h,\<alpha>)"
   using assms cofinal_comp[OF _ _ _ _ trans_Memrel] by auto
 
 definition
   cf :: "i\<Rightarrow>i" where
   "cf(\<gamma>) \<equiv> \<mu> \<beta>.  \<exists>A. A\<subseteq>\<gamma> \<and> cofinal(A,\<gamma>,Memrel(\<gamma>)) \<and> \<beta> = ordertype(A,Memrel(\<gamma>))"
 
 lemma Ord_cf [TC]: "Ord(cf(\<beta>))"
   unfolding cf_def using Ord_Least by simp
 
 lemma gamma_cofinal_gamma:
   assumes "Ord(\<gamma>)"
   shows "cofinal(\<gamma>,\<gamma>,Memrel(\<gamma>))"
   unfolding cofinal_def by auto
 
 lemma cf_is_ordertype:
   assumes "Ord(\<gamma>)"
   shows "\<exists>A. A\<subseteq>\<gamma> \<and> cofinal(A,\<gamma>,Memrel(\<gamma>)) \<and> cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     (is "?P(cf(\<gamma>))")
   using gamma_cofinal_gamma LeastI[of ?P \<gamma>] ordertype_Memrel[symmetric] assms
   unfolding cf_def by blast
 
 lemma cf_fun_succ':
   assumes "Ord(\<beta>)" "Ord(\<alpha>)" "f:\<alpha>\<rightarrow>succ(\<beta>)"
   shows "(\<exists>x\<in>\<alpha>. f`x=\<beta>) \<longleftrightarrow> cf_fun(f,succ(\<beta>))"
 proof (intro iffI)
   assume "(\<exists>x\<in>\<alpha>. f`x=\<beta>)"
   with assms
   show "cf_fun(f,succ(\<beta>))"
     using domain_of_fun[OF \<open>f:\<alpha>\<rightarrow>succ(\<beta>)\<close>]
     unfolding cf_fun_def cofinal_fun_def by auto
 next
   assume "cf_fun(f,succ(\<beta>))"
   with assms
   obtain x where "x\<in>\<alpha>" "\<langle>\<beta>,f`x\<rangle> \<in> Memrel(succ(\<beta>)) \<or> \<beta> = f ` x"
     using domain_of_fun[OF \<open>f:\<alpha>\<rightarrow>succ(\<beta>)\<close>]
     unfolding cf_fun_def cofinal_fun_def by auto
   moreover from \<open>Ord(\<beta>)\<close>
   have "\<langle>\<beta>,y\<rangle> \<notin> Memrel(succ(\<beta>))" for y
     using foundation unfolding Memrel_def by blast
   ultimately
   show "\<exists>x\<in>\<alpha>. f ` x = \<beta>" by blast
 qed
 
 lemma cf_fun_succ:
   "Ord(\<beta>) \<Longrightarrow> f:1\<rightarrow>succ(\<beta>) \<Longrightarrow> f`0=\<beta> \<Longrightarrow> cf_fun(f,succ(\<beta>))"
   using cf_fun_succ' by blast
 
 lemma ordertype_0_not_cofinal_succ:
   assumes "ordertype(A,Memrel(succ(i))) = 0"  "A\<subseteq>succ(i)" "Ord(i)"
   shows "\<not>cofinal(A,succ(i),Memrel(succ(i)))"
 proof
   have 1:"ordertype(A,Memrel(succ(i))) = ordertype(0,Memrel(0))"
     using \<open>ordertype(A,Memrel(succ(i))) = 0\<close> ordertype_0 by simp
   from  \<open>A\<subseteq>succ(i)\<close> \<open>Ord(i)\<close>
   have "\<exists>f. f \<in> \<langle>A, Memrel(succ(i))\<rangle> \<cong> \<langle>0, Memrel(0)\<rangle>"
     using   well_ord_Memrel well_ord_subset
       ordertype_eq_imp_ord_iso[OF 1] Ord_0  by blast
   then
   have "A=0"
     using  ord_iso_is_bij bij_imp_eqpoll eqpoll_0_is_0 by blast
   moreover
   assume "cofinal(A, succ(i), Memrel(succ(i)))"
   moreover
   note \<open>Ord(i)\<close>
   ultimately
   show "False"
     using not_mem_empty unfolding cofinal_def by auto
 qed
 
 text\<open>I thank Edwin Pacheco Rodríguez for the following lemma.\<close>
 lemma cf_succ:
   assumes "Ord(\<alpha>)"
   shows "cf(succ(\<alpha>)) = 1"
 proof -
   define f where "f \<equiv> {\<langle>0,\<alpha>\<rangle>}"
   then
   have  "f : 1\<rightarrow>succ(\<alpha>)" "f`0 = \<alpha>"
     using fun_extend3[of 0 0 "succ(\<alpha>)" 0 \<alpha>] singleton_0 by auto
   with assms
   have "cf_fun(f,succ(\<alpha>))"
     using cf_fun_succ unfolding cofinal_fun_def by simp
   from \<open>f:1\<rightarrow>succ(\<alpha>)\<close>
   have "0\<in>domain(f)" using domain_of_fun by simp
   define A where "A={f`0}"
   with \<open>cf_fun(f,succ(\<alpha>))\<close> \<open>0\<in>domain(f)\<close> \<open>f`0=\<alpha>\<close>
   have "cofinal(A,succ(\<alpha>),Memrel(succ(\<alpha>)))"
     unfolding cofinal_def cofinal_fun_def by simp
   moreover from  \<open>f`0=\<alpha>\<close> \<open>A={f`0}\<close>
   have "A \<subseteq> succ(\<alpha>)" unfolding succ_def  by auto
   moreover from \<open>Ord(\<alpha>)\<close> \<open>A\<subseteq> succ(\<alpha>)\<close>
   have "well_ord(A,Memrel(succ(\<alpha>)))"
     using Ord_succ well_ord_Memrel  well_ord_subset relation_Memrel by blast
   moreover from \<open>Ord(\<alpha>)\<close>
   have "\<not>(\<exists>A. A \<subseteq> succ(\<alpha>) \<and> cofinal(A, succ(\<alpha>), Memrel(succ(\<alpha>))) \<and> 0 = ordertype(A, Memrel(succ(\<alpha>))))"
     (is "\<not>?P(0)")
     using ordertype_0_not_cofinal_succ  unfolding cf_def  by auto
   moreover
   have "1 = ordertype(A,Memrel(succ(\<alpha>)))"
   proof -
     from \<open>A={f`0}\<close>
     have "A\<approx>1" using singleton_eqpoll_1 by simp
     with \<open>well_ord(A,Memrel(succ(\<alpha>)))\<close>
     show ?thesis using nat_1I ordertype_eq_n by simp
   qed
   ultimately
   show "cf(succ(\<alpha>)) = 1" using Ord_1  Least_equality[of ?P 1]
     unfolding cf_def by blast
 qed
 
 lemma cf_zero [simp]:
   "cf(0) = 0"
   unfolding cf_def cofinal_def using
     ordertype_0 subset_empty_iff Least_le[of _ 0] by auto
 
 lemma surj_is_cofinal: "f \<in> surj(\<delta>,\<gamma>) \<Longrightarrow> cf_fun(f,\<gamma>)"
   unfolding surj_def cofinal_fun_def cf_fun_def
   using domain_of_fun by force
 
 lemma cf_zero_iff: "Ord(\<alpha>) \<Longrightarrow> cf(\<alpha>) = 0 \<longleftrightarrow> \<alpha> = 0"
 proof (intro iffI)
   assume "\<alpha> = 0" "Ord(\<alpha>)"
   then
   show "cf(\<alpha>) = 0" using cf_zero by simp
 next
   assume "cf(\<alpha>) = 0" "Ord(\<alpha>)"
   moreover from this
   obtain A where "A\<subseteq>\<alpha>" "cf(\<alpha>) = ordertype(A,Memrel(\<alpha>))"
     "cofinal(A,\<alpha>,Memrel(\<alpha>))"
     using cf_is_ordertype by blast
   ultimately
   have "cofinal(0,\<alpha>,Memrel(\<alpha>))"
     using ordertype_zero_imp_zero[of A "Memrel(\<alpha>)"] by simp
   then
   show "\<alpha>=0"
     unfolding cofinal_def by blast
 qed
 
 \<comment> \<open>TODO: define Succ (predicate for successor ordinals)\<close>
 lemma cf_eq_one_iff:
   assumes "Ord(\<gamma>)"
   shows "cf(\<gamma>) = 1 \<longleftrightarrow> (\<exists>\<alpha>. Ord(\<alpha>) \<and> \<gamma>  = succ(\<alpha>))"
 proof (intro iffI)
   assume "\<exists>\<alpha>. Ord(\<alpha>) \<and> \<gamma>  = succ(\<alpha>)"
   then
   show "cf(\<gamma>) = 1" using cf_succ by auto
 next
   assume "cf(\<gamma>) = 1"
   moreover from assms
   obtain A where "A \<subseteq> \<gamma>" "cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     "cofinal(A,\<gamma>,Memrel(\<gamma>))"
     using cf_is_ordertype by blast
   ultimately
   have "ordertype(A,Memrel(\<gamma>)) = 1" by simp
   moreover
   define f where "f\<equiv>converse(ordermap(A,Memrel(\<gamma>)))"
   moreover from this \<open>ordertype(A,Memrel(\<gamma>)) = 1\<close> \<open>A \<subseteq> \<gamma>\<close> assms
   have "f \<in> surj(1,A)"
     using well_ord_subset[OF well_ord_Memrel, THEN ordermap_bij,
         THEN bij_converse_bij, of \<gamma> A] bij_is_surj
     by simp
   with \<open>cofinal(A,\<gamma>,Memrel(\<gamma>))\<close>
   have "\<forall>a\<in>\<gamma>. \<langle>a, f`0\<rangle> \<in> Memrel(\<gamma>) \<or> a = f`0"
     unfolding cofinal_def surj_def
     by auto
   with assms \<open>A \<subseteq> \<gamma>\<close> \<open>f \<in> surj(1,A)\<close>
   show "\<exists>\<alpha>. Ord(\<alpha>) \<and> \<gamma>  = succ(\<alpha>)"
     using Ord_has_max_imp_succ[of \<gamma> "f`0"]
       surj_is_fun[of f 1 A] apply_type[of f 1 "\<lambda>_.A" 0]
     unfolding lt_def
     by (auto intro:Ord_in_Ord)
 qed
 
 lemma ordertype_in_cf_imp_not_cofinal:
   assumes
     "ordertype(A,Memrel(\<gamma>)) \<in> cf(\<gamma>)"
     "A \<subseteq> \<gamma>"
   shows
     "\<not> cofinal(A,\<gamma>,Memrel(\<gamma>))"
 proof
   note \<open>A \<subseteq> \<gamma>\<close>
   moreover
   assume "cofinal(A,\<gamma>,Memrel(\<gamma>))"
   ultimately
   have "\<exists>B. B \<subseteq> \<gamma> \<and> cofinal(B, \<gamma>, Memrel(\<gamma>)) \<and>  ordertype(A,Memrel(\<gamma>)) = ordertype(B, Memrel(\<gamma>))"
     (is "?P(ordertype(A,_))")
     by blast
   moreover from assms
   have "ordertype(A,Memrel(\<gamma>)) < cf(\<gamma>)"
     using Ord_cf ltI by blast
   ultimately
   show "False"
     unfolding cf_def using less_LeastE[of ?P  "ordertype(A,Memrel(\<gamma>))"]
     by auto
 qed
 
 lemma cofinal_mono_map_cf:
   assumes "Ord(\<gamma>)"
   shows "\<exists>j \<in> mono_map(cf(\<gamma>), Memrel(cf(\<gamma>)), \<gamma>, Memrel(\<gamma>)) . cf_fun(j,\<gamma>)"
 proof -
   note assms
   moreover from this
   obtain A where "A \<subseteq> \<gamma>" "cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     "cofinal(A,\<gamma>,Memrel(\<gamma>))"
     using cf_is_ordertype by blast
   moreover
   define j where "j \<equiv> converse(ordermap(A,Memrel(\<gamma>)))"
   moreover from calculation
   have "j :cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma>"
     using ordertype_ord_iso[THEN ord_iso_sym,
         THEN ord_iso_is_mono_map, THEN mono_map_mono,
         of A "Memrel(\<gamma>)" \<gamma>] well_ord_Memrel[THEN well_ord_subset]
     by simp
   moreover from calculation
   have "j \<in> surj(cf(\<gamma>),A)"
     using well_ord_Memrel[THEN well_ord_subset, THEN ordertype_ord_iso,
         THEN ord_iso_sym, of \<gamma> A, THEN ord_iso_is_bij,
         THEN bij_is_surj]
     by simp
   with \<open>cofinal(A,\<gamma>,Memrel(\<gamma>))\<close>
   have "cf_fun(j,\<gamma>)"
     using cofinal_range_iff_cofinal_fun[of j \<gamma> "Memrel(\<gamma>)"]
       surj_range[of j "cf(\<gamma>)" A] surj_is_fun fun_is_function
     by fastforce
   with \<open>j \<in> mono_map(_,_,_,_)\<close>
   show ?thesis by auto
 qed
 
 
 subsection\<open>The factorization lemma\<close>
 
 text\<open>In this subsection we prove a factorization lemma for cofinal functions
 into ordinals, which shows that any cofinal function between ordinals can be
 ``decomposed'' in such a way that a commutative triangle of strictly increasing
 maps arises.
 
 The factorization lemma has a kind of
 fundamental character, in that the rest of the basic results on cofinality
 (for, instance, idempotence) follow easily from it, in a more algebraic way.
 
 This is a consequence that the proof encapsulates uses of transfinite
 recursion in the basic theory of cofinality; indeed, only one use is needed.
 In the setting of Isabelle/ZF, this is convenient since the machinery of
 recursion is pretty clumsy. On the downside, this way of presenting things 
 results in a longer proof of the factorization lemma. This approach was
 taken by the author in the notes \cite{apunte_st} for an introductory course
 in Set Theory.
 
 To organize the use of the hypotheses of the factorization lemma,
 we set up a locale containing all the relevant ingredients.
 \<close>
 locale cofinal_factor =
   fixes j \<delta> \<xi> \<gamma> f
   assumes j_mono: "j :\<xi> \<rightarrow>\<^sub>< \<gamma>"
     and     ords: "Ord(\<delta>)" "Ord(\<xi>)" "Limit(\<gamma>)"
     and   f_type: "f: \<delta> \<rightarrow> \<gamma>"
 begin
 
 text\<open>Here, \<^term>\<open>f\<close> is cofinal function from \<^term>\<open>\<delta>\<close> to \<^term>\<open>\<gamma>\<close>, and the
 ordinal \<^term>\<open>\<xi>\<close> is meant to be the cofinality of \<^term>\<open>\<gamma>\<close>. Hence, there exists
 an increasing map \<^term>\<open>j\<close> from  \<^term>\<open>\<xi>\<close> to  \<^term>\<open>\<gamma>\<close> by the last lemma.
 
 The main goal is to construct an increasing function \<^term>\<open>g:\<xi>\<rightarrow>\<delta>\<close> such that
 the composition \<^term>\<open>f O g\<close> is still cofinal but also increasing.\<close>
 
 definition
   factor_body :: "[i,i,i] \<Rightarrow> o" where
   "factor_body(\<beta>,h,x) \<equiv> (x\<in>\<delta> \<and> j`\<beta> \<le> f`x \<and> (\<forall>\<alpha><\<beta> . f`(h`\<alpha>) < f`x)) \<or> x=\<delta>"
 
 definition
   factor_rec :: "[i,i] \<Rightarrow> i" where
   "factor_rec(\<beta>,h) \<equiv>  \<mu> x. factor_body(\<beta>,h,x)"
 
-txt\<open>\<^term>\<open>factor_rec\<close> is the inductive step for the definition by transfinite
+text\<open>\<^term>\<open>factor_rec\<close> is the inductive step for the definition by transfinite
 recursion of the \<^emph>\<open>factor\<close> function (called \<^term>\<open>g\<close> above), which in
 turn is obtained by minimizing the predicate \<^term>\<open>factor_body\<close>. Next we show
 that this predicate is monotonous.\<close>
 
 lemma factor_body_mono:
   assumes
     "\<beta>\<in>\<xi>" "\<alpha><\<beta>"
     "factor_body(\<beta>,\<lambda>x\<in>\<beta>. G(x),x)"
   shows
     "factor_body(\<alpha>,\<lambda>x\<in>\<alpha>. G(x),x)"
 proof -
   from \<open>\<alpha><\<beta>\<close>
   have "\<alpha>\<in>\<beta>" using ltD by simp
   moreover
   note \<open>\<beta>\<in>\<xi>\<close>
   moreover from calculation
   have "\<alpha>\<in>\<xi>" using ords ltD Ord_cf Ord_trans by blast
   ultimately
   have "j`\<alpha> \<in> j`\<beta>" using j_mono mono_map_increasing by blast
   moreover from \<open>\<beta>\<in>\<xi>\<close>
   have "j`\<beta>\<in>\<gamma>"
     using j_mono domain_of_fun apply_rangeI mono_map_is_fun by force
   moreover from this
   have "Ord(j`\<beta>)"
     using Ord_in_Ord ords Limit_is_Ord by auto
   ultimately
   have "j`\<alpha> \<le> j`\<beta>"  unfolding lt_def by blast
   then
   have "j`\<beta> \<le> f`\<theta> \<Longrightarrow> j`\<alpha> \<le> f`\<theta>" for \<theta> using le_trans by blast
   moreover
   have "f`((\<lambda>w\<in>\<alpha>. G(w))`y) < f`z" if "z\<in>\<delta>" "\<forall>x<\<beta>. f`((\<lambda>w\<in>\<beta>. G(w))`x) < f`z" "y<\<alpha>" for y z
   proof -
     note \<open>y<\<alpha>\<close>
     also
     note \<open>\<alpha><\<beta>\<close>
     finally
     have "y<\<beta>" by simp
     with \<open>\<forall>x<\<beta>. f`((\<lambda>w\<in>\<beta>. G(w))`x) < f`z\<close>
     have "f ` ((\<lambda>w\<in>\<beta>. G(w)) ` y) < f ` z" by simp
     moreover from \<open>y<\<alpha>\<close> \<open>y<\<beta>\<close>
     have "(\<lambda>w\<in>\<beta>. G(w)) ` y = (\<lambda>w\<in>\<alpha>. G(w)) ` y"
       using beta_if  by (auto dest:ltD)
     ultimately show ?thesis by simp
   qed
   moreover
   note \<open>factor_body(\<beta>,\<lambda>x\<in>\<beta>. G(x),x)\<close>
   ultimately
   show ?thesis
     unfolding factor_body_def by blast
 qed
 
 lemma factor_body_simp[simp]: "factor_body(\<alpha>,g,\<delta>)"
   unfolding factor_body_def by simp
 
 lemma factor_rec_mono:
   assumes
     "\<beta>\<in>\<xi>" "\<alpha><\<beta>"
   shows
     "factor_rec(\<alpha>,\<lambda>x\<in>\<alpha>. G(x)) \<le> factor_rec(\<beta>,\<lambda>x\<in>\<beta>. G(x))"
   unfolding factor_rec_def
   using assms ords factor_body_mono Least_antitone by simp
 
 text\<open>We now define the factor as higher-order function.
 Later it will be restricted to a set to obtain a bona fide function of
 type @{typ i}.\<close>
 definition
   factor :: "i \<Rightarrow> i" where
   "factor(\<beta>) \<equiv> transrec(\<beta>,factor_rec)"
 
 lemma factor_unfold:
   "factor(\<alpha>) = factor_rec(\<alpha>,\<lambda>x\<in>\<alpha>. factor(x))"
   using def_transrec[OF factor_def] .
 
 lemma factor_mono:
   assumes "\<beta>\<in>\<xi>" "\<alpha><\<beta>" "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>"
   shows "factor(\<alpha>) \<le> factor(\<beta>)"
 proof -
   have "factor(\<alpha>) = factor_rec(\<alpha>, \<lambda>x\<in>\<alpha>. factor(x))"
     using factor_unfold .
   also from assms and factor_rec_mono
   have "... \<le> factor_rec(\<beta>, \<lambda>x\<in>\<beta>. factor(x))"
     by simp
   also
   have "factor_rec(\<beta>, \<lambda>x\<in>\<beta>. factor(x)) = factor(\<beta>)"
     using def_transrec[OF factor_def, symmetric] .
   finally show ?thesis .
 qed
 
 text\<open>The factor satisfies the predicate body of the minimization.\<close>
 
 lemma factor_body_factor:
   "factor_body(\<alpha>,\<lambda>x\<in>\<alpha>. factor(x),factor(\<alpha>))"
   using ords factor_unfold[of \<alpha>]
     LeastI[of "factor_body(_,_)" \<delta>]
   unfolding factor_rec_def by simp
 
 lemma factor_type [TC]: "Ord(factor(\<alpha>))"
   using ords factor_unfold[of \<alpha>]
   unfolding factor_rec_def by simp
 
 text\<open>The value \<^term>\<open>\<delta>\<close> in \<^term>\<open>factor_body\<close> (and therefore, in
 \<^term>\<open>factor\<close>) is meant to be a ``default value''. Whenever it is not 
 attained, the factor function behaves as expected: It is increasing
 and its composition with \<^term>\<open>f\<close> also is.\<close>
 
 lemma f_factor_increasing:
   assumes "\<beta>\<in>\<xi>" "\<alpha><\<beta>" "factor(\<beta>)\<noteq>\<delta>"
   shows "f`factor(\<alpha>) < f`factor(\<beta>)"
 proof -
   from assms
   have "f ` ((\<lambda>x\<in>\<beta>. factor(x)) ` \<alpha>) < f ` factor(\<beta>)"
     using factor_unfold[of \<beta>] ords LeastI[of "factor_body(\<beta>,\<lambda>x\<in>\<beta>. factor(x))"]
     unfolding factor_rec_def factor_body_def
     by (auto simp del:beta_if)
   with \<open>\<alpha><\<beta>\<close>
   show ?thesis using ltD by auto
 qed
 
 lemma factor_increasing:
   assumes "\<beta>\<in>\<xi>" "\<alpha><\<beta>" "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>"
   shows "factor(\<alpha>)<factor(\<beta>)"
   using assms f_factor_increasing factor_mono by (force intro:le_neq_imp_lt)
 
 lemma factor_in_delta:
   assumes "factor(\<beta>) \<noteq> \<delta>"
   shows "factor(\<beta>) \<in> \<delta>"
   using assms factor_body_factor ords
   unfolding factor_body_def by auto
 
 text\<open>Finally, we define the (set) factor function as the restriction of
 factor to the ordinal  \<^term>\<open>\<xi>\<close>.\<close>
 
 definition
   fun_factor :: "i" where
   "fun_factor \<equiv> \<lambda>\<beta>\<in>\<xi>. factor(\<beta>)"
 
 lemma fun_factor_is_mono_map:
   assumes "\<And>\<beta>. \<beta> \<in> \<xi> \<Longrightarrow> factor(\<beta>) \<noteq> \<delta>"
   shows "fun_factor \<in> mono_map(\<xi>, Memrel(\<xi>), \<delta>, Memrel(\<delta>))"
   unfolding mono_map_def
 proof (intro CollectI ballI impI)
   (* Proof that \<^term>\<open>fun_factor\<close> respects membership *)
   fix \<alpha> \<beta>
   assume "\<alpha>\<in>\<xi>" "\<beta>\<in>\<xi>"
   moreover
   note assms
   moreover from calculation
   have "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>" "Ord(\<beta>)"
     using factor_in_delta Ord_in_Ord ords by auto
   moreover
   assume "\<langle>\<alpha>, \<beta>\<rangle> \<in> Memrel(\<xi>)"
   ultimately
   show "\<langle>fun_factor ` \<alpha>, fun_factor ` \<beta>\<rangle> \<in> Memrel(\<delta>)"
     unfolding fun_factor_def
     using ltI factor_increasing[THEN ltD] factor_in_delta
     by simp
 next
   (* Proof of type *)
   from assms
   show "fun_factor : \<xi> \<rightarrow> \<delta>"
     unfolding fun_factor_def
     using ltI lam_type factor_in_delta by simp
 qed
 
 lemma f_fun_factor_is_mono_map:
   assumes "\<And>\<beta>. \<beta> \<in> \<xi> \<Longrightarrow> factor(\<beta>) \<noteq> \<delta>"
   shows "f O fun_factor \<in> mono_map(\<xi>, Memrel(\<xi>), \<gamma>, Memrel(\<gamma>))"
   unfolding mono_map_def
   using f_type
 proof (intro CollectI ballI impI comp_fun[of _ _ \<delta>])
   from assms
   show "fun_factor : \<xi> \<rightarrow> \<delta>"
     using fun_factor_is_mono_map mono_map_is_fun by simp
       (* Proof that f O ?g respects membership *)
   fix \<alpha> \<beta>
   assume "\<langle>\<alpha>, \<beta>\<rangle> \<in> Memrel(\<xi>)"
   then
   have "\<alpha><\<beta>"
     using Ord_in_Ord[of "\<xi>"] ltI ords by blast
   assume "\<alpha>\<in>\<xi>" "\<beta>\<in>\<xi>"
   moreover from this and assms
   have "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>" by auto
   moreover
   have "Ord(\<gamma>)" "\<gamma>\<noteq>0" using ords Limit_is_Ord by auto
   moreover
   note \<open>\<alpha><\<beta>\<close> \<open>fun_factor : \<xi> \<rightarrow> \<delta>\<close>
   ultimately
   show "\<langle>(f O fun_factor) ` \<alpha>, (f O fun_factor) ` \<beta>\<rangle> \<in> Memrel(\<gamma>)"
     using ltD[of "f ` factor(\<alpha>)" "f ` factor(\<beta>)"]
-      f_factor_increasing apply_in_range f_type
+      f_factor_increasing apply_in_codomain_Ord f_type
     unfolding fun_factor_def by auto
 qed
 
 end (* cofinal_factor *)
 
 text\<open>We state next the factorization lemma.\<close>
 
 lemma cofinal_fun_factorization:
   notes le_imp_subset [dest] lt_trans2 [trans]
   assumes
     "Ord(\<delta>)" "Limit(\<gamma>)" "f: \<delta> \<rightarrow> \<gamma>" "cf_fun(f,\<gamma>)"
   shows
     "\<exists>g \<in> cf(\<gamma>) \<rightarrow>\<^sub>< \<delta>.  f O g : cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma> \<and>
            cofinal_fun(f O g,\<gamma>,Memrel(\<gamma>))"
 proof -
   from \<open>Limit(\<gamma>)\<close>
   have "Ord(\<gamma>)" using Limit_is_Ord by simp
   then
   obtain j where "j :cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma>" "cf_fun(j,\<gamma>)"
     using cofinal_mono_map_cf by blast
   then
   have "domain(j) = cf(\<gamma>)"
     using domain_of_fun mono_map_is_fun by force
   from \<open>j \<in> _\<close> assms
   interpret cofinal_factor j \<delta> "cf(\<gamma>)"
     by (unfold_locales) (simp_all)
   text\<open>The core of the argument is to show that the factor function
   indeed maps into \<^term>\<open>\<delta>\<close>, therefore its values satisfy the first
   disjunct of \<^term>\<open>factor_body\<close>. This holds in turn because no
   restriction of the factor composed with \<^term>\<open>f\<close> to a proper initial
   segment of \<^term>\<open>cf(\<gamma>)\<close> can be cofinal in \<^term>\<open>\<gamma>\<close> by definition of
   cofinality. Hence there must be a witness that satisfies the first
   disjunct.\<close>
   have factor_not_delta: "factor(\<beta>)\<noteq>\<delta>" if "\<beta> \<in> cf(\<gamma>)" for \<beta>
     text\<open>For this, we induct on \<^term>\<open>\<beta>\<close> ranging over \<^term>\<open>cf(\<gamma>)\<close>.\<close>
   proof (induct \<beta> rule:Ord_induct[OF _ Ord_cf[of \<gamma>]])
     case 1 with that show ?case .
   next
     case (2 \<beta>)
     then
     have IH: "z\<in>\<beta> \<Longrightarrow> factor(z)\<noteq>\<delta>" for z by simp
     define h where "h \<equiv> \<lambda>x\<in>\<beta>. f`factor(x)"
     from IH
     have "z\<in>\<beta> \<Longrightarrow> factor(z) \<in> \<delta>" for z
       using factor_in_delta by blast
     with \<open>f:\<delta>\<rightarrow>\<gamma>\<close>
     have "h : \<beta> \<rightarrow> \<gamma>" unfolding h_def using apply_funtype lam_type by auto
     then
     have "h : \<beta> \<rightarrow>\<^sub>< \<gamma>"
       unfolding mono_map_def
     proof (intro CollectI ballI impI)
       fix x y
       assume "x\<in>\<beta>" "y\<in>\<beta>"
       moreover from this and IH
       have "factor(y) \<noteq> \<delta>" by simp
       moreover from calculation and \<open>h \<in> \<beta> \<rightarrow> \<gamma>\<close>
       have "h`x \<in> \<gamma>" "h`y \<in> \<gamma>" by simp_all
       moreover from \<open>\<beta>\<in>cf(\<gamma>)\<close> and \<open>y\<in>\<beta>\<close>
       have "y \<in> cf(\<gamma>)"
         using Ord_trans Ord_cf by blast
       moreover from this
       have "Ord(y)"
         using Ord_cf Ord_in_Ord by blast
       moreover
       assume "\<langle>x,y\<rangle> \<in> Memrel(\<beta>)"
       moreover from calculation
       have "x<y" by (blast intro:ltI)
       ultimately
       show "\<langle>h ` x, h ` y\<rangle> \<in> Memrel(\<gamma>)"
         unfolding h_def using f_factor_increasing ltD by (auto)
     qed
     with \<open>\<beta>\<in>cf(\<gamma>)\<close> \<open>Ord(\<gamma>)\<close>
     have "ordertype(h``\<beta>,Memrel(\<gamma>)) = \<beta>" (* Maybe should use range(h) *)
       using mono_map_ordertype_image[of \<beta>] Ord_cf Ord_in_Ord by blast
     also
     note \<open>\<beta> \<in>cf(\<gamma>)\<close>
     finally
     have "ordertype(h``\<beta>,Memrel(\<gamma>)) \<in> cf(\<gamma>)" by simp
     moreover from \<open>h \<in> \<beta> \<rightarrow> \<gamma>\<close>
     have "h``\<beta> \<subseteq> \<gamma>"
       using mono_map_is_fun Image_sub_codomain by blast
     ultimately
     have "\<not> cofinal(h``\<beta>,\<gamma>,Memrel(\<gamma>))"
       using ordertype_in_cf_imp_not_cofinal by simp
     then
     obtain \<alpha>_0 where "\<alpha>_0\<in>\<gamma>" "\<forall>x\<in>h `` \<beta>. \<not> \<langle>\<alpha>_0, x\<rangle> \<in> Memrel(\<gamma>) \<and> \<alpha>_0 \<noteq> x"
       unfolding cofinal_def by auto
     with \<open>Ord(\<gamma>)\<close> \<open>h``\<beta> \<subseteq> \<gamma>\<close>
     have "\<forall>x\<in>h `` \<beta>. x \<in> \<alpha>_0"
       using well_ord_Memrel[of \<gamma>] well_ord_is_linear[of \<gamma> "Memrel(\<gamma>)"]
       unfolding linear_def by blast
     from \<open>\<alpha>_0 \<in> \<gamma>\<close> \<open>j \<in> mono_map(_,_,\<gamma>,_)\<close> \<open>Ord(\<gamma>)\<close>
     have "j`\<beta> \<in> \<gamma>"
-      using mono_map_is_fun apply_in_range by force
+      using mono_map_is_fun apply_in_codomain_Ord by force
     with \<open>\<alpha>_0 \<in> \<gamma>\<close> \<open>Ord(\<gamma>)\<close>
     have "\<alpha>_0 \<union> j`\<beta> \<in> \<gamma>"
       using Un_least_mem_iff Ord_in_Ord by auto
     with \<open>cf_fun(f,\<gamma>)\<close>
     obtain \<theta> where "\<theta>\<in>domain(f)" "\<langle>\<alpha>_0 \<union> j`\<beta>, f ` \<theta>\<rangle> \<in> Memrel(\<gamma>) \<or>  \<alpha>_0 \<union> j`\<beta> = f ` \<theta>"
       by (auto simp add:cofinal_fun_def) blast
     moreover from this and \<open>f:\<delta>\<rightarrow>\<gamma>\<close>
     have "\<theta> \<in> \<delta>" using domain_of_fun by auto
     moreover
     note \<open>Ord(\<gamma>)\<close>
     moreover from this and \<open>f:\<delta>\<rightarrow>\<gamma>\<close>  \<open>\<alpha>_0 \<in> \<gamma>\<close>
     have "Ord(f`\<theta>)"
-      using apply_in_range Ord_in_Ord by blast
+      using apply_in_codomain_Ord Ord_in_Ord by blast
     moreover from calculation and \<open>\<alpha>_0 \<in> \<gamma>\<close> and \<open>Ord(\<delta>)\<close> and \<open>j`\<beta> \<in> \<gamma>\<close>
     have "Ord(\<alpha>_0)" "Ord(j`\<beta>)" "Ord(\<theta>)"
       using Ord_in_Ord by auto
     moreover from \<open>\<forall>x\<in>h `` \<beta>. x \<in> \<alpha>_0\<close> \<open>Ord(\<alpha>_0)\<close> \<open>h:\<beta>\<rightarrow>\<gamma>\<close>
     have "x\<in>\<beta> \<Longrightarrow> h`x < \<alpha>_0" for x
       using fun_is_function[of h \<beta> "\<lambda>_. \<gamma>"]
         Image_subset_Ord_imp_lt domain_of_fun[of h \<beta> "\<lambda>_. \<gamma>"]
       by blast
     moreover
     have "x\<in>\<beta> \<Longrightarrow> h`x < f`\<theta>" for x
     proof -
       fix x
       assume "x\<in>\<beta>"
       with \<open>\<forall>x\<in>h `` \<beta>. x \<in> \<alpha>_0\<close> \<open>Ord(\<alpha>_0)\<close> \<open>h:\<beta>\<rightarrow>\<gamma>\<close>
       have "h`x < \<alpha>_0"
         using fun_is_function[of h \<beta> "\<lambda>_. \<gamma>"]
           Image_subset_Ord_imp_lt domain_of_fun[of h \<beta> "\<lambda>_. \<gamma>"]
         by blast
       also from \<open>\<langle>\<alpha>_0 \<union> _, f ` \<theta>\<rangle> \<in> Memrel(\<gamma>) \<or> \<alpha>_0 \<union> _= f ` \<theta>\<close>
         \<open>Ord(f`\<theta>)\<close> \<open>Ord(\<alpha>_0)\<close> \<open>Ord(j`\<beta>)\<close>
       have "\<alpha>_0 \<le> f`\<theta>"
         using Un_leD1[OF leI [OF ltI]] Un_leD1[OF le_eqI] by blast
       finally
       show "h`x < f`\<theta>" .
     qed
     ultimately
     have "factor_body(\<beta>,\<lambda>x\<in>\<beta>. factor(x),\<theta>)"
       unfolding h_def factor_body_def using ltD
       by (auto dest:Un_memD2 Un_leD2[OF le_eqI])
     with \<open>Ord(\<theta>)\<close>
     have "factor(\<beta>) \<le> \<theta>"
       using factor_unfold[of \<beta>] Least_le unfolding factor_rec_def by auto
     with \<open>\<theta>\<in>\<delta>\<close> \<open>Ord(\<delta>)\<close>
     have "factor(\<beta>) \<in> \<delta>"
       using leI[of \<theta>] ltI[of \<theta>]  by (auto dest:ltD)
     then
     show ?case by (auto elim:mem_irrefl)
   qed
   moreover
   have "cofinal_fun(f O fun_factor, \<gamma>, Memrel(\<gamma>))"
   proof (intro cofinal_funI)
     fix a
     assume "a \<in> \<gamma>"
     with \<open>cf_fun(j,\<gamma>)\<close> \<open>domain(j) = cf(\<gamma>)\<close>
     obtain x where "x\<in>cf(\<gamma>)" "a \<in> j`x \<or> a = j`x"
       by (auto simp add:cofinal_fun_def) blast
     with factor_not_delta
     have "x \<in> domain(f O fun_factor)"
       using f_fun_factor_is_mono_map mono_map_is_fun domain_of_fun by force
     moreover
     have "a \<in> (f O fun_factor) `x \<or> a = (f O fun_factor) `x"
     proof -
       from \<open>x\<in>cf(\<gamma>)\<close> factor_not_delta
       have "j ` x \<le> f ` factor(x)"
         using mem_not_refl factor_body_factor factor_in_delta
         unfolding factor_body_def by auto
       with \<open>a \<in> j`x \<or> a = j`x\<close>
       have "a \<in> f ` factor(x) \<or> a = f ` factor(x)"
         using ltD by blast
       with \<open>x\<in>cf(\<gamma>)\<close>
       show ?thesis using lam_funtype[of "cf(\<gamma>)" factor]
         unfolding fun_factor_def by auto
     qed
     moreover
     note \<open>a \<in> \<gamma>\<close>
     moreover from calculation and \<open>Ord(\<gamma>)\<close> and factor_not_delta
     have "(f O fun_factor) `x \<in> \<gamma>"
-      using Limit_nonzero apply_in_range mono_map_is_fun[of "f O fun_factor"]
+      using Limit_nonzero apply_in_codomain_Ord mono_map_is_fun[of "f O fun_factor"]
         f_fun_factor_is_mono_map by blast
     ultimately
     show "\<exists>x \<in> domain(f O fun_factor). \<langle>a, (f O fun_factor) ` x\<rangle> \<in> Memrel(\<gamma>)
                                        \<or> a = (f O fun_factor) `x"
       by blast
   qed
   ultimately
   show ?thesis
     using fun_factor_is_mono_map f_fun_factor_is_mono_map by blast
 qed
 
 text\<open>As a final observation in this part, we note that if the original
 cofinal map was increasing, then the factor function is also cofinal.\<close>
 lemma factor_is_cofinal:
   assumes
     "Ord(\<delta>)" "Ord(\<gamma>)"
     "f :\<delta> \<rightarrow>\<^sub>< \<gamma>"  "f O g \<in> mono_map(\<alpha>,r,\<gamma>,Memrel(\<gamma>))"
     "cofinal_fun(f O g,\<gamma>,Memrel(\<gamma>))" "g: \<alpha> \<rightarrow> \<delta>"
   shows
     "cf_fun(g,\<delta>)"
   unfolding cf_fun_def cofinal_fun_def
 proof
   fix a
   assume "a \<in> \<delta>"
   with \<open>f \<in> mono_map(\<delta>,_,\<gamma>,_)\<close>
   have "f`a \<in> \<gamma>"
     using mono_map_is_fun by force
   with \<open>cofinal_fun(f O g,\<gamma>,_)\<close>
   obtain y where "y\<in>\<alpha>"  "\<langle>f`a, (f O g) ` y\<rangle> \<in> Memrel(\<gamma>) \<or> f`a = (f O g) ` y"
     unfolding cofinal_fun_def using domain_of_fun[OF \<open>g:\<alpha> \<rightarrow> \<delta>\<close>] by blast
   with \<open>g:\<alpha> \<rightarrow> \<delta>\<close>
   have "\<langle>f`a, f ` (g ` y)\<rangle> \<in> Memrel(\<gamma>) \<or> f`a = f ` (g ` y)" "g`y \<in> \<delta>"
     using comp_fun_apply[of g \<alpha> \<delta> y f] by auto
   with assms(1-3) and \<open>a\<in>\<delta>\<close>
   have "\<langle>a, g ` y\<rangle> \<in> Memrel(\<delta>) \<or> a = g ` y"
     using Memrel_mono_map_reflects Memrel_mono_map_is_inj[of \<delta> f \<gamma> \<gamma>]
       inj_apply_equality[of f \<delta> \<gamma>]  by blast
   with \<open>y\<in>\<alpha>\<close>
   show "\<exists>x\<in>domain(g). \<langle>a, g ` x\<rangle> \<in> Memrel(\<delta>) \<or> a = g ` x"
     using domain_of_fun[OF \<open>g:\<alpha> \<rightarrow> \<delta>\<close>] by blast
 qed
 
 
 subsection\<open>Classical results on cofinalities\<close>
 
 text\<open>Now the rest of the results follow in a more algebraic way. The
 next proof one invokes a case analysis on whether the argument is zero,
 a successor ordinal or a limit one; the last case being the most
 relevant one and is immediate from the factorization lemma.\<close>
 
 lemma cf_le_domain_cofinal_fun:
   assumes
     "Ord(\<gamma>)" "Ord(\<delta>)" "f:\<delta> \<rightarrow> \<gamma>" "cf_fun(f,\<gamma>)"
   shows
     "cf(\<gamma>)\<le>\<delta>"
   using assms
 proof (cases rule:Ord_cases)
   case 0
   with \<open>Ord(\<delta>)\<close>
   show ?thesis using Ord_0_le by simp
 next
   case (succ \<gamma>)
   with assms
   obtain x where "x\<in>\<delta>" "f`x=\<gamma>" using cf_fun_succ' by blast
   then
   have "\<delta>\<noteq>0" by blast
   let ?f="{\<langle>0,f`x\<rangle>}"
   from \<open>f`x=\<gamma>\<close>
   have "?f:1\<rightarrow>succ(\<gamma>)"
     using singleton_0 singleton_fun[of 0 \<gamma>] singleton_subsetI fun_weaken_type by simp
   with \<open>Ord(\<gamma>)\<close>  \<open>f`x=\<gamma>\<close>
   have "cf(succ(\<gamma>)) = 1" using cf_succ by simp
   with \<open>\<delta>\<noteq>0\<close> succ
   show ?thesis using Ord_0_lt_iff succ_leI \<open>Ord(\<delta>)\<close> by simp
 next
   case (limit)
   with assms
   obtain g where "g :cf(\<gamma>) \<rightarrow>\<^sub>< \<delta>"
     using cofinal_fun_factorization by blast
   with assms
   show ?thesis using mono_map_imp_le by simp
 qed
 
 lemma cf_ordertype_cofinal:
   assumes
     "Limit(\<gamma>)" "A\<subseteq>\<gamma>" "cofinal(A,\<gamma>,Memrel(\<gamma>))"
   shows
     "cf(\<gamma>) = cf(ordertype(A,Memrel(\<gamma>)))"
 proof (intro le_anti_sym)
   from \<open>Limit(\<gamma>)\<close>
   have "Ord(\<gamma>)"
     using Limit_is_Ord by simp
   with \<open>A \<subseteq> \<gamma>\<close>
   have "well_ord(A,Memrel(\<gamma>))"
     using well_ord_Memrel well_ord_subset by blast
   then
   obtain f \<alpha> where "f:\<langle>\<alpha>, Memrel(\<alpha>)\<rangle> \<cong> \<langle>A,Memrel(\<gamma>)\<rangle>" "Ord(\<alpha>)" "\<alpha> = ordertype(A,Memrel(\<gamma>))"
     using ordertype_ord_iso Ord_ordertype ord_iso_sym by blast
   moreover from this
   have "f: \<alpha> \<rightarrow> A"
     using ord_iso_is_mono_map mono_map_is_fun[of f _ "Memrel(\<alpha>)"] by blast
   moreover from this
   have "function(f)"
     using fun_is_function by simp
   moreover from \<open>f:\<langle>\<alpha>, Memrel(\<alpha>)\<rangle> \<cong> \<langle>A,Memrel(\<gamma>)\<rangle>\<close>
   have "range(f) = A"
     using ord_iso_is_bij bij_is_surj surj_range by blast
   moreover note \<open>cofinal(A,\<gamma>,_)\<close>
   ultimately
   have "cf_fun(f,\<gamma>)"
     using cofinal_range_iff_cofinal_fun by blast
   moreover from \<open>Ord(\<alpha>)\<close>
   obtain h where "h :cf(\<alpha>) \<rightarrow>\<^sub>< \<alpha>" "cf_fun(h,\<alpha>)"
     using cofinal_mono_map_cf by blast
   moreover from \<open>Ord(\<gamma>)\<close>
   have "trans(Memrel(\<gamma>))"
     using trans_Memrel by simp
   moreover
   note \<open>A\<subseteq>\<gamma>\<close>
   ultimately
   have "cofinal_fun(f O h,\<gamma>,Memrel(\<gamma>))"
     using cofinal_comp ord_iso_is_mono_map[OF \<open>f:\<langle>\<alpha>,_\<rangle> \<cong> \<langle>A,_\<rangle>\<close>] mono_map_is_fun
       mono_map_mono by blast
   moreover from \<open>f:\<alpha>\<rightarrow>A\<close> \<open>A\<subseteq>\<gamma>\<close> \<open>h\<in>mono_map(cf(\<alpha>),_,\<alpha>,_)\<close>
   have "f O h : cf(\<alpha>) \<rightarrow> \<gamma>"
     using Pi_mono[of A \<gamma>] comp_fun  mono_map_is_fun by blast
   moreover
   note \<open>Ord(\<gamma>)\<close> \<open>Ord(\<alpha>)\<close> \<open>\<alpha> = ordertype(A,Memrel(\<gamma>))\<close>
   ultimately
   show "cf(\<gamma>) \<le> cf(ordertype(A,Memrel(\<gamma>)))"
     using cf_le_domain_cofinal_fun[of _ _ "f O h"]
     by (auto simp add:cf_fun_def)
       (********************************************************)
   from \<open>f:\<langle>\<alpha>, _\<rangle> \<cong> \<langle>A,_\<rangle>\<close> \<open>A\<subseteq>\<gamma>\<close>
   have "f :\<alpha> \<rightarrow>\<^sub>< \<gamma>"
     using mono_map_mono[OF ord_iso_is_mono_map] by simp
   then
   have "f: \<alpha> \<rightarrow> \<gamma>"
     using mono_map_is_fun by simp
   with \<open>cf_fun(f,\<gamma>)\<close> \<open>Limit(\<gamma>)\<close> \<open>Ord(\<alpha>)\<close>
   obtain g where "g :cf(\<gamma>) \<rightarrow>\<^sub>< \<alpha>"
     "f O g :cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma>"
     "cofinal_fun(f O g,\<gamma>,Memrel(\<gamma>))"
     using cofinal_fun_factorization by blast
   moreover from this
   have "g:cf(\<gamma>)\<rightarrow>\<alpha>"
     using mono_map_is_fun by simp
   moreover
   note \<open>Ord(\<alpha>)\<close>
   moreover from calculation and \<open>f :\<alpha> \<rightarrow>\<^sub>< \<gamma>\<close> \<open>Ord(\<gamma>)\<close>
   have "cf_fun(g,\<alpha>)"
     using factor_is_cofinal by blast
   moreover
   note \<open>\<alpha> = ordertype(A,Memrel(\<gamma>))\<close>
   ultimately
   show "cf(ordertype(A,Memrel(\<gamma>))) \<le> cf(\<gamma>)"
     using cf_le_domain_cofinal_fun[OF _ Ord_cf mono_map_is_fun] by simp
 qed
 
 lemma cf_idemp:
   assumes "Limit(\<gamma>)"
   shows "cf(\<gamma>) = cf(cf(\<gamma>))"
 proof -
   from assms
   obtain A where "A\<subseteq>\<gamma>" "cofinal(A,\<gamma>,Memrel(\<gamma>))" "cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     using Limit_is_Ord cf_is_ordertype by blast
   with assms
   have "cf(\<gamma>) = cf(ordertype(A,Memrel(\<gamma>)))" using cf_ordertype_cofinal by simp
   also
   have "... = cf(cf(\<gamma>))"
     using \<open>cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))\<close> by simp
   finally
   show "cf(\<gamma>) = cf(cf(\<gamma>))"  .
 qed
 
 lemma cf_le_cardinal:
   assumes "Limit(\<gamma>)"
   shows "cf(\<gamma>) \<le> |\<gamma>|"
 proof -
   from assms
   have \<open>Ord(\<gamma>)\<close> using Limit_is_Ord by simp
   then
   obtain f where "f \<in> surj(|\<gamma>|,\<gamma>)"
     using Ord_cardinal_eqpoll unfolding eqpoll_def bij_def by blast
   with \<open>Ord(\<gamma>)\<close>
   show ?thesis
     using Card_is_Ord[OF Card_cardinal] surj_is_cofinal
       cf_le_domain_cofinal_fun[of \<gamma>] surj_is_fun by blast
 qed
 
 lemma regular_is_Card:
   notes le_imp_subset [dest]
   assumes "Limit(\<gamma>)" "\<gamma> = cf(\<gamma>)"
   shows "Card(\<gamma>)"
 proof -
   from assms
   have "|\<gamma>| \<subseteq> \<gamma>"
     using Limit_is_Ord Ord_cardinal_le by blast
   also from \<open>\<gamma> = cf(\<gamma>)\<close>
   have "\<gamma> \<subseteq> cf(\<gamma>)" by simp
   finally
   have "|\<gamma>| \<subseteq> cf(\<gamma>)" .
   with assms
   show ?thesis unfolding Card_def using cf_le_cardinal by force
 qed
 
 lemma Limit_cf: assumes "Limit(\<kappa>)" shows "Limit(cf(\<kappa>))"
   using Ord_cf[of \<kappa>, THEN Ord_cases]
     \<comment> \<open>\<^term>\<open>cf(\<kappa>)\<close> being 0 or successor leads to contradiction\<close>
 proof (cases)
   case 1
   with \<open>Limit(\<kappa>)\<close>
   show ?thesis using cf_zero_iff Limit_is_Ord by simp
 next
   case (2 \<alpha>)
   moreover
   note \<open>Limit(\<kappa>)\<close>
   moreover from calculation
   have "cf(\<kappa>) = 1"
     using cf_idemp cf_succ by fastforce
   ultimately
   show ?thesis
     using succ_LimitE cf_eq_one_iff Limit_is_Ord
     by auto
 qed
 
 lemma InfCard_cf: "Limit(\<kappa>) \<Longrightarrow> InfCard(cf(\<kappa>))"
   using regular_is_Card cf_idemp Limit_cf nat_le_Limit Limit_cf
   unfolding InfCard_def by simp
 
 lemma cf_le_cf_fun:
   notes [dest] = Limit_is_Ord
   assumes "cf(\<kappa>) \<le> \<nu>" "Limit(\<kappa>)"
   shows "\<exists>f.  f:\<nu> \<rightarrow> \<kappa>  \<and>  cf_fun(f, \<kappa>)"
 proof -
   note assms
   moreover from this
   obtain h where h_cofinal_mono: "cf_fun(h,\<kappa>)"
     "h :cf(\<kappa>) \<rightarrow>\<^sub>< \<kappa>"
     "h : cf(\<kappa>) \<rightarrow> \<kappa>"
     using cofinal_mono_map_cf mono_map_is_fun by force
   moreover from calculation
   obtain g where "g \<in> inj(cf(\<kappa>), \<nu>)"
     using le_imp_lepoll by blast
   from this and calculation(2,3,5)
   obtain f where "f \<in> surj(\<nu>, cf(\<kappa>))" "f: \<nu> \<rightarrow> cf(\<kappa>)"
     using inj_imp_surj[OF _ Limit_has_0[THEN ltD]]
       surj_is_fun Limit_cf by blast
   moreover from this
   have "cf_fun(f,cf(\<kappa>))"
     using surj_is_cofinal by simp
   moreover
   note h_cofinal_mono \<open>Limit(\<kappa>)\<close>
   moreover from calculation
   have "cf_fun(h O f,\<kappa>)"
     using cf_fun_comp by blast
   moreover from calculation
   have "h O f \<in> \<nu> -> \<kappa>"
     using comp_fun by simp
   ultimately
   show ?thesis by blast
 qed
 
 lemma Limit_cofinal_fun_lt:
   notes [dest] = Limit_is_Ord
   assumes "Limit(\<kappa>)" "f: \<nu> \<rightarrow> \<kappa>" "cf_fun(f,\<kappa>)" "n\<in>\<kappa>"
   shows "\<exists>\<alpha>\<in>\<nu>. n < f`\<alpha>"
 proof -
   from \<open>Limit(\<kappa>)\<close> \<open>n\<in>\<kappa>\<close>
   have "succ(n) \<in> \<kappa>"
     using Limit_has_succ[OF _ ltI, THEN ltD] by auto
   moreover
   note \<open>f: \<nu> \<rightarrow> _\<close>
   moreover from this
   have "domain(f) = \<nu>"
     using domain_of_fun by simp
   moreover
   note \<open>cf_fun(f,\<kappa>)\<close>
   ultimately
   obtain \<alpha> where "\<alpha> \<in> \<nu>" "succ(n) \<in> f`\<alpha> \<or> succ(n) = f `\<alpha>"
     using cf_funD[THEN cofinal_funD] by blast
   moreover from this
   consider (1) "succ(n) \<in> f`\<alpha>" | (2) "succ(n) = f `\<alpha>"
     by blast
   then
   have "n < f`\<alpha>"
   proof (cases)
     case 1
     moreover
     have "n \<in> succ(n)" by simp
     moreover
     note \<open>Limit(\<kappa>)\<close> \<open>f: \<nu> \<rightarrow> _\<close> \<open>\<alpha> \<in> \<nu>\<close>
     moreover from this
     have "Ord(f ` \<alpha>)"
       using apply_type[of f \<nu> "\<lambda>_. \<kappa>", THEN [2] Ord_in_Ord]
       by blast
     ultimately
     show ?thesis
       using Ord_trans[of n "succ(n)" "f ` \<alpha>"] ltI  by blast
   next
     case 2
     have "n \<in> f ` \<alpha>" by (simp add:2[symmetric])
     with \<open>Limit(\<kappa>)\<close> \<open>f: \<nu> \<rightarrow> _\<close> \<open>\<alpha> \<in> \<nu>\<close>
     show ?thesis
       using ltI
         apply_type[of f \<nu> "\<lambda>_. \<kappa>", THEN [2] Ord_in_Ord]
       by blast
   qed
   ultimately
   show ?thesis by blast
 qed
 
 context
   includes Ord_dests Aleph_dests Aleph_intros Aleph_mem_dests mono_map_rules
 begin
 
 text\<open>We end this section by calculating the cofinality of Alephs, for
 the zero and limit case. The successor case depends on $\AC$.\<close>
 
 lemma cf_nat: "cf(\<omega>) = \<omega>"
   using Limit_nat[THEN InfCard_cf] cf_le_cardinal[of \<omega>]
     Card_nat[THEN Card_cardinal_eq] le_anti_sym
   unfolding InfCard_def by auto
 
 lemma cf_Aleph_zero: "cf(\<aleph>\<^bsub>0\<^esub>) = \<aleph>\<^bsub>0\<^esub>" 
   using cf_nat unfolding Aleph_def by simp
 
 lemma cf_Aleph_Limit:
   assumes "Limit(\<gamma>)"
   shows "cf(\<aleph>\<^bsub>\<gamma>\<^esub>) = cf(\<gamma>)" 
 proof -
   note \<open>Limit(\<gamma>)\<close>
   moreover from this
   have "(\<lambda>x\<in>\<gamma>. \<aleph>\<^bsub>x\<^esub>) : \<gamma> \<rightarrow> \<aleph>\<^bsub>\<gamma>\<^esub>" (is "?f : _ \<rightarrow> _")
     using lam_funtype[of _ Aleph] fun_weaken_type[of _ _ _ "\<aleph>\<^bsub>\<gamma>\<^esub>"] by blast
   moreover from \<open>Limit(\<gamma>)\<close>
   have "x \<in> y \<Longrightarrow> \<aleph>\<^bsub>x\<^esub> \<in> \<aleph>\<^bsub>y\<^esub>" if "x \<in> \<gamma>" "y \<in> \<gamma>" for x y
     using that Ord_in_Ord[of \<gamma>] Ord_trans[of _ _ \<gamma>] by blast
   ultimately
   have "?f \<in> mono_map(\<gamma>,Memrel(\<gamma>),\<aleph>\<^bsub>\<gamma>\<^esub>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>))"
     by auto
   with  \<open>Limit(\<gamma>)\<close> 
   have "?f \<in> \<langle>\<gamma>, Memrel(\<gamma>)\<rangle> \<cong> \<langle>?f``\<gamma>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)\<rangle>"
     using mono_map_imp_ord_iso_Memrel[of \<gamma> "\<aleph>\<^bsub>\<gamma>\<^esub>" ?f] 
       Card_Aleph (* Already an intro rule, but need it explicitly *)
     by blast
   then
   have "converse(?f) \<in> \<langle>?f``\<gamma>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)\<rangle> \<cong> \<langle>\<gamma>, Memrel(\<gamma>)\<rangle>"
     using ord_iso_sym by simp
   with \<open>Limit(\<gamma>)\<close>
   have "ordertype(?f``\<gamma>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)) = \<gamma>"
     using ordertype_eq[OF _ well_ord_Memrel]
     ordertype_Memrel by auto
   moreover from \<open>Limit(\<gamma>)\<close>
   have "cofinal(?f``\<gamma>, \<aleph>\<^bsub>\<gamma>\<^esub>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>))" 
     unfolding cofinal_def 
   proof (standard, intro ballI)
     fix a
     assume "a\<in>\<aleph>\<^bsub>\<gamma>\<^esub>" "\<aleph>\<^bsub>\<gamma>\<^esub> = (\<Union>i<\<gamma>. \<aleph>\<^bsub>i\<^esub>)"
     moreover from this
     obtain i where "i<\<gamma>" "a\<in>\<aleph>\<^bsub>i\<^esub>"
       by auto
     moreover from this and \<open>Limit(\<gamma>)\<close>
     have "Ord(i)" using ltD Ord_in_Ord by blast
     moreover from \<open>Limit(\<gamma>)\<close> and calculation
     have "succ(i) \<in> \<gamma>" using ltD by auto
     moreover from this and \<open>Ord(i)\<close>
     have "\<aleph>\<^bsub>i\<^esub> < \<aleph>\<^bsub>succ(i)\<^esub>" 
       by (auto) 
     ultimately
     have "\<langle>a,\<aleph>\<^bsub>i\<^esub>\<rangle> \<in> Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)"
       using ltD by (auto dest:Aleph_increasing)
     moreover from \<open>i<\<gamma>\<close>
     have "\<aleph>\<^bsub>i\<^esub> \<in> ?f``\<gamma>" 
       using ltD apply_in_image[OF \<open>?f : _ \<rightarrow> _\<close>] by auto
     ultimately
     show "\<exists>x\<in>?f `` \<gamma>. \<langle>a, x\<rangle> \<in> Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>) \<or> a = x" by blast
   qed
   moreover
   note \<open>?f: \<gamma> \<rightarrow> \<aleph>\<^bsub>\<gamma>\<^esub>\<close> \<open>Limit(\<gamma>)\<close>
   ultimately
   show "cf(\<aleph>\<^bsub>\<gamma>\<^esub>) =  cf(\<gamma>)"
     using cf_ordertype_cofinal[OF Limit_Aleph Image_sub_codomain, of \<gamma> ?f \<gamma> \<gamma> ] 
       Limit_is_Ord by simp 
 qed
 
 end (* includes *)
 
 end
\ No newline at end of file
diff --git a/thys/Delta_System_Lemma/Cohen_Posets.thy b/thys/Delta_System_Lemma/Cohen_Posets.thy
--- a/thys/Delta_System_Lemma/Cohen_Posets.thy
+++ b/thys/Delta_System_Lemma/Cohen_Posets.thy
@@ -1,248 +1,248 @@
 subsection\<open>Application to Cohen posets\label{sec:cohen}\<close>
 
 theory Cohen_Posets
   imports 
     Delta_System
 
 begin
 
 text\<open>We end this session by applying DSL to the combinatorics of
 finite function posets. We first define some basic concepts; we take
 a different approach from \cite{2020arXiv200109715G}, in that the
 order relation is presented as a predicate (of type @{typ \<open>[i,i] \<Rightarrow> o\<close>}). 
 
 Two elements of a poset are \<^emph>\<open>compatible\<close> if they have a common lower
 bound.\<close>
 
 definition compat_in :: "[i,[i,i]\<Rightarrow>o,i,i]\<Rightarrow>o" where
   "compat_in(A,r,p,q) \<equiv> \<exists>d\<in>A . r(d,p) \<and> r(d,q)"
 
 text\<open>An \<^emph>\<open>antichain\<close> is a subset of pairwise incompatible members.\<close>
 
 definition
   antichain :: "[i,[i,i]\<Rightarrow>o,i]\<Rightarrow>o" where
   "antichain(P,leq,A) \<equiv> A\<subseteq>P \<and> (\<forall>p\<in>A. \<forall>q\<in>A.
                 p\<noteq>q \<longrightarrow> \<not>compat_in(P,leq,p,q))"
 
 text\<open>A poset has the  \<^emph>\<open>countable chain condition\<close> (ccc) if all of its
 antichains are countable.\<close>
 
 definition
   ccc :: "[i,[i,i]\<Rightarrow>o]\<Rightarrow>o" where
   "ccc(P,leq) \<equiv> \<forall>A. antichain(P,leq,A) \<longrightarrow> countable(A)"
 
 text\<open>Finally, the \<^emph>\<open>Cohen poset\<close> is the set of finite partial functions
 between two sets with the order of reverse inclusion.\<close>
 
 definition
   Fn :: "[i,i] \<Rightarrow> i" where
   "Fn(I,J) \<equiv> \<Union>{(d\<rightarrow>J) . d \<in> {x \<in> Pow(I).  Finite(x)}}"
 
 abbreviation
   Supset :: "i \<Rightarrow> i \<Rightarrow> o" (infixl \<open>\<supseteq>\<close> 50) where
   "f \<supseteq> g \<equiv> g \<subseteq> f"
 
 lemma FnI[intro]:
   assumes "p : d \<rightarrow> J" "d \<subseteq> I" "Finite(d)"
   shows "p \<in> Fn(I,J)"
   using assms unfolding Fn_def by auto
 
 lemma FnD[dest]:
   assumes "p \<in> Fn(I,J)"
   shows "\<exists>d. p : d \<rightarrow> J \<and> d \<subseteq> I \<and> Finite(d)"
   using assms unfolding Fn_def by auto
 
 lemma Fn_is_function: "p \<in> Fn(I,J) \<Longrightarrow> function(p)"
   unfolding Fn_def using fun_is_function by auto
 
 lemma restrict_eq_imp_compat:
   assumes "f \<in> Fn(I, J)" "g \<in> Fn(I, J)"
     "restrict(f, domain(f) \<inter> domain(g)) = restrict(g, domain(f) \<inter> domain(g))"
   shows "f \<union> g \<in> Fn(I, J)"
 proof -
   from assms
   obtain d1 d2 where "f : d1 \<rightarrow> J" "d1 \<in> Pow(I)" "Finite(d1)"
     "g : d2 \<rightarrow> J" "d2 \<in> Pow(I)" "Finite(d2)"
     by blast
   with assms
   show ?thesis
     using domain_of_fun
       restrict_eq_imp_Un_into_Pi[of f d1 "\<lambda>_. J" g d2 "\<lambda>_. J"]
     by auto
 qed
 
 text\<open>We finally arrive to our application of DSL.\<close>
 
 lemma ccc_Fn_2: "ccc(Fn(I,2), (\<supseteq>))"
 proof -
   {
     fix A
     assume "\<not> countable(A)"
     assume "A \<subseteq> Fn(I, 2)"
     moreover from this
     have "countable({p\<in>A. domain(p) = d})" for d
     proof (cases "Finite(d) \<and> d \<subseteq> I")
       case True
       with \<open>A \<subseteq> Fn(I, 2)\<close>
       have "{p \<in> A . domain(p) = d} \<subseteq> d \<rightarrow> 2"
         using domain_of_fun by fastforce
       moreover from True
       have "Finite(d \<rightarrow> 2)"
         using Finite_Pi lesspoll_nat_is_Finite by auto
       ultimately
       show ?thesis using subset_Finite[of _ "d\<rightarrow>2" ] Finite_imp_countable
         by auto
     next
       case False
       with \<open>A \<subseteq> Fn(I, 2)\<close>
       have "{p \<in> A . domain(p) = d} = 0"
         by (intro equalityI) (auto dest!: domain_of_fun)
       then
       show ?thesis using empty_lepollI by auto
     qed
     moreover
     have "uncountable({domain(p) . p \<in> A})"
     proof
       from \<open>A \<subseteq> Fn(I, 2)\<close>
       have "A = (\<Union>d\<in>{domain(p) . p \<in> A}. {p\<in>A. domain(p) = d})"
         by auto
       moreover
       assume "countable({domain(p) . p \<in> A})"
       moreover
       note \<open>\<And>d. countable({p\<in>A. domain(p) = d})\<close> \<open>\<not>countable(A)\<close>
       ultimately
       show "False"
         using countable_imp_countable_UN[of "{domain(p). p\<in>A}"
             "\<lambda>d. {p \<in> A. domain(p) = d }"]
         by auto
     qed
     moreover from \<open>A \<subseteq> Fn(I, 2)\<close>
     have "p \<in> A \<Longrightarrow> Finite(domain(p))" for p
       using lesspoll_nat_is_Finite[of "domain(p)"]
         domain_of_fun[of p _ "\<lambda>_. 2"] by auto
     ultimately
     obtain D where "delta_system(D)" "D \<subseteq> {domain(p) . p \<in> A}" "D \<approx> \<aleph>\<^bsub>1\<^esub>"
       using delta_system_uncountable[of "{domain(p) . p \<in> A}"] by auto
     then
     have delta:"\<forall>d1\<in>D. \<forall>d2\<in>D. d1 \<noteq> d2 \<longrightarrow> d1 \<inter> d2 = \<Inter>D"
       using delta_system_root_eq_Inter
       by simp
     moreover from \<open>D \<approx> \<aleph>\<^bsub>1\<^esub>\<close>
     have "uncountable(D)"
       using uncountable_iff_subset_eqpoll_Aleph1 by auto
     moreover from this and \<open>D \<subseteq> {domain(p) . p \<in> A}\<close>
     obtain p1 where "p1 \<in> A" "domain(p1) \<in> D"
       using uncountable_not_empty[of D] by blast
     moreover from this and \<open>p1 \<in> A \<Longrightarrow> Finite(domain(p1))\<close>
     have "Finite(domain(p1))" using Finite_domain by simp
     moreover
     define r where "r \<equiv> \<Inter>D"
     ultimately
     have "Finite(r)" using subset_Finite[of "r" "domain(p1)"] by auto
     have "countable({restrict(p,r) . p\<in>A})"
     proof -
       have "f \<in> Fn(I, 2) \<Longrightarrow> restrict(f,r) \<in> Pow(r \<times> 2)" for f
         using restrict_subset_Sigma[of f _ "\<lambda>_. 2" r]
-        by (auto dest!:FnD simp: Pi_def) auto
+        by (force simp: Pi_def)
       with \<open>A \<subseteq> Fn(I, 2)\<close>
       have "{restrict(f,r) . f \<in> A } \<subseteq> Pow(r \<times> 2)"
         by fast
       with \<open>Finite(r)\<close>
       show ?thesis
         using Finite_Sigma[THEN Finite_Pow, of r "\<lambda>_. 2"]
         by (intro Finite_imp_countable) (auto intro:subset_Finite)
     qed
     moreover
     have "uncountable({p\<in>A. domain(p) \<in> D})" (is "uncountable(?X)")
     proof
       from \<open>D \<subseteq> {domain(p) . p \<in> A}\<close>
       have "(\<lambda>p\<in>?X. domain(p)) \<in> surj(?X, D)"
         using lam_type unfolding surj_def by auto
       moreover
       assume "countable(?X)"
       moreover
       note \<open>uncountable(D)\<close>
       ultimately
       show False
         using surj_countable by auto
     qed
     moreover
     have "D = (\<Union>f\<in>Pow(r\<times>2) . {domain(p) . p\<in>{ x\<in>A. restrict(x,r) = f \<and> domain(x) \<in> D}})"
     proof -
       {
         fix z
         assume "z \<in> D"
         with \<open>D \<subseteq> _\<close>
         obtain p  where "domain(p) = z" "p \<in> A"
           by auto
         moreover from \<open>A \<subseteq> Fn(I, 2)\<close> and this
         have "p : z \<rightarrow> 2"
-          using domain_of_fun by (auto dest!:FnD)
+          using domain_of_fun by force
         moreover from this
         have "restrict(p,r) \<subseteq> r \<times> 2"
           using function_restrictI[of p r] fun_is_function[of p z "\<lambda>_. 2"]
             restrict_subset_Sigma[of p z "\<lambda>_. 2" r]
           by (auto simp:Pi_def)
         ultimately
         have "\<exists>p\<in>A.  restrict(p,r) \<in> Pow(r\<times>2) \<and> domain(p) = z" by auto
       }
       then
       show ?thesis
         by (intro equalityI) (force)+
     qed
     obtain f where "uncountable({domain(p) . p\<in>{x\<in>A. restrict(x,r) = f \<and> domain(x) \<in> D}})"
       (is "uncountable(?Y(f))")
     proof -
       {
         from \<open>Finite(r)\<close>
         have "countable(Pow(r\<times>2))"
           using Finite_Sigma[THEN Finite_Pow, THEN Finite_imp_countable]
           by simp
         moreover
         assume "countable(?Y(f))" for f
         moreover
         note \<open>D = (\<Union>f\<in>Pow(r\<times>2) .?Y(f))\<close>
         moreover
         note \<open>uncountable(D)\<close>
         ultimately
         have "False"
           using countable_imp_countable_UN[of "Pow(r\<times>2)" ?Y] by auto
       }
       with that
       show ?thesis by auto
     qed
     then
     obtain j where "j \<in> inj(nat, ?Y(f))"
       using uncountable_iff_nat_lt_cardinal[THEN iffD1, THEN leI,
           THEN cardinal_le_imp_lepoll, THEN lepollD]
       by auto
     then
     have "j`0 \<noteq> j`1" "j`0 \<in> ?Y(f)" "j`1 \<in> ?Y(f)"
       using inj_is_fun[THEN apply_type, of j nat "?Y(f)"]
       unfolding inj_def by auto
     then
     obtain p q where "domain(p) \<noteq> domain(q)" "p \<in> A" "q \<in> A"
       "domain(p) \<in> D" "domain(q) \<in> D"
       "restrict(p,r) = restrict(q,r)" by auto
     moreover from this and delta
     have "domain(p) \<inter> domain(q) = r" unfolding r_def by simp
     moreover
     note \<open>A \<subseteq> Fn(I, 2)\<close>
     moreover from calculation
     have "p \<union> q \<in> Fn(I, 2)"
       by (rule_tac restrict_eq_imp_compat) auto
     ultimately
     have "\<exists>p\<in>A. \<exists>q\<in>A. p \<noteq> q \<and> compat_in(Fn(I, 2), (\<supseteq>), p, q)"
       unfolding compat_in_def
       by (rule_tac bexI[of _ p], rule_tac bexI[of _ q]) blast
   }
   then
   show ?thesis unfolding ccc_def antichain_def by auto
 qed
 
 text\<open>The fact that a poset $P$ has the ccc has useful consequences for the
 theory of forcing, since it implies that cardinals from the original
 model are exactly the cardinals in any generic extension by $P$
 \cite[Chap.~IV]{kunen2011set}.\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Delta_System_Lemma/Delta_System.thy b/thys/Delta_System_Lemma/Delta_System.thy
--- a/thys/Delta_System_Lemma/Delta_System.thy
+++ b/thys/Delta_System_Lemma/Delta_System.thy
@@ -1,274 +1,230 @@
 section\<open>The Delta System Lemma\label{sec:dsl}\<close>
 
 theory Delta_System
   imports 
     Cardinal_Library
 
 begin
 
-text\<open>A \<^emph>\<open>delta system\<close> is family of sets with a common pairwise
-intersection.\<close>
-
-definition
-  delta_system :: "i \<Rightarrow> o" where
-  "delta_system(D) \<equiv> \<exists>r. \<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
-
-lemma delta_systemI[intro]: 
-  assumes "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
-  shows "delta_system(D)"
-  using assms unfolding delta_system_def by simp
-
-lemma delta_systemD[dest]:
-  "delta_system(D) \<Longrightarrow> \<exists>r. \<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
-  unfolding delta_system_def by simp
-
-text\<open>Hence, pairwise intersections equal the intersection of the whole
-family.\<close>
-
-lemma delta_system_root_eq_Inter:
-  assumes "delta_system(D)"
-  shows "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = \<Inter>D"
-proof (clarify, intro equalityI, auto)
-  fix A' B' x C
-  assume hyp:"A'\<in>D" "B'\<in> D" "A'\<noteq>B'" "x\<in>A'" "x\<in>B'" "C\<in>D"
-  with assms
-  obtain r where delta:"\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
-    by auto
-  show "x \<in> C"
-  proof (cases "C=A'")
-    case True
-    with hyp and assms
-    show ?thesis by simp
-  next
-    case False
-    moreover
-    note hyp
-    moreover from calculation and delta
-    have "r = C \<inter> A'" "A' \<inter> B' = r" "x\<in>r" by auto
-    ultimately
-    show ?thesis by simp
-  qed
-qed
-
 text\<open>The \<^emph>\<open>Delta System Lemma\<close> (DSL) states that any uncountable family of
 finite sets includes an uncountable delta system. This is the simplest
 non trivial version; others, for cardinals greater than \<^term>\<open>\<aleph>\<^bsub>1\<^esub>\<close>  assume
 some weak versions of the generalized continuum hypothesis for the
 cardinals involved.
 
 The proof is essentially the one in \cite[III.2.6]{kunen2011set} for the
 case  \<^term>\<open>\<aleph>\<^bsub>1\<^esub>\<close>; another similar presentation can be found in
 \cite[Chap.~16]{JW}.\<close>
 
 lemma delta_system_Aleph1:
   assumes "\<forall>A\<in>F. Finite(A)" "F \<approx> \<aleph>\<^bsub>1\<^esub>"
   shows "\<exists>D. D \<subseteq> F \<and> delta_system(D) \<and> D \<approx> \<aleph>\<^bsub>1\<^esub>"
 proof -
   text\<open>Since all members are finite,\<close>
   from \<open>\<forall>A\<in>F. Finite(A)\<close>
   have "(\<lambda>A\<in>F. |A|) : F \<rightarrow> \<omega>" (is "?cards : _")
     by (rule_tac lam_type) simp
   moreover from this
   have a:"?cards -`` {n} = { A\<in>F . |A| = n }" for n
     using vimage_lam by auto
   moreover
   note \<open>F \<approx> \<aleph>\<^bsub>1\<^esub>\<close>
   moreover from calculation
   text\<open>there are uncountably many have the same cardinal:\<close>
   obtain n where "n\<in>\<omega>" "|?cards -`` {n}| = \<aleph>\<^bsub>1\<^esub>"
     using eqpoll_Aleph1_cardinal_vimage[of F ?cards] by auto
   moreover
   define G where "G \<equiv> ?cards -`` {n}"
   moreover from calculation
   have "G \<subseteq> F" by auto
   ultimately
   text\<open>Therefore, without loss of generality, we can assume that all
   elements of the family have cardinality \<^term>\<open>n\<in>\<omega>\<close>.\<close>
   have "A\<in>G \<Longrightarrow> |A| = n" and "G \<approx> \<aleph>\<^bsub>1\<^esub>" for A
     using cardinal_Card_eqpoll_iff by auto
   with \<open>n\<in>\<omega>\<close>
   text\<open>So we prove the result by induction on this \<^term>\<open>n\<close> and
   generalizing \<^term>\<open>G\<close>, since the argument requires changing the
   family in order to apply the inductive hypothesis.\<close>
   have "\<exists>D. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx> \<aleph>\<^bsub>1\<^esub>"
   proof (induct arbitrary:G)
     case 0 \<comment> \<open>This case is impossible\<close>
     then
     have "G \<subseteq> {0}"
       using cardinal_0_iff_0 by auto
     with \<open>G \<approx> \<aleph>\<^bsub>1\<^esub>\<close>
     show ?case
       using nat_lt_Aleph1 subset_imp_le_cardinal[of G "{0}"]
         lt_trans2 cardinal_Card_eqpoll_iff by auto
   next
     case (succ n)
     then
     have "\<forall>a\<in>G. Finite(a)"
       using Finite_cardinal_iff' nat_into_Finite[of "succ(n)"]
       by fastforce
     show "\<exists>D. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx> \<aleph>\<^bsub>1\<^esub>"
     proof (cases "\<exists>p. {A\<in>G . p \<in> A} \<approx> \<aleph>\<^bsub>1\<^esub>")
       case True \<comment> \<open>the positive case, uncountably many sets with a
                     common element\<close>
       then
       obtain p where "{A\<in>G . p \<in> A} \<approx> \<aleph>\<^bsub>1\<^esub>" by blast
       moreover from this
       have "{A-{p} . A\<in>{X\<in>G. p\<in>X}} \<approx> \<aleph>\<^bsub>1\<^esub>" (is "?F \<approx> _")
         using Diff_bij[of "{A\<in>G . p \<in> A}" "{p}"]
           comp_bij[OF bij_converse_bij, where C="\<aleph>\<^bsub>1\<^esub>"] by fast
       text\<open>Now using the hypothesis of the successor case,\<close>
       moreover from \<open>\<And>A. A\<in>G \<Longrightarrow> |A|=succ(n)\<close> \<open>\<forall>a\<in>G. Finite(a)\<close>
         and this
       have "p\<in>A \<Longrightarrow> A\<in>G \<Longrightarrow> |A - {p}| = n" for A
         using Finite_imp_succ_cardinal_Diff[of _ p] by force
       moreover from this and \<open>n\<in>\<omega>\<close>
       have "\<forall>a\<in>?F. Finite(a)"
         using Finite_cardinal_iff' nat_into_Finite by auto
       moreover
       text\<open>we may apply the inductive hypothesis to the new family \<^term>\<open>?F\<close>:\<close>
       note \<open>(\<And>A. A \<in> ?F \<Longrightarrow> |A| = n) \<Longrightarrow> ?F \<approx> \<aleph>\<^bsub>1\<^esub> \<Longrightarrow>
              \<exists>D. D \<subseteq> ?F \<and> delta_system(D) \<and> D \<approx> \<aleph>\<^bsub>1\<^esub>\<close>
       ultimately
       obtain D where "D\<subseteq>{A-{p} . A\<in>{X\<in>G. p\<in>X}}" "delta_system(D)" "D \<approx> \<aleph>\<^bsub>1\<^esub>"
         by auto
       moreover from this
       obtain r where "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
         by fastforce
       then
       have "\<forall>A\<in>D.\<forall>B\<in>D. A\<union>{p} \<noteq> B\<union>{p}\<longrightarrow>(A \<union> {p}) \<inter> (B \<union> {p}) = r\<union>{p}"
         by blast
       ultimately
       have "delta_system({B \<union> {p} . B\<in>D})" (is "delta_system(?D)")
         by fastforce
       moreover from \<open>D \<approx> \<aleph>\<^bsub>1\<^esub>\<close>
       have "|D| = \<aleph>\<^bsub>1\<^esub>" "Infinite(D)"
         using cardinal_eqpoll_iff
         by (auto intro!: uncountable_iff_subset_eqpoll_Aleph1[THEN iffD2]
             uncountable_imp_Infinite) force
       moreover from this
       have "?D \<approx> \<aleph>\<^bsub>1\<^esub>"
         using cardinal_map_Un[of D "{p}"] naturals_lt_nat
           cardinal_eqpoll_iff[THEN iffD1] by simp
       moreover
       note \<open>D \<subseteq> {A-{p} . A\<in>{X\<in>G. p\<in>X}}\<close>
       have "?D \<subseteq> G"
       proof -
         {
           fix A
           assume "A\<in>G" "p\<in>A"
           moreover from this
           have "A = A - {p} \<union> {p}"
             by blast
           ultimately
           have "A -{p} \<union> {p} \<in> G"
             by auto
         }
         with \<open>D \<subseteq> {A-{p} . A\<in>{X\<in>G. p\<in>X}}\<close>
         show ?thesis
           by blast
       qed
       ultimately
       show "\<exists>D. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx> \<aleph>\<^bsub>1\<^esub>" by auto
     next
       case False
       note \<open>\<not> (\<exists>p. {A \<in> G . p \<in> A} \<approx> \<aleph>\<^bsub>1\<^esub>)\<close> \<comment> \<open>the other case\<close>
       moreover from \<open>G \<approx> \<aleph>\<^bsub>1\<^esub>\<close>
       have "{A \<in> G . p \<in> A} \<lesssim> \<aleph>\<^bsub>1\<^esub>" (is "?G(p) \<lesssim> _") for p
         by (blast intro:lepoll_eq_trans[OF subset_imp_lepoll])
       ultimately
       have "?G(p) \<prec> \<aleph>\<^bsub>1\<^esub>" for p
         unfolding lesspoll_def by simp
       then (* may omit the previous step if unfolding here: *)
       have "?G(p) \<lesssim> \<omega>" for p
         using lesspoll_aleph_plus_one[of 0] Aleph_zero_eq_nat by auto
       moreover
       have "{A \<in> G . S \<inter> A \<noteq> 0} = (\<Union>p\<in>S. ?G(p))" for S
         by auto
       ultimately
       have "countable(S) \<Longrightarrow> countable({A \<in> G . S \<inter> A \<noteq> 0})" for S
         using InfCard_nat Card_nat
-         le_Card_iff[THEN iffD2, THEN [3] leqpoll_imp_cardinal_UN_le,
+         le_Card_iff[THEN iffD2, THEN [3] lepoll_imp_cardinal_UN_le,
            THEN [2] le_Card_iff[THEN iffD1], of \<omega> S]
         unfolding countable_def by simp
       text\<open>For every countable subfamily of \<^term>\<open>G\<close> there is another some
       element disjoint from all of them:\<close>
       have "\<exists>A\<in>G. \<forall>S\<in>X. S \<inter> A = 0" if "|X| < \<aleph>\<^bsub>1\<^esub>" "X \<subseteq> G" for X
       proof -
         from \<open>n\<in>\<omega>\<close> \<open>\<And>A. A\<in>G \<Longrightarrow> |A| = succ(n)\<close>
         have "A\<in>G \<Longrightarrow> Finite(A)" for A
           using cardinal_Card_eqpoll_iff
           unfolding Finite_def by fastforce
         with \<open>X\<subseteq>G\<close>
         have "A\<in>X \<Longrightarrow> countable(A)" for A
           using Finite_imp_countable by auto
         with \<open>|X| < \<aleph>\<^bsub>1\<^esub>\<close>
         have "countable(\<Union>X)"
           using Card_nat[THEN cardinal_lt_csucc_iff, of X]
             countable_union_countable countable_iff_cardinal_le_nat
           unfolding Aleph_def by simp
         with \<open>countable(_) \<Longrightarrow> countable({A \<in> G . _  \<inter> A \<noteq> 0})\<close>
         have "countable({A \<in> G . (\<Union>X) \<inter> A \<noteq> 0})" .
         with \<open>G \<approx> \<aleph>\<^bsub>1\<^esub>\<close>
         obtain B where "B\<in>G" "B \<notin> {A \<in> G . (\<Union>X) \<inter> A \<noteq> 0}" 
           using nat_lt_Aleph1 cardinal_Card_eqpoll_iff[of "\<aleph>\<^bsub>1\<^esub>" G]
             uncountable_not_subset_countable[of "{A \<in> G . (\<Union>X) \<inter> A \<noteq> 0}" G]
             uncountable_iff_nat_lt_cardinal
           by auto
         then
         show "\<exists>A\<in>G. \<forall>S\<in>X. S \<inter> A = 0" by auto
       qed
       moreover from \<open>G \<approx> \<aleph>\<^bsub>1\<^esub>\<close>
       obtain b where "b\<in>G"
         using uncountable_iff_subset_eqpoll_Aleph1
           uncountable_not_empty by blast
       ultimately
       text\<open>Hence, the hypotheses to perform a bounded-cardinal selection
       are satisfied,\<close>
       obtain S where "S:\<aleph>\<^bsub>1\<^esub>\<rightarrow>G" "\<alpha>\<in>\<aleph>\<^bsub>1\<^esub> \<Longrightarrow> \<beta>\<in>\<aleph>\<^bsub>1\<^esub> \<Longrightarrow> \<alpha><\<beta> \<Longrightarrow> S`\<alpha> \<inter> S`\<beta> = 0"
         for \<alpha> \<beta>
         using bounded_cardinal_selection[of "\<aleph>\<^bsub>1\<^esub>" G "\<lambda>s a. s \<inter> a = 0" b]
         by force
       then
       have "\<alpha> \<in> \<aleph>\<^bsub>1\<^esub> \<Longrightarrow> \<beta> \<in> \<aleph>\<^bsub>1\<^esub> \<Longrightarrow> \<alpha>\<noteq>\<beta> \<Longrightarrow> S`\<alpha> \<inter> S`\<beta> = 0" for \<alpha> \<beta>
         using lt_neq_symmetry[of "\<aleph>\<^bsub>1\<^esub>" "\<lambda>\<alpha> \<beta>. S`\<alpha> \<inter> S`\<beta> = 0"] Card_is_Ord
         by auto blast
       text\<open>and a symmetry argument shows that obtained \<^term>\<open>S\<close> is
       an injective  \<^term>\<open>\<aleph>\<^bsub>1\<^esub>\<close>-sequence of disjoint elements of \<^term>\<open>G\<close>.\<close>
       moreover from this and \<open>\<And>A. A\<in>G \<Longrightarrow> |A| = succ(n)\<close> \<open>S : \<aleph>\<^bsub>1\<^esub> \<rightarrow> G\<close>
       have "S \<in> inj(\<aleph>\<^bsub>1\<^esub>, G)"
         using cardinal_succ_not_0 Int_eq_zero_imp_not_eq[of "\<aleph>\<^bsub>1\<^esub>" "\<lambda>x. S`x"]
         unfolding inj_def by fastforce
       moreover from calculation
       have "range(S) \<approx> \<aleph>\<^bsub>1\<^esub>"
         using inj_bij_range eqpoll_sym unfolding eqpoll_def by fast
       moreover from calculation
       have "range(S) \<subseteq> G"
         using inj_is_fun range_fun_subset_codomain by fast
       ultimately
       show "\<exists>D. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx> \<aleph>\<^bsub>1\<^esub>"
         using inj_is_fun range_eq_image[of S "\<aleph>\<^bsub>1\<^esub>" G]
           image_function[OF fun_is_function, OF inj_is_fun, of S "\<aleph>\<^bsub>1\<^esub>" G]
           domain_of_fun[OF inj_is_fun, of S "\<aleph>\<^bsub>1\<^esub>" G]
         by (rule_tac x="S``\<aleph>\<^bsub>1\<^esub>" in exI) auto
       text\<open>This finishes the successor case and hence the proof.\<close>
     qed
   qed
   with \<open>G \<subseteq> F\<close>
   show ?thesis by blast
 qed
 
 lemma delta_system_uncountable:
   assumes "\<forall>A\<in>F. Finite(A)" "uncountable(F)"
   shows "\<exists>D. D \<subseteq> F \<and> delta_system(D) \<and> D \<approx> \<aleph>\<^bsub>1\<^esub>"
 proof -
   from assms
   obtain S where "S \<subseteq> F" "S \<approx> \<aleph>\<^bsub>1\<^esub>"
     using uncountable_iff_subset_eqpoll_Aleph1[of F] by auto
   moreover from \<open>\<forall>A\<in>F. Finite(A)\<close> and this
   have "\<forall>A\<in>S. Finite(A)" by auto
   ultimately
   show ?thesis using delta_system_Aleph1[of S]
     by auto
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Delta_System_Lemma/Konig.thy b/thys/Delta_System_Lemma/Konig.thy
--- a/thys/Delta_System_Lemma/Konig.thy
+++ b/thys/Delta_System_Lemma/Konig.thy
@@ -1,187 +1,187 @@
 theory Konig
   imports
     Cofinality
     Cardinal_Library
 
 begin
 
 text\<open>Now, using the Axiom of choice, we can show that all successor
 cardinals are regular.\<close>
 
 lemma cf_csucc:
   assumes "InfCard(z)"
   shows "cf(z\<^sup>+) = z\<^sup>+"
 proof (rule ccontr)
   assume "cf(z\<^sup>+) \<noteq> z\<^sup>+"
   moreover from \<open>InfCard(z)\<close>
   have "Ord(z\<^sup>+)" "Ord(z)" "Limit(z)" "Limit(z\<^sup>+)" "Card(z\<^sup>+)" "Card(z)"
     using InfCard_csucc Card_is_Ord InfCard_is_Card InfCard_is_Limit
     by fastforce+
   moreover from calculation
   have "cf(z\<^sup>+) < z\<^sup>+"
     using cf_le_cardinal[of "z\<^sup>+", THEN le_iff[THEN iffD1]]
       Card_cardinal_eq
     by simp
   ultimately
   obtain G where "G:cf(z\<^sup>+)\<rightarrow> z\<^sup>+" "\<forall>\<beta>\<in>z\<^sup>+. \<exists>y\<in>cf(z\<^sup>+). \<beta> < G`y"
     using Limit_cofinal_fun_lt[of "z\<^sup>+" _ "cf(z\<^sup>+)"] Ord_cf
       cf_le_cf_fun[of "z\<^sup>+" "cf(z\<^sup>+)"] le_refl[of "cf(z\<^sup>+)"]
     by auto
   with \<open>Card(z)\<close> \<open>Card(z\<^sup>+)\<close> \<open>Ord(z\<^sup>+)\<close>
   have "\<forall>\<beta>\<in>cf(z\<^sup>+). |G`\<beta>| \<le> z"
     using apply_type[of G "cf(z\<^sup>+)" "\<lambda>_. z\<^sup>+", THEN ltI] Card_lt_iff[THEN iffD2]
       Ord_in_Ord[OF Card_is_Ord, of "z\<^sup>+"] cardinal_lt_csucc_iff[THEN iffD1]
     by auto
   from \<open>cf(z\<^sup>+) < z\<^sup>+\<close> \<open>InfCard(z)\<close> \<open>Ord(z)\<close>
   have "cf(z\<^sup>+) \<lesssim> z"
     using cardinal_lt_csucc_iff[of "z" "cf(z\<^sup>+)"] Card_csucc[of "z"]
       le_Card_iff[of "z" "cf(z\<^sup>+)"] InfCard_is_Card
       Card_lt_iff[of "cf(z\<^sup>+)" "z\<^sup>+"] lt_Ord[of "cf(z\<^sup>+)" "z\<^sup>+"]
     by simp
   with \<open>cf(z\<^sup>+) < z\<^sup>+\<close> \<open>\<forall>\<beta>\<in>cf(z\<^sup>+). |G`\<beta>| \<le> _\<close> \<open>InfCard(z)\<close>
   have "|\<Union>\<beta>\<in>cf(z\<^sup>+). G`\<beta>| \<le> z"
     using InfCard_csucc[of z]
       subset_imp_lepoll[THEN lepoll_imp_cardinal_le, of "\<Union>\<beta>\<in>cf(z\<^sup>+). G`\<beta>" "z"]
-    by (rule_tac leqpoll_imp_cardinal_UN_le) auto
+    by (rule_tac lepoll_imp_cardinal_UN_le) auto
   moreover
   note \<open>Ord(z)\<close>
   moreover from \<open>\<forall>\<beta>\<in>z\<^sup>+. \<exists>y\<in>cf(z\<^sup>+). \<beta> < G`y\<close> and this
   have "z\<^sup>+ \<subseteq> (\<Union>\<beta>\<in>cf(z\<^sup>+). G`\<beta>)"
     by (blast dest:ltD)
   ultimately
   have "z\<^sup>+ \<le> z"
     using subset_imp_le_cardinal[of "z\<^sup>+" "\<Union>\<beta>\<in>cf(z\<^sup>+). G`\<beta>"] le_trans
       InfCard_is_Card Card_csucc[of z] Card_cardinal_eq
     by auto
   with \<open>Ord(z)\<close>
   show "False"
     using lt_csucc[of z] not_lt_iff_le[THEN iffD2, of z "z\<^sup>+"]
       Card_csucc[THEN Card_is_Ord]
     by auto
 qed
 
 text\<open>And this finishes the calculation of cofinality of Alephs.\<close>
 
 lemma cf_Aleph_succ: "Ord(z) \<Longrightarrow> cf(\<aleph>\<^bsub>succ(z)\<^esub>) = \<aleph>\<^bsub>succ(z)\<^esub>"
   using Aleph_succ cf_csucc InfCard_Aleph by simp
 
 subsection\<open>König's Theorem\label{sec:konig}\<close>
 
 text\<open>We end this section by proving König's Theorem on the cofinality
 of cardinal exponentiation. This is a strengthening of Cantor's theorem
 and it is essentially the only basic way to prove strict cardinal
 inequalities.
 
 It is proved rather straightforwardly with the tools already developed.\<close>
 
 lemma konigs_theorem:
   notes [dest] = InfCard_is_Card Card_is_Ord
     and [trans] = lt_trans1 lt_trans2
   assumes
     "InfCard(\<kappa>)" "InfCard(\<nu>)" "cf(\<kappa>) \<le> \<nu>"
   shows
     "\<kappa> < \<kappa>\<^bsup>\<up>\<nu>\<^esup>"
   using assms(1,2) Card_cexp
 proof (intro not_le_iff_lt[THEN iffD1] notI)
   assume "\<kappa>\<^bsup>\<up>\<nu>\<^esup> \<le> \<kappa>"
   moreover
   note \<open>InfCard(\<kappa>)\<close>
   moreover from calculation
   have "\<nu> \<rightarrow> \<kappa> \<lesssim> \<kappa>"
     using Card_cardinal_eq[OF InfCard_is_Card, symmetric]
       Card_le_imp_lepoll
     unfolding cexp_def by simp
   ultimately
   obtain G where "G \<in> surj(\<kappa>, \<nu> \<rightarrow> \<kappa>)"
     using inj_imp_surj[OF _ function_space_nonempty,
         OF _ nat_into_InfCard] by blast
   from assms
   obtain f where "f:\<nu> \<rightarrow> \<kappa>" "cf_fun(f,\<kappa>)"
     using cf_le_cf_fun[OF _ InfCard_is_Limit] by blast
   define H where "H(\<alpha>) \<equiv> \<mu> x. x\<in>\<kappa> \<and> (\<forall>m<f`\<alpha>. G`m`\<alpha> \<noteq> x)"
     (is "_ \<equiv> \<mu> x. ?P(\<alpha>,x)") for \<alpha>
   have H_satisfies: "?P(\<alpha>,H(\<alpha>))" if "\<alpha> \<in> \<nu>" for \<alpha>
   proof -
     obtain h where "?P(\<alpha>,h)"
     proof -
       from \<open>\<alpha>\<in>\<nu>\<close> \<open>f:\<nu> \<rightarrow> \<kappa>\<close> \<open>InfCard(\<kappa>)\<close>
       have "f`\<alpha> < \<kappa>"
         using apply_type[of _ _ "\<lambda>_ . \<kappa>"] by (auto intro:ltI)
       have "|{G`m`\<alpha> . m \<in> {x\<in>\<kappa> . x < f`\<alpha>}}| \<le> |{x\<in>\<kappa> . x < f`\<alpha>}|"
         using cardinal_RepFun_le by simp
       also from \<open>f`\<alpha> < \<kappa>\<close> \<open>InfCard(\<kappa>)\<close>
       have "|{x\<in>\<kappa> . x < f`\<alpha>}| < |\<kappa>|"
         using Card_lt_iff[OF lt_Ord, THEN iffD2, of "f`\<alpha>" \<kappa> \<kappa>]
           Ord_eq_Collect_lt[of "f`\<alpha>" \<kappa>] Card_cardinal_eq
         by force
       finally
       have "|{G`m`\<alpha> . m \<in> {x\<in>\<kappa> . x < f`\<alpha>}}| < |\<kappa>|" .
       moreover from \<open>f`\<alpha> < \<kappa>\<close> \<open>InfCard(\<kappa>)\<close>
       have "m<f`\<alpha> \<Longrightarrow> m\<in>\<kappa>" for m
         using Ord_trans[of m "f`\<alpha>" \<kappa>]
         by (auto dest:ltD)
       ultimately
       have "\<exists>h. ?P(\<alpha>,h)"
         using lt_cardinal_imp_not_subset by blast
       with that
       show ?thesis by blast
     qed
     with assms
     show "?P(\<alpha>,H(\<alpha>))"
       using LeastI[of "?P(\<alpha>)" h] lt_Ord Ord_in_Ord
       unfolding H_def by fastforce
   qed
   then
   have "(\<lambda>\<alpha>\<in>\<nu>. H(\<alpha>)): \<nu> \<rightarrow> \<kappa>"
     using lam_type by auto
   with \<open>G \<in> surj(\<kappa>, \<nu> \<rightarrow> \<kappa>)\<close>
   obtain n where "n\<in>\<kappa>" "G`n = (\<lambda>\<alpha>\<in>\<nu>. H(\<alpha>))"
     unfolding surj_def by blast
   moreover
   note \<open>InfCard(\<kappa>)\<close> \<open>f: \<nu> \<rightarrow> \<kappa>\<close> \<open>cf_fun(f,_)\<close>
   ultimately
   obtain \<alpha> where "n < f`\<alpha>" "\<alpha>\<in>\<nu>"
     using Limit_cofinal_fun_lt[OF InfCard_is_Limit] by blast
   moreover from calculation and \<open>G`n = (\<lambda>\<alpha>\<in>\<nu>. H(\<alpha>))\<close>
   have "G`n`\<alpha> = H(\<alpha>)"
     using ltD by simp
   moreover from calculation and H_satisfies
   have "\<forall>m<f`\<alpha>. G`m`\<alpha> \<noteq> H(\<alpha>)" by simp
   ultimately
   show "False" by blast
 qed blast+
 
 lemma cf_cexp:
   assumes
     "Card(\<kappa>)" "InfCard(\<nu>)" "2 \<le> \<kappa>"
   shows
     "\<nu> < cf(\<kappa>\<^bsup>\<up>\<nu>\<^esup>)"
 proof (rule ccontr)
   assume "\<not> \<nu> < cf(\<kappa>\<^bsup>\<up>\<nu>\<^esup>)"
   with \<open>InfCard(\<nu>)\<close>
   have "cf(\<kappa>\<^bsup>\<up>\<nu>\<^esup>) \<le> \<nu>" 
     using not_lt_iff_le Ord_cf InfCard_is_Card Card_is_Ord by simp
   moreover
   note assms
   moreover from calculation
   have "InfCard(\<kappa>\<^bsup>\<up>\<nu>\<^esup>)" using InfCard_cexp by simp
   moreover from calculation
   have "\<kappa>\<^bsup>\<up>\<nu>\<^esup> < (\<kappa>\<^bsup>\<up>\<nu>\<^esup>)\<^bsup>\<up>\<nu>\<^esup>" 
     using konigs_theorem by simp
   ultimately
   show "False" using cexp_cexp_cmult InfCard_csquare_eq by auto
 qed
 
 text\<open>Finally, the next two corollaries illustrate the only possible
 exceptions to the value of the cardinality of the continuum: The limit
 cardinals of countable cofinality. That these are the only exceptions
 is a consequence of Easton's Theorem~\cite[Thm 15.18]{Jech_Millennium}.\<close>
 
 corollary cf_continuum: "\<aleph>\<^bsub>0\<^esub> < cf(2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^esup>)"
   using cf_cexp InfCard_Aleph nat_into_Card by simp
 
 corollary continuum_not_eq_Aleph_nat: "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^esup> \<noteq> \<aleph>\<^bsub>\<omega>\<^esub>"
   using cf_continuum cf_Aleph_Limit[OF Limit_nat] cf_nat
     Aleph_zero_eq_nat by auto
 
 end
\ No newline at end of file
diff --git a/thys/Delta_System_Lemma/ZF_Library.thy b/thys/Delta_System_Lemma/ZF_Library.thy
--- a/thys/Delta_System_Lemma/ZF_Library.thy
+++ b/thys/Delta_System_Lemma/ZF_Library.thy
@@ -1,996 +1,1064 @@
 section\<open>Library of basic $\ZF$ results\label{sec:zf-lib}\<close>
 
 theory ZF_Library
   imports
     "ZF-Constructible.Normal"
 
 begin
 
 text\<open>This theory gathers basic ``combinatorial'' results that can be proved
 in $\ZF$ (that is, without using the Axiom of Choice $\AC$).
 \<close>
 
 text\<open>We begin by setting up math-friendly notation.\<close>
 
 no_notation oadd (infixl \<open>++\<close> 65)
 no_notation sum (infixr \<open>+\<close> 65)
 notation oadd (infixl \<open>+\<close> 65)
 notation nat (\<open>\<omega>\<close>)
 notation csucc (\<open>_\<^sup>+\<close> [90])
 no_notation Aleph (\<open>\<aleph>_\<close> [90] 90)
 notation Aleph (\<open>\<aleph>\<^bsub>_\<^esub>\<close>)
 syntax "_ge"  :: "[i,i] \<Rightarrow> o"  (infixl \<open>\<ge>\<close> 50)
 translations "x \<ge> y" \<rightharpoonup> "y \<le> x"
 
 
 subsection\<open>Some minimal arithmetic/ordinal stuff\<close>
 
 lemma Un_leD1 : "i \<union> j \<le> k \<Longrightarrow> Ord(i) \<Longrightarrow> Ord(j) \<Longrightarrow> Ord(k) \<Longrightarrow> i \<le> k"
   by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct1]],simp_all)
 
 lemma Un_leD2 : "i \<union> j \<le> k \<Longrightarrow> Ord(i) \<Longrightarrow> Ord(j) \<Longrightarrow> Ord(k) \<Longrightarrow> j \<le> k"
   by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct2]],simp_all)
 
 lemma Un_memD1: "i \<union> j \<in> k \<Longrightarrow> Ord(i) \<Longrightarrow> Ord(j) \<Longrightarrow> Ord(k) \<Longrightarrow> i \<le> k"
   by (drule ltI, assumption, drule leI, rule Un_least_lt_iff[THEN iffD1[THEN conjunct1]],simp_all)
 
 lemma Un_memD2 : "i \<union> j \<in> k \<Longrightarrow> Ord(i) \<Longrightarrow> Ord(j) \<Longrightarrow> Ord(k) \<Longrightarrow> j \<le> k"
   by (drule ltI, assumption, drule leI, rule Un_least_lt_iff[THEN iffD1[THEN conjunct2]],simp_all)
 
 text\<open>This lemma allows to apply arithmetic simprocs to ordinal addition\<close>
 lemma nat_oadd_add[simp]:
   assumes "m \<in> \<omega>" "n \<in> \<omega>" shows "n + m = n #+ m"
   using assms
   by induct simp_all
 
 lemma Ord_has_max_imp_succ:
   assumes "Ord(\<gamma>)" "\<beta> \<in> \<gamma>" "\<forall>\<alpha>\<in>\<gamma>. \<alpha> \<le> \<beta>"
   shows "\<gamma> = succ(\<beta>)"
   using assms Ord_trans[of _ \<beta> \<gamma>]
   unfolding lt_def
   by (intro equalityI subsetI) auto
 
 lemma Least_antitone:
   assumes
     "Ord(j)" "P(j)" "\<And>i. P(i) \<Longrightarrow> Q(i)"
   shows
     "(\<mu> i. Q(i)) \<le> (\<mu> i. P(i))"
   using assms LeastI2[of P j Q] Least_le by simp
 
 lemma Least_set_antitone:
   "Ord(j) \<Longrightarrow> j\<in>A \<Longrightarrow> A \<subseteq> B \<Longrightarrow> (\<mu> i. i\<in>B) \<le> (\<mu> i. i\<in>A)"
   using subset_iff by (auto intro:Least_antitone)
 
 lemma le_neq_imp_lt:
   "x\<le>y \<Longrightarrow> x\<noteq>y \<Longrightarrow> x<y"
   using ltD ltI[of x y] le_Ord2
   unfolding succ_def by auto
 
 text\<open>Strict upper bound of a set of ordinals.\<close>
 definition
   str_bound :: "i\<Rightarrow>i" where
   "str_bound(A) \<equiv> \<Union>a\<in>A. succ(a)"
 
 lemma str_bound_type [TC]: "\<forall>a\<in>A. Ord(a) \<Longrightarrow> Ord(str_bound(A))"
   unfolding str_bound_def by auto
 
 lemma str_bound_lt: "\<forall>a\<in>A. Ord(a) \<Longrightarrow> \<forall>a\<in>A. a < str_bound(A)"
   unfolding str_bound_def using str_bound_type
   by (blast intro:ltI)
 
 lemma naturals_lt_nat[intro]: "n \<in> \<omega> \<Longrightarrow> n < \<omega>"
   unfolding lt_def by simp
 
 text\<open>The next two lemmas are handy when one is constructing
 some object recursively. The first handles injectivity (of recursively
 constructed sequences of sets), while the second is helpful for
 establishing a symmetry argument.\<close>
 lemma Int_eq_zero_imp_not_eq:
   assumes
     "\<And>x y. x\<in>D \<Longrightarrow> y \<in> D \<Longrightarrow> x \<noteq> y \<Longrightarrow> A(x) \<inter> A(y) = 0"
     "\<And>x. x\<in>D \<Longrightarrow> A(x) \<noteq> 0" "a\<in>D" "b\<in>D" "a\<noteq>b"
   shows
     "A(a) \<noteq> A(b)"
   using assms by fastforce
 
 lemma lt_neq_symmetry:
   assumes
     "\<And>\<alpha> \<beta>. \<alpha> \<in> \<gamma> \<Longrightarrow> \<beta> \<in> \<gamma> \<Longrightarrow> \<alpha> < \<beta> \<Longrightarrow> Q(\<alpha>,\<beta>)"
     "\<And>\<alpha> \<beta>. Q(\<alpha>,\<beta>) \<Longrightarrow> Q(\<beta>,\<alpha>)"
     "\<alpha> \<in> \<gamma>" "\<beta> \<in> \<gamma>" "\<alpha> \<noteq> \<beta>"
     "Ord(\<gamma>)"
   shows
     "Q(\<alpha>,\<beta>)"
 proof -
   from assms
   consider "\<alpha><\<beta>" | "\<beta><\<alpha>"
     using Ord_linear_lt[of \<alpha> \<beta> thesis] Ord_in_Ord[of \<gamma>]
     by auto
   then
   show ?thesis by cases (auto simp add:assms)
 qed
 
 lemma cardinal_succ_not_0: "|A| = succ(n) \<Longrightarrow> A \<noteq> 0"
   by auto
 
 lemma Ord_eq_Collect_lt: "i<\<alpha> \<Longrightarrow> {j\<in>\<alpha>. j<i} = i"
   \<comment> \<open>almost the same proof as @{thm nat_eq_Collect_lt}\<close>
   apply (rule equalityI)
   apply (blast dest: ltD)
   apply (auto simp add: Ord_mem_iff_lt)
   apply (rule Ord_trans ltI[OF _ lt_Ord]; auto simp add:lt_def dest:ltD)+
   done
 
 
 subsection\<open>Manipulation of function spaces\<close>
 
 definition
   Finite_to_one :: "[i,i] \<Rightarrow> i" where
   "Finite_to_one(X,Y) \<equiv> {f:X\<rightarrow>Y. \<forall>y\<in>Y. Finite({x\<in>X . f`x = y})}"
 
 lemma Finite_to_oneI[intro]:
   assumes "f:X\<rightarrow>Y" "\<And>y. y\<in>Y \<Longrightarrow> Finite({x\<in>X . f`x = y})"
   shows "f \<in> Finite_to_one(X,Y)"
   using assms unfolding Finite_to_one_def by simp
 
 lemma Finite_to_oneD[dest]:
   "f \<in> Finite_to_one(X,Y) \<Longrightarrow> f:X\<rightarrow>Y"
   "f \<in> Finite_to_one(X,Y) \<Longrightarrow> y\<in>Y \<Longrightarrow>  Finite({x\<in>X . f`x = y})"
   unfolding Finite_to_one_def by simp_all
 
 lemma subset_Diff_Un: "X \<subseteq> A \<Longrightarrow> A = (A - X) \<union> X " by auto
 
 lemma Diff_bij:
   assumes "\<forall>A\<in>F. X \<subseteq> A" shows "(\<lambda>A\<in>F. A-X) \<in> bij(F, {A-X. A\<in>F})"
   using assms unfolding bij_def inj_def surj_def
   by (auto intro:lam_type, subst subset_Diff_Un[of X]) auto
 
 lemma function_space_nonempty:
   assumes "b\<in>B"
   shows "(\<lambda>x\<in>A. b) : A \<rightarrow> B"
   using assms lam_type by force
 
 lemma vimage_lam: "(\<lambda>x\<in>A. f(x)) -`` B = { x\<in>A . f(x) \<in> B }"
   using lam_funtype[of A f, THEN [2] domain_type]
     lam_funtype[of A f, THEN [2] apply_equality] lamI[of _ A f]
   by auto blast
 
 lemma range_fun_subset_codomain:
   assumes "h:B \<rightarrow> C"
   shows "range(h) \<subseteq> C"
   unfolding range_def domain_def converse_def using range_type[OF _ assms]  by auto
 
 lemma Pi_rangeD:
   assumes "f\<in>Pi(A,B)" "b \<in> range(f)"
   shows "\<exists>a\<in>A. f`a = b"
   using assms apply_equality[OF _ assms(1), of _ b]
     domain_type[OF _ assms(1)] by auto
 
 lemma Pi_range_eq: "f \<in> Pi(A,B) \<Longrightarrow> range(f) = {f ` x . x \<in> A}"
   using Pi_rangeD[of f A B] apply_rangeI[of f A B]
   by blast
 
 lemma Pi_vimage_subset : "f \<in> Pi(A,B) \<Longrightarrow> f-``C \<subseteq> A"
   unfolding Pi_def by auto
 
-lemma apply_in_range:
+lemma apply_in_codomain_Ord:
   assumes
     "Ord(\<gamma>)" "\<gamma>\<noteq>0" "f: A \<rightarrow> \<gamma>"
   shows
     "f`x\<in>\<gamma>"
 proof (cases "x\<in>A")
   case True
   from assms \<open>x\<in>A\<close>
   show ?thesis
     using   domain_of_fun apply_rangeI  by simp
 next
   case False
   from assms \<open>x\<notin>A\<close>
   show ?thesis
     using apply_0 Ord_0_lt ltD domain_of_fun by auto
 qed
 
 lemma range_eq_image:
   assumes "f:A\<rightarrow>B"
   shows "range(f) = f``A"
 proof
   show "f `` A \<subseteq> range(f)"
     unfolding image_def by blast
   {
     fix x
     assume "x\<in>range(f)"
     with assms
     have "x\<in>f``A"
       using domain_of_fun[of f A "\<lambda>_. B"] by auto
   }
   then
   show "range(f) \<subseteq> f `` A" ..
 qed
 
 lemma Image_sub_codomain: "f:A\<rightarrow>B \<Longrightarrow> f``C \<subseteq> B"
   using image_subset fun_is_rel[of _ _ "\<lambda>_ . B"] by force
 
 lemma inj_to_Image:
   assumes
     "f:A\<rightarrow>B" "f \<in> inj(A,B)"
   shows
     "f \<in> inj(A,f``A)"
   using assms inj_inj_range range_eq_image by force
 
 lemma inj_imp_surj:
   fixes f b
   notes inj_is_fun[dest]
   defines [simp]: "ifx(x) \<equiv> if x\<in>range(f) then converse(f)`x else b"
   assumes "f \<in> inj(B,A)" "b\<in>B"
   shows "(\<lambda>x\<in>A. ifx(x)) \<in> surj(A,B)"
 proof -
   from assms
   have "converse(f) \<in> surj(range(f),B)" "range(f) \<subseteq> A"
     "converse(f) : range(f) \<rightarrow> B"
     using inj_converse_surj range_fun_subset_codomain surj_is_fun by blast+
   with \<open>b\<in>B\<close>
   show "(\<lambda>x\<in>A. ifx(x)) \<in> surj(A,B)"
     unfolding surj_def
   proof (intro CollectI lam_type ballI; elim CollectE)
     fix y
     assume "y \<in> B" "\<forall>y\<in>B. \<exists>x\<in>range(f). converse(f) ` x = y"
     with \<open>range(f) \<subseteq> A\<close>
     show "\<exists>x\<in>A. (\<lambda>x\<in>A. ifx(x)) ` x = y"
       by (drule_tac bspec, auto)
   qed simp
 qed
 
 lemma fun_Pi_disjoint_Un:
   assumes "f \<in> Pi(A,B)" "g \<in> Pi(C,D)"  "A \<inter> C = 0"
   shows "f \<union> g \<in> Pi(A \<union> C, \<lambda>x. B(x) \<union> D(x))"
   using assms
   by (simp add: Pi_iff extension Un_rls) (unfold function_def, blast)
 
 lemma Un_restrict_decomposition:
   assumes "f \<in> Pi(A,B)"
   shows "f = restrict(f, A \<inter> C) \<union> restrict(f, A - C)"
   using assms
 proof (rule fun_extension)
   from assms
   have "restrict(f,A\<inter>C) \<union> restrict(f,A-C) \<in> Pi(A\<inter>C \<union> (A-C), \<lambda>x. B(x)\<union>B(x))"
     using restrict_type2[of f A B]
     by (rule_tac fun_Pi_disjoint_Un) force+
   moreover
   have "(A \<inter> C) \<union> (A - C) = A" by auto
   ultimately
   show "restrict(f, A \<inter> C) \<union> restrict(f, A - C) \<in> Pi(A, B)" by simp
 next
   fix x
   assume "x \<in> A"
   with assms
   show "f ` x = (restrict(f, A \<inter> C) \<union> restrict(f, A - C)) ` x"
     using restrict fun_disjoint_apply1[of _ "restrict(f,_)"]
       fun_disjoint_apply2[of _ "restrict(f,_)"]
       domain_restrict[of f] apply_0 domain_of_fun
     by (cases "x\<in>C") simp_all
 qed
 
 lemma restrict_eq_imp_Un_into_Pi:
   assumes "f \<in> Pi(A,B)" "g \<in> Pi(C,D)" "restrict(f, A \<inter> C) = restrict(g, A \<inter> C)"
   shows "f \<union> g \<in> Pi(A \<union> C, \<lambda>x. B(x) \<union> D(x))"
 proof -
   note assms
   moreover from this
   have "x \<notin> g \<Longrightarrow> x \<notin> restrict(g, A \<inter> C)" for x
     using restrict_subset[of g "A \<inter> C"] by auto
   moreover from calculation
   have "x \<in> f \<Longrightarrow> x \<in> restrict(f, A - C) \<or> x \<in> restrict(g, A \<inter> C)" for x
     by (subst (asm) Un_restrict_decomposition[of f A B "C"]) auto
   ultimately
   have "f \<union> g = restrict(f, A - C) \<union> g"
     using restrict_subset[of g "A \<inter> C"]
     by (subst Un_restrict_decomposition[of f A B "C"]) auto
   moreover
   have "A - C \<union> C = A \<union> C" by auto
   moreover
   note assms
   ultimately
   show ?thesis
     using fun_Pi_disjoint_Un[OF
         restrict_type2[of f A B "A-C"], of g C D]
     by auto
 qed
 
 lemma restrict_eq_imp_Un_into_Pi':
   assumes "f \<in> Pi(A,B)" "g \<in> Pi(C,D)"
     "restrict(f, domain(f) \<inter> domain(g)) = restrict(g, domain(f) \<inter> domain(g))"
   shows "f \<union> g \<in> Pi(A \<union> C, \<lambda>x. B(x) \<union> D(x))"
   using  assms domain_of_fun restrict_eq_imp_Un_into_Pi by simp
 
 lemma restrict_subset_Sigma: "f \<subseteq> Sigma(C,B) \<Longrightarrow> restrict(f,A) \<subseteq> Sigma(A\<inter>C, B)"
   by (auto simp add: restrict_def)
 
 
 subsection\<open>Finite sets\<close>
 
 lemma Replace_sing1:
   "\<lbrakk> (\<exists>a. P(d,a)) \<and> (\<forall>y y'. P(d,y) \<longrightarrow> P(d,y') \<longrightarrow> y=y') \<rbrakk> \<Longrightarrow> \<exists>a. {y . x \<in> {d}, P(x,y)} = {a}"
   by blast
 
 \<comment> \<open>Not really necessary\<close>
 lemma Replace_sing2:
   assumes "\<forall>a. \<not> P(d,a)"
   shows "{y . x \<in> {d}, P(x,y)} = 0"
   using assms by auto
 
 lemma Replace_sing3:
   assumes "\<exists>c e. c \<noteq> e \<and> P(d,c) \<and> P(d,e)"
   shows "{y . x \<in> {d}, P(x,y)} = 0"
 proof -
   {
     fix z
     {
       assume "\<forall>y. P(d, y) \<longrightarrow> y = z"
       with assms
       have "False" by auto
     }
     then
     have "z \<notin> {y . x \<in> {d}, P(x,y)}"
       using Replace_iff by auto
   }
   then
   show ?thesis
     by (intro equalityI subsetI) simp_all
 qed
 
 lemma Replace_Un: "{b . a \<in> A \<union> B, Q(a, b)} =
         {b . a \<in> A, Q(a, b)} \<union> {b . a \<in> B, Q(a, b)}"
   by (intro equalityI subsetI) (auto simp add:Replace_iff)
 
 lemma Replace_subset_sing: "\<exists>z. {y . x \<in> {d}, P(x,y)} \<subseteq> {z}"
 proof -
   consider
     (1) "(\<exists>a. P(d,a)) \<and> (\<forall>y y'. P(d,y) \<longrightarrow> P(d,y') \<longrightarrow> y=y')" |
     (2) "\<forall>a. \<not> P(d,a)" | (3) "\<exists>c e. c \<noteq> e \<and> P(d,c) \<and> P(d,e)" by auto
   then
   show "\<exists>z. {y . x \<in> {d}, P(x,y)} \<subseteq> {z}"
   proof (cases)
     case 1
     then show ?thesis using Replace_sing1[of P d] by auto
   next
     case 2
     then show ?thesis by auto
   next
     case 3
     then show ?thesis using Replace_sing3[of P d] by auto
   qed
 qed
 
 lemma Finite_Replace: "Finite(A) \<Longrightarrow> Finite(Replace(A,Q))"
 proof (induct rule:Finite_induct)
   case 0
   then
   show ?case by simp
 next
   case (cons x B)
   moreover
   have "{b . a \<in> cons(x, B), Q(a, b)} =
         {b . a \<in> B, Q(a, b)} \<union> {b . a \<in> {x}, Q(a, b)}"
     using Replace_Un unfolding cons_def by auto
   moreover
   obtain d where "{b . a \<in> {x}, Q(a, b)} \<subseteq> {d}"
     using Replace_subset_sing[of _ Q] by blast
   moreover from this
   have "Finite({b . a \<in> {x}, Q(a, b)})"
     using subset_Finite by simp
   ultimately
   show ?case using subset_Finite by simp
 qed
 
 lemma Finite_domain: "Finite(A) \<Longrightarrow> Finite(domain(A))"
   using Finite_Replace unfolding domain_def
   by auto
 
 lemma Finite_converse: "Finite(A) \<Longrightarrow> Finite(converse(A))"
   using Finite_Replace unfolding converse_def
   by auto
 
 lemma Finite_range: "Finite(A) \<Longrightarrow> Finite(range(A))"
   using Finite_domain Finite_converse unfolding range_def
   by blast
 
 lemma Finite_Sigma: "Finite(A) \<Longrightarrow> \<forall>x. Finite(B(x)) \<Longrightarrow> Finite(Sigma(A,B))"
   unfolding Sigma_def using Finite_RepFun Finite_Union
   by simp
 
 lemma Finite_Pi: "Finite(A) \<Longrightarrow> \<forall>x. Finite(B(x)) \<Longrightarrow> Finite(Pi(A,B))"
   using Finite_Sigma
     Finite_Pow subset_Finite[of "Pi(A,B)" "Pow(Sigma(A,B))"]
   unfolding Pi_def
   by auto
 
 
 subsection\<open>Basic results on equipollence, cardinality and related concepts\<close>
 
 lemma lepollD[dest]: "A \<lesssim> B \<Longrightarrow> \<exists>f. f \<in> inj(A, B)"
   unfolding lepoll_def .
 
 lemma lepollI[intro]: "f \<in> inj(A, B) \<Longrightarrow> A \<lesssim> B"
   unfolding lepoll_def by blast
 
 lemma eqpollD[dest]: "A \<approx> B \<Longrightarrow> \<exists>f. f \<in> bij(A, B)"
   unfolding eqpoll_def .
 
 declare bij_imp_eqpoll[intro]
 
 lemma range_of_subset_eqpoll:
   assumes "f \<in> inj(X,Y)" "S \<subseteq> X"
   shows "S \<approx> f `` S"
   using assms restrict_bij by blast
 
 text\<open>I thank Miguel Pagano for this proof.\<close>
 lemma function_space_eqpoll_cong:
   assumes
     "A \<approx> A'" "B \<approx> B'"
   shows
     "A \<rightarrow> B \<approx> A' \<rightarrow> B'"
 proof -
   from assms(1)[THEN eqpoll_sym] assms(2)
   obtain f g where "f \<in> bij(A',A)" "g \<in> bij(B,B')"
     by blast
   then
   have "converse(g) : B' \<rightarrow> B" "converse(f): A \<rightarrow> A'"
     using bij_converse_bij bij_is_fun by auto
   show ?thesis
     unfolding eqpoll_def
   proof (intro exI fg_imp_bijective, rule_tac [1-2] lam_type)
     fix F
     assume "F: A \<rightarrow> B"
     with \<open>f \<in> bij(A',A)\<close> \<open>g \<in> bij(B,B')\<close>
     show "g O F O f : A' \<rightarrow> B'"
       using bij_is_fun comp_fun by blast
   next
     fix F
     assume "F: A' \<rightarrow> B'"
     with \<open>converse(g) : B' \<rightarrow> B\<close> \<open>converse(f): A \<rightarrow> A'\<close>
     show "converse(g) O F O converse(f) : A \<rightarrow> B"
       using comp_fun by blast
   next
     from \<open>f\<in>_\<close> \<open>g\<in>_\<close> \<open>converse(f)\<in>_\<close> \<open>converse(g)\<in>_\<close>
     have "(\<And>x. x \<in> A' \<rightarrow> B' \<Longrightarrow> converse(g) O x O converse(f) \<in> A \<rightarrow> B)"
       using bij_is_fun comp_fun by blast
     then
     have "(\<lambda>x\<in>A \<rightarrow> B. g O x O f) O (\<lambda>x\<in>A' \<rightarrow> B'. converse(g) O x O converse(f))
           =  (\<lambda>x\<in>A' \<rightarrow> B' . (g O converse(g)) O x O (converse(f) O f))"
       using lam_cong comp_assoc comp_lam[of "A' \<rightarrow> B'" ] by auto
     also
     have "... = (\<lambda>x\<in>A' \<rightarrow> B' . id(B') O x O (id(A')))"
       using left_comp_inverse[OF bij_is_inj[OF \<open>f\<in>_\<close>]]
         right_comp_inverse[OF bij_is_surj[OF \<open>g\<in>_\<close>]]
       by auto
     also
     have "... = (\<lambda>x\<in>A' \<rightarrow> B' . x)"
       using left_comp_id[OF fun_is_rel] right_comp_id[OF fun_is_rel]  lam_cong by auto
     also
     have "... = id(A'\<rightarrow>B')" unfolding id_def by simp
     finally
     show "(\<lambda>x\<in>A -> B. g O x O f) O (\<lambda>x\<in>A' -> B'. converse(g) O x O converse(f)) = id(A' -> B')" .
   next
     from \<open>f\<in>_\<close> \<open>g\<in>_\<close>
     have "(\<And>x. x \<in> A \<rightarrow> B \<Longrightarrow> g O x O f \<in> A' \<rightarrow> B')"
       using bij_is_fun comp_fun by blast
     then
     have "(\<lambda>x\<in>A' -> B'. converse(g) O x O converse(f)) O (\<lambda>x\<in>A -> B. g O x O f)
           = (\<lambda>x\<in>A \<rightarrow> B . (converse(g) O g) O x O (f O converse(f)))"
       using comp_lam comp_assoc by auto
     also
     have "... = (\<lambda>x\<in>A \<rightarrow> B . id(B) O x O (id(A)))"
       using
         right_comp_inverse[OF bij_is_surj[OF \<open>f\<in>_\<close>]]
         left_comp_inverse[OF bij_is_inj[OF \<open>g\<in>_\<close>]] lam_cong
       by auto
     also
     have "... = (\<lambda>x\<in>A \<rightarrow> B . x)"
       using left_comp_id[OF fun_is_rel] right_comp_id[OF fun_is_rel] lam_cong by auto
     also
     have "... = id(A\<rightarrow>B)" unfolding id_def by simp
     finally
     show "(\<lambda>x\<in>A' \<rightarrow> B'. converse(g) O x O converse(f)) O (\<lambda>x\<in>A -> B. g O x O f) = id(A -> B)" .
   qed
 qed
 
 lemma curry_eqpoll:
   fixes d \<nu>1 \<nu>2  \<kappa>
   shows "\<nu>1 \<rightarrow> \<nu>2 \<rightarrow> \<kappa> \<approx> \<nu>1 \<times> \<nu>2 \<rightarrow> \<kappa>"
   unfolding eqpoll_def
 proof (intro exI, rule lam_bijective,
     rule_tac [1-2] lam_type, rule_tac [2] lam_type)
   fix f z
   assume "f : \<nu>1 \<rightarrow> \<nu>2 \<rightarrow> \<kappa>" "z \<in> \<nu>1 \<times> \<nu>2"
   then
   show "f`fst(z)`snd(z) \<in> \<kappa>"
     by simp
 next
   fix f x y
   assume "f : \<nu>1 \<times> \<nu>2 \<rightarrow> \<kappa>" "x\<in>\<nu>1" "y\<in>\<nu>2"
   then
   show "f`\<langle>x,y\<rangle> \<in> \<kappa>" by simp
 next \<comment> \<open>one composition is the identity:\<close>
   fix f
   assume "f : \<nu>1 \<times> \<nu>2 \<rightarrow> \<kappa>"
   then
   show "(\<lambda>x\<in>\<nu>1 \<times> \<nu>2. (\<lambda>x\<in>\<nu>1. \<lambda>xa\<in>\<nu>2. f ` \<langle>x, xa\<rangle>) ` fst(x) ` snd(x)) = f"
     by (auto intro:fun_extension)
 qed simp \<comment> \<open>the other composition follows automatically\<close>
 
 lemma Pow_eqpoll_function_space:
   fixes d X
   notes bool_of_o_def [simp]
   defines [simp]:"d(A) \<equiv> (\<lambda>x\<in>X. bool_of_o(x\<in>A))"
     \<comment> \<open>the witnessing map for the thesis:\<close>
   shows "Pow(X) \<approx> X \<rightarrow> 2"
   unfolding eqpoll_def
 proof (intro exI, rule lam_bijective)
   \<comment> \<open>We give explicit mutual inverses\<close>
   fix A
   assume "A\<in>Pow(X)"
   then
   show "d(A) : X \<rightarrow> 2"
     using lam_type[of _ "\<lambda>x. bool_of_o(x\<in>A)" "\<lambda>_. 2"]
     by force
   from \<open>A\<in>Pow(X)\<close>
   show "{y\<in>X. d(A)`y = 1} = A"
     by (auto)
 next
   fix f
   assume "f: X\<rightarrow>2"
   then
   show "d({y \<in> X . f ` y = 1}) = f"
     using apply_type[OF \<open>f: X\<rightarrow>2\<close>]
     by (force intro:fun_extension)
 qed blast
 
 lemma cantor_inj: "f \<notin> inj(Pow(A),A)"
   using inj_imp_surj[OF _ Pow_bottom] cantor_surj by blast
 
 definition
   cexp :: "[i,i] \<Rightarrow> i" ("_\<^bsup>\<up>_\<^esup>" [76,1] 75) where
   "\<kappa>\<^bsup>\<up>\<nu>\<^esup> \<equiv> |\<nu> \<rightarrow> \<kappa>|"
 
 lemma Card_cexp: "Card(\<kappa>\<^bsup>\<up>\<nu>\<^esup>)"
   unfolding cexp_def Card_cardinal by simp
 
 lemma eq_csucc_ord:
   "Ord(i) \<Longrightarrow> i\<^sup>+ = |i|\<^sup>+"
   using Card_lt_iff Least_cong unfolding csucc_def by auto
 
 text\<open>I thank Miguel Pagano for this proof.\<close>
 lemma lesspoll_csucc:
   assumes "Ord(\<kappa>)"
   shows "d \<prec> \<kappa>\<^sup>+ \<longleftrightarrow> d \<lesssim> \<kappa>"
 proof
   assume "d \<prec> \<kappa>\<^sup>+"
   moreover
   note Card_is_Ord \<open>Ord(\<kappa>)\<close>
   moreover from calculation
   have "\<kappa> < \<kappa>\<^sup>+" "Card(\<kappa>\<^sup>+)"
     using Ord_cardinal_eqpoll csucc_basic by simp_all
   moreover from calculation
   have "d \<prec> |\<kappa>|\<^sup>+" "Card(|\<kappa>|)" "d \<approx> |d|"
     using eq_csucc_ord[of \<kappa>] lesspoll_imp_eqpoll eqpoll_sym by simp_all
   moreover from calculation
   have "|d| < |\<kappa>|\<^sup>+"
     using lesspoll_cardinal_lt csucc_basic by simp
   moreover from calculation
   have "|d| \<lesssim> |\<kappa>|"
     using Card_lt_csucc_iff le_imp_lepoll by simp
   moreover from calculation
   have "|d| \<lesssim> \<kappa>"
     using lepoll_eq_trans Ord_cardinal_eqpoll by simp
   ultimately
   show "d \<lesssim> \<kappa>"
     using eq_lepoll_trans by simp
 next
   from \<open>Ord(\<kappa>)\<close>
   have "\<kappa> < \<kappa>\<^sup>+" "Card(\<kappa>\<^sup>+)"
     using csucc_basic by simp_all
   moreover
   assume "d \<lesssim> \<kappa>"
   ultimately
   have "d \<lesssim> \<kappa>\<^sup>+"
     using le_imp_lepoll leI lepoll_trans by simp
   moreover
   from \<open>d \<lesssim> \<kappa>\<close> \<open>Ord(\<kappa>)\<close>
   have "\<kappa>\<^sup>+ \<lesssim> \<kappa>" if "d \<approx> \<kappa>\<^sup>+"
     using eqpoll_sym[OF that] eq_lepoll_trans[OF _ \<open>d\<lesssim>\<kappa>\<close>] by simp
   moreover from calculation \<open>Card(_)\<close>
   have "\<not> d \<approx> \<kappa>\<^sup>+"
     using lesspoll_irrefl lesspoll_trans1 lt_Card_imp_lesspoll[OF _ \<open>\<kappa> <_\<close>]
     by auto
   ultimately
   show "d \<prec> \<kappa>\<^sup>+"
     unfolding lesspoll_def by simp
 qed
 
 abbreviation
   Infinite :: "i\<Rightarrow>o" where
   "Infinite(X) \<equiv> \<not> Finite(X)"
 
 lemma Infinite_not_empty: "Infinite(X) \<Longrightarrow> X \<noteq> 0"
   using empty_lepollI by auto
 
 lemma Infinite_imp_nats_lepoll:
   assumes "Infinite(X)" "n \<in> \<omega>"
   shows "n \<lesssim> X"
   using \<open>n \<in> \<omega>\<close>
 proof (induct)
   case 0
   then
   show ?case using empty_lepollI by simp
 next
   case (succ x)
   show ?case
   proof -
     from \<open>Infinite(X)\<close> and \<open>x \<in> \<omega>\<close>
     have "\<not> (x \<approx> X)"
       using eqpoll_sym unfolding Finite_def by auto
     with \<open>x \<lesssim> X\<close>
     obtain f where "f \<in> inj(x,X)" "f \<notin> surj(x,X)"
       unfolding bij_def eqpoll_def by auto
     moreover from this
     obtain b where "b \<in> X" "\<forall>a\<in>x. f`a \<noteq> b"
       using inj_is_fun unfolding surj_def by auto
     ultimately
     have "f \<in> inj(x,X-{b})"
       unfolding inj_def by (auto intro:Pi_type)
     then
     have "cons(\<langle>x, b\<rangle>, f) \<in> inj(succ(x), cons(b, X - {b}))"
       using inj_extend[of f x "X-{b}" x b] unfolding succ_def
       by (auto dest:mem_irrefl)
     moreover from \<open>b\<in>X\<close>
     have "cons(b, X - {b}) = X" by auto
     ultimately
     show "succ(x) \<lesssim> X" by auto
   qed
 qed
 
 lemma zero_lesspoll: assumes "0<\<kappa>" shows "0 \<prec> \<kappa>"
   using assms eqpoll_0_iff[THEN iffD1, of \<kappa>] eqpoll_sym
   unfolding lesspoll_def lepoll_def
   by (auto simp add:inj_def)
 
 lemma lepoll_nat_imp_Infinite: "\<omega> \<lesssim> X \<Longrightarrow> Infinite(X)"
 proof (rule ccontr, simp)
   assume "\<omega> \<lesssim> X" "Finite(X)"
   moreover from this
   obtain n where "X \<approx> n" "n \<in> \<omega>"
     unfolding Finite_def by auto
   moreover from calculation
   have "\<omega> \<lesssim> n"
     using lepoll_eq_trans by simp
   ultimately
   show "False"
     using lepoll_nat_imp_Finite nat_not_Finite by simp
 qed
 
 lemma InfCard_imp_Infinite: "InfCard(\<kappa>) \<Longrightarrow> Infinite(\<kappa>)"
   using le_imp_lepoll[THEN lepoll_nat_imp_Infinite, of \<kappa>]
   unfolding InfCard_def by simp
 
 lemma lt_surj_empty_imp_Card:
   assumes "Ord(\<kappa>)" "\<And>\<alpha>. \<alpha> < \<kappa> \<Longrightarrow> surj(\<alpha>,\<kappa>) = 0"
   shows "Card(\<kappa>)"
 proof -
   {
     assume "|\<kappa>| < \<kappa>"
     with assms
     have "False"
       using LeastI[of "\<lambda>i. i \<approx> \<kappa>" \<kappa>, OF eqpoll_refl]
         Least_le[of "\<lambda>i. i \<approx> \<kappa>" "|\<kappa>|", OF Ord_cardinal_eqpoll]
       unfolding Card_def cardinal_def eqpoll_def bij_def
       by simp
   }
   with assms
   show ?thesis
     using Ord_cardinal_le[of \<kappa>] not_lt_imp_le[of "|\<kappa>|" \<kappa>] le_anti_sym
     unfolding Card_def by auto
 qed
 
 
 subsection\<open>Morphisms of binary relations\<close>
 
 text\<open>The main case of interest is in the case of partial orders.\<close>
 
 lemma mono_map_mono:
   assumes
     "f \<in> mono_map(A,r,B,s)" "B \<subseteq> C"
   shows
     "f \<in> mono_map(A,r,C,s)"
   unfolding mono_map_def
 proof (intro CollectI ballI impI)
   from \<open>f \<in> mono_map(A,_,B,_)\<close>
   have "f: A \<rightarrow> B"
     using mono_map_is_fun by simp
   with \<open>B\<subseteq>C\<close>
   show "f: A \<rightarrow> C"
     using fun_weaken_type by simp
   fix x y
   assume "x\<in>A" "y\<in>A" "\<langle>x,y\<rangle> \<in> r"
   moreover from this and \<open>f: A \<rightarrow> B\<close>
   have "f`x \<in> B" "f`y \<in> B"
     using apply_type by simp_all
   moreover
   note \<open>f \<in> mono_map(_,r,_,s)\<close>
   ultimately
   show "\<langle>f ` x, f ` y\<rangle> \<in> s"
     unfolding mono_map_def by blast
 qed
 
 lemma ordertype_zero_imp_zero: "ordertype(A,r) = 0 \<Longrightarrow> A = 0"
   using ordermap_type[of A r]
   by (cases "A=0") auto
 
 lemma mono_map_increasing:
   "j\<in>mono_map(A,r,B,s) \<Longrightarrow> a\<in>A \<Longrightarrow> c\<in>A \<Longrightarrow> \<langle>a,c\<rangle>\<in>r \<Longrightarrow> \<langle>j`a,j`c\<rangle>\<in>s"
   unfolding mono_map_def by simp
 
 lemma linear_mono_map_reflects:
   assumes
     "linear(\<alpha>,r)" "trans[\<beta>](s)" "irrefl(\<beta>,s)" "f\<in>mono_map(\<alpha>,r,\<beta>,s)"
     "x\<in>\<alpha>" "y\<in>\<alpha>" "\<langle>f`x,f`y\<rangle>\<in>s"
   shows
     "\<langle>x,y\<rangle>\<in>r"
 proof -
   from \<open>f\<in>mono_map(_,_,_,_)\<close>
   have preserves:"x\<in>\<alpha> \<Longrightarrow> y\<in>\<alpha> \<Longrightarrow> \<langle>x,y\<rangle>\<in>r \<Longrightarrow> \<langle>f`x,f`y\<rangle>\<in>s" for x y
     unfolding mono_map_def by blast
   {
     assume "\<langle>x, y\<rangle> \<notin> r" "x\<in>\<alpha>" "y\<in>\<alpha>"
     moreover
     note \<open>\<langle>f`x,f`y\<rangle>\<in>s\<close> and \<open>linear(\<alpha>,r)\<close>
     moreover from calculation
     have "y = x \<or> \<langle>y,x\<rangle>\<in>r"
       unfolding linear_def by blast
     moreover
     note preserves [of y x]
     ultimately
     have "y = x \<or> \<langle>f`y, f`x\<rangle>\<in> s" by blast
     moreover from \<open>f\<in>mono_map(_,_,\<beta>,_)\<close> \<open>x\<in>\<alpha>\<close> \<open>y\<in>\<alpha>\<close>
     have "f`x\<in>\<beta>" "f`y\<in>\<beta>"
       using apply_type[OF mono_map_is_fun] by simp_all
     moreover
     note \<open>\<langle>f`x,f`y\<rangle>\<in>s\<close>  \<open>trans[\<beta>](s)\<close> \<open>irrefl(\<beta>,s)\<close>
     ultimately
     have "False"
       using trans_onD[of \<beta> s "f`x" "f`y" "f`x"] irreflE by blast
   }
   with assms
   show "\<langle>x,y\<rangle>\<in>r" by blast
 qed
 
 lemma irrefl_Memrel: "irrefl(x, Memrel(x))"
   unfolding irrefl_def using mem_irrefl by auto
 
 lemmas Memrel_mono_map_reflects = linear_mono_map_reflects
   [OF well_ord_is_linear[OF well_ord_Memrel] well_ord_is_trans_on[OF well_ord_Memrel]
     irrefl_Memrel]
 
 \<comment> \<open>Same proof as Paulson's @{thm mono_map_is_inj}\<close>
 lemma mono_map_is_inj':
   "\<lbrakk> linear(A,r);  irrefl(B,s);  f \<in> mono_map(A,r,B,s) \<rbrakk> \<Longrightarrow> f \<in> inj(A,B)"
   unfolding irrefl_def mono_map_def inj_def using linearE
   by (clarify, rename_tac x w)
     (erule_tac x=w and y=x in linearE, assumption+, (force intro: apply_type)+)
 
 lemma mono_map_imp_ord_iso_image:
   assumes
     "linear(\<alpha>,r)" "trans[\<beta>](s)"  "irrefl(\<beta>,s)" "f\<in>mono_map(\<alpha>,r,\<beta>,s)"
   shows
     "f \<in> ord_iso(\<alpha>,r,f``\<alpha>,s)"
   unfolding ord_iso_def
 proof (intro CollectI ballI iffI)
   \<comment> \<open>Enough to show it's bijective and preserves both ways\<close>
   from assms
   have "f \<in> inj(\<alpha>,\<beta>)"
     using mono_map_is_inj' by blast
   moreover from \<open>f \<in> mono_map(_,_,_,_)\<close>
   have "f \<in> surj(\<alpha>, f``\<alpha>)"
     unfolding mono_map_def using surj_image by auto
   ultimately
   show "f \<in> bij(\<alpha>, f``\<alpha>)"
     unfolding bij_def using inj_is_fun inj_to_Image by simp
   from \<open>f\<in>mono_map(_,_,_,_)\<close>
   show "x\<in>\<alpha> \<Longrightarrow> y\<in>\<alpha> \<Longrightarrow> \<langle>x,y\<rangle>\<in>r \<Longrightarrow> \<langle>f`x,f`y\<rangle>\<in>s" for x y
     unfolding mono_map_def by blast
   with assms
   show "\<langle>f`x,f`y\<rangle>\<in>s \<Longrightarrow> x\<in>\<alpha> \<Longrightarrow> y\<in>\<alpha> \<Longrightarrow> \<langle>x,y\<rangle>\<in>r" for x y
     using linear_mono_map_reflects
     by blast
 qed
 
 text\<open>We introduce the following notation for strictly increasing maps
 between ordinals.\<close>
 
 abbreviation
   mono_map_Memrel :: "[i,i] \<Rightarrow> i" (infixr \<open>\<rightarrow>\<^sub><\<close> 60) where
   "\<alpha> \<rightarrow>\<^sub>< \<beta> \<equiv> mono_map(\<alpha>,Memrel(\<alpha>),\<beta>,Memrel(\<beta>))"
 
 lemma mono_map_imp_ord_iso_Memrel:
   assumes
     "Ord(\<alpha>)" "Ord(\<beta>)" "f:\<alpha> \<rightarrow>\<^sub>< \<beta>"
   shows
     "f \<in> ord_iso(\<alpha>,Memrel(\<alpha>),f``\<alpha>,Memrel(\<beta>))"
   using assms mono_map_imp_ord_iso_image[OF well_ord_is_linear[OF well_ord_Memrel]
       well_ord_is_trans_on[OF well_ord_Memrel] irrefl_Memrel] by blast
 
 lemma mono_map_ordertype_image':
   assumes
     "X\<subseteq>\<alpha>" "Ord(\<alpha>)" "Ord(\<beta>)" "f \<in> mono_map(X,Memrel(\<alpha>),\<beta>,Memrel(\<beta>))"
   shows
     "ordertype(f``X,Memrel(\<beta>)) = ordertype(X,Memrel(\<alpha>))"
   using assms mono_map_is_fun[of f X _ \<beta>]  ordertype_eq
     mono_map_imp_ord_iso_image[OF well_ord_is_linear[OF well_ord_Memrel, THEN linear_subset]
       well_ord_is_trans_on[OF well_ord_Memrel] irrefl_Memrel, of \<alpha> X \<beta> f]
     well_ord_subset[OF well_ord_Memrel]  Image_sub_codomain[of f X \<beta> X] by auto
 
 lemma mono_map_ordertype_image:
   assumes
     "Ord(\<alpha>)" "Ord(\<beta>)" "f:\<alpha> \<rightarrow>\<^sub>< \<beta>"
   shows
     "ordertype(f``\<alpha>,Memrel(\<beta>)) = \<alpha>"
   using assms mono_map_is_fun ordertype_Memrel ordertype_eq[of f \<alpha> "Memrel(\<alpha>)"]
     mono_map_imp_ord_iso_Memrel well_ord_subset[OF well_ord_Memrel] Image_sub_codomain[of _ \<alpha>]
   by auto
 
 lemma apply_in_image: "f:A\<rightarrow>B \<Longrightarrow> a\<in>A \<Longrightarrow> f`a \<in> f``A"
   using range_eq_image apply_rangeI[of f]  by simp
 
 lemma Image_subset_Ord_imp_lt:
   assumes
     "Ord(\<alpha>)" "h``A \<subseteq> \<alpha>" "x\<in>domain(h)" "x\<in>A" "function(h)"
   shows
     "h`x < \<alpha>"
   using assms
   unfolding domain_def using imageI ltI function_apply_equality by auto
 
 lemma ordermap_le_arg:
   assumes
     "X\<subseteq>\<beta>" "x\<in>X" "Ord(\<beta>)"
   shows
     "x\<in>X \<Longrightarrow> ordermap(X,Memrel(\<beta>))`x\<le>x"
 proof (induct rule:Ord_induct[OF subsetD, OF assms])
   case (1 x)
   have "wf[X](Memrel(\<beta>))"
     using wf_imp_wf_on[OF wf_Memrel] .
   with 1
   have "ordermap(X,Memrel(\<beta>))`x = {ordermap(X,Memrel(\<beta>))`y . y\<in>{y\<in>X . y\<in>x \<and> y\<in>\<beta>}}"
     using ordermap_unfold Ord_trans[of _ x \<beta>] by auto
   also from assms
   have "... = {ordermap(X,Memrel(\<beta>))`y . y\<in>{y\<in>X . y\<in>x}}"
     using Ord_trans[of _ x \<beta>] Ord_in_Ord by blast
   finally
   have ordm:"ordermap(X,Memrel(\<beta>))`x = {ordermap(X,Memrel(\<beta>))`y . y\<in>{y\<in>X . y\<in>x}}" .
   from 1
   have "y\<in>x \<Longrightarrow> y\<in>X \<Longrightarrow> ordermap(X,Memrel(\<beta>))`y \<le> y" for y by simp
   with \<open>x\<in>\<beta>\<close> and \<open>Ord(\<beta>)\<close>
   have "y\<in>x \<Longrightarrow> y\<in>X \<Longrightarrow> ordermap(X,Memrel(\<beta>))`y \<in> x" for y
     using ltI[OF _ Ord_in_Ord[of \<beta> x]] lt_trans1 ltD by blast
   with ordm
   have "ordermap(X,Memrel(\<beta>))`x \<subseteq> x" by auto
   with \<open>x\<in>X\<close> assms
   show ?case
     using subset_imp_le Ord_in_Ord[of \<beta> x] Ord_ordermap
       well_ord_subset[OF well_ord_Memrel, of \<beta>] by force
 qed
 
 lemma subset_imp_ordertype_le:
   assumes
     "X\<subseteq>\<beta>" "Ord(\<beta>)"
   shows
     "ordertype(X,Memrel(\<beta>))\<le>\<beta>"
 proof -
   {
     fix x
     assume "x\<in>X"
     with assms
     have "ordermap(X,Memrel(\<beta>))`x \<le> x"
       using ordermap_le_arg by simp
     with \<open>x\<in>X\<close> and assms
     have "ordermap(X,Memrel(\<beta>))`x \<in> \<beta>" (is "?y \<in> _")
       using ltD[of ?y "succ(x)"] Ord_trans[of  ?y x \<beta>] by auto
   }
   then
   have "ordertype(X, Memrel(\<beta>)) \<subseteq> \<beta>"
     using ordertype_unfold[of X] by auto
   with assms
   show ?thesis
     using subset_imp_le Ord_ordertype[OF well_ord_subset, OF well_ord_Memrel] by simp
 qed
 
 lemma mono_map_imp_le:
   assumes
     "f\<in>mono_map(\<alpha>, Memrel(\<alpha>),\<beta>, Memrel(\<beta>))" "Ord(\<alpha>)" "Ord(\<beta>)"
   shows
     "\<alpha>\<le>\<beta>"
 proof -
   from assms
   have "f \<in> \<langle>\<alpha>, Memrel(\<alpha>)\<rangle> \<cong> \<langle>f``\<alpha>, Memrel(\<beta>)\<rangle>"
     using mono_map_imp_ord_iso_Memrel by simp
   then
   have "converse(f) \<in> \<langle>f``\<alpha>, Memrel(\<beta>)\<rangle> \<cong> \<langle>\<alpha>, Memrel(\<alpha>)\<rangle>"
     using ord_iso_sym by simp
   with \<open>Ord(\<alpha>)\<close>
   have "\<alpha> = ordertype(f``\<alpha>,Memrel(\<beta>))"
     using ordertype_eq well_ord_Memrel ordertype_Memrel by auto
   also from assms
   have "ordertype(f``\<alpha>,Memrel(\<beta>)) \<le> \<beta>"
     using subset_imp_ordertype_le mono_map_is_fun[of f] Image_sub_codomain[of f] by force
   finally
   show ?thesis .
 qed
 
 \<comment> \<open>\<^term>\<open>Ord(A) \<Longrightarrow> f \<in> mono_map(A, Memrel(A), B, Memrel(Aa)) \<Longrightarrow> f \<in> inj(A, B)\<close>\<close> 
 lemmas Memrel_mono_map_is_inj = mono_map_is_inj
   [OF well_ord_is_linear[OF well_ord_Memrel]
     wf_imp_wf_on[OF wf_Memrel]]
 
 lemma mono_mapI:
   assumes "f: A\<rightarrow>B" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> \<langle>x,y\<rangle>\<in>r \<Longrightarrow> \<langle>f`x,f`y\<rangle>\<in>s"
   shows   "f \<in> mono_map(A,r,B,s)"
   unfolding mono_map_def using assms by simp
 
 lemmas mono_mapD = mono_map_is_fun mono_map_increasing
 
 bundle mono_map_rules =  mono_mapI[intro!] mono_map_is_fun[dest] mono_mapD[dest]
 
 lemma nats_le_InfCard:
   assumes "n \<in> \<omega>" "InfCard(\<kappa>)"
   shows "n \<le> \<kappa>"
   using assms Ord_is_Transset
     le_trans[of n \<omega> \<kappa>, OF le_subset_iff[THEN iffD2]]
   unfolding InfCard_def Transset_def by simp
 
 lemma nat_into_InfCard:
   assumes "n \<in> \<omega>" "InfCard(\<kappa>)"
   shows "n \<in> \<kappa>"
   using assms  le_imp_subset[of \<omega> \<kappa>]
   unfolding InfCard_def by auto
 
 
 subsection\<open>Alephs are infinite cardinals\<close>
 
 lemma Aleph_zero_eq_nat: "\<aleph>\<^bsub>0\<^esub> = \<omega>"
   unfolding Aleph_def by simp
 
 lemma InfCard_Aleph:
   notes Aleph_zero_eq_nat[simp]
   assumes "Ord(\<alpha>)"
   shows "InfCard(\<aleph>\<^bsub>\<alpha>\<^esub>)"
 proof -
   have "\<not> (\<aleph>\<^bsub>\<alpha>\<^esub> \<in> \<omega>)"
   proof (cases "\<alpha>=0")
     case True
     then show ?thesis using mem_irrefl by auto
   next
     case False
     with \<open>Ord(\<alpha>)\<close>
     have "\<omega> \<in> \<aleph>\<^bsub>\<alpha>\<^esub>" using Ord_0_lt[of \<alpha>] ltD  by (auto dest:Aleph_increasing)
     then show ?thesis using foundation by blast
   qed
   with \<open>Ord(\<alpha>)\<close>
   have "\<not> (|\<aleph>\<^bsub>\<alpha>\<^esub>| \<in> \<omega>)"
     using Card_cardinal_eq by auto
   then
   have "\<not> Finite(\<aleph>\<^bsub>\<alpha>\<^esub>)" by auto
   with \<open>Ord(\<alpha>)\<close>
   show ?thesis
     using Inf_Card_is_InfCard by simp
 qed
 
+text\<open>A \<^emph>\<open>delta system\<close> is family of sets with a common pairwise
+intersection. We will work with this notion in Section~\ref{sec:dsl},
+but we state the definition here in order to have it available in a
+choiceless context.\<close>
+
+definition
+  delta_system :: "i \<Rightarrow> o" where
+  "delta_system(D) \<equiv> \<exists>r. \<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
+
+lemma delta_systemI[intro]:
+  assumes "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
+  shows "delta_system(D)"
+  using assms unfolding delta_system_def by simp
+
+lemma delta_systemD[dest]:
+  "delta_system(D) \<Longrightarrow> \<exists>r. \<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
+  unfolding delta_system_def by simp
+
+text\<open>Hence, pairwise intersections equal the intersection of the whole
+family.\<close>
+
+lemma delta_system_root_eq_Inter:
+  assumes "delta_system(D)"
+  shows "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = \<Inter>D"
+proof (clarify, intro equalityI, auto)
+  fix A' B' x C
+  assume hyp:"A'\<in>D" "B'\<in> D" "A'\<noteq>B'" "x\<in>A'" "x\<in>B'" "C\<in>D"
+  with assms
+  obtain r where delta:"\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
+    by auto
+  show "x \<in> C"
+  proof (cases "C=A'")
+    case True
+    with hyp and assms
+    show ?thesis by simp
+  next
+    case False
+    moreover
+    note hyp
+    moreover from calculation and delta
+    have "r = C \<inter> A'" "A' \<inter> B' = r" "x\<in>r" by auto
+    ultimately
+    show ?thesis by simp
+  qed
+qed
+
 lemmas Limit_Aleph = InfCard_Aleph[THEN InfCard_is_Limit]
 
 lemmas Aleph_cont = Normal_imp_cont[OF Normal_Aleph]
 lemmas Aleph_sup = Normal_Union[OF _ _ Normal_Aleph]
 
 bundle Ord_dests = Limit_is_Ord[dest] Card_is_Ord[dest]
 bundle Aleph_dests = Aleph_cont[dest] Aleph_sup[dest]
 bundle Aleph_intros = Aleph_increasing[intro!]
 bundle Aleph_mem_dests = Aleph_increasing[OF ltI, THEN ltD, dest]
 
+subsection\<open>Transfinite recursive constructions\<close>
+
+definition
+  rec_constr :: "[i,i] \<Rightarrow> i" where
+  "rec_constr(f,\<alpha>) \<equiv> transrec(\<alpha>,\<lambda>a g. f`(g``a))"
+
+text\<open>The function \<^term>\<open>rec_constr\<close> allows to perform \<^emph>\<open>recursive
+     constructions\<close>: given a choice function on the powerset of some
+     set, a transfinite sequence is created by successively choosing
+     some new element.
+
+     The next result explains its use.\<close>
+
+lemma rec_constr_unfold: "rec_constr(f,\<alpha>) = f`({rec_constr(f,\<beta>). \<beta>\<in>\<alpha>})"
+  using def_transrec[OF rec_constr_def, of f \<alpha>] image_lam by simp
+
+lemma rec_constr_type: assumes "f:Pow(G)\<rightarrow> G" "Ord(\<alpha>)"
+  shows "rec_constr(f,\<alpha>) \<in> G"
+  using assms(2,1)
+  by (induct rule:trans_induct)
+    (subst rec_constr_unfold, rule apply_type[of f "Pow(G)" "\<lambda>_. G"], auto)
+
 
 end
\ No newline at end of file
diff --git a/thys/Delta_System_Lemma/document/root.bib b/thys/Delta_System_Lemma/document/root.bib
--- a/thys/Delta_System_Lemma/document/root.bib
+++ b/thys/Delta_System_Lemma/document/root.bib
@@ -1,81 +1,103 @@
 @article{DBLP:journals/jar/PaulsonG96,
   author    = {Lawrence C. Paulson and
                Krzysztof Grabczewski},
   title     = {Mechanizing Set Theory},
   journal   = {J. Autom. Reasoning},
   volume    = {17},
   number    = {3},
   pages     = {291--323},
   year      = {1996},
   xurl       = {https://doi.org/10.1007/BF00283132},
   doi       = {10.1007/BF00283132},
   timestamp = {Sat, 20 May 2017 00:22:31 +0200},
   biburl    = {https://dblp.org/rec/bib/journals/jar/PaulsonG96},
   bibsource = {dblp computer science bibliography, https://dblp.org}
 }
 
 @inproceedings{2020arXiv200109715G,
        author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
         title = "{Formalization of Forcing in Isabelle/ZF}",
     isbn      = {978-3-662-45488-6},
     booktitle = {Automated Reasoning. 10th International Joint Conference, IJCAR 2020, Paris, France, July 1--4, 2020, Proceedings, Part II},
     volume    = 12167,
     series    = {Lecture Notes in Artificial Intelligence},
     editor    = {Peltier, Nicolas and  Sofronie-Stokkermans, Viorica},
     publisher = {Springer International Publishing},
     doi       = {10.1007/978-3-030-51054-1},
     pages     = {221--235},
      keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1},
          year = 2020,
           eid = {arXiv:2001.09715},
 archivePrefix = {arXiv},
        eprint = {2001.09715},
  primaryClass = {cs.LO},
        adsurl = {https://ui.adsabs.harvard.edu/abs/2020arXiv200109715G},
      abstract = {We formalize the theory of forcing in the set theory framework of
 Isabelle/ZF. Under the assumption of the existence of a countable
 transitive model of $\mathit{ZFC}$, we construct a proper generic extension and show
 that the latter also satisfies $\mathit{ZFC}$. In doing so, we remodularized
 Paulson's ZF-Constructibility library.},
       adsnote = {Provided by the SAO/NASA Astrophysics Data System}
 }
 
 @Book{Jech_Millennium,
     author =	"Thomas Jech",
     title =	"Set Theory. The Millennium Edition",
     series =	"Springer Monographs in Mathematics",
     publisher = "Springer-Verlag",
     edition = "Third",
     year =	"2002",
     note = {Corrected fourth printing, 2006}
 }
 
 @misc{apunte_st,
   author = {S{\'a}nchez Terraf, Pedro},
   title = "Course notes on set theory",
   howpublished = {online},
   year = 2019,
   note = "In Spanish",
   url = {https://cs.famaf.unc.edu.ar/~pedro/home_en.html#set_theory}
 }
 
 @book{kunen2011set,
   title={Set Theory},
   author={Kunen, K.},
   edition = {Second},
   isbn=9781848900509,
   series={Studies in Logic},
   url={https://books.google.com.ar/books?id=Zn8ppwAACAAJ},
   year=2011,
   publisher={College Publications},
   note = {Revised edition, 2013}
 }
 
 @Book{JW,
     author =	"Winfried Just and Martin Weese",
     title =	"Discovering Modern Set Theory. II",
     series =	"Grad. Studies in Mathematics",
     volume =	"18",
     publisher = "American Mathematical Society", 
     year =	"1997"
 }
+
+@article{Transitive_Models-AFP,
+  author  = {Emmanuel Gunther and Miguel Pagano and Sánchez Terraf, Pedro and Matías Steinberg},
+  title   = {Transitive Models of Fragments of {ZFC}},
+  journal = {Archive of Formal Proofs},
+  month   = mar,
+  year    = 2022,
+  note    = {\url{https://isa-afp.org/entries/Transitive_Models.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
+
+@article{Independence_CH-AFP,
+  author  = {Emmanuel Gunther and Miguel Pagano and Sánchez Terraf, Pedro and Matías Steinberg},
+  title   = {The Independence of the Continuum Hypothesis in {Isabelle/ZF}},
+  journal = {Archive of Formal Proofs},
+  month   = mar,
+  year    = 2022,
+  note    = {\url{https://isa-afp.org/entries/Independence_CH.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
diff --git a/thys/Delta_System_Lemma/document/root.tex b/thys/Delta_System_Lemma/document/root.tex
--- a/thys/Delta_System_Lemma/document/root.tex
+++ b/thys/Delta_System_Lemma/document/root.tex
@@ -1,120 +1,119 @@
 \documentclass[11pt,a4paper]{article}
 \usepackage[T1]{fontenc}
 \usepackage{isabelle,isabellesym}
 \usepackage[numbers]{natbib}
 
 \usepackage{relsize}
 \DeclareRobustCommand{\isactrlbsub}{\emph\bgroup\math{}\sb\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
 \DeclareRobustCommand{\isactrlesub}{\egroup\egroup\endmath\egroup}
 \DeclareRobustCommand{\isactrlbsup}{\emph\bgroup\math{}\sp\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
 \DeclareRobustCommand{\isactrlesup}{\egroup\egroup\endmath\egroup}
 
 % further packages required for unusual symbols (see also
 % isabellesym.sty), use only when needed
 
 \usepackage{amssymb}
   %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
   %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
   %\<triangleq>, \<yen>, \<lozenge>
 
 %\usepackage{eurosym}
   %for \<euro>
 
 %\usepackage[only,bigsqcap]{stmaryrd}
   %for \<Sqinter>
 
 %\usepackage{eufrak}
   %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
 
 %\usepackage{textcomp}
   %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
   %\<currency>
 
 \input{header-delta-system}
 
 % this should be the last package used
 \usepackage{pdfsetup}
 
 % urls in roman style, theory text in math-similar italics
 \urlstyle{tt}
 \isabellestyle{it}
 
 % for uniform font size
 %\renewcommand{\isastyle}{\isastyleminor}
 
 \renewcommand{\isacharunderscorekeyword}{\mbox{\_}}
 \renewcommand{\isacharunderscore}{\mbox{\_}}
 \renewcommand{\isasymtturnstile}{\isamath{\Vdash}}
 \renewcommand{\isacharminus}{-}
 
 \begin{document}
 
 \title{Cofinality and the Delta System Lemma}
 \author{
   Pedro S\'anchez Terraf\thanks{Universidad Nacional de C\'ordoba. 
     Facultad de Matem\'atica, Astronom\'{\i}a,  F\'{\i}sica y
     Computaci\'on.}
   \thanks{%
     Centro de Investigaci\'on y Estudios de Matem\'atica
     (CIEM-FaMAF), Conicet. C\'ordoba. Argentina.
-    Supported by Secyt-UNC project 33620180100465CB.}
+    Supported by Secyt-UNC project 33620180100465CB.
+    \href{https://cs.famaf.unc.edu.ar/~pedro/}{\texttt{https://cs.famaf.unc.edu.ar/$\sim$pedro/}}}
 }
 \maketitle
 
 \begin{abstract}
   We formalize the basic results on cofinality of linearly ordered
   sets and ordinals and \v{S}anin's Lemma for uncountable families of
   finite sets. We work in the set theory framework of
   Isabelle/ZF, using the Axiom of Choice as needed.
 \end{abstract}
 
 
 \tableofcontents
 
 % sane default for proof documents
 \parindent 0pt\parskip 0.5ex
 
 \section{Introduction}
 
 The session we present gathers very basic results built on the set
 theory formalization of Isabelle/ZF
 \cite{DBLP:journals/jar/PaulsonG96}. In a sense, some of the material
 formalized here corresponds to a natural continuation of that
 work. This is even clearer after perusing Section~\ref{sec:zf-lib},
 where notions like cardinal exponentiation are first defined, together
 with various lemmas that do not depend on the Axiom of Choice ($\AC$);
 the same holds for the basic theory of cofinality of ordinals, which
 is developed in Section~\ref{sec:cofinality}. In
 Section~\ref{sec:cardinal-lib}, (un)countability is defined
 and several results proved, now using $\AC$ freely; the latter is also
 needed to prove König's Theorem on cofinality of cardinal
 exponentiation. The simplest infinitary version of the Delta
 System Lemma (DSL, also known as the ``Sunflower Lemma'') due to  \v{S}anin
 is proved in Section~\ref{sec:dsl}, and it is applied to prove
 that Cohen posets satisfy the \emph{countable chain condition}.
 
-A greater part of this development was motivated by an ongoing joint
+A greater part of this development was motivated by a joint
 project on the formalization of the ctm approach to
 forcing~\cite{2020arXiv200109715G} by Gunther, Pagano, Steinberg, and
 the author. Indeed, most of the results presented here are required
 for the development of forcing. As it turns out, the material as
-formalized presently will not be part of the forcing formalization,
-since for that goal we need relativized versions of both the concepts
+formalized presently is not imported as a whole by the forcing
+formalization \cite{Transitive_Models-AFP,Independence_CH-AFP},
+since the latter requires relativized versions of both the concepts
 and the proofs.
 
-A cross-linked HTML version of the development can be found at
-\url{https://cs.famaf.unc.edu.ar/~pedro/Delta_System_Lemma/html}.
-
 % generated text of all theories
 \input{session}
 
 % optional bibliography
 \bibliographystyle{root}
 \bibliography{root}
 
 \end{document}
 
 %%% Local Variables:
 %%% mode: latex
 %%% TeX-master: t
 %%% End:
diff --git a/thys/Independence_CH/Absolute_Versions.thy b/thys/Independence_CH/Absolute_Versions.thy
--- a/thys/Independence_CH/Absolute_Versions.thy
+++ b/thys/Independence_CH/Absolute_Versions.thy
@@ -1,148 +1,150 @@
 section\<open>From $M$ to $\calV$\<close>
 
 theory Absolute_Versions
   imports
     CH
     ZF.Cardinal_AC
 begin
 
+hide_const (open) Order.pred
+
 subsection\<open>Locales of a class \<^term>\<open>M\<close> hold in \<^term>\<open>\<V>\<close>\<close>
 
 interpretation V: M_trivial \<V>
   using Union_ax_absolute upair_ax_absolute
   by unfold_locales auto
 
 lemmas bad_simps = V.nonempty V.Forall_in_M_iff V.Inl_in_M_iff V.Inr_in_M_iff
   V.succ_in_M_iff V.singleton_in_M_iff V.Equal_in_M_iff V.Member_in_M_iff V.Nand_in_M_iff
   V.Cons_in_M_iff V.pair_in_M_iff V.upair_in_M_iff
 
 lemmas bad_M_trivial_simps[simp del] = V.Forall_in_M_iff V.Equal_in_M_iff
   V.nonempty
 
 lemmas bad_M_trivial_rules[rule del] =  V.pair_in_MI V.singleton_in_MI V.pair_in_MD V.nat_into_M
   V.depth_closed V.length_closed V.nat_case_closed V.separation_closed
   V.Un_closed V.strong_replacement_closed V.nonempty
 
 interpretation V:M_basic \<V>
   using power_ax_absolute separation_absolute replacement_absolute
   by unfold_locales auto
 
 interpretation V:M_eclose \<V>
   by unfold_locales (auto intro:separation_absolute replacement_absolute
       simp:iterates_replacement_def wfrec_replacement_def)
 
 lemmas bad_M_basic_rules[simp del, rule del] =
   V.cartprod_closed V.finite_funspace_closed V.converse_closed
   V.list_case'_closed V.pred_closed
 
 interpretation V:M_cardinal_arith \<V>
   by unfold_locales (auto intro:separation_absolute replacement_absolute
       simp add:iterates_replacement_def wfrec_replacement_def lam_replacement_def)
 
 lemmas bad_M_cardinals_rules[simp del, rule del] =
   V.iterates_closed V.M_nat V.trancl_closed V.rvimage_closed
 
 interpretation V:M_cardinal_arith_jump \<V>
   by unfold_locales (auto intro:separation_absolute replacement_absolute
       simp:wfrec_replacement_def)
 
 lemma choice_ax_Universe: "choice_ax(\<V>)"
 proof -
   {
     fix x
     obtain f where "f \<in> surj(|x|,x)"
       using cardinal_eqpoll unfolding eqpoll_def bij_def by fast
     moreover
     have "Ord(|x|)" by simp
     ultimately
     have "\<exists>a. Ord(a) \<and> (\<exists>f. f \<in> surj(a,x))"
       by fast
   }
   then
   show ?thesis  unfolding choice_ax_def rall_def rex_def
     by simp
 qed
 
 interpretation V:M_master \<V>
   using choice_ax_Universe
   by unfold_locales (auto intro:separation_absolute replacement_absolute
       simp:lam_replacement_def transrec_replacement_def wfrec_replacement_def
       is_wfrec_def M_is_recfun_def)
 
 named_theorems V_simps
 
 \<comment> \<open>To work systematically, ASCII versions of "\_absolute" theorems as
     those below are preferable.\<close>
 lemma eqpoll_rel_absolute[V_simps]: "x \<approx>\<^bsup>\<V>\<^esup> y \<longleftrightarrow> x \<approx> y"
   unfolding eqpoll_def using V.def_eqpoll_rel by auto
 
 lemma cardinal_rel_absolute[V_simps]: "|x|\<^bsup>\<V>\<^esup> = |x|"
   unfolding cardinal_def cardinal_rel_def by (simp add:V_simps)
 
 lemma Card_rel_absolute[V_simps]:"Card\<^bsup>\<V>\<^esup>(a) \<longleftrightarrow> Card(a)"
-  unfolding Card_rel_def Card_def by (simp add:V_simps)
+  unfolding Card_rel_def Card_def by (simp only:V_simps)
 
 lemma csucc_rel_absolute[V_simps]:"(a\<^sup>+)\<^bsup>\<V>\<^esup> = a\<^sup>+"
   unfolding csucc_rel_def csucc_def by (simp add:V_simps)
 
 lemma function_space_rel_absolute[V_simps]:"x \<rightarrow>\<^bsup>\<V>\<^esup> y = x \<rightarrow> y"
   using V.function_space_rel_char by (simp add:V_simps)
 
 lemma cexp_rel_absolute[V_simps]:"x\<^bsup>\<up>y,\<V>\<^esup> = x\<^bsup>\<up>y\<^esup>"
-  unfolding cexp_rel_def cexp_def by (simp add:V_simps)
+  unfolding cexp_rel_def cexp_def by (simp only:V_simps)
 
 lemma HAleph_rel_absolute[V_simps]:"HAleph_rel(\<V>,a,b) = HAleph(a,b)"
   unfolding HAleph_rel_def HAleph_def by (auto simp add:V_simps)
 
 lemma Aleph_rel_absolute[V_simps]: "Ord(x) \<Longrightarrow> \<aleph>\<^bsub>x\<^esub>\<^bsup>\<V>\<^esup> = \<aleph>\<^bsub>x\<^esub>"
 proof -
   assume "Ord(x)"
   have "\<aleph>\<^bsub>x\<^esub>\<^bsup>\<V>\<^esup> = transrec(x, \<lambda>a b. HAleph_rel(\<V>,a,b))"
     unfolding Aleph_rel_def by simp
   also
   have "\<dots> = transrec(x, HAleph)"
-    by (simp add:V_simps)
+    by (simp only:V_simps)
   also from \<open>Ord(x)\<close>
   have "\<dots> = \<aleph>\<^bsub>x\<^esub>"
     using Aleph'_eq_Aleph unfolding Aleph'_def by simp
   finally
   show ?thesis .
 qed
 
-txt\<open>Example of absolute lemmas obtained from the relative versions.
+text\<open>Example of absolute lemmas obtained from the relative versions.
     Note the \<^emph>\<open>only\<close> declarations\<close>
 lemma Ord_cardinal_idem': "Ord(A) \<Longrightarrow> ||A|| = |A|"
   using V.Ord_cardinal_rel_idem by (simp only:V_simps)
 
 lemma Aleph_succ': "Ord(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>succ(\<alpha>)\<^esub> = \<aleph>\<^bsub>\<alpha>\<^esub>\<^sup>+"
   using V.Aleph_rel_succ by (simp only:V_simps)
 
-txt\<open>These two results are new, first obtained in relative form
+text\<open>These two results are new, first obtained in relative form
     (not ported).\<close>
 lemma csucc_cardinal:
   assumes "Ord(\<kappa>)" shows "|\<kappa>|\<^sup>+ = \<kappa>\<^sup>+"
-  using assms V.csucc_rel_cardinal_rel by (simp add:V_simps)
+  using assms V.csucc_rel_cardinal_rel by (simp only:V_simps)
 
 lemma csucc_le_mono:
   assumes "\<kappa> \<le> \<nu>"  shows "\<kappa>\<^sup>+ \<le> \<nu>\<^sup>+"
-  using assms V.csucc_rel_le_mono by (simp add:V_simps)
+  using assms V.csucc_rel_le_mono by (simp only:V_simps)
 
-txt\<open>Example of transferring results from a transitive model to \<^term>\<open>\<V>\<close>\<close>
+text\<open>Example of transferring results from a transitive model to \<^term>\<open>\<V>\<close>\<close>
 lemma (in M_Perm) eqpoll_rel_transfer_absolute:
   assumes "M(A)" "M(B)" "A \<approx>\<^bsup>M\<^esup> B"
   shows "A \<approx> B"
 proof -
   interpret M_N_Perm M \<V>
     by (unfold_locales, simp only:V_simps)
   from assms
   show ?thesis using eqpoll_rel_transfer
     by (simp only:V_simps)
 qed
 
-txt\<open>The “relationalized” $\CH$ with respect to \<^term>\<open>\<V>\<close> corresponds
+text\<open>The “relationalized” $\CH$ with respect to \<^term>\<open>\<V>\<close> corresponds
     to the real $\CH$.\<close>
 lemma is_ContHyp_iff_CH: "is_ContHyp(\<V>) \<longleftrightarrow> ContHyp"
   using V.is_ContHyp_iff
   by (auto simp add:ContHyp_rel_def ContHyp_def V_simps)
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/CH.thy b/thys/Independence_CH/CH.thy
--- a/thys/Independence_CH/CH.thy
+++ b/thys/Independence_CH/CH.thy
@@ -1,529 +1,447 @@
 section\<open>Forcing extension satisfying the Continuum Hypothesis\<close>
 
 theory CH
   imports
     Kappa_Closed_Notions
     Cohen_Posets_Relative
 begin
 
 context M_ctm3_AC
 begin
 
 declare Fn_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]
 declare Fnle_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]
 
 abbreviation
   Coll :: "i" where
   "Coll \<equiv> Fn\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
 
 abbreviation
   Colleq :: "i" where
   "Colleq \<equiv> Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
 
 lemma Coll_in_M[intro,simp]: "Coll \<in> M" by simp
 
 lemma Colleq_refl : "refl(Coll,Colleq)"
   unfolding Fnle_rel_def Fnlerel_def refl_def
   using RrelI by simp
 
 subsection\<open>Collapse forcing is sufficiently closed\<close>
 
 \<comment> \<open>Kunen IV.7.14, only for \<^term>\<open>\<aleph>\<^bsub>1\<^esub>\<close>\<close>
 lemma succ_omega_closed_Coll: "succ(\<omega>)-closed\<^bsup>M\<^esup>(Coll,Colleq)"
 proof -
   \<comment> \<open>Case for finite sequences\<close>
   have "n\<in>\<omega> \<Longrightarrow> \<forall>f \<in> n \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)).
           \<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> n \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq)" for n
   proof (induct rule:nat_induct)
     case 0
     then
     show ?case
       using zero_lt_Aleph_rel1 zero_in_Fn_rel
       by (auto simp del:setclass_iff) (rule bexI[OF _ zero_in_M], auto)
   next
     case (succ x)
     then
     have "\<forall>f\<in>succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)). \<forall>\<alpha> \<in> succ(x). \<langle>f`x, f ` \<alpha>\<rangle> \<in> Colleq"
     proof(intro ballI)
       fix f \<alpha>
       assume "f\<in>succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))" "\<alpha>\<in>succ(x)"
       moreover from \<open>x\<in>\<omega>\<close> this
       have "f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))"
         using mono_seqspace_rel_char nat_into_M
         by simp
       moreover from calculation succ
       consider "\<alpha>\<in>x" | "\<alpha>=x"
         by auto
       then
       show "\<langle>f`x, f ` \<alpha>\<rangle> \<in> Colleq"
       proof(cases)
         case 1
         then
         have "\<langle>\<alpha>, x\<rangle> \<in> Memrel(succ(x))" "x\<in>succ(x)" "\<alpha>\<in>succ(x)"
           by auto
         with \<open>f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))\<close>
         show ?thesis
           using mono_mapD(2)[OF _ \<open>\<alpha>\<in>succ(x)\<close> _ \<open>\<langle>\<alpha>, x\<rangle> \<in> Memrel(succ(x))\<close>]
           unfolding mono_seqspace_def
           by auto
       next
         case 2
         with \<open>f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))\<close>
         show ?thesis
           using Colleq_refl mono_seqspace_is_fun[THEN apply_type]
           unfolding refl_def
           by simp
       qed
     qed
     moreover
     note \<open>x\<in>\<omega>\<close>
     moreover from this
     have "f`x \<in> Coll" if "f: succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))" for f
       using that mono_seqspace_rel_char[simplified, of "succ(x)" Coll "converse(Colleq)"]
         nat_into_M[simplified] mono_seqspace_is_fun[of "converse(Colleq)"]
       by (intro apply_type[of _ "succ(x)"]) (auto simp del:setclass_iff)
     ultimately
     show ?case
       using transM[of _ Coll]
       by (auto dest:transM simp del:setclass_iff, rule_tac x="f`x" in bexI)
         (auto simp del:setclass_iff, simp)
   qed
   moreover
     \<comment> \<open>Interesting case: Countably infinite sequences.\<close>
   have "\<forall>f\<in>M. f \<in> \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)) \<longrightarrow>
                   (\<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq))"
   proof(intro ballI impI)
     fix f
-    let ?G="f``\<omega>"
+    let ?rnf="f``\<omega>"
     assume "f\<in>M" "f \<in> \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))"
     moreover from this
     have "f\<in>\<omega> \<^sub><\<rightarrow> (Coll,converse(Colleq))" "f\<in>\<omega> \<rightarrow> Coll"
       using mono_seqspace_rel_char mono_mapD(2) nat_in_M
       by auto
     moreover from this
     have "countable\<^bsup>M\<^esup>(f`x)" if "x\<in>\<omega>" for x
       using that Fn_rel_is_function countable_iff_lesspoll_rel_Aleph_rel_one
       by auto
     moreover from calculation
-    have "?G \<in> M" "f\<subseteq>\<omega>\<times>Coll"
+    have "?rnf \<in> M" "f\<subseteq>\<omega>\<times>Coll"
       using nat_in_M image_closed Pi_iff
       by simp_all
     moreover from calculation
-    have 1:"\<exists>d\<in>?G. d \<supseteq> h \<and> d \<supseteq> g" if "h \<in> ?G" "g \<in> ?G" for h g
+    have 1:"\<exists>d\<in>?rnf. d \<supseteq> h \<and> d \<supseteq> g" if "h \<in> ?rnf" "g \<in> ?rnf" for h g
     proof -
       from calculation
-      have "?G={f`x . x\<in>\<omega>}"
+      have "?rnf={f`x . x\<in>\<omega>}"
         using  image_function[of f \<omega>] Pi_iff domain_of_fun
         by auto
-      from \<open>?G=_\<close> that
+      from \<open>?rnf=_\<close> that
       obtain m n where eq:"h=f`m" "g=f`n" "n\<in>\<omega>" "m\<in>\<omega>"
         by auto
       then
       have "m\<union>n\<in>\<omega>" "m\<le>m\<union>n" "n\<le>m\<union>n"
         using Un_upper1_le Un_upper2_le nat_into_Ord by simp_all
-      with calculation eq \<open>?G=_\<close>
-      have "f`(m\<union>n)\<in>?G" "f`(m\<union>n) \<supseteq> h" "f`(m\<union>n) \<supseteq> g"
+      with calculation eq \<open>?rnf=_\<close>
+      have "f`(m\<union>n)\<in>?rnf" "f`(m\<union>n) \<supseteq> h" "f`(m\<union>n) \<supseteq> g"
         using Fnle_relD mono_map_lt_le_is_mono converse_refl[OF Colleq_refl]
         by auto
       then
       show ?thesis
         by auto
     qed
     moreover from calculation
-    have "?G \<subseteq> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
+    have "?rnf \<subseteq> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
       using subset_trans[OF image_subset[OF \<open>f\<subseteq>_\<close>,of \<omega>] Fn_rel_subset_PFun_rel]
       by simp
     moreover
-    have "\<Union> ?G \<in> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
-      using pfun_Un_filter_closed'[OF \<open>?G\<subseteq>_\<close> 1]  \<open>?G\<in>M\<close>
+    have "\<Union> ?rnf \<in> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
+      using pfun_Un_filter_closed'[OF \<open>?rnf\<subseteq>_\<close> 1]  \<open>?rnf\<in>M\<close>
       by simp
     moreover from calculation
-    have "\<Union>?G \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
+    have "\<Union>?rnf \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
       using countable_fun_imp_countable_image[of f]
         mem_function_space_rel_abs[simplified,OF nat_in_M Coll_in_M \<open>f\<in>M\<close>]
         countableI[OF lepoll_rel_refl]
-        countable_iff_lesspoll_rel_Aleph_rel_one[of "\<Union>?G"]
+        countable_iff_lesspoll_rel_Aleph_rel_one[of "\<Union>?rnf"]
       by auto
     moreover from calculation
-    have "\<Union>?G\<in>Coll"
+    have "\<Union>?rnf\<in>Coll"
       unfolding Fn_rel_def
       by simp
     moreover from calculation
-    have "\<Union>?G \<supseteq> f ` \<alpha> " if "\<alpha>\<in>\<omega>" for \<alpha>
+    have "\<Union>?rnf \<supseteq> f ` \<alpha> " if "\<alpha>\<in>\<omega>" for \<alpha>
       using that image_function[OF fun_is_function] domain_of_fun
       by auto
     ultimately
     show "\<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq)"
       using Fn_rel_is_function Fnle_relI
       by auto
   qed
   ultimately
   show ?thesis
     unfolding kappa_closed_rel_def by (auto elim!:leE dest:ltD)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_ctm3_AC\<close>\<close>
 
-locale collapse_generic4 = G_generic4_AC "Fn\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" "Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" 0
+sublocale M_ZFC3_trans \<subseteq> M_library "##M"
+  by unfold_locales (simp_all add:repl_instances sep_instances del:setclass_iff
+      add: transrec_replacement_def wfrec_replacement_def)
 
-sublocale collapse_generic4 \<subseteq> forcing_notion "Coll" "Colleq" 0
+locale collapse_CH = G_generic4_AC_CH "Fn\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" "Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" 0
+
+sublocale collapse_CH \<subseteq> forcing_notion "Coll" "Colleq" 0
   using zero_lt_Aleph_rel1 by unfold_locales
 
-context collapse_generic4
+context collapse_CH
 begin
 
 notation Leq (infixl "\<preceq>" 50)
 notation Incompatible (infixl "\<bottom>" 50)
-notation GenExt_at_P ("_[_]" [71,1])
 
 abbreviation
   f_G :: "i" (\<open>f\<^bsub>G\<^esub>\<close>) where
   "f\<^bsub>G\<^esub> \<equiv> \<Union>G"
 
 lemma f_G_in_MG[simp]:
   shows "f\<^bsub>G\<^esub> \<in> M[G]"
   using G_in_MG by simp
 
 abbreviation
   dom_dense :: "i\<Rightarrow>i" where
   "dom_dense(x) \<equiv> { p\<in>Coll . x \<in> domain(p) }"
 
-lemma Coll_into_countable_rel: "p \<in> Coll \<Longrightarrow> countable\<^bsup>M\<^esup>(p)"
-proof -
-  assume "p\<in>Coll"
-  then
-  have "p \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "p\<in>M"
-    using Fn_rel_is_function by simp_all
-  moreover from this
-  have "p \<lesssim>\<^bsup>M\<^esup> \<omega>"
-    using lesspoll_rel_Aleph_rel_succ[of 0] Aleph_rel_zero
-    by simp
-  ultimately
-  show ?thesis
-    using countableI eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym cardinal_rel_eqpoll_rel
-    by simp
-qed
-
-(* TODO: Should be more general, cf. @{thm add_generic.dense_dom_dense} *)
-lemma dense_dom_dense: "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> dense(dom_dense(x))"
-proof
-  fix p
-  assume "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "p \<in> Coll"
-  show "\<exists>d\<in>dom_dense(x). d \<preceq> p"
-  proof (cases "x \<in> domain(p)")
-    case True
-    with \<open>x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>p \<in> Coll\<close>
-    show ?thesis using refl_leq by auto
-  next
-    case False
-    note \<open>p \<in> Coll\<close>
-    moreover from this and False and \<open>x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
-    have "cons(\<langle>x,\<lambda>n\<in>\<omega>. 0\<rangle>, p) \<in> Coll" "x\<in>M"
-      using function_space_rel_char
-        function_space_rel_closed lam_replacement_constant
-        lam_replacement_iff_lam_closed InfCard_rel_Aleph_rel
-      by (auto intro!: cons_in_Fn_rel dest:transM intro:function_space_nonempty)
-    ultimately
-    show ?thesis
-      using Fn_relD by blast
-  qed
-qed
-
 lemma dom_dense_closed[intro,simp]: "x\<in>M \<Longrightarrow> dom_dense(x) \<in> M"
   using separation_in_domain[of x]
   by simp
 
 lemma domain_f_G: assumes "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
   shows "x \<in> domain(f\<^bsub>G\<^esub>)"
 proof -
-  from assms
+  have "(\<lambda>n\<in>\<omega>. 0) \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
+    using function_space_rel_nonempty[of 0 2 \<omega>]
+    by auto
+  with assms
   have "dense(dom_dense(x))" "x\<in>M"
-    using dense_dom_dense transitivity[OF _
-        Aleph_rel_closed[of 1,THEN setclass_iff[THEN iffD1]]]
-    by simp_all
+    using dense_dom_dense InfCard_rel_Aleph_rel[of 1] transitivity[OF _
+       Aleph_rel_closed[of 1,THEN setclass_iff[THEN iffD1]]]
+    unfolding dense_def
+     by auto
   with assms
   obtain p where "p\<in>dom_dense(x)" "p\<in>G"
-    using generic[THEN M_generic_denseD, of "dom_dense(x)"]
+    using M_generic_denseD[of "dom_dense(x)"]
     by auto
   then
   show "x \<in> domain(f\<^bsub>G\<^esub>)" by blast
 qed
 
-lemma rex_mono : assumes "\<exists> d \<in> A . P(d)" "A\<subseteq>B"
-  shows "\<exists> d \<in> B. P(d)"
-  using assms by auto
-
 lemma Un_filter_is_function:
   assumes "filter(G)"
   shows "function(\<Union>G)"
 proof -
   have "Coll \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
     using Fn_rel_subset_PFun_rel
     by simp
   moreover
   have "\<exists> d \<in> Coll. d \<supseteq> f \<and> d \<supseteq> g" if "f\<in>G" "g\<in>G" for f g
     using filter_imp_compat[OF assms \<open>f\<in>G\<close> \<open>g\<in>G\<close>] filterD[OF assms]
     unfolding compat_def compat_in_def
     by auto
   ultimately
   have "\<exists>d \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2). d \<supseteq> f \<and> d \<supseteq> g" if "f\<in>G" "g\<in>G" for f g
     using rex_mono[of Coll] that by simp
   moreover
   have "G\<subseteq>Coll"
     using assms
     unfolding filter_def
     by simp
   moreover from this
   have "G \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
-    using assms  unfolding Fn_rel_def
+    using assms unfolding Fn_rel_def
     by auto
   ultimately
   show ?thesis
     using pfun_Un_filter_closed[of G]
     by simp
 qed
 
 lemma f_G_funtype:
   shows "f\<^bsub>G\<^esub> : \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
 proof -
   have "x \<in> B \<Longrightarrow> B \<in> G \<Longrightarrow> x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<times> (\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)" for B x
   proof -
     assume "x\<in>B" "B\<in>G"
     moreover from this
     have "x \<in> M[G]"
-      by (auto dest!:generic_dests ext.transM)
-        (intro generic_simps(2)[of Coll], simp)
+      by (auto dest!: ext.transM simp add:G_in_MG)
     moreover from calculation
     have "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<times> (\<omega> \<rightarrow> 2)"
       using Fn_rel_subset_Pow[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2",
           OF _ _ function_space_rel_closed] function_space_rel_char
-      by (auto dest!:generic_dests)
+      by (auto dest!: M_genericD)
     moreover from this
     obtain z w where "x=\<langle>z,w\<rangle>" "z\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "w:\<omega> \<rightarrow> 2" by auto
     moreover from calculation
     have "w \<in> M[G]" by (auto dest:ext.transM)
     ultimately
     show ?thesis using ext.function_space_rel_char by auto
   qed
   moreover
   have "function(f\<^bsub>G\<^esub>)"
     using Un_filter_is_function generic
     unfolding M_generic_def by fast
   ultimately
   show ?thesis
-    using generic domain_f_G unfolding Pi_def by auto
+    using generic domain_f_G Pi_iff by auto
 qed
 
 abbreviation
   surj_dense :: "i\<Rightarrow>i" where
   "surj_dense(x) \<equiv> { p\<in>Coll . x \<in> range(p) }"
 
-(* TODO: write general versions of this for \<^term>\<open>Fn\<^bsup>M\<^esup>(\<kappa>,I,J)\<close> *)
-lemma dense_surj_dense:
-  assumes "x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
-  shows "dense(surj_dense(x))"
-proof
-  fix p
-  assume "p \<in> Coll"
-  then
-  have "countable\<^bsup>M\<^esup>(p)" using Coll_into_countable_rel by simp
-  show "\<exists>d\<in>surj_dense(x). d \<preceq> p"
-  proof -
-    from \<open>p \<in> Coll\<close>
-    have "domain(p) \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "p\<in>M"
-      using transM[of _ Coll] domain_of_fun
-      by (auto del:Fn_relD dest!:Fn_relD del:domainE)
-    moreover from \<open>countable\<^bsup>M\<^esup>(p)\<close>
-    have "domain(p) \<subseteq> {fst(x) . x \<in> p }" by (auto intro!: rev_bexI)
-    moreover from calculation
-    have "{ fst(x) . x \<in> p } \<in> M"
-      using lam_replacement_fst[THEN lam_replacement_imp_strong_replacement]
-      by (auto simp flip:setclass_iff intro!:RepFun_closed dest:transM)
-    moreover from calculation and \<open>countable\<^bsup>M\<^esup>(p)\<close>
-    have "countable\<^bsup>M\<^esup>({fst(x) . x \<in> p })"
-      using cardinal_rel_RepFun_le lam_replacement_fst
-        countable_rel_iff_cardinal_rel_le_nat[THEN iffD1, THEN [2] le_trans, of _ p]
-      by (rule_tac countable_rel_iff_cardinal_rel_le_nat[THEN iffD2]) simp_all
-    moreover from calculation
-    have "countable\<^bsup>M\<^esup>(domain(p))"
-      using uncountable_rel_not_subset_countable_rel[of "{fst(x) . x \<in> p }" "domain(p)"]
-      by auto
-    ultimately
-    obtain \<alpha> where "\<alpha> \<notin> domain(p)" "\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
-      using lt_cardinal_rel_imp_not_subset[of "domain(p)" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"]
-        Ord_Aleph_rel countable_iff_le_rel_Aleph_rel_one[THEN iffD1,
-          THEN lesspoll_cardinal_lt_rel, of "domain(p)"]
-        cardinal_rel_idem by auto
-    moreover note assms
-    moreover from calculation and \<open>p \<in> Coll\<close>
-    have "cons(\<langle>\<alpha>,x\<rangle>, p) \<in> Coll" "x\<in>M" "cons(\<langle>\<alpha>,x\<rangle>, p) \<preceq> p"
-      using InfCard_rel_Aleph_rel
-      by (auto del:Fnle_relI intro!: cons_in_Fn_rel Fnle_relI dest:transM)
-    ultimately
-    show ?thesis by blast
-  qed
-qed
-
 lemma surj_dense_closed[intro,simp]:
   "x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2 \<Longrightarrow> surj_dense(x) \<in> M"
   using separation_in_range transM[of x] by simp
 
 lemma reals_sub_image_f_G:
-  assumes "x\<in>\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
+  assumes "x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
   shows "\<exists>\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>. f\<^bsub>G\<^esub> ` \<alpha> = x"
 proof -
   from assms
-  have "dense(surj_dense(x))" using dense_surj_dense by simp
+  have "dense(surj_dense(x))"
+    using dense_surj_dense lepoll_rel_refl InfCard_rel_Aleph_rel
+    unfolding dense_def
+    by auto
   with \<open>x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2\<close>
   obtain p where "p\<in>surj_dense(x)" "p\<in>G"
-    using generic[THEN M_generic_denseD, of "surj_dense(x)"]
+    using M_generic_denseD[of "surj_dense(x)"]
     by blast
   then
   show ?thesis
     using succ_omega_closed_Coll f_G_funtype function_apply_equality[of _ x f_G]
       succ_omega_closed_imp_no_new_reals[symmetric]
     by (auto, rule_tac bexI) (auto simp:Pi_def)
 qed
 
 lemma f_G_surj_Aleph_rel1_reals: "f\<^bsub>G\<^esub> \<in> surj\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
   using Aleph_rel_sub_closed
-proof (intro ext.mem_surj_abs[THEN iffD2])
+proof (intro ext.mem_surj_abs[THEN iffD2],simp_all)
   show "f\<^bsub>G\<^esub> \<in> surj(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
+    using f_G_funtype G_in_MG ext.nat_into_M f_G_in_MG
+      reals_sub_image_f_G succ_omega_closed_Coll
+      succ_omega_closed_imp_no_new_reals
     unfolding surj_def
-  proof (intro ballI CollectI impI)
-    show "f\<^bsub>G\<^esub> \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
-      using f_G_funtype G_in_MG ext.nat_into_M f_G_in_MG by simp
-    fix x
-    assume "x \<in> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
-    then
-    show "\<exists>\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>. f\<^bsub>G\<^esub> ` \<alpha> = x"
-      using reals_sub_image_f_G succ_omega_closed_Coll
-        f_G_funtype succ_omega_closed_imp_no_new_reals by simp
-  qed
-qed simp_all
+    by auto
+qed
 
 lemma continuum_rel_le_Aleph1_extension:
   includes G_generic1_lemmas
   shows "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
 proof -
   have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "Ord(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)"
     using Card_rel_is_Ord by auto
   moreover from this
   have "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2 \<lesssim>\<^bsup>M[G]\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     using ext.surj_rel_implies_inj_rel[OF f_G_surj_Aleph_rel1_reals]
       f_G_in_MG unfolding lepoll_rel_def by auto
   with \<open>Ord(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close>
   have "|\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2|\<^bsup>M[G]\<^esup> \<le> |\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>|\<^bsup>M[G]\<^esup>"
-    using  M_subset_MG[OF one_in_G, OF generic] Aleph_rel_closed[of 1]
+    using M_subset_MG[OF one_in_G] Aleph_rel_closed[of 1]
     by (rule_tac ext.lepoll_rel_imp_cardinal_rel_le) simp_all
   ultimately
   have "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> |\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>|\<^bsup>M[G]\<^esup>"
     using ext.lepoll_rel_imp_cardinal_rel_le[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"]
       ext.Aleph_rel_zero succ_omega_closed_Coll
       succ_omega_closed_imp_Aleph_1_preserved
     unfolding cexp_rel_def by simp
   then
   show "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>" by simp
 qed
 
 theorem CH: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
   using continuum_rel_le_Aleph1_extension ext.Aleph_rel_succ[of 0]
     ext.Aleph_rel_zero ext.csucc_rel_le[of "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>" \<omega>]
     ext.Card_rel_cexp_rel ext.cantor_cexp_rel[of \<omega>] ext.Card_rel_nat
     le_anti_sym
   by auto
 
-end \<comment> \<open>\<^locale>\<open>collapse_generic4\<close>\<close>
+end \<comment> \<open>\<^locale>\<open>collapse_CH\<close>\<close>
 
 subsection\<open>Models of fragments of $\ZFC + \CH$\<close>
 
 theorem ctm_of_CH:
   assumes
-    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
+    "M \<approx> \<omega>" "Transset(M)"
+    "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH}"
     "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
   shows
     "\<exists>N.
       M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>} \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
       (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
 proof -
-  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
+  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH}\<close>
   interpret M_ZFC4 M
-    using M_satT_overhead_imp_M_ZF4 by simp
-  from \<open>Transset(M)\<close>
-  interpret M_ZFC4_trans M
-    using M_satT_imp_M_ZF4
-    by unfold_locales
+    using M_satT_overhead_imp_M_ZF4 unfolding overhead_CH_def by auto
+  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH}\<close>
+  have "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms \<union>
+            instances_ground_fms \<union> {replacement_dcwit_repl_body_fm}}"
+    unfolding overhead_CH_def overhead_def ZC_def
+    by auto
+  with \<open>Transset(M)\<close>
+  interpret M_ZF_ground_CH_trans M
+    using M_satT_imp_M_ZF_ground_CH_trans
+    by simp
   from \<open>M \<approx> \<omega>\<close>
   obtain enum where "enum \<in> bij(\<omega>,M)"
     using eqpoll_sym unfolding eqpoll_def by blast
   then
-  interpret M_ctm3_AC M enum by unfold_locales
+  interpret M_ctm3_AC_CH M enum by unfold_locales
   interpret forcing_data1 "Coll" "Colleq" 0 M enum
     using zero_in_Fn_rel[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
       zero_top_Fn_rel[of _ "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
       preorder_on_Fnle_rel[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
       zero_lt_Aleph_rel1
     by unfold_locales simp_all
   obtain G where "M_generic(G)"
     using generic_filter_existence[OF one_in_P]
     by auto
   moreover from this
-  interpret collapse_generic4 M enum G by unfold_locales
+  interpret collapse_CH M enum G by unfold_locales
   have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
     using CH .
   then
   have "M[G], [] \<Turnstile> \<cdot>CH\<cdot>"
     using ext.is_ContHyp_iff
     by (simp add:ContHyp_rel_def)
   then
   have "M[G] \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>}"
     using ext.M_satT_ZC by auto
   moreover
   have "Transset(M[G])" using Transset_MG .
   moreover
   have "M \<subseteq> M[G]" using M_subset_MG[OF one_in_G] generic by simp
   moreover
   note \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
   ultimately
   show ?thesis
     using Ord_MG_iff MG_eqpoll_nat satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
     by (rule_tac x="M[G]" in exI,blast)
 qed
 
 corollary ctm_ZFC_imp_ctm_CH:
   assumes
     "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZFC"
   shows
     "\<exists>N.
       M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>} \<and>
       (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
 proof -
   from assms
   have "\<exists>N.
       M \<subseteq> N \<and>
         N \<approx> \<omega> \<and>
         Transset(N) \<and>
         N \<Turnstile> ZC \<and> N \<Turnstile> {\<cdot>CH\<cdot>} \<and> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
     using ctm_of_CH[of M formula] satT_ZFC_imp_satT_ZC[of M]
       satT_mono[OF _ ground_repl_fm_sub_ZFC, of M]
-      satT_mono[OF _ ZF_replacement_overhead_sub_ZFC, of M]
+      satT_mono[OF _ ZF_replacement_overhead_CH_sub_ZFC, of M]
       satT_mono[OF _ ZF_replacement_fms_sub_ZFC, of M]
     by (simp add: satT_Un_iff)
   then
   obtain N where "N \<Turnstile> ZC" "N \<Turnstile> {\<cdot>CH\<cdot>}" "N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula}"
     "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
     by auto
   moreover from this
   have "N \<Turnstile> ZFC"
     using satT_ZC_ZF_replacement_imp_satT_ZFC
     by auto
   moreover from this and \<open>N \<Turnstile> {\<cdot>CH\<cdot>}\<close>
   have "N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>}"
     using satT_ZC_ZF_replacement_imp_satT_ZFC
     by auto
   ultimately
   show ?thesis
     by auto
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Cardinal_Preservation.thy b/thys/Independence_CH/Cardinal_Preservation.thy
--- a/thys/Independence_CH/Cardinal_Preservation.thy
+++ b/thys/Independence_CH/Cardinal_Preservation.thy
@@ -1,523 +1,495 @@
 section\<open>Preservation of cardinals in generic extensions\<close>
 
 theory Cardinal_Preservation
   imports
     Forcing_Main
 begin
 
-context forcing_notion
-begin
-
-definition
-  antichain :: "i\<Rightarrow>o" where
-  "antichain(A) \<equiv> A\<subseteq>P \<and> (\<forall>p\<in>A. \<forall>q\<in>A. p \<noteq> q \<longrightarrow> p \<bottom> q)"
-
-definition
-  ccc :: "o" where
-  "ccc \<equiv> \<forall>A. antichain(A) \<longrightarrow> |A| \<le> \<omega>"
-
-end \<comment> \<open>\<^locale>\<open>forcing_notion\<close>\<close>
-
 context forcing_data1
 
 begin
-abbreviation
-  antichain_r' :: "i \<Rightarrow> o" where
-  "antichain_r'(A) \<equiv> antichain_rel(##M,P,leq,A)"
 
 lemma antichain_abs' [absolut]:
-  "\<lbrakk> A\<in>M \<rbrakk> \<Longrightarrow> antichain_r'(A) \<longleftrightarrow> antichain(A)"
+  "\<lbrakk> A\<in>M \<rbrakk> \<Longrightarrow> antichain\<^bsup>M\<^esup>(P,leq,A) \<longleftrightarrow> antichain(P,leq,A)"
   unfolding antichain_rel_def antichain_def compat_def
-  using P_in_M leq_in_M transitivity[of _ A]
+  using transitivity[of _ A]
   by (auto simp add:absolut)
 
-lemma (in forcing_notion) Incompatible_imp_not_eq: "\<lbrakk> p \<bottom> q; p\<in>P; q\<in>P \<rbrakk>\<Longrightarrow> p \<noteq> q"
-  using refl_leq by blast
-
 lemma inconsistent_imp_incompatible:
   assumes "p \<tturnstile> \<phi> env" "q \<tturnstile> Neg(\<phi>) env" "p\<in>P" "q\<in>P"
     "arity(\<phi>) \<le> length(env)" "\<phi> \<in> formula" "env \<in> list(M)"
   shows "p \<bottom> q"
 proof
   assume "compat(p,q)"
   then
   obtain d where "d \<preceq> p" "d \<preceq> q" "d \<in> P" by blast
   moreover
   note assms
   moreover from calculation
   have "d \<tturnstile> \<phi> env" "d \<tturnstile> Neg(\<phi>) env"
     using strengthening_lemma by simp_all
   ultimately
   show "False"
-    using Forces_Neg[of d env \<phi>] refl_leq P_in_M
-    by (auto dest:transM; drule_tac bspec; auto dest:transM)
+    using Forces_Neg[of d env \<phi>] refl_leq
+    by (auto dest:transitivity; drule_tac bspec; auto dest:transitivity)
 qed
 
 notation check (\<open>_\<^sup>v\<close> [101] 100)
 
 end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
 
-locale G_generic2 = G_generic1 + forcing_data2
-locale G_generic2_AC = G_generic1_AC + G_generic2 + M_ctm2_AC
 
 locale G_generic3 = G_generic2 + forcing_data3
 locale G_generic3_AC = G_generic2_AC + G_generic3
 
 locale G_generic4 = G_generic3 + forcing_data4
 locale G_generic4_AC = G_generic3_AC + G_generic4
 
+locale G_generic4_AC_CH = G_generic4_AC + M_ZFC3_ground_CH_trans
+
 sublocale G_generic4_AC \<subseteq> ext:M_ZFC3_trans "M[G]"
   using ground_replacements4 replacement_assm_MG
   by unfold_locales simp_all
 
 lemma (in forcing_data1) forces_neq_apply_imp_incompatible:
   assumes
     "p \<tturnstile> \<cdot>0`1 is 2\<cdot> [f,a,b\<^sup>v]"
     "q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f,a,b'\<^sup>v]"
     "b \<noteq> b'"
     \<comment> \<open>More general version: taking general names
        \<^term>\<open>b\<^sup>v\<close> and \<^term>\<open>b'\<^sup>v\<close>, satisfying
        \<^term>\<open>p \<tturnstile> \<cdot>\<not>\<cdot>0 = 1\<cdot>\<cdot> [b\<^sup>v, b'\<^sup>v]\<close> and
        \<^term>\<open>q \<tturnstile> \<cdot>\<not>\<cdot>0 = 1\<cdot>\<cdot> [b\<^sup>v, b'\<^sup>v]\<close>.\<close>
     and
     types:"f\<in>M" "a\<in>M" "b\<in>M" "b'\<in>M" "p\<in>P" "q\<in>P"
   shows
     "p \<bottom> q"
 proof -
   {
     fix G
     assume "M_generic(G)"
     then
     interpret G_generic1 _ _ _ _ _ G by unfold_locales
     include G_generic1_lemmas
       (* NOTE: might be useful to have a locale containg two \<open>M_ZF1_trans\<close>
          instances, one for \<^term>\<open>M\<close> and one for \<^term>\<open>M[G]\<close> *)
     assume "q\<in>G"
     with assms \<open>M_generic(G)\<close>
-    have "M[G], map(val(P,G),[f,a,b'\<^sup>v]) \<Turnstile> \<cdot>0`1 is 2\<cdot>"
-      using truth_lemma[of "\<cdot>0`1 is 2\<cdot>" G "[f,a,b'\<^sup>v]"]
+    have "M[G], map(val(G),[f,a,b'\<^sup>v]) \<Turnstile> \<cdot>0`1 is 2\<cdot>"
+      using truth_lemma[of "\<cdot>0`1 is 2\<cdot>" "[f,a,b'\<^sup>v]"]
       by (auto simp add:ord_simp_union arity_fun_apply_fm
           fun_apply_type)
     with \<open>b \<noteq> b'\<close> types
-    have "M[G], map(val(P,G),[f,a,b\<^sup>v]) \<Turnstile> \<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot>"
+    have "M[G], map(val(G),[f,a,b\<^sup>v]) \<Turnstile> \<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot>"
       using GenExtI by auto
   }
   with types
   have "q \<tturnstile> \<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot> [f,a,b\<^sup>v]"
-    using definition_of_forcing[where \<phi>="\<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot>" ] check_in_M
+    using definition_of_forcing[where \<phi>="\<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot>" ]
     by (auto simp add:ord_simp_union arity_fun_apply_fm)
   with \<open>p \<tturnstile> \<cdot>0`1 is 2\<cdot> [f,a,b\<^sup>v]\<close> and types
   show "p \<bottom> q"
-    using check_in_M inconsistent_imp_incompatible
+    using inconsistent_imp_incompatible
     by (simp add:ord_simp_union arity_fun_apply_fm fun_apply_type)
 qed
 
 context M_ctm3_AC
 begin
 
-\<comment> \<open>Simplifying simp rules (because of the occurrence of "\#\#")\<close>
+\<comment> \<open>Simplifying simp rules (because of the occurrence of
+   \<^term>\<open>setclass\<close>)\<close>
 lemmas sharp_simps = Card_rel_Union Card_rel_cardinal_rel Collect_abs
   Cons_abs Cons_in_M_iff Diff_closed Equal_abs Equal_in_M_iff Finite_abs
   Forall_abs Forall_in_M_iff Inl_abs Inl_in_M_iff Inr_abs Inr_in_M_iff
   Int_closed Inter_abs Inter_closed M_nat Member_abs Member_in_M_iff
   Memrel_closed Nand_abs Nand_in_M_iff Nil_abs Nil_in_M Ord_cardinal_rel
   Pow_rel_closed Un_closed Union_abs Union_closed and_abs and_closed
   apply_abs apply_closed bij_rel_closed bijection_abs bool_of_o_abs
   bool_of_o_closed cadd_rel_0 cadd_rel_closed cardinal_rel_0_iff_0
   cardinal_rel_closed cardinal_rel_idem cartprod_abs cartprod_closed
   cmult_rel_0 cmult_rel_1 cmult_rel_closed comp_closed composition_abs
   cons_abs cons_closed converse_abs converse_closed csquare_lam_closed
   csquare_rel_closed depth_closed domain_abs domain_closed eclose_abs
   eclose_closed empty_abs field_abs field_closed finite_funspace_closed
   finite_ordinal_abs formula_N_abs formula_N_closed formula_abs
   formula_case_abs formula_case_closed formula_closed
   formula_functor_abs fst_closed function_abs function_space_rel_closed
   hd_abs image_abs image_closed inj_rel_closed injection_abs inter_abs
   irreflexive_abs is_depth_apply_abs is_eclose_n_abs is_funspace_abs
   iterates_closed length_abs length_closed lepoll_rel_refl
   limit_ordinal_abs linear_rel_abs list_N_abs list_N_closed list_abs
   list_case'_closed list_case_abs list_closed list_functor_abs
   mem_bij_abs mem_eclose_abs mem_inj_abs mem_list_abs membership_abs
   minimum_closed nat_case_abs nat_case_closed nonempty not_abs
   not_closed nth_abs number1_abs number2_abs number3_abs omega_abs
   or_abs or_closed order_isomorphism_abs ordermap_closed
   ordertype_closed ordinal_abs pair_abs pair_in_M_iff powerset_abs
   pred_closed pred_set_abs quasilist_abs quasinat_abs radd_closed
   rall_abs range_abs range_closed relation_abs restrict_closed
   restriction_abs rex_abs rmult_closed rtrancl_abs rtrancl_closed
   rvimage_closed separation_closed setdiff_abs singleton_abs
   singleton_in_M_iff snd_closed strong_replacement_closed subset_abs
   succ_in_M_iff successor_abs successor_ordinal_abs sum_abs sum_closed
   surj_rel_closed surjection_abs tl_abs trancl_abs trancl_closed
   transitive_rel_abs transitive_set_abs typed_function_abs union_abs
   upair_abs upair_in_M_iff vimage_abs vimage_closed well_ord_abs
   mem_formula_abs nth_closed Aleph_rel_closed csucc_rel_closed
   Card_rel_Aleph_rel
 
 declare sharp_simps[simp del, simplified setclass_iff, simp]
 
 lemmas sharp_intros = nat_into_M Aleph_rel_closed Card_rel_Aleph_rel
 
 declare sharp_intros[rule del, simplified setclass_iff, intro]
 
 end \<comment> \<open>\<^locale>\<open>M_ctm3_AC\<close>\<close>
 
 context G_generic4_AC begin
 
 context
   includes G_generic1_lemmas
 begin
 
 lemmas mg_sharp_simps = ext.Card_rel_Union ext.Card_rel_cardinal_rel
   ext.Collect_abs ext.Cons_abs ext.Cons_in_M_iff ext.Diff_closed
   ext.Equal_abs ext.Equal_in_M_iff ext.Finite_abs ext.Forall_abs
   ext.Forall_in_M_iff ext.Inl_abs ext.Inl_in_M_iff ext.Inr_abs
   ext.Inr_in_M_iff ext.Int_closed ext.Inter_abs ext.Inter_closed
   ext.M_nat ext.Member_abs ext.Member_in_M_iff ext.Memrel_closed
   ext.Nand_abs ext.Nand_in_M_iff ext.Nil_abs ext.Nil_in_M
   ext.Ord_cardinal_rel ext.Pow_rel_closed ext.Un_closed
   ext.Union_abs ext.Union_closed ext.and_abs ext.and_closed
   ext.apply_abs ext.apply_closed ext.bij_rel_closed
   ext.bijection_abs ext.bool_of_o_abs ext.bool_of_o_closed
   ext.cadd_rel_0 ext.cadd_rel_closed ext.cardinal_rel_0_iff_0
   ext.cardinal_rel_closed ext.cardinal_rel_idem ext.cartprod_abs
   ext.cartprod_closed ext.cmult_rel_0 ext.cmult_rel_1
   ext.cmult_rel_closed ext.comp_closed ext.composition_abs
   ext.cons_abs ext.cons_closed ext.converse_abs ext.converse_closed
   ext.csquare_lam_closed ext.csquare_rel_closed ext.depth_closed
   ext.domain_abs ext.domain_closed ext.eclose_abs ext.eclose_closed
   ext.empty_abs ext.field_abs ext.field_closed
   ext.finite_funspace_closed ext.finite_ordinal_abs ext.formula_N_abs
   ext.formula_N_closed ext.formula_abs ext.formula_case_abs
   ext.formula_case_closed ext.formula_closed ext.formula_functor_abs
   ext.fst_closed ext.function_abs ext.function_space_rel_closed
   ext.hd_abs ext.image_abs ext.image_closed ext.inj_rel_closed
   ext.injection_abs ext.inter_abs ext.irreflexive_abs
   ext.is_depth_apply_abs ext.is_eclose_n_abs ext.is_funspace_abs
   ext.iterates_closed ext.length_abs ext.length_closed
   ext.lepoll_rel_refl ext.limit_ordinal_abs ext.linear_rel_abs
   ext.list_N_abs ext.list_N_closed ext.list_abs
   ext.list_case'_closed ext.list_case_abs ext.list_closed
   ext.list_functor_abs ext.mem_bij_abs ext.mem_eclose_abs
   ext.mem_inj_abs ext.mem_list_abs ext.membership_abs
   ext.nat_case_abs ext.nat_case_closed
   ext.nonempty ext.not_abs ext.not_closed ext.nth_abs
   ext.number1_abs ext.number2_abs ext.number3_abs ext.omega_abs
   ext.or_abs ext.or_closed ext.order_isomorphism_abs
   ext.ordermap_closed ext.ordertype_closed ext.ordinal_abs
   ext.pair_abs ext.pair_in_M_iff ext.powerset_abs ext.pred_closed
   ext.pred_set_abs ext.quasilist_abs ext.quasinat_abs
   ext.radd_closed ext.rall_abs ext.range_abs ext.range_closed
   ext.relation_abs ext.restrict_closed ext.restriction_abs
   ext.rex_abs ext.rmult_closed ext.rtrancl_abs ext.rtrancl_closed
   ext.rvimage_closed ext.separation_closed ext.setdiff_abs
   ext.singleton_abs ext.singleton_in_M_iff ext.snd_closed
   ext.strong_replacement_closed ext.subset_abs ext.succ_in_M_iff
   ext.successor_abs ext.successor_ordinal_abs ext.sum_abs
   ext.sum_closed ext.surj_rel_closed ext.surjection_abs ext.tl_abs
   ext.trancl_abs ext.trancl_closed ext.transitive_rel_abs
   ext.transitive_set_abs ext.typed_function_abs ext.union_abs
   ext.upair_abs ext.upair_in_M_iff ext.vimage_abs ext.vimage_closed
   ext.well_ord_abs ext.mem_formula_abs ext.nth_closed ext.Aleph_rel_closed
   ext.csucc_rel_closed ext.Card_rel_Aleph_rel
 
 \<comment> \<open>The following was motivated by the fact that
     @{thm ext.apply_closed} did not simplify appropriately.\<close>
 declare mg_sharp_simps[simp del, simplified setclass_iff, simp]
 
 lemmas mg_sharp_intros = ext.nat_into_M ext.Aleph_rel_closed
   ext.Card_rel_Aleph_rel
 
 declare mg_sharp_intros[rule del, simplified setclass_iff, intro]
 
 \<comment> \<open>Kunen IV.2.31\<close>
 lemma forces_below_filter:
-  assumes "M[G], map(val(P,G),env) \<Turnstile> \<phi>" "p \<in> G"
+  assumes "M[G], map(val(G),env) \<Turnstile> \<phi>" "p \<in> G"
     "arity(\<phi>) \<le> length(env)" "\<phi> \<in> formula" "env \<in> list(M)"
   shows "\<exists>q\<in>G. q \<preceq> p \<and> q \<tturnstile> \<phi> env"
 proof -
   note assms
   moreover from this
   obtain r where "r \<tturnstile> \<phi> env" "r\<in>G"
-    using generic truth_lemma[of  \<phi> _ env]
+    using generic truth_lemma[of \<phi> env]
     by blast
   moreover from this and \<open>p\<in>G\<close>
   obtain q where "q \<preceq> p" "q \<preceq> r" "q \<in> G" by auto
   ultimately
   show ?thesis
     using strengthening_lemma[of r \<phi> _ env] by blast
 qed
 
 subsection\<open>Preservation by ccc forcing notions\<close>
 
-\<comment> \<open>This definition has the arguments in the expected order by most of the lemmas:
-first the parameters, the only argument in the penultimate place and the result in
-the last place.\<close>
-definition check_fm' where
-  "check_fm'(ofm,arg,res) \<equiv> check_fm(arg,ofm,res)"
-
 lemma ccc_fun_closed_lemma_aux:
   assumes "f_dot\<in>M" "p\<in>M" "a\<in>M" "b\<in>M"
   shows "{q \<in> P . q \<preceq> p \<and> (M, [q, P, leq, \<one>, f_dot, a\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))} \<in> M"
-proof -
-  have "\<cdot>0`1 is 2\<cdot> \<in> formula" "arity(\<cdot>0`1 is 2\<cdot> ) = 3"
-    using arity_fun_apply_fm union_abs1
-    by simp_all
-  then
-  show ?thesis
-    using separation_forces[where env="[f_dot, a\<^sup>v, b\<^sup>v]" and \<phi>="\<cdot>0`1 is 2\<cdot>",simplified]
-      assms G_subset_M[THEN subsetD] generic one_in_M P_in_M
-      separation_in lam_replacement_constant lam_replacement_identity
-      lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] leq_in_M check_in_M
-      separation_conj separation_forces
-    by simp_all
-qed
+  using separation_forces[where env="[f_dot, a\<^sup>v, b\<^sup>v]" and \<phi>="\<cdot>0`1 is 2\<cdot>",simplified]
+    assms G_subset_M[THEN subsetD] generic
+    separation_in lam_replacement_constant lam_replacement_identity
+    lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
+    separation_conj arity_fun_apply_fm union_abs1
+  by simp_all
 
 lemma ccc_fun_closed_lemma_aux2:
   assumes "B\<in>M" "f_dot\<in>M" "p\<in>M" "a\<in>M"
   shows "(##M)(\<lambda>b\<in>B. {q \<in> P . q \<preceq> p \<and> (M, [q, P, leq, \<one>, f_dot, a\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))})"
 proof -
   have "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, \<tau>, fst(fst(z))\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
     if "\<tau>\<in>M" for \<tau>
   proof -
     let ?f_fm="snd_fm(1,0)"
-    let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(fst_fm,fst_fm),2,0)"
-    note types = assms leq_in_M P_in_M one_in_M
+    let ?g_fm="hcomp_fm(check_fm(6),hcomp_fm(fst_fm,fst_fm),2,0)"
+    note assms
+    moreover
     have "arity(forces(\<cdot>0`1 is 2\<cdot> )) \<le> 7"
       using arity_fun_apply_fm union_abs1 arity_forces[of "\<cdot>0`1 is 2\<cdot> "]
       by simp
     moreover
     have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
       using ord_simp_union
-      unfolding hcomp_fm_def check_fm'_def
+      unfolding hcomp_fm_def
       by (simp_all add:arity)
     ultimately
     show ?thesis
-      using separation_sat_after_function types that sats_fst_fm
-        snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M fst_abs
-      unfolding hcomp_fm_def check_fm'_def
+      using separation_sat_after_function assms that sats_fst_fm
+        snd_abs sats_snd_fm sats_check_fm check_abs fst_abs
+      unfolding hcomp_fm_def
       by simp
   qed
   then
   show ?thesis
     using lam_replacement_imp_lam_closed lam_replacement_Collect
       separation_conj separation_in separation_forces separation_ball separation_iff'
       lam_replacement_Pair[THEN [5] lam_replacement_hcomp2] lam_replacement_identity
       lam_replacement_constant lam_replacement_snd lam_replacement_fst lam_replacement_hcomp
       ccc_fun_closed_lemma_aux arity_fun_apply_fm union_abs1
-      transitivity[of _ B] leq_in_M assms
+      transitivity[of _ B] assms
     by simp
 qed
 
 lemma ccc_fun_closed_lemma:
   assumes "A\<in>M" "B\<in>M" "f_dot\<in>M" "p\<in>M"
   shows "(\<lambda>a\<in>A. {b\<in>B. \<exists>q\<in>P. q \<preceq> p \<and> (q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v])}) \<in> M"
 proof -
   have "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, fst(fst(fst(z)))\<^sup>v, snd(fst(z))\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
   proof -
-    note types = assms leq_in_M P_in_M one_in_M
     let ?f_fm="snd_fm(1,0)"
     let ?g="\<lambda>z . fst(fst(fst(z)))\<^sup>v"
-    let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)),2,0)"
-    let ?h_fm="hcomp_fm(check_fm'(7),hcomp_fm(snd_fm,fst_fm),3,0)"
+    let ?g_fm="hcomp_fm(check_fm(6),hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)),2,0)"
+    let ?h_fm="hcomp_fm(check_fm(7),hcomp_fm(snd_fm,fst_fm),3,0)"
+    note assms
+    moreover
     have "arity(forces(\<cdot>0`1 is 2\<cdot> )) \<le> 7"
-      using arity_fun_apply_fm union_abs1 arity_forces[of "\<cdot>0`1 is 2\<cdot> "] by simp
+      using arity_fun_apply_fm union_abs1 arity_forces[of "\<cdot>0`1 is 2\<cdot> "]
+      by simp
     moreover
     have "?f_fm \<in> formula" "arity(?f_fm) \<le> 6" "?g_fm \<in> formula" "arity(?g_fm) \<le> 7"
       "?h_fm \<in> formula" "arity(?h_fm) \<le> 8"
       using ord_simp_union
-      unfolding hcomp_fm_def check_fm'_def
+      unfolding hcomp_fm_def
       by (simp_all add:arity)
     ultimately
     show ?thesis
-      using separation_sat_after_function3 assms types sats_check_fm check_abs check_in_M
+      using separation_sat_after_function3 assms sats_check_fm check_abs
         fst_abs snd_abs
-      unfolding hcomp_fm_def check_fm'_def
+      unfolding hcomp_fm_def
       by simp
   qed
   moreover
-  have  "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, \<tau>, fst(z)\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
+  have "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, \<tau>, fst(z)\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
     if "\<tau>\<in>M" for \<tau>
   proof -
     let ?f_fm="snd_fm(1,0)"
-    let ?g_fm="hcomp_fm(check_fm'(6),fst_fm,2,0)"
-    note types = assms leq_in_M P_in_M one_in_M
+    let ?g_fm="hcomp_fm(check_fm(6),fst_fm,2,0)"
+    note assms
+    moreover
     have "arity(forces(\<cdot>0`1 is 2\<cdot> )) \<le> 7"
       using arity_forces[of "\<cdot>0`1 is 2\<cdot> "] arity_fun_apply_fm union_abs1
       by simp
     moreover
     have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
       using ord_simp_union
-      unfolding hcomp_fm_def check_fm'_def
+      unfolding hcomp_fm_def
       by (simp_all add:arity)
     ultimately
     show ?thesis
-      using separation_sat_after_function assms types that fst_abs
-        snd_abs types sats_check_fm check_abs check_in_M
-      unfolding hcomp_fm_def check_fm'_def
+      using separation_sat_after_function that fst_abs snd_abs sats_check_fm check_abs
+      unfolding hcomp_fm_def
       by simp
   qed
+  moreover note assms
   ultimately
   show ?thesis
     using lam_replacement_imp_lam_closed lam_replacement_Collect
       lam_replacement_constant lam_replacement_identity lam_replacement_snd lam_replacement_fst
       lam_replacement_hcomp lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
       separation_conj separation_in  separation_ball separation_bex separation_iff'
-      transitivity[of _ A] leq_in_M assms
+      transitivity[of _ A]
     by simp
 qed
 
 \<comment> \<open>Kunen IV.3.5\<close>
 lemma ccc_fun_approximation_lemma:
   notes le_trans[trans]
   assumes "ccc\<^bsup>M\<^esup>(P,leq)" "A\<in>M" "B\<in>M" "f\<in>M[G]" "f : A \<rightarrow> B"
   shows
     "\<exists>F\<in>M. F : A \<rightarrow> Pow\<^bsup>M\<^esup>(B) \<and> (\<forall>a\<in>A. f`a \<in> F`a \<and> |F`a|\<^bsup>M\<^esup> \<le> \<omega>)"
 proof -
   from \<open>f\<in>M[G]\<close>
-  obtain f_dot where "f = val(P,G,f_dot)" "f_dot\<in>M" using GenExtD by force
+  obtain f_dot where "f = val(G,f_dot)" "f_dot\<in>M" using GenExtD by force
   with assms
   obtain p where "p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]" "p\<in>G" "p\<in>M"
-    using transitivity[OF M_genericD P_in_M]
-      generic truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[f_dot, A\<^sup>v, B\<^sup>v]"]
+    using G_subset_M truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" "[f_dot, A\<^sup>v, B\<^sup>v]"]
     by (auto simp add:ord_simp_union arity_typed_function_fm
         \<comment> \<open>NOTE: type-checking is not performed here by the Simplifier\<close>
         typed_function_type)
   define F where "F\<equiv>\<lambda>a\<in>A. {b\<in>B. \<exists>q\<in>P. q \<preceq> p \<and> (q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v])}"
   from assms \<open>f_dot\<in>_\<close> \<open>p\<in>M\<close>
   have "F \<in> M"
     unfolding F_def using ccc_fun_closed_lemma by simp
   moreover from calculation
   have "f`a \<in> F`a" if "a \<in> A" for a
   proof -
     note \<open>f: A \<rightarrow> B\<close> \<open>a \<in> A\<close>
     moreover from this
     have "f ` a \<in> B" by simp
     moreover
     note \<open>f\<in>M[G]\<close> \<open>A\<in>M\<close>
     moreover from calculation
     have "M[G], [f, a, f`a] \<Turnstile> \<cdot>0`1 is 2\<cdot>"
-      by (auto dest:transM)
+      by (auto dest:transitivity)
     moreover
-    note \<open>B\<in>M\<close> \<open>f = val(P,G,f_dot)\<close>
+    note \<open>B\<in>M\<close> \<open>f = val(G,f_dot)\<close>
     moreover from calculation
-    have "a\<in>M" "val(P,G, f_dot)`a\<in>M"
-      by (auto dest:transM)
+    have "a\<in>M" "val(G, f_dot)`a\<in>M"
+      by (auto dest:transitivity)
     moreover
     note \<open>f_dot\<in>M\<close> \<open>p\<in>G\<close>
     ultimately
     obtain q where "q \<preceq> p" "q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, (f`a)\<^sup>v]" "q\<in>G"
       using forces_below_filter[of "\<cdot>0`1 is 2\<cdot>" "[f_dot, a\<^sup>v, (f`a)\<^sup>v]" p]
       by (auto simp add: ord_simp_union arity_fun_apply_fm
           fun_apply_type)
     with \<open>f`a \<in> B\<close>
     have "f`a \<in> {b\<in>B . \<exists>q\<in>P. q \<preceq> p \<and> q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]}"
       by blast
     with \<open>a\<in>A\<close>
     show ?thesis unfolding F_def by simp
   qed
   moreover
   have "|F`a|\<^bsup>M\<^esup> \<le> \<omega> \<and> F`a\<in>M" if "a \<in> A" for a
   proof -
     let ?Q="\<lambda>b. {q\<in>P. q \<preceq> p \<and> (q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v])}"
     from \<open>F \<in> M\<close> \<open>a\<in>A\<close> \<open>A\<in>M\<close>
     have "F`a \<in> M" "a\<in>M"
       using transitivity[OF _ \<open>A\<in>M\<close>] by simp_all
     moreover
     have 2:"\<And>x. x\<in>F`a \<Longrightarrow> x\<in>M"
       using transitivity[OF _ \<open>F`a\<in>M\<close>] by simp
     moreover
     have 3:"\<And>x. x\<in>F`a \<Longrightarrow> (##M)(?Q(x))"
       using ccc_fun_closed_lemma_aux[OF \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close> 2] transitivity[of _ "F`a"]
       by simp
     moreover
     have 4:"lam_replacement(##M,\<lambda>b. {q \<in> P . q \<preceq> p \<and> (M, [q, P, leq, \<one>, f_dot, a\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))})"
       using ccc_fun_closed_lemma_aux2[OF _ \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close>]
         lam_replacement_iff_lam_closed[THEN iffD2]
         ccc_fun_closed_lemma_aux[OF  \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close>]
       by simp
     ultimately
     interpret M_Pi_assumptions_choice "##M" "F`a" ?Q
       using Pi_replacement1[OF _ 3] lam_replacement_Sigfun[OF 4]
         lam_replacement_imp_strong_replacement
         ccc_fun_closed_lemma_aux[OF \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close>]
         lam_replacement_hcomp2[OF lam_replacement_constant 4 _ _
           lam_replacement_minimum,unfolded lam_replacement_def]
       by unfold_locales simp_all
     from \<open>F`a \<in> M\<close>
     interpret M_Pi_assumptions2 "##M" "F`a" ?Q "\<lambda>_ . P"
-      using P_in_M lam_replacement_imp_strong_replacement[OF
+      using lam_replacement_imp_strong_replacement[OF
           lam_replacement_Sigfun[OF lam_replacement_constant]]
-        Pi_replacement1 transM[of _ "F`a"]
+        Pi_replacement1 transitivity[of _ "F`a"]
       by unfold_locales simp_all
     from \<open>p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]\<close> \<open>a\<in>A\<close>
     have "\<exists>y. y \<in> ?Q(b)" if "b \<in> F`a" for b
       using that unfolding F_def by auto
     then
     obtain q where "q \<in> Pi\<^bsup>M\<^esup>(F`a,?Q)" "q\<in>M" using AC_Pi_rel by auto
     moreover
     note \<open>F`a \<in> M\<close>
     moreover from calculation
     have "q : F`a \<rightarrow>\<^bsup>M\<^esup> P"
       using Pi_rel_weaken_type def_function_space_rel by auto
     moreover from calculation
     have "q : F`a \<rightarrow> range(q)" "q : F`a \<rightarrow> P" "q : F`a \<rightarrow>\<^bsup>M\<^esup> range(q)"
       using mem_function_space_rel_abs range_of_fun by simp_all
     moreover
     have "q`b \<bottom> q`c" if "b \<in> F`a" "c \<in> F`a" "b \<noteq> c"
       \<comment> \<open>For the next step, if the premise \<^term>\<open>b \<noteq> c\<close> is first,
         the proof breaks down badly\<close>
       for b c
     proof -
       from \<open>b \<in> F`a\<close> \<open>c \<in> F`a\<close> \<open>q \<in> Pi\<^bsup>M\<^esup>(F`a,?Q)\<close> \<open>q\<in>M\<close>
       have "q`b \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]"
         "q`c \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, c\<^sup>v]"
         using mem_Pi_rel_abs[of q] apply_type[of _ _  ?Q]
         by simp_all
       with \<open>b \<noteq> c\<close> \<open>q : F`a \<rightarrow> P\<close> \<open>a\<in>A\<close> \<open>b\<in>_\<close> \<open>c\<in>_\<close>
         \<open>A\<in>M\<close> \<open>f_dot\<in>M\<close> \<open>F`a\<in>M\<close>
       show ?thesis
         using forces_neq_apply_imp_incompatible
           transitivity[of _ A] transitivity[of _ "F`a"]
         by auto
     qed
     moreover from calculation
-    have "antichain(range(q))"
+    have "antichain(P,leq,range(q))"
       using Pi_range_eq[of _  _ "\<lambda>_ . P"]
-      unfolding antichain_def by auto
+      unfolding antichain_def compat_in_def by auto
     moreover from this and \<open>q\<in>M\<close>
-    have "antichain_r'(range(q))"
-      by (simp add:absolut)
+    have "antichain\<^bsup>M\<^esup>(P,leq,range(q))"
+      by (simp add:absolut del:P_in_M)
     moreover from calculation
     have "q`b \<noteq> q`c" if "b \<noteq> c" "b \<in> F`a" "c \<in> F`a" for b c
       using that Incompatible_imp_not_eq apply_type
         mem_function_space_rel_abs by simp
     ultimately
     have "q \<in> inj\<^bsup>M\<^esup>(F`a,range(q))"
       using def_inj_rel by auto
     with \<open>F`a \<in> M\<close> \<open>q\<in>M\<close>
     have "|F`a|\<^bsup>M\<^esup> \<le> |range(q)|\<^bsup>M\<^esup>"
       using def_lepoll_rel
       by (rule_tac lepoll_rel_imp_cardinal_rel_le) auto
-    also from \<open>antichain_r'(range(q))\<close> \<open>ccc\<^bsup>M\<^esup>(P,leq)\<close> \<open>q\<in>M\<close>
+    also from \<open>antichain\<^bsup>M\<^esup>(P,leq,range(q))\<close> \<open>ccc\<^bsup>M\<^esup>(P,leq)\<close> \<open>q\<in>M\<close>
     have "|range(q)|\<^bsup>M\<^esup> \<le> \<omega>"
       using def_ccc_rel by simp
     finally
     show ?thesis using \<open>F`a\<in>M\<close> by auto
   qed
   moreover from this
   have "F`a\<in>M" if "a\<in>A" for a
     using that by simp
   moreover from this \<open>B\<in>M\<close>
   have "F : A \<rightarrow> Pow\<^bsup>M\<^esup>(B)"
     using Pow_rel_char
     unfolding F_def by (rule_tac lam_type) auto
   ultimately
   show ?thesis by auto
 qed
 
 end \<comment> \<open>G\_generic1\_lemmas bundle\<close>
 
 end \<comment> \<open>\<^locale>\<open>G_generic4_AC\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Choice_Axiom.thy b/thys/Independence_CH/Choice_Axiom.thy
--- a/thys/Independence_CH/Choice_Axiom.thy
+++ b/thys/Independence_CH/Choice_Axiom.thy
@@ -1,355 +1,326 @@
 section\<open>The Axiom of Choice in $M[G]$\<close>
 
 theory Choice_Axiom
   imports
     Powerset_Axiom
     Extensionality_Axiom
     Foundation_Axiom
     Replacement_Axiom
     Infinity_Axiom
 begin
 
 definition
+  upair_name :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
+  "upair_name(\<tau>,\<rho>,on) \<equiv> Upair(\<langle>\<tau>,on\<rangle>,\<langle>\<rho>,on\<rangle>)"
+
+definition
+  opair_name :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
+  "opair_name(\<tau>,\<rho>,on) \<equiv> upair_name(upair_name(\<tau>,\<tau>,on),upair_name(\<tau>,\<rho>,on),on)"
+
+definition
   induced_surj :: "i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>i" where
   "induced_surj(f,a,e) \<equiv> f-``(range(f)-a)\<times>{e} \<union> restrict(f,f-``a)"
 
 lemma domain_induced_surj: "domain(induced_surj(f,a,e)) = domain(f)"
   unfolding induced_surj_def using domain_restrict domain_of_prod by auto
 
 lemma range_restrict_vimage:
   assumes "function(f)"
   shows "range(restrict(f,f-``a)) \<subseteq> a"
 proof
   from assms
   have "function(restrict(f,f-``a))"
     using function_restrictI by simp
   fix y
   assume "y \<in> range(restrict(f,f-``a))"
   then
   obtain x where "\<langle>x,y\<rangle> \<in> restrict(f,f-``a)"  "x \<in> f-``a" "x\<in>domain(f)"
     using domain_restrict domainI[of _ _ "restrict(f,f-``a)"] by auto
   moreover
   note \<open>function(restrict(f,f-``a))\<close>
   ultimately
   have "y = restrict(f,f-``a)`x"
     using function_apply_equality by blast
   also from \<open>x \<in> f-``a\<close>
   have "restrict(f,f-``a)`x = f`x"
     by simp
   finally
   have "y = f`x" .
   moreover from assms \<open>x\<in>domain(f)\<close>
   have "\<langle>x,f`x\<rangle> \<in> f"
     using function_apply_Pair by auto
   moreover
   note assms \<open>x \<in> f-``a\<close>
   ultimately
   show "y\<in>a"
     using function_image_vimage[of f a] by auto
 qed
 
 lemma induced_surj_type:
   assumes "function(f)" (* "relation(f)" (* a function can contain non-pairs *) *)
   shows
     "induced_surj(f,a,e): domain(f) \<rightarrow> {e} \<union> a"
     and
     "x \<in> f-``a \<Longrightarrow> induced_surj(f,a,e)`x = f`x"
 proof -
   let ?f1="f-``(range(f)-a) \<times> {e}" and ?f2="restrict(f, f-``a)"
   have "domain(?f2) = domain(f) \<inter> f-``a"
     using domain_restrict by simp
   moreover from assms
   have "domain(?f1) = f-``(range(f))-f-``a"
     using domain_of_prod function_vimage_Diff by simp
   ultimately
   have "domain(?f1) \<inter> domain(?f2) = 0"
     by auto
   moreover
   have "function(?f1)" "relation(?f1)" "range(?f1) \<subseteq> {e}"
     unfolding function_def relation_def range_def by auto
   moreover from this and assms
   have "?f1: domain(?f1) \<rightarrow> range(?f1)"
     using function_imp_Pi by simp
   moreover from assms
   have "?f2: domain(?f2) \<rightarrow> range(?f2)"
     using function_imp_Pi[of "restrict(f, f -`` a)"] function_restrictI by simp
   moreover from assms
   have "range(?f2) \<subseteq> a"
     using range_restrict_vimage by simp
   ultimately
   have "induced_surj(f,a,e): domain(?f1) \<union> domain(?f2) \<rightarrow> {e} \<union> a"
     unfolding induced_surj_def using fun_is_function fun_disjoint_Un fun_weaken_type by simp
   moreover
   have "domain(?f1) \<union> domain(?f2) = domain(f)"
     using domain_restrict domain_of_prod by auto
   ultimately
   show "induced_surj(f,a,e): domain(f) \<rightarrow> {e} \<union> a"
     by simp
   assume "x \<in> f-``a"
   then
   have "?f2`x = f`x"
     using restrict by simp
   moreover from \<open>x \<in> f-``a\<close> \<open>domain(?f1) = _\<close>
   have "x \<notin> domain(?f1)"
     by simp
   ultimately
   show "induced_surj(f,a,e)`x = f`x"
     unfolding induced_surj_def using fun_disjoint_apply2[of x ?f1 ?f2] by simp
 qed
 
 lemma induced_surj_is_surj :
   assumes
     "e\<in>a" "function(f)" "domain(f) = \<alpha>" "\<And>y. y \<in> a \<Longrightarrow> \<exists>x\<in>\<alpha>. f ` x = y"
   shows "induced_surj(f,a,e) \<in> surj(\<alpha>,a)"
   unfolding surj_def
 proof (intro CollectI ballI)
   from assms
   show "induced_surj(f,a,e): \<alpha> \<rightarrow> a"
     using induced_surj_type[of f a e] cons_eq cons_absorb by simp
   fix y
   assume "y \<in> a"
   with assms
   have "\<exists>x\<in>\<alpha>. f ` x = y"
     by simp
   then
   obtain x where "x\<in>\<alpha>" "f ` x = y" by auto
   with \<open>y\<in>a\<close> assms
   have "x\<in>f-``a"
     using vimage_iff function_apply_Pair[of f x] by auto
   with \<open>f ` x = y\<close> assms
   have "induced_surj(f, a, e) ` x = y"
     using induced_surj_type by simp
   with \<open>x\<in>\<alpha>\<close> show
     "\<exists>x\<in>\<alpha>. induced_surj(f, a, e) ` x = y" by auto
 qed
 
-context G_generic1
-begin
-
-lemma upair_name_abs :
-  assumes "x\<in>M" "y\<in>M" "z\<in>M" "o\<in>M"
-  shows "is_upair_name(##M,x,y,o,z) \<longleftrightarrow> z = upair_name(x,y,o)"
-  unfolding is_upair_name_def upair_name_def
-  using assms zero_in_M pair_in_M_iff Upair_eq_cons
-  by simp
-
-lemma upair_name_closed :
+lemma (in M_ZF1_trans) upair_name_closed :
   "\<lbrakk> x\<in>M; y\<in>M ; o\<in>M\<rbrakk> \<Longrightarrow> upair_name(x,y,o)\<in>M"
   unfolding upair_name_def
   using upair_in_M_iff pair_in_M_iff Upair_eq_cons
   by simp
 
-lemma opair_name_abs :
-  assumes "x\<in>M" "y\<in>M" "z\<in>M" "o\<in>M"
-  shows "is_opair_name(##M,x,y,o,z) \<longleftrightarrow> z = opair_name(x,y,o)"
-  unfolding is_opair_name_def opair_name_def
-  using assms upair_name_abs upair_name_closed
+locale G_generic2 = G_generic1 + forcing_data2
+
+context G_generic2
+begin
+
+lemma val_upair_name : "val(G,upair_name(\<tau>,\<rho>,\<one>)) = {val(G,\<tau>),val(G,\<rho>)}"
+  unfolding upair_name_def
+  using val_Upair Upair_eq_cons generic one_in_G
   by simp
 
-lemma opair_name_closed :
-  "\<lbrakk> x\<in>M; y\<in>M ; o\<in>M \<rbrakk> \<Longrightarrow> opair_name(x,y,o)\<in>M"
-  unfolding opair_name_def
-  using upair_name_closed by simp
-
-lemma val_upair_name : "val(P,G,upair_name(\<tau>,\<rho>,\<one>)) = {val(P,G,\<tau>),val(P,G,\<rho>)}"
-  unfolding upair_name_def
-  using val_Upair Upair_eq_cons generic one_in_G one_in_P
-  by simp
-
-lemma val_opair_name : "val(P,G,opair_name(\<tau>,\<rho>,\<one>)) = \<langle>val(P,G,\<tau>),val(P,G,\<rho>)\<rangle>"
+lemma val_opair_name : "val(G,opair_name(\<tau>,\<rho>,\<one>)) = \<langle>val(G,\<tau>),val(G,\<rho>)\<rangle>"
   unfolding opair_name_def Pair_def
   using val_upair_name by simp
 
-lemma val_RepFun_one: "val(P,G,{\<langle>f(x),\<one>\<rangle> . x\<in>a}) = {val(P,G,f(x)) . x\<in>a}"
+lemma val_RepFun_one: "val(G,{\<langle>f(x),\<one>\<rangle> . x\<in>a}) = {val(G,f(x)) . x\<in>a}"
 proof -
   let ?A = "{f(x) . x \<in> a}"
   let ?Q = "\<lambda>\<langle>x,p\<rangle> . p = \<one>"
   have "\<one> \<in> P\<inter>G" using generic one_in_G one_in_P by simp
   have "{\<langle>f(x),\<one>\<rangle> . x \<in> a} = {t \<in> ?A \<times> P . ?Q(t)}"
     using one_in_P by force
   then
-  have "val(P,G,{\<langle>f(x),\<one>\<rangle>  . x \<in> a}) = val(P,G,{t \<in> ?A \<times> P . ?Q(t)})"
+  have "val(G,{\<langle>f(x),\<one>\<rangle>  . x \<in> a}) = val(G,{t \<in> ?A \<times> P . ?Q(t)})"
     by simp
   also
-  have "... = {z . t \<in> ?A , (\<exists>p\<in>P\<inter>G . ?Q(\<langle>t,p\<rangle>)) \<and> z= val(P,G,t)}"
+  have "... = {z . t \<in> ?A , (\<exists>p\<in>P\<inter>G . ?Q(\<langle>t,p\<rangle>)) \<and> z= val(G,t)}"
     using val_of_name_alt by simp
+  also from \<open>\<one>\<in>P\<inter>G\<close>
+  have "... = {val(G,t) . t \<in> ?A }"
+    by force
   also
-  have "... = {val(P,G,t) . t \<in> ?A }"
-    using \<open>\<one>\<in>P\<inter>G\<close> by force
-  also
-  have "... = {val(P,G,f(x)) . x \<in> a}"
+  have "... = {val(G,f(x)) . x \<in> a}"
     by auto
   finally
   show ?thesis
     by simp
 qed
 
-\<comment> \<open>NOTE: The following bundled additions to the simpset might be of
-    use later on, perhaps add them globally to some appropriate
-    locale.\<close>
-lemmas generic_simps = generic[THEN one_in_G, THEN valcheck, OF one_in_P]
-  generic[THEN one_in_G, THEN M_subset_MG, THEN subsetD]
-  check_in_M GenExtI P_in_M
-lemmas generic_dests = M_genericD[OF generic] M_generic_compatD[OF generic]
-
-bundle G_generic1_lemmas = generic_simps[simp] generic_dests[dest]
-
-end\<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+end\<comment> \<open>\<^locale>\<open>G_generic2\<close>\<close>
 
 subsection\<open>$M[G]$ is a transitive model of ZF\<close>
 
 sublocale G_generic1 \<subseteq> ext:M_Z_trans "M[G]"
   using Transset_MG generic pairing_in_MG Union_MG
     extensionality_in_MG power_in_MG foundation_in_MG
     replacement_assm_MG separation_in_MG infinity_in_MG
-    replacement_ax1 by unfold_locales
-
-context G_generic1
-begin
+    replacement_ax1
+  by unfold_locales
 
-lemma opname_check_abs :
-  assumes "s\<in>M" "x\<in>M" "y\<in>M"
-  shows "is_opname_check(##M,\<one>,s,x,y) \<longleftrightarrow> y = opair_name(check(x),s`x,\<one>)"
-  unfolding is_opname_check_def
-  using assms check_abs check_in_M opair_name_abs apply_abs apply_closed one_in_M
+lemma (in M_replacement) upair_name_lam_replacement :
+  "M(z) \<Longrightarrow> lam_replacement(M,\<lambda>x . upair_name(fst(x),snd(x),z))"
+  using lam_replacement_Upair[THEN [5] lam_replacement_hcomp2]
+    lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+    lam_replacement_fst lam_replacement_snd lam_replacement_constant
+  unfolding upair_name_def
   by simp
 
-lemma repl_opname_check :
+lemma (in forcing_data2) repl_opname_check :
   assumes "A\<in>M" "f\<in>M"
   shows "{opair_name(check(x),f`x,\<one>). x\<in>A}\<in>M"
-proof -
-  have "arity(is_opname_check_fm(3,2,0,1))= 4"
-    using arity_is_opname_check_fm
-    by (simp add:ord_simp_union arity)
-  moreover
-  have "opair_name(check(x), f ` x,\<one>)\<in>M" if "x\<in>A" for x
-    using assms opair_name_closed apply_closed transitivity check_in_M one_in_M that
+    using assms lam_replacement_constant check_lam_replacement lam_replacement_identity
+      upair_name_lam_replacement[THEN [5] lam_replacement_hcomp2]
+      lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
+      lam_replacement_imp_strong_replacement_aux
+      transitivity RepFun_closed upair_name_closed apply_closed
+    unfolding opair_name_def
     by simp
-  ultimately
-  show ?thesis
-    using assms opname_check_abs[of f] is_opname_check_iff_sats
-      one_in_M zero_in_M transitivity
-      Replace_relativized_in_M[of "is_opname_check_fm(3,2,0,1)"
-        "[f,\<one>]" _ "is_opname_check(##M,\<one>,f)"] replacement_ax1(14)
-    by simp
-qed
 
-theorem choice_in_MG:
+theorem (in G_generic2) choice_in_MG:
   assumes "choice_ax(##M)"
   shows "choice_ax(##M[G])"
 proof -
   {
     fix a
     assume "a\<in>M[G]"
     then
-    obtain \<tau> where "\<tau>\<in>M" "val(P,G,\<tau>) = a"
+    obtain \<tau> where "\<tau>\<in>M" "val(G,\<tau>) = a"
       using GenExt_def by auto
     with \<open>\<tau>\<in>M\<close>
     have "domain(\<tau>)\<in>M"
       using domain_closed by simp
     then
     obtain s \<alpha> where "s\<in>surj(\<alpha>,domain(\<tau>))" "Ord(\<alpha>)" "s\<in>M" "\<alpha>\<in>M"
       using assms choice_ax_abs
       by auto
     then
     have "\<alpha>\<in>M[G]"
       using M_subset_MG generic one_in_G subsetD
       by blast
     let ?A="domain(\<tau>)\<times>P"
     let ?g = "{opair_name(check(\<beta>),s`\<beta>,\<one>). \<beta>\<in>\<alpha>}"
     have "?g \<in> M"
       using \<open>s\<in>M\<close> \<open>\<alpha>\<in>M\<close> repl_opname_check
       by simp
     let ?f_dot="{\<langle>opair_name(check(\<beta>),s`\<beta>,\<one>),\<one>\<rangle>. \<beta>\<in>\<alpha>}"
     have "?f_dot = ?g \<times> {\<one>}" by blast
     define f where
-      "f \<equiv> val(P,G,?f_dot)"
+      "f \<equiv> val(G,?f_dot)"
     from \<open>?g\<in>M\<close> \<open>?f_dot = ?g\<times>{\<one>}\<close>
     have "?f_dot\<in>M"
-      using cartprod_closed singleton_closed one_in_M
+      using cartprod_closed singleton_closed
       by simp
     then
     have "f \<in> M[G]"
       unfolding f_def
       by (blast intro:GenExtI)
-    have "f = {val(P,G,opair_name(check(\<beta>),s`\<beta>,\<one>)) . \<beta>\<in>\<alpha>}"
+    have "f = {val(G,opair_name(check(\<beta>),s`\<beta>,\<one>)) . \<beta>\<in>\<alpha>}"
       unfolding f_def
       using val_RepFun_one
       by simp
     also
-    have "... = {\<langle>\<beta>,val(P,G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}"
-      using val_opair_name valcheck generic one_in_G one_in_P
+    have "... = {\<langle>\<beta>,val(G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}"
+      using val_opair_name val_check generic one_in_G one_in_P
       by simp
     finally
-    have "f = {\<langle>\<beta>,val(P,G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}" .
+    have "f = {\<langle>\<beta>,val(G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}" .
     then
     have 1: "domain(f) = \<alpha>" "function(f)"
       unfolding function_def by auto
     have 2: "y \<in> a \<Longrightarrow> \<exists>x\<in>\<alpha>. f ` x = y" for y
     proof -
       fix y
       assume
         "y \<in> a"
-      with \<open>val(P,G,\<tau>) = a\<close>
-      obtain \<sigma> where  "\<sigma>\<in>domain(\<tau>)" "val(P,G,\<sigma>) = y"
+      with \<open>val(G,\<tau>) = a\<close>
+      obtain \<sigma> where  "\<sigma>\<in>domain(\<tau>)" "val(G,\<sigma>) = y"
         using elem_of_val[of y _ \<tau>]
         by blast
       with \<open>s\<in>surj(\<alpha>,domain(\<tau>))\<close>
       obtain \<beta> where "\<beta>\<in>\<alpha>" "s`\<beta> = \<sigma>"
         unfolding surj_def
         by auto
-      with \<open>val(P,G,\<sigma>) = y\<close>
-      have "val(P,G,s`\<beta>) = y"
+      with \<open>val(G,\<sigma>) = y\<close>
+      have "val(G,s`\<beta>) = y"
         by simp
-      with \<open>f = {\<langle>\<beta>,val(P,G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}\<close> \<open>\<beta>\<in>\<alpha>\<close>
+      with \<open>f = {\<langle>\<beta>,val(G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}\<close> \<open>\<beta>\<in>\<alpha>\<close>
       have "\<langle>\<beta>,y\<rangle>\<in>f"
         by auto
       with \<open>function(f)\<close>
       have "f`\<beta> = y"
         using function_apply_equality by simp
       with \<open>\<beta>\<in>\<alpha>\<close> show
         "\<exists>\<beta>\<in>\<alpha>. f ` \<beta> = y"
         by auto
     qed
     then
     have "\<exists>\<alpha>\<in>(M[G]). \<exists>f'\<in>(M[G]). Ord(\<alpha>) \<and> f' \<in> surj(\<alpha>,a)"
     proof (cases "a=0")
       case True
       then
       show ?thesis
         unfolding surj_def
         using zero_in_MG
         by auto
     next
       case False
       with \<open>a\<in>M[G]\<close>
       obtain e where "e\<in>a" "e\<in>M[G]"
         using transitivity_MG
         by blast
       with 1 and 2
       have "induced_surj(f,a,e) \<in> surj(\<alpha>,a)"
         using induced_surj_is_surj by simp
       moreover from \<open>f\<in>M[G]\<close> \<open>a\<in>M[G]\<close> \<open>e\<in>M[G]\<close>
       have "induced_surj(f,a,e) \<in> M[G]"
         unfolding induced_surj_def
         by (simp flip: setclass_iff)
       moreover
       note \<open>\<alpha>\<in>M[G]\<close> \<open>Ord(\<alpha>)\<close>
       ultimately
       show ?thesis
         by auto
     qed
   }
   then
   show ?thesis
     using ext.choice_ax_abs
     by simp
 qed
 
-end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+locale G_generic2_AC = G_generic1_AC + G_generic2 + M_ctm2_AC
 
-sublocale G_generic1_AC \<subseteq> ext:M_ZC_basic "M[G]"
+sublocale G_generic2_AC \<subseteq> ext:M_ZC_basic "M[G]"
   using choice_ax choice_in_MG
   by unfold_locales
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Cohen_Posets_Relative.thy b/thys/Independence_CH/Cohen_Posets_Relative.thy
--- a/thys/Independence_CH/Cohen_Posets_Relative.thy
+++ b/thys/Independence_CH/Cohen_Posets_Relative.thy
@@ -1,658 +1,552 @@
 section\<open>Cohen forcing notions\<close>
 
 theory Cohen_Posets_Relative
   imports
     Forcing_Notions
     Transitive_Models.Delta_System_Relative
     Transitive_Models.Partial_Functions_Relative
 begin
 
 locale cohen_data =
   fixes \<kappa> I J::i
   assumes zero_lt_kappa: "0<\<kappa>"
 begin
 
 lemmas zero_lesspoll_kappa = zero_lesspoll[OF zero_lt_kappa]
 
 end \<comment> \<open>\<^locale>\<open>cohen_data\<close>\<close>
 
+abbreviation
+  inj_dense :: "[i,i,i,i]\<Rightarrow>i" where
+  "inj_dense(I,J,w,x) \<equiv>
+    { p\<in>Fn(\<omega>,I\<times>\<omega>,J) . (\<exists>n\<in>\<omega>. \<langle>\<langle>w,n\<rangle>,1\<rangle> \<in> p \<and> \<langle>\<langle>x,n\<rangle>,0\<rangle> \<in> p) }"
+
+(* TODO write general versions of this for \<^term>\<open>Fn(\<omega>,I,J)\<close> *)
+lemma dense_inj_dense:
+  assumes "w \<in> I" "x \<in> I" "w \<noteq> x" "p\<in>Fn(\<omega>,I\<times>\<omega>,J)" "0\<in>J" "1\<in>J"
+  shows "\<exists>d\<in>inj_dense(I,J,w,x). \<langle>d ,p\<rangle> \<in> Fnle(\<omega>,I\<times>\<omega>,J)"
+proof -
+  obtain n where "\<langle>w,n\<rangle> \<notin> domain(p)" "\<langle>x,n\<rangle> \<notin> domain(p)" "n \<in> \<omega>"
+  proof -
+    {
+      assume "\<langle>w,n\<rangle> \<in> domain(p) \<or> \<langle>x,n\<rangle> \<in> domain(p)" if "n \<in> \<omega>" for n
+      then
+      have "\<omega> \<subseteq> range(domain(p))" by blast
+      then
+      have "\<not> Finite(p)"
+        using Finite_range Finite_domain subset_Finite nat_not_Finite
+        by auto
+      with \<open>p \<in> _\<close>
+      have False
+        using Fn_nat_eq_FiniteFun FiniteFun.dom_subset[of "I\<times>\<omega>" J]
+          Fin_into_Finite by auto
+    }
+    with that\<comment> \<open>the shape of the goal puts assumptions in this variable\<close>
+    show ?thesis by auto
+  qed
+  moreover
+  note \<open>p \<in> _\<close> assms
+  moreover from calculation
+  have "cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p) \<in> Fn(\<omega>,I\<times>\<omega>,J)"
+    using FiniteFun.consI[of "\<langle>x,n\<rangle>" "I\<times>\<omega>" 0 J p]
+      Fn_nat_eq_FiniteFun by auto
+  ultimately
+  have "cons(\<langle>\<langle>w,n\<rangle>,1\<rangle>, cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p) ) \<in> Fn(\<omega>,I\<times>\<omega>,J)"
+    using FiniteFun.consI[of "\<langle>w,n\<rangle>" "I \<times> \<omega>" 1 J "cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p)"]
+      Fn_nat_eq_FiniteFun by auto
+  with \<open>n \<in> \<omega>\<close>
+  show ?thesis
+    using \<open>p \<in> _\<close> by (intro bexI) auto
+qed
+
 locale add_reals = cohen_data nat _ 2
 
 subsection\<open>Combinatorial results on Cohen posets\<close>
 
 sublocale cohen_data \<subseteq> forcing_notion "Fn(\<kappa>,I,J)" "Fnle(\<kappa>,I,J)" 0
 proof
   show "0 \<in> Fn(\<kappa>, I, J)"
     using zero_lt_kappa zero_in_Fn by simp
   then
   show "\<forall>p\<in>Fn(\<kappa>, I, J). \<langle>p, 0\<rangle> \<in> Fnle(\<kappa>, I, J)"
     unfolding preorder_on_def refl_def trans_on_def
     by auto
 next
   show "preorder_on(Fn(\<kappa>, I, J), Fnle(\<kappa>, I, J))"
     unfolding preorder_on_def refl_def trans_on_def
     by blast
 qed
 
+
 context cohen_data
 begin
 
+
 lemma compat_imp_Un_is_function:
   assumes "G \<subseteq> Fn(\<kappa>, I, J)" "\<And>p q. p \<in> G \<Longrightarrow> q \<in> G \<Longrightarrow> compat(p,q)"
   shows "function(\<Union>G)"
   unfolding function_def
 proof (intro allI ballI impI)
   fix x y y'
   assume "\<langle>x, y\<rangle> \<in> \<Union>G" "\<langle>x, y'\<rangle> \<in> \<Union>G"
   then
   obtain p q where "\<langle>x, y\<rangle> \<in> p" "\<langle>x, y'\<rangle> \<in> q" "p \<in> G" "q \<in> G"
     by auto
   moreover from this and assms
   obtain r where "r \<in> Fn(\<kappa>, I, J)" "r \<supseteq> p" "r \<supseteq> q"
     using compatD[of p q] by force
   moreover from this
   have "function(r)"
     using Fn_is_function by simp
   ultimately
   show "y = y'"
     unfolding function_def by fastforce
 qed
 
 (* MOVE THIS to an appropriate place *)
 lemma filter_subset_notion: "filter(G) \<Longrightarrow> G \<subseteq> Fn(\<kappa>, I, J)"
   unfolding filter_def by simp
 
 lemma Un_filter_is_function: "filter(G) \<Longrightarrow> function(\<Union>G)"
   using compat_imp_Un_is_function filter_imp_compat[of G]
     filter_subset_notion
   by simp
 
 end \<comment> \<open>\<^locale>\<open>cohen_data\<close>\<close>
 
 locale M_cohen = M_delta +
   assumes
     countable_lepoll_assms2:
     "M(A') \<Longrightarrow> M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. {p \<in> A . domain(p) = a}, b, f, i)\<rangle>)"
     and
     countable_lepoll_assms3:
     "M(A) \<Longrightarrow> M(f) \<Longrightarrow> M(b) \<Longrightarrow> M(D) \<Longrightarrow> M(r') \<Longrightarrow> M(A')\<Longrightarrow>
         separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(drSR_Y(r', D, A), b, f, i)\<rangle>)"
 
-context M_cardinal_library
-begin
-
-lemma lesspoll_nat_imp_lesspoll_rel:
-  assumes "A \<prec> \<omega>" "M(A)"
-  shows "A \<prec>\<^bsup>M\<^esup> \<omega>"
-proof -
-  note assms
-  moreover from this
-  obtain f n where "f\<in>bij\<^bsup>M\<^esup>(A,n)" "n\<in>\<omega>" "A \<approx>\<^bsup>M\<^esup> n"
-    using lesspoll_nat_is_Finite Finite_rel_def[of M A]
-    by auto
-  moreover from calculation
-  have "A \<lesssim>\<^bsup>M\<^esup> \<omega>"
-    using lesspoll_nat_is_Finite Infinite_imp_nats_lepoll_rel[of \<omega> n]
-      nat_not_Finite eq_lepoll_rel_trans[of A n \<omega>]
-    by auto
-  moreover from calculation
-  have "\<not> g \<in> bij\<^bsup>M\<^esup>(A,\<omega>)" for g
-    using mem_bij_rel unfolding lesspoll_def by auto
-  ultimately
-  show ?thesis
-    unfolding lesspoll_rel_def
-    by auto
-qed
-
-lemma Finite_imp_lesspoll_rel_nat:
-  assumes "Finite(A)" "M(A)"
-  shows "A \<prec>\<^bsup>M\<^esup> \<omega>"
-  using Finite_imp_lesspoll_nat assms lesspoll_nat_imp_lesspoll_rel
-  by auto
-
-lemma InfCard_rel_lesspoll_rel_Un:
-  includes Ord_dests
-  assumes "InfCard_rel(M,\<kappa>)" "A \<prec>\<^bsup>M\<^esup> \<kappa>" "B \<prec>\<^bsup>M\<^esup> \<kappa>"
-    and types: "M(\<kappa>)" "M(A)" "M(B)"
-  shows "A \<union> B \<prec>\<^bsup>M\<^esup> \<kappa>"
-proof -
-  from assms
-  have "|A|\<^bsup>M\<^esup> < \<kappa>" "|B|\<^bsup>M\<^esup> < \<kappa>"
-    using lesspoll_rel_cardinal_rel_lt InfCard_rel_is_Card_rel
-    by auto
-  show ?thesis
-  proof (cases "Finite(A) \<and> Finite(B)")
-    case True
-    with assms
-    show ?thesis
-      using lesspoll_rel_trans2[OF _ le_imp_lepoll_rel, of _ nat \<kappa>]
-        Finite_imp_lesspoll_rel_nat[OF Finite_Un]
-      unfolding InfCard_rel_def
-      by simp
-  next
-    case False
-    with types
-    have "InfCard_rel(M,max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>))"
-      using Infinite_InfCard_rel_cardinal_rel InfCard_rel_is_Card_rel
-        le_trans[of nat] not_le_iff_lt[THEN iffD1, THEN leI, of "|A|\<^bsup>M\<^esup>" "|B|\<^bsup>M\<^esup>"]
-      unfolding max_def InfCard_rel_def
-      by auto
-    with \<open>M(A)\<close> \<open>M(B)\<close>
-    have "|A \<union> B|\<^bsup>M\<^esup> \<le> max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>)"
-      using cardinal_rel_Un_le[of "max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>)" A B]
-        not_le_iff_lt[THEN iffD1, THEN leI, of "|A|\<^bsup>M\<^esup>" "|B|\<^bsup>M\<^esup>" ]
-      unfolding max_def
-      by simp
-    moreover from \<open>|A|\<^bsup>M\<^esup> < \<kappa>\<close> \<open>|B|\<^bsup>M\<^esup> < \<kappa>\<close>
-    have "max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>) < \<kappa>"
-      unfolding max_def
-      by simp
-    ultimately
-    have "|A \<union> B|\<^bsup>M\<^esup> <  \<kappa>"
-      using lt_trans1
-      by blast
-    moreover
-    note \<open>InfCard_rel(M,\<kappa>)\<close>
-    moreover from calculation types
-    have "|A \<union> B|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<kappa>"
-      using lt_Card_rel_imp_lesspoll_rel InfCard_rel_is_Card_rel
-      by simp
-    ultimately
-    show ?thesis
-      using cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[of "A \<union> B" "|A \<union> B|\<^bsup>M\<^esup>" \<kappa>]
-        eqpoll_rel_sym types
-      by simp
-  qed
-qed
-
-end \<comment> \<open>\<^locale>\<open>M_cardinal_library\<close>\<close>
-
-lemma (in M_cohen) Fn_rel_unionI:
-  assumes "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "q\<in>Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
-    "M(\<kappa>)" "M(I)" "M(J)" "domain(p) \<inter> domain(q) = 0"
-  shows "p\<union>q \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
-proof -
-  note assms
-  moreover from calculation
-  have "p \<prec>\<^bsup>M\<^esup> \<kappa>" "q \<prec>\<^bsup>M\<^esup> \<kappa>" "M(p)" "M(q)"
-    using Fn_rel_is_function by simp_all
-  moreover from calculation
-  have "p\<union>q \<prec>\<^bsup>M\<^esup> \<kappa>"
-    using eqpoll_rel_sym cardinal_rel_eqpoll_rel InfCard_rel_lesspoll_rel_Un
-    by simp_all
-  ultimately
-  show ?thesis
-    unfolding Fn_rel_def
-    using pfun_unionI cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[OF _ \<open>p\<union>q \<prec>\<^bsup>M\<^esup> _\<close>]
-    by auto
-qed
-
-lemma (in M_cohen) restrict_eq_imp_compat_rel:
-  assumes "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "q \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(J)" "M(\<kappa>)"
-    "restrict(p, domain(p) \<inter> domain(q)) = restrict(q, domain(p) \<inter> domain(q))"
-  shows "p \<union> q \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)"
-proof -
-  note assms
-  moreover from calculation
-  have "p \<prec>\<^bsup>M\<^esup> \<kappa>" "q \<prec>\<^bsup>M\<^esup> \<kappa>" "M(p)" "M(q)"
-    using Fn_rel_is_function by simp_all
-  moreover from calculation
-  have "p\<union>q \<prec>\<^bsup>M\<^esup> \<kappa>"
-    using InfCard_rel_lesspoll_rel_Un cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym]
-    by auto
-  ultimately
-  show ?thesis
-    unfolding Fn_rel_def
-    using pfun_restrict_eq_imp_compat cardinal_rel_eqpoll_rel
-      eq_lesspoll_rel_trans[OF _ \<open>p\<union>q \<prec>\<^bsup>M\<^esup> _\<close>]
-    by auto
-qed
-
-lemma (in M_cohen) InfCard_rel_imp_n_lesspoll_rel :
-  assumes "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(\<kappa>)" "n\<in>\<omega>"
-  shows "n \<prec>\<^bsup>M\<^esup> \<kappa>"
-proof -
-  note assms
-  moreover from this
-  have "n \<prec>\<^bsup>M\<^esup> \<omega>"
-    using n_lesspoll_rel_nat by simp
-  ultimately
-  show ?thesis
-    using lesspoll_rel_trans2 Infinite_iff_lepoll_rel_nat InfCard_rel_imp_Infinite nat_into_M
-    by simp
-qed
-
-lemma (in M_cohen) cons_in_Fn_rel:
-  assumes "x \<notin> domain(p)" "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "x \<in> I" "j \<in> J" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
-    "M(\<kappa>)" "M(I)" "M(J)"
-  shows "cons(\<langle>x,j\<rangle>, p) \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
-  using assms cons_eq Fn_rel_unionI[OF Fn_rel_singletonI[of x I j J] \<open>p\<in>_\<close>]
-    InfCard_rel_imp_n_lesspoll_rel
-  by auto
-
 lemma (in M_library) Fnle_rel_Aleph_rel1_closed[intro,simp]:
   "M(Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2))"
   by simp
 
 locale M_add_reals = M_cohen + add_reals
 begin
 
 lemmas zero_lesspoll_rel_kappa = zero_lesspoll_rel[OF zero_lt_kappa]
 
 end \<comment> \<open>\<^locale>\<open>M_add_reals\<close>\<close>
 
 (* MOVE THIS to some appropriate place. Notice that in Forcing_Notions
 we don't import anything relative. *)
 relativize relational "compat_in" "is_compat_in" external
 synthesize "compat_in" from_definition "is_compat_in" assuming "nonempty"
 context
   notes Un_assoc[simp] Un_trasposition_aux2[simp]
 begin
 arity_theorem for "compat_in_fm"
 end
 
 lemma (in M_trivial) compat_in_abs[absolut]:
   assumes
     "M(A)" "M(r)" "M(p)" "M(q)"
   shows
     "is_compat_in(M,A,r,p,q) \<longleftrightarrow> compat_in(A,r,p,q)"
   using assms unfolding is_compat_in_def compat_in_def by simp
 
 definition
   antichain :: "i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
   "antichain(P,leq,A) \<equiv> A\<subseteq>P \<and> (\<forall>p\<in>A. \<forall>q\<in>A. p\<noteq>q \<longrightarrow> \<not>compat_in(P,leq,p,q))"
 
 relativize relational  "antichain" "antichain_rel"
+
 definition
   ccc :: "i \<Rightarrow> i \<Rightarrow> o" where
   "ccc(P,leq) \<equiv> \<forall>A. antichain(P,leq,A) \<longrightarrow> |A| \<le> nat"
 
 abbreviation
   antichain_rel_abbr :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" (\<open>antichain\<^bsup>_\<^esup>'(_,_,_')\<close>) where
   "antichain\<^bsup>M\<^esup>(P,leq,A) \<equiv> antichain_rel(M,P,leq,A)"
 
 abbreviation
   antichain_r_set :: "[i,i,i,i] \<Rightarrow> o" (\<open>antichain\<^bsup>_\<^esup>'(_,_,_')\<close>) where
   "antichain\<^bsup>M\<^esup>(P,leq,A) \<equiv> antichain_rel(##M,P,leq,A)"
 
 context M_trivial
 begin
 
 lemma antichain_abs [absolut]:
   "\<lbrakk> M(A); M(P); M(leq) \<rbrakk> \<Longrightarrow> antichain\<^bsup>M\<^esup>(P,leq,A) \<longleftrightarrow> antichain(P,leq,A)"
   unfolding antichain_rel_def antichain_def by (simp add:absolut)
 
 end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
 
 relativize relational "ccc" "ccc_rel"
 
 abbreviation
   ccc_rel_abbr :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" (\<open>ccc\<^bsup>_\<^esup>'(_,_')\<close>) where
   "ccc_rel_abbr(M) \<equiv> ccc_rel(M)"
 
 abbreviation
   ccc_r_set :: "[i,i,i]\<Rightarrow>o" (\<open>ccc\<^bsup>_\<^esup>'(_,_')\<close>) where
   "ccc_r_set(M) \<equiv> ccc_rel(##M)"
 
 context M_cardinals
 begin
 
 lemma def_ccc_rel:
   shows
     "ccc\<^bsup>M\<^esup>(P,leq) \<longleftrightarrow> (\<forall>A[M]. antichain\<^bsup>M\<^esup>(P,leq,A) \<longrightarrow> |A|\<^bsup>M\<^esup> \<le> \<omega>)"
   using is_cardinal_iff
   unfolding ccc_rel_def by (simp add:absolut)
 
 end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
 
 context M_FiniteFun
 begin
 
 lemma Fnle_nat_closed[intro,simp]:
   assumes "M(I)" "M(J)"
   shows "M(Fnle(\<omega>,I,J))"
   unfolding Fnle_def Fnlerel_def Rrel_def
   using supset_separation FiniteFun_closed Fn_nat_eq_FiniteFun assms by simp
 
 lemma Fn_nat_closed:
   assumes "M(A)" "M(B)" shows "M(Fn(\<omega>,A,B))"
   using assms Fn_nat_eq_FiniteFun
   by simp
 
 end \<comment> \<open>\<^locale>\<open>M_FiniteFun\<close>\<close>
 
 context M_add_reals
 begin
 
 lemma lam_replacement_drSR_Y: "M(A) \<Longrightarrow> M(D) \<Longrightarrow> M(r') \<Longrightarrow> lam_replacement(M, drSR_Y(r',D,A))"
   using lam_replacement_drSR_Y
   by simp
 
 lemma (in M_trans) mem_F_bound3:
   fixes F A
   defines "F \<equiv> dC_F"
   shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> {domain(x). x\<in>A})"
   using apply_0 unfolding F_def
   by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
 
 lemma ccc_rel_Fn_nat:
   assumes "M(I)"
   shows "ccc\<^bsup>M\<^esup>(Fn(nat,I,2), Fnle(nat,I,2))"
 proof -
   have repFun_dom_closed:"M({domain(p) . p \<in> A})" if "M(A)" for A
     using RepFun_closed domain_replacement_simp transM[OF _ \<open>M(A)\<close>] that
     by auto
   from assms
   have "M(Fn(nat,I,2))" using Fn_nat_eq_FiniteFun by simp
   {
     fix A
     assume "\<not> |A|\<^bsup>M\<^esup> \<le> nat" "M(A)" "A \<subseteq> Fn(nat, I, 2)"
     moreover from this
     have "countable_rel(M,{p\<in>A. domain(p) = d})" if "M(d)" for d
     proof (cases "d\<prec>\<^bsup>M\<^esup>nat \<and> d \<subseteq> I")
       case True
       with \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(A)\<close>
       have "{p \<in> A . domain(p) = d} \<subseteq> d \<rightarrow>\<^bsup>M\<^esup> 2"
         using domain_of_fun function_space_rel_char[of _ 2]
         by (auto,subgoal_tac "M(domain(x))",simp_all add:transM[of _ A],force)
       moreover from True \<open>M(d)\<close>
       have "Finite(d \<rightarrow>\<^bsup>M\<^esup> 2)"
         using Finite_Pi[THEN [2] subset_Finite, of _ d "\<lambda>_. 2"]
           lesspoll_rel_nat_is_Finite_rel function_space_rel_char[of _ 2]
         by auto
       moreover from \<open>M(d)\<close>
       have "M(d \<rightarrow>\<^bsup>M\<^esup> 2)"
         by simp
       moreover from \<open>M(A)\<close>
       have "M({p \<in> A . domain(p) = d})"
         using separation_closed domain_eq_separation[OF \<open>M(d)\<close>] by simp
       ultimately
       show ?thesis using subset_Finite[of _ "d\<rightarrow>\<^bsup>M\<^esup>2" ]
         by (auto intro!:Finite_imp_countable_rel)
     next
       case False
       with \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(A)\<close>
       have "domain(p) \<noteq> d" if "p\<in>A" for p
       proof -
         note False that \<open>M(A)\<close>
         moreover from this
         obtain d' where "d' \<subseteq> I" "p\<in>d' \<rightarrow> 2" "d' \<prec> \<omega>"
           using FnD[OF subsetD[OF \<open>A\<subseteq>_\<close> \<open>p\<in>A\<close>]]
           by auto
         moreover from this
         have "p \<approx> d'" "domain(p) = d'"
           using function_eqpoll Pi_iff
           by auto
         ultimately
         show ?thesis
           using lesspoll_nat_imp_lesspoll_rel transM[of p]
           by auto
       qed
       then
       show ?thesis
         using empty_lepoll_relI by auto
     qed
     have 2:"M(x) \<Longrightarrow> x \<in> dC_F(X, i) \<Longrightarrow> M(i)" for x X i
       unfolding dC_F_def
       by auto
     moreover
     have "uncountable_rel(M,{domain(p) . p \<in> A})"
     proof
       interpret M_replacement_lepoll M dC_F
-        using lam_replacement_dC_F domain_eq_separation lam_replacement_inj_rel
+        using lam_replacement_dC_F domain_eq_separation lam_replacement_inj_rel lam_replacement_minimum
         unfolding dC_F_def
       proof(unfold_locales,simp_all)
         fix X b f
         assume "M(X)" "M(b)" "M(f)"
         with 2[of X]
         show "lam_replacement(M, \<lambda>x. \<mu> i. x \<in> if_range_F_else_F(\<lambda>d. {p \<in> X . domain(p) = d}, b, f, i))"
           using lam_replacement_dC_F domain_eq_separation
             mem_F_bound3 countable_lepoll_assms2 repFun_dom_closed
           by (rule_tac lam_Least_assumption_general[where U="\<lambda>_. {domain(x). x\<in>X}"],auto)
       qed (auto)
       have "\<exists>a\<in>A. x = domain(a) \<Longrightarrow> M(dC_F(A,x))" for x
         using \<open>M(A)\<close> transM[OF _ \<open>M(A)\<close>] by (auto)
       moreover
       have "w \<in> A \<and> domain(w) = x \<Longrightarrow> M(x)" for w x
         using transM[OF _ \<open>M(A)\<close>] by auto
       ultimately
       interpret M_cardinal_UN_lepoll _ "dC_F(A)" "{domain(p). p\<in>A}"
         using lam_replacement_dC_F lam_replacement_inj_rel \<open>M(A)\<close>
-          lepoll_assumptions domain_eq_separation
+          lepoll_assumptions domain_eq_separation lam_replacement_minimum
           countable_lepoll_assms2 repFun_dom_closed
           lepoll_assumptions1[OF \<open>M(A)\<close> repFun_dom_closed[OF \<open>M(A)\<close>]]
         apply(unfold_locales)
         by(simp_all del:if_range_F_else_F_def,
             rule_tac lam_Least_assumption_general[where U="\<lambda>_. {domain(x). x\<in>A}"])
           (auto simp del:if_range_F_else_F_def simp add:dC_F_def)
       from \<open>A \<subseteq> Fn(nat, I, 2)\<close>
       have x:"(\<Union>d\<in>{domain(p) . p \<in> A}. {p\<in>A. domain(p) = d}) = A"
         by auto
       moreover
       assume "countable_rel(M,{domain(p) . p \<in> A})"
       moreover
       note \<open>\<And>d. M(d) \<Longrightarrow> countable_rel(M,{p\<in>A. domain(p) = d})\<close>
       moreover from \<open>M(A)\<close>
       have "p\<in>A \<Longrightarrow> M(domain(p))" for p
         by (auto dest: transM)
       ultimately
       have "countable_rel(M,A)"
         using countable_rel_imp_countable_rel_UN
         unfolding dC_F_def
         by auto
       with \<open>\<not> |A|\<^bsup>M\<^esup> \<le> nat\<close> \<open>M(A)\<close>
       show False
         using countable_rel_iff_cardinal_rel_le_nat by simp
     qed
     moreover from \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(A)\<close>
     have "p \<in> A \<Longrightarrow> Finite(domain(p))" for p
       using lesspoll_rel_nat_is_Finite_rel[of "domain(p)"]
         lesspoll_nat_imp_lesspoll_rel[of "domain(p)"]
         domain_of_fun[of p _ "\<lambda>_. 2"] by (auto dest:transM)
     moreover
     note repFun_dom_closed[OF \<open>M(A)\<close>]
     ultimately
     obtain D where "delta_system(D)" "D \<subseteq> {domain(p) . p \<in> A}" "D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(D)"
       using delta_system_uncountable_rel[of "{domain(p) . p \<in> A}"] by auto
     then
     have delta:"\<forall>d1\<in>D. \<forall>d2\<in>D. d1 \<noteq> d2 \<longrightarrow> d1 \<inter> d2 = \<Inter>D"
       using delta_system_root_eq_Inter
       by simp
     moreover from \<open>D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(D)\<close>
     have "uncountable_rel(M,D)"
       using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1 by auto
     moreover from this and \<open>D \<subseteq> {domain(p) . p \<in> A}\<close>
     obtain p1 where "p1 \<in> A" "domain(p1) \<in> D"
       using uncountable_rel_not_empty[of D] by blast
     moreover from this and \<open>p1 \<in> A \<Longrightarrow> Finite(domain(p1))\<close>
     have "Finite(domain(p1))"
       using Finite_domain by simp
     moreover
     define r where "r \<equiv> \<Inter>D"
     moreover from \<open>M(D)\<close>
     have "M(r)" "M(r\<times>2)"
       unfolding r_def by simp_all
     ultimately
     have "Finite(r)" using subset_Finite[of "r" "domain(p1)"]
       by auto
     have "countable_rel(M,{restrict(p,r) . p\<in>A})"
     proof -
       note \<open>M(Fn(nat, I, 2))\<close> \<open>M(r)\<close>
       moreover from this
       have "f\<in>Fn(nat, I, 2) \<Longrightarrow> M(restrict(f,r))" for f
         by (blast dest: transM)
       ultimately
       have "f\<in>Fn(nat, I, 2) \<Longrightarrow> restrict(f,r) \<in> Pow_rel(M,r \<times> 2)" for f
         using restrict_subset_Sigma[of f _ "\<lambda>_. 2" r] Pow_rel_char
         by (auto del:FnD dest!:FnD simp: Pi_def) (auto dest:transM)
       with \<open>A \<subseteq> Fn(nat, I, 2)\<close>
       have "{restrict(f,r) . f \<in> A } \<subseteq> Pow_rel(M,r \<times> 2)"
         by fast
       moreover from \<open>M(A)\<close> \<open>M(r)\<close>
       have "M({restrict(f,r) . f \<in> A })"
         using RepFun_closed restrict_strong_replacement transM[OF _ \<open>M(A)\<close>] by auto
       moreover
       note \<open>Finite(r)\<close> \<open>M(r)\<close>
       ultimately
       show ?thesis
         using Finite_Sigma[THEN Finite_Pow_rel, of r "\<lambda>_. 2"]
         by (intro Finite_imp_countable_rel) (auto intro:subset_Finite)
     qed
     moreover from \<open>M(A)\<close> \<open>M(D)\<close>
     have "M({p\<in>A. domain(p) \<in> D})"
       using domain_mem_separation by simp
     have "uncountable_rel(M,{p\<in>A. domain(p) \<in> D})" (is "uncountable_rel(M,?X)")
     proof
       from \<open>D \<subseteq> {domain(p) . p \<in> A}\<close>
       have "(\<lambda>p\<in>?X. domain(p)) \<in> surj(?X, D)"
         using lam_type unfolding surj_def by auto
       moreover from \<open>M(A)\<close> \<open>M(?X)\<close>
       have "M(\<lambda>p\<in>?X. domain(p))"
         using lam_closed[OF domain_replacement \<open>M(?X)\<close>] transM[OF _ \<open>M(?X)\<close>] by simp
       moreover
       note \<open>M(?X)\<close> \<open>M(D)\<close>
       moreover from calculation
       have surjection:"(\<lambda>p\<in>?X. domain(p)) \<in> surj\<^bsup>M\<^esup>(?X, D)"
         using surj_rel_char by simp
       moreover
       assume "countable_rel(M,?X)"
       moreover
       note \<open>uncountable_rel(M,D)\<close>
       ultimately
       show False
         using surj_rel_countable_rel[OF _ surjection] by auto
     qed
     moreover
     have "D = (\<Union>f\<in>Pow_rel(M,r\<times>2) . {y . p\<in>A, restrict(p,r) = f \<and> y=domain(p) \<and> domain(p) \<in> D})"
     proof -
       {
         fix z
         assume "z \<in> D"
         with \<open>M(D)\<close>
         have \<open>M(z)\<close> by (auto dest:transM)
         from \<open>z\<in>D\<close> \<open>D \<subseteq> _\<close> \<open>M(A)\<close>
         obtain p  where "domain(p) = z" "p \<in> A" "M(p)"
           by (auto dest:transM)
         moreover from \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(z)\<close> and this
         have "p \<in> z \<rightarrow>\<^bsup>M\<^esup> 2"
           using domain_of_fun function_space_rel_char by (auto del:FnD dest!:FnD)
         moreover from this \<open>M(z)\<close>
         have "p \<in> z \<rightarrow> 2"
           using domain_of_fun function_space_rel_char by (auto)
         moreover from this \<open>M(r)\<close>
         have "restrict(p,r) \<subseteq> r \<times> 2"
           using function_restrictI[of p r] fun_is_function[of p z "\<lambda>_. 2"]
             restrict_subset_Sigma[of p z "\<lambda>_. 2" r] function_space_rel_char
           by (auto simp:Pi_def)
         moreover from \<open>M(p)\<close> \<open>M(r)\<close>
         have "M(restrict(p,r))" by simp
         moreover
         note \<open>M(r)\<close>
         ultimately
         have "\<exists>p\<in>A.  restrict(p,r) \<in> Pow_rel(M,r\<times>2) \<and> domain(p) = z"
           using Pow_rel_char by auto
       }
       then
       show ?thesis
         by (intro equalityI) (force)+
     qed
     from \<open>M(D)\<close>\<open>M(r)\<close>
     have "M({y . p\<in>A, restrict(p,r) = f \<and> y=domain(p) \<and> domain(p) \<in> D})" (is "M(?Y(A,f))")
       if "M(f)" "M(A)" for f A
       using drSR_Y_closed[unfolded drSR_Y_def] that
       by simp
     then
     obtain f where "uncountable_rel(M,?Y(A,f))" "M(f)"
     proof -
       have 1:"M(i)"
         if "M(B)" "M(x)"
           "x \<in> {y . x \<in> B, restrict(x, r) = i \<and> y = domain(x) \<and> domain(x) \<in> D}"
         for B x i
         using that \<open>M(r)\<close>
         by (auto dest:transM)
       note \<open>M(r)\<close>
       moreover from this
       have "M(Pow\<^bsup>M\<^esup>(r \<times> 2))" by simp
       moreover
       note \<open>M(A)\<close> \<open>\<And>f A. M(f) \<Longrightarrow> M(A) \<Longrightarrow> M(?Y(A,f))\<close> \<open>M(D)\<close>
       moreover from calculation
       interpret M_replacement_lepoll M "drSR_Y(r,D)"
         using countable_lepoll_assms3 lam_replacement_inj_rel lam_replacement_drSR_Y
-          drSR_Y_closed lam_Least_assumption_drSR_Y
+          drSR_Y_closed lam_Least_assumption_drSR_Y lam_replacement_minimum
         by (unfold_locales,simp_all add:drSR_Y_def,rule_tac 1,simp_all)
       from calculation
       have "x \<in> Pow\<^bsup>M\<^esup>(r \<times> 2) \<Longrightarrow> M(drSR_Y(r, D, A, x))" for x
         unfolding drSR_Y_def by (auto dest:transM)
       ultimately
       interpret M_cardinal_UN_lepoll _ "?Y(A)" "Pow_rel(M,r\<times>2)"
         using countable_lepoll_assms3 lam_replacement_drSR_Y
           lepoll_assumptions[where S="Pow_rel(M,r\<times>2)", unfolded lepoll_assumptions_defs]
-          lam_Least_assumption_drSR_Y[unfolded drSR_Y_def]
+          lam_Least_assumption_drSR_Y[unfolded drSR_Y_def] lam_replacement_minimum
         unfolding drSR_Y_def
         apply unfold_locales
-                        apply (simp_all add:lam_replacement_inj_rel del: if_range_F_else_F_def,rule_tac 1,simp_all)
+             apply (simp_all add:lam_replacement_inj_rel del: if_range_F_else_F_def,rule_tac 1,simp_all)
         by ((fastforce dest:transM[OF _ \<open>M(A)\<close>])+)
       {
         from \<open>Finite(r)\<close> \<open>M(r)\<close>
         have "countable_rel(M,Pow_rel(M,r\<times>2))"
           using Finite_Sigma[THEN Finite_Pow_rel] Finite_imp_countable_rel
           by simp
         moreover
         assume "M(f) \<Longrightarrow> countable_rel(M,?Y(A,f))" for f
         moreover
         note \<open>D = (\<Union>f\<in>Pow_rel(M,r\<times>2) .?Y(A,f))\<close> \<open>M(r)\<close>
         moreover
         note \<open>uncountable_rel(M,D)\<close>
         ultimately
         have "False"
           using countable_rel_imp_countable_rel_UN by (auto dest: transM)
       }
       with that
       show ?thesis
         by auto
     qed
     moreover from this \<open>M(A)\<close> and \<open>M(f) \<Longrightarrow> M(A) \<Longrightarrow> M(?Y(A,f))\<close>
     have "M(?Y(A,f))"
       by blast
     ultimately
     obtain j where "j \<in> inj_rel(M,nat, ?Y(A,f))" "M(j)"
       using uncountable_rel_iff_nat_lt_cardinal_rel[THEN iffD1, THEN leI,
           THEN cardinal_rel_le_imp_lepoll_rel, THEN lepoll_relD]
       by auto
     with \<open>M(?Y(A,f))\<close>
     have "j`0 \<noteq> j`1" "j`0 \<in> ?Y(A,f)" "j`1 \<in> ?Y(A,f)"
       using inj_is_fun[THEN apply_type, of j nat "?Y(A,f)"]
         inj_rel_char
       unfolding inj_def by auto
     then
     obtain p q where "domain(p) \<noteq> domain(q)" "p \<in> A" "q \<in> A"
       "domain(p) \<in> D" "domain(q) \<in> D"
       "restrict(p,r) = restrict(q,r)" by auto
     moreover from this and delta
     have "domain(p) \<inter> domain(q) = r"
       unfolding r_def by simp
     moreover
     note \<open>A \<subseteq> Fn(nat, I, 2)\<close> Fn_nat_abs[OF \<open>M(I)\<close> nat_into_M[of 2],simplified]
     moreover from calculation
     have "p \<in> Fn\<^bsup>M\<^esup>(nat, I, 2)" "q \<in> Fn\<^bsup>M\<^esup>(nat, I, 2)"
       by auto
     moreover from calculation
     have "p \<union> q \<in> Fn(nat, I, 2)"
       using restrict_eq_imp_compat_rel InfCard_rel_nat
       by simp
     ultimately
     have "\<exists>p\<in>A. \<exists>q\<in>A. p \<noteq> q \<and> compat_in(Fn(nat, I, 2), Fnle(nat, I, 2), p, q)"
       unfolding compat_in_def
       by (rule_tac bexI[of _ p], rule_tac bexI[of _ q]) blast
   }
   moreover from assms
   have "M(Fnle(\<omega>,I,2))"
     by simp
   moreover note \<open>M(Fn(\<omega>,I,2))\<close>
   ultimately
   show ?thesis using def_ccc_rel by (auto simp:absolut antichain_def) fastforce
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_add_reals\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Definitions_Main.thy b/thys/Independence_CH/Definitions_Main.thy
--- a/thys/Independence_CH/Definitions_Main.thy
+++ b/thys/Independence_CH/Definitions_Main.thy
@@ -1,610 +1,628 @@
 section\<open>Main definitions of the development\label{sec:main-definitions}\<close>
 
 theory Definitions_Main
   imports
     Absolute_Versions
 begin
 
-text\<open>This theory gathers the main definitions of the Forcing session.
+text\<open>This theory gathers the main definitions of the
+\<^session>\<open>Transitive_Models\<close> session and the present one.
 
 It might be considered as the bare minimum reading requisite to
 trust that our development indeed formalizes the theory of
 forcing. This should be mathematically clear since this is the
 only known method for obtaining proper extensions of ctms while
 preserving the ordinals.
 
 The main theorem of this session and all of its relevant definitions
 appear in Section~\ref{sec:def-main-forcing}. The reader trusting
-all the libraries in which our development is based, might jump
-directly there. But in case one wants to dive deeper, the following
-sections treat some basic concepts in the ZF logic
-(Section~\ref{sec:def-main-ZF})  and in the
+all the libraries on which our development is based, might jump
+directly to Section~\ref{sec:relative-arith}, which treats relative
+cardinal arithmetic as implemented in
+\<^session>\<open>Transitive_Models\<close>. But in case one wants to dive deeper, the
+following sections treat some basic concepts of the ZF logic
+(Section~\ref{sec:def-main-ZF}) and in the
 ZF-Constructible library (Section~\ref{sec:def-main-relative})
 on which our definitions are built.
 \<close>
 
 declare [[show_question_marks=false]]
 
 subsection\<open>ZF\label{sec:def-main-ZF}\<close>
 
 text\<open>For the basic logic ZF we restrict ourselves to just a few
 concepts.\<close>
 
 thm bij_def[unfolded inj_def surj_def]
 text\<open>@{thm [display] bij_def[unfolded inj_def surj_def]}\<close>
 (*
-  bij(A, B) \<equiv> {f \<in> A \<rightarrow> B . \<forall>w\<in>A. \<forall>x\<in>A. f ` w = f ` x \<longrightarrow> w = x}
-               \<inter> {f \<in> A \<rightarrow> B . \<forall>y\<in>B. \<exists>x\<in>A. f ` x = y}
+bij(A, B) \<equiv>
+  {f \<in> A \<rightarrow> B . \<forall>w\<in>A. \<forall>x\<in>A. f ` w = f ` x \<longrightarrow> w = x} \<inter>
+  {f \<in> A \<rightarrow> B . \<forall>y\<in>B. \<exists>x\<in>A. f ` x = y}
 *)
 
 thm eqpoll_def
 text\<open>@{thm [display] eqpoll_def}\<close>
 (*
   A \<approx> B \<equiv> \<exists>f. f \<in> bij(A, B)
 *)
 
 thm Transset_def
 text\<open>@{thm [display] Transset_def}\<close>
 (*
   Transset(i) \<equiv> \<forall>x\<in>i. x \<subseteq> i
 *)
 
 thm Ord_def
 text\<open>@{thm [display] Ord_def}\<close>
 (*
   Ord(i) \<equiv> Transset(i) \<and> (\<forall>x\<in>i. Transset(x))
 *)
 
 thm lt_def le_iff
 text\<open>@{thm [display] lt_def le_iff}\<close>
 (*
   i < j \<equiv> i \<in> j \<and> Ord(j)
   i \<le> j \<longleftrightarrow> i < j \<or> i = j \<and> Ord(j)
 *)
 
 text\<open>With the concepts of empty set and successor in place,\<close>
 lemma empty_def': "\<forall>x. x \<notin> 0" by simp
 lemma succ_def': "succ(i) = i \<union> {i}" by blast
 
 text\<open>we can define the set of natural numbers \<^term>\<open>\<omega>\<close>. In the
 sources, it is  defined as a fixpoint, but here we just write
 its characterization as the first limit ordinal.\<close>
 thm Limit_nat[unfolded Limit_def] nat_le_Limit[unfolded Limit_def]
 text\<open>@{thm [display] Limit_nat[unfolded Limit_def]
  nat_le_Limit[unfolded Limit_def]}\<close>
 (*
   Ord(\<omega>) \<and> 0 < \<omega> \<and> (\<forall>y. y < \<omega> \<longrightarrow> succ(y) < \<omega>)
   Ord(i) \<and> 0 < i \<and> (\<forall>y. y < i \<longrightarrow> succ(y) < i) \<Longrightarrow> \<omega> \<le> i
 *)
 
-text\<open>Then, addition and predecessor are inductively characterized
-as follows:\<close>
+text\<open>Then, addition and predecessor on \<^term>\<open>\<omega>\<close> are inductively
+characterized as follows:\<close>
 thm add_0_right add_succ_right pred_0 pred_succ_eq
 text\<open>@{thm [display] add_succ_right add_0_right pred_0 pred_succ_eq}\<close>
 (*
   m \<in> \<omega> \<Longrightarrow> m +\<^sub>\<omega> 0 = m
   m +\<^sub>\<omega> succ(n) = succ(m +\<^sub>\<omega> n)
 
   pred(0) = 0
   pred(succ(y)) = y
 *)
 
 text\<open>Lists on a set \<^term>\<open>A\<close> can be characterized by being
 recursively generated from the empty list \<^term>\<open>[]\<close> and the
 operation \<^term>\<open>Cons\<close> that adds a new element to the left end;
 the induction theorem for them shows that the characterization is
 “complete”.\<close>
 
 thm Nil Cons list.induct
 text\<open>@{thm [display] Nil Cons list.induct }\<close>
 (*
   [] \<in> list(A)
   a \<in> A \<Longrightarrow> l \<in> list(A) \<Longrightarrow> Cons(a, l) \<in> list(A)
-  x \<in> list(A) \<Longrightarrow> P([]) \<Longrightarrow> (\<And>a l. a \<in> A \<Longrightarrow> l \<in> list(A) \<Longrightarrow> P(l) \<Longrightarrow> P(Cons(a, l))) \<Longrightarrow> P(x)
+  x \<in> list(A) \<Longrightarrow>
+  P([]) \<Longrightarrow> (\<And>a l. a \<in> A \<Longrightarrow> l \<in> list(A) \<Longrightarrow> P(l) \<Longrightarrow> P(Cons(a, l))) \<Longrightarrow> P(x)
 *)
 
 text\<open>Length, concatenation, and \<^term>\<open>n\<close>th element of lists are
 recursively characterized as follows.\<close>
 thm length.simps app.simps nth_0 nth_Cons
 text\<open>@{thm [display] length.simps app.simps nth_0 nth_Cons}\<close>
 (*
   length([]) = 0
   length(Cons(a, l)) = succ(length(l))
 
   [] @ ys = ys
   Cons(a, l) @ ys = Cons(a, l @ ys)
 
   nth(0, Cons(a, l)) = a
   n \<in> \<omega> \<Longrightarrow> nth(succ(n), Cons(a, l)) = nth(n, l)
 *)
-txt\<open>We have the usual Haskell-like notation for iterated applications
+text\<open>We have the usual Haskell-like notation for iterated applications
 of \<^term>\<open>Cons\<close>:\<close>
 lemma Cons_app: "[a,b,c] = Cons(a,Cons(b,Cons(c,[])))" ..
 
-txt\<open>Relative quantifiers restrict the range of the bound variable to a
+text\<open>Relative quantifiers restrict the range of the bound variable to a
 class \<^term>\<open>M\<close> of type \<^typ>\<open>i\<Rightarrow>o\<close>; that is, a truth-valued function with
 set arguments.\<close>
 lemma "\<forall>x[M]. P(x) \<equiv> \<forall>x. M(x) \<longrightarrow> P(x)"
       "\<exists>x[M]. P(x) \<equiv> \<exists>x. M(x) \<and> P(x)"
   unfolding rall_def rex_def .
 
-txt\<open>Finally, a set can be viewed (“cast”) as a class using the
+text\<open>Finally, a set can be viewed (“cast”) as a class using the
 following function of type \<^typ>\<open>i\<Rightarrow>(i\<Rightarrow>o)\<close>.\<close>
 thm setclass_iff
 text\<open>@{thm [display] setclass_iff}\<close>
 (*
   (##A)(x) \<longleftrightarrow> x \<in> A
 *)
 
 subsection\<open>Relative concepts\label{sec:def-main-relative}\<close>
-txt\<open>A list of relative concepts (mostly from the ZF-Constructible
+text\<open>A list of relative concepts (mostly from the ZF-Constructible
     library) follows next.\<close>
 
 thm big_union_def
 text\<open>@{thm [display] big_union_def}\<close>
 (*
   big_union(M, A, z) \<equiv> \<forall>x[M]. x \<in> z \<longleftrightarrow> (\<exists>y[M]. y \<in> A \<and> x \<in> y)
 *)
 
 thm upair_def
 text\<open>@{thm [display] upair_def}\<close>
 (*
   upair(M, a, b, z) \<equiv> a \<in> z \<and> b \<in> z \<and> (\<forall>x[M]. x \<in> z \<longrightarrow> x = a \<or> x = b)
 *)
 
 thm pair_def
 text\<open>@{thm [display] pair_def}\<close>
 (*
   pair(M, a, b, z) \<equiv> \<exists>x[M]. upair(M, a, a, x) \<and>
                         (\<exists>y[M]. upair(M, a, b, y) \<and> upair(M, x, y, z))
 *)
 
 thm successor_def[unfolded is_cons_def union_def]
 text\<open>@{thm [display] successor_def[unfolded is_cons_def union_def]}\<close>
 (*
   successor(M, a, z) \<equiv> \<exists>x[M]. upair(M, a, a, x) \<and> (\<forall>xa[M]. xa \<in> z \<longleftrightarrow> xa \<in> x \<or> xa \<in> a)
 *)
 
 thm empty_def
 text\<open>@{thm [display] empty_def}\<close>
 (*
   empty(M, z) \<equiv> \<forall>x[M]. x \<notin> z
 *)
 
 thm transitive_set_def[unfolded subset_def]
 text\<open>@{thm [display] transitive_set_def[unfolded subset_def]}\<close>
 (*
   transitive_set(M, a) \<equiv> \<forall>x[M]. x \<in> a \<longrightarrow> (\<forall>xa[M]. xa \<in> x \<longrightarrow> xa \<in> a)
 *)
 
 
 thm ordinal_def
 text\<open>@{thm [display] ordinal_def}\<close>
 (*
   ordinal(M, a) \<equiv> transitive_set(M, a) \<and> (\<forall>x[M]. x \<in> a \<longrightarrow>
                                               transitive_set(M, x))
 *)
 
 thm image_def
 text\<open>@{thm [display] image_def}\<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)))
 *)
 
 thm fun_apply_def
 text\<open>@{thm [display] fun_apply_def}\<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)
 *)
 
 thm is_function_def
 text\<open>@{thm [display] is_function_def}\<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'
 *)
 
 thm is_relation_def
 text\<open>@{thm [display] is_relation_def}\<close>
 (*
   is_relation(M, r) \<equiv> \<forall>z[M]. z \<in> r \<longrightarrow> (\<exists>x[M]. \<exists>y[M]. pair(M, x, y, z))
 *)
 
 thm is_domain_def
 text\<open>@{thm [display] is_domain_def}\<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)))
 *)
 
 thm typed_function_def
 text\<open>@{thm [display] typed_function_def}\<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))
 *)
 
 thm is_function_space_def[unfolded is_funspace_def]
   function_space_rel_def surjection_def
 text\<open>@{thm [display] is_function_space_def[unfolded is_funspace_def]
   function_space_rel_def surjection_def}\<close>
 (*
   is_function_space(M, A, B, fs) \<equiv>
   M(fs) \<and> (\<forall>f[M]. f \<in> fs \<longleftrightarrow> typed_function(M, A, B, f))
 
   A \<rightarrow>\<^bsup>M\<^esup> B \<equiv> THE d. is_function_space(M, A, B, d)
 
   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> is_apply(M, f, x, y)))
 *)
 
 
-txt\<open>Relative version of the $\ZFC$ axioms\<close>
+text\<open>Relative version of the $\ZFC$ axioms\<close>
 thm extensionality_def
 text\<open>@{thm [display] extensionality_def}\<close>
 (*
   extensionality(M) \<equiv> \<forall>x[M]. \<forall>y[M]. (\<forall>z[M]. z \<in> x \<longleftrightarrow> z \<in> y) \<longrightarrow> x = y
 *)
 
 thm foundation_ax_def
 text\<open>@{thm [display] foundation_ax_def}\<close>
 (*
   foundation_ax(M) \<equiv> \<forall>x[M]. (\<exists>y[M]. y \<in> x) \<longrightarrow> (\<exists>y[M]. y \<in> x \<and> \<not> (\<exists>z[M]. z \<in> x \<and> z \<in> y))
 *)
 
 thm upair_ax_def
 text\<open>@{thm [display] upair_ax_def}\<close>
 (*
   upair_ax(M) \<equiv> \<forall>x[M]. \<forall>y[M]. \<exists>z[M]. upair(M, x, y, z)
 *)
 
 thm Union_ax_def
 text\<open>@{thm [display] Union_ax_def}\<close>
 (*
   Union_ax(M) \<equiv> \<forall>x[M]. \<exists>z[M]. \<forall>xa[M]. xa \<in> z \<longleftrightarrow> (\<exists>y[M]. y \<in> x \<and> xa \<in> y)
 *)
 
 thm power_ax_def[unfolded powerset_def subset_def]
 text\<open>@{thm [display] power_ax_def[unfolded powerset_def subset_def]}\<close>
 (*
   power_ax(M) \<equiv> \<forall>x[M]. \<exists>z[M]. \<forall>xa[M]. xa \<in> z \<longleftrightarrow> (\<forall>xb[M]. xb \<in> xa \<longrightarrow> xb \<in> x)
 *)
 
 thm infinity_ax_def
 text\<open>@{thm [display] infinity_ax_def}\<close>
 (*
   infinity_ax(M) \<equiv> \<exists>I[M]. (\<exists>z[M]. empty(M, z) \<and> z \<in> I) \<and> (\<forall>y[M]. y \<in> I \<longrightarrow>
                         (\<exists>sy[M]. successor(M, y, sy) \<and> sy \<in> I))
 *)
 
 thm choice_ax_def
 text\<open>@{thm [display] choice_ax_def}\<close>
 (*
   choice_ax(M) \<equiv> \<forall>x[M]. \<exists>a[M]. \<exists>f[M]. ordinal(M, a) \<and> surjection(M, a, x, f)
 *)
 
 thm separation_def
 text\<open>@{thm [display] separation_def}\<close>
 (*
   separation(M, P) \<equiv> \<forall>z[M]. \<exists>y[M]. \<forall>x[M]. x \<in> y \<longleftrightarrow> x \<in> z \<and> P(x)
 *)
 
 thm univalent_def
 text\<open>@{thm [display] univalent_def}\<close>
 (*
   univalent(M, A, P) \<equiv> \<forall>x[M]. x \<in> A \<longrightarrow>
                           (\<forall>y[M]. \<forall>z[M]. P(x, y) \<and> P(x, z) \<longrightarrow> y = z)
 *)
 
 thm strong_replacement_def
 text\<open>@{thm [display] strong_replacement_def}\<close>
 (*
   strong_replacement(M, P) \<equiv> \<forall>A[M]. univalent(M, A, P) \<longrightarrow>
        (\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> P(x, b)))
 *)
 
 text\<open>Internalized formulas\<close>
 
-txt\<open>“Codes” for formulas (as sets) are constructed from natural
+text\<open>“Codes” for formulas (as sets) are constructed from natural
 numbers using \<^term>\<open>Member\<close>, \<^term>\<open>Equal\<close>, \<^term>\<open>Nand\<close>,
 and \<^term>\<open>Forall\<close>.\<close>
 
 thm Member Equal Nand Forall formula.induct
 text\<open>@{thm [display] Member Equal Nand Forall formula.induct}\<close>
 (*
   x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> \<cdot>x \<in> y\<cdot> \<in> formula
   x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> \<cdot>x = y\<cdot> \<in> formula
   p \<in> formula \<Longrightarrow> q \<in> formula \<Longrightarrow> \<cdot>\<not>(p \<and> q)\<cdot> \<in> formula
   p \<in> formula \<Longrightarrow> (\<forall>p) \<in> formula
 
   x \<in> formula \<Longrightarrow>
   (\<And>x y. x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> P(\<cdot>x \<in> y\<cdot>)) \<Longrightarrow>
   (\<And>x y. x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> P(\<cdot>x = y\<cdot>)) \<Longrightarrow>
   (\<And>p q. p \<in> formula \<Longrightarrow> P(p) \<Longrightarrow> q \<in> formula \<Longrightarrow> P(q) \<Longrightarrow> P(\<cdot>\<not>(p \<and> q)\<cdot>)) \<Longrightarrow>
   (\<And>p. p \<in> formula \<Longrightarrow> P(p) \<Longrightarrow> P((\<forall>p))) \<Longrightarrow> P(x)
 *)
 
-txt\<open>Definitions for the other connectives and the internal existential
+text\<open>Definitions for the other connectives and the internal existential
 quantifier are also provided. For instance, negation:\<close>
 thm Neg_def
 text\<open>@{thm [display] Neg_def}\<close>
+(*
+  \<cdot>\<not>p\<cdot> \<equiv> \<cdot>\<not>(p \<and> p)\<cdot>
+*)
 
 thm arity.simps
 text\<open>@{thm [display] arity.simps}\<close>
 (*
   arity(\<cdot>x \<in> y\<cdot>) = succ(x) \<union> succ(y)
   arity(\<cdot>x = y\<cdot>) = succ(x) \<union> succ(y)
   arity(\<cdot>\<not>(p \<and> q)\<cdot>) = arity(p) \<union> arity(q)
   arity((\<forall>p)) = pred(arity(p))
 *)
 
-txt\<open>We have the satisfaction relation between $\in$-models and
+text\<open>We have the satisfaction relation between $\in$-models and
     first order formulas (given a “environment” list representing
     the assignment of free variables),\<close>
 thm mem_iff_sats equal_iff_sats sats_Nand_iff sats_Forall_iff
 text\<open>@{thm [display] mem_iff_sats equal_iff_sats sats_Nand_iff sats_Forall_iff}\<close>
 (*
   nth(i, env) = x \<Longrightarrow> nth(j, env) = y \<Longrightarrow> env \<in> list(A) \<Longrightarrow> x \<in> y \<longleftrightarrow> A, env \<Turnstile> \<cdot>i \<in> j\<cdot>
   nth(i, env) = x \<Longrightarrow> nth(j, env) = y \<Longrightarrow> env \<in> list(A) \<Longrightarrow> x = y \<longleftrightarrow> A, env \<Turnstile> \<cdot>i = j\<cdot>
   env \<in> list(A) \<Longrightarrow> (A, env \<Turnstile> \<cdot>\<not>(p \<and> q)\<cdot>) \<longleftrightarrow> \<not> ((A, env \<Turnstile> p) \<and> (A, env \<Turnstile> q))
   env \<in> list(A) \<Longrightarrow> (A, env \<Turnstile> (\<cdot>\<forall>p\<cdot>)) \<longleftrightarrow> (\<forall>x\<in>A. A, Cons(x, env) \<Turnstile> p)*)
 
-txt\<open>as well as the satisfaction of an arbitrary set of sentences.\<close>
+text\<open>as well as the satisfaction of an arbitrary set of sentences.\<close>
 thm satT_def
 text\<open>@{thm [display] satT_def}\<close>
 (*
   A \<Turnstile> \<Phi>  \<equiv>  \<forall>\<phi>\<in>\<Phi>. A, [] \<Turnstile> \<phi>
 *)
 
-txt\<open>The internalized (viz. as elements of the set \<^term>\<open>formula\<close>)
+text\<open>The internalized (viz. as elements of the set \<^term>\<open>formula\<close>)
     version of the axioms follow next.\<close>
 
 thm ZF_union_iff_sats ZF_power_iff_sats ZF_pairing_iff_sats
   ZF_foundation_iff_sats ZF_extensionality_iff_sats
   ZF_infinity_iff_sats sats_ZF_separation_fm_iff
   sats_ZF_replacement_fm_iff ZF_choice_iff_sats
 text\<open>@{thm [display] ZF_union_iff_sats ZF_power_iff_sats
   ZF_pairing_iff_sats
   ZF_foundation_iff_sats ZF_extensionality_iff_sats
   ZF_infinity_iff_sats sats_ZF_separation_fm_iff
   sats_ZF_replacement_fm_iff ZF_choice_iff_sats}\<close>
 (*
   Union_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Union Ax\<cdot>
   power_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Powerset Ax\<cdot>
   upair_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Pairing\<cdot>
   foundation_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Foundation\<cdot>
   extensionality(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Extensionality\<cdot>
   infinity_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Infinity\<cdot>
 
   \<phi> \<in> formula \<Longrightarrow>
   (M, [] \<Turnstile> \<cdot>Separation(\<phi>)\<cdot>) \<longleftrightarrow>
   (\<forall>env\<in>list(M).
       arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<longrightarrow> separation(##M, \<lambda>x. M, [x] @ env \<Turnstile> \<phi>))
 
   \<phi> \<in> formula \<Longrightarrow>
   (M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>) \<longleftrightarrow>
   (\<forall>env\<in>list(M).
       arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
       strong_replacement(##M, \<lambda>x y. M, [x, y] @ env \<Turnstile> \<phi>))
 
   choice_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>AC\<cdot>
 *)
 
 thm ZF_fin_def ZF_schemes_def Zermelo_fms_def ZC_def ZF_def ZFC_def
 text\<open>@{thm [display] ZF_fin_def ZF_schemes_def Zermelo_fms_def ZC_def ZF_def
   ZFC_def}\<close>
 (*
   ZF_fin \<equiv> {\<cdot>Extensionality\<cdot>, \<cdot>Foundation\<cdot>, \<cdot>Pairing\<cdot>, \<cdot>Union Ax\<cdot>, \<cdot>Infinity\<cdot>, \<cdot>Powerset Ax\<cdot>}
   ZF_schemes \<equiv> {\<cdot>Separation(p)\<cdot> . p \<in> formula} \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> formula}
   \<cdot>Z\<cdot> \<equiv> ZF_fin \<union> {\<cdot>Separation(p)\<cdot> . p \<in> formula}
   ZC \<equiv> \<cdot>Z\<cdot> \<union> {\<cdot>AC\<cdot>}
   ZF \<equiv> ZF_schemes \<union> ZF_fin
   ZFC \<equiv> ZF \<union> {\<cdot>AC\<cdot>}
 *)
 
-subsection\<open>Relativization of infinitary arithmetic\<close>
+subsection\<open>Relativization of infinitary arithmetic\label{sec:relative-arith}\<close>
 
-txt\<open>In order to state the defining property of the relative
+text\<open>In order to state the defining property of the relative
     equipotence relation, we work under the assumptions of the
     locale \<^term>\<open>M_cardinals\<close>. They comprise a finite set
     of instances of Separation and Replacement to prove
     closure properties of the transitive class \<^term>\<open>M\<close>.\<close>
 
 lemma (in M_cardinals) eqpoll_def':
   assumes "M(A)" "M(B)" shows "A \<approx>\<^bsup>M\<^esup> B \<longleftrightarrow> (\<exists>f[M]. f \<in> bij(A,B))"
   using assms unfolding eqpoll_rel_def by auto
 
-txt\<open>Below, $\mu$ denotes the minimum operator on the ordinals.\<close>
+text\<open>Below, $\mu$ denotes the minimum operator on the ordinals.\<close>
 lemma cardinalities_defs:
   fixes M::"i\<Rightarrow>o"
   shows
     "|A|\<^bsup>M\<^esup> \<equiv> \<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"
     "Card\<^bsup>M\<^esup>(\<alpha>) \<equiv> \<alpha> = |\<alpha>|\<^bsup>M\<^esup>"
     "\<kappa>\<^bsup>\<up>\<nu>,M\<^esup> \<equiv> |\<nu> \<rightarrow>\<^bsup>M\<^esup> \<kappa>|\<^bsup>M\<^esup>"
     "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<equiv> \<mu> x. M(x) \<and> Card\<^bsup>M\<^esup>(x) \<and> \<kappa> < x"
   unfolding cardinal_rel_def cexp_rel_def
     csucc_rel_def Card_rel_def .
 
 context M_aleph
 begin
 
-txt\<open>As in the previous Lemma @{thm [source] eqpoll_def'}, we are now under
+text\<open>Analogous to the previous Lemma @{thm [source] eqpoll_def'}, we are now under
     the assumptions of the locale \<^term>\<open>M_aleph\<close>. The axiom instances
     included are sufficient to state and prove the defining
     properties of the relativized \<^term>\<open>Aleph\<close> function
     (in particular, the required ability to perform transfinite recursions).\<close>
 
 thm Aleph_rel_zero Aleph_rel_succ Aleph_rel_limit
 text\<open>@{thm [display] Aleph_rel_zero Aleph_rel_succ Aleph_rel_limit}\<close>
 (*
   \<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup> = \<omega>
   Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>succ(\<alpha>)\<^esub>\<^bsup>M\<^esup> = (\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>
   Limit(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> = (\<Union>j\<in>\<alpha>. \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>)
 *)
 
 end \<comment> \<open>\<^locale>\<open>M_aleph\<close>\<close>
 
 lemma ContHyp_rel_def':
   fixes N::"i\<Rightarrow>o"
   shows
     "CH\<^bsup>N\<^esup> \<equiv> \<aleph>\<^bsub>1\<^esub>\<^bsup>N\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>N\<^esup>,N\<^esup>"
   unfolding ContHyp_rel_def .
 
-txt\<open>Under appropriate hypothesis (this time, from the locale \<^term>\<open>M_master\<close>),
+text\<open>Under appropriate hypotheses (this time, from the locale \<^term>\<open>M_ZF_library\<close>),
    \<^term>\<open>CH\<^bsup>M\<^esup>\<close> is equivalent to its fully relational version \<^term>\<open>is_ContHyp\<close>.
     As a sanity check, we see that if the transitive class is indeed \<^term>\<open>\<V>\<close>,
     we recover the original $\CH$.\<close>
 
-thm M_master.is_ContHyp_iff is_ContHyp_iff_CH[unfolded ContHyp_def]
-text\<open>@{thm [display] M_master.is_ContHyp_iff
+thm M_ZF_library.is_ContHyp_iff is_ContHyp_iff_CH[unfolded ContHyp_def]
+text\<open>@{thm [display] M_ZF_library.is_ContHyp_iff
     is_ContHyp_iff_CH[unfolded ContHyp_def]}\<close>
 (*
-  M_master(M) \<Longrightarrow> is_ContHyp(M) \<longleftrightarrow> CH\<^bsup>M\<^esup>
+  M_ZF_library(M) \<Longrightarrow> is_ContHyp(M) \<longleftrightarrow> CH\<^bsup>M\<^esup>
   is_ContHyp(\<V>) \<longleftrightarrow> \<aleph>\<^bsub>1\<^esub> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^esup>
 *)
 
-txt\<open>In turn, the fully relational version evaluated on a nonempty
+text\<open>In turn, the fully relational version evaluated on a nonempty
     transitive \<^term>\<open>A\<close> is equivalent to the satisfaction of the
     first-order formula \<^term>\<open>\<cdot>CH\<cdot>\<close>.\<close>
 thm is_ContHyp_iff_sats
 text\<open>@{thm [display] is_ContHyp_iff_sats}\<close>
 (*
   env \<in> list(A) \<Longrightarrow> 0 \<in> A \<Longrightarrow> is_ContHyp(##A) \<longleftrightarrow> A, env \<Turnstile> \<cdot>CH\<cdot>
 *)
 
 
 subsection\<open>Forcing \label{sec:def-main-forcing}\<close>
 
-txt\<open>Our first milestone was to obtain a proper extension using forcing.
-It's original proof didn't required the previous developments involving
+text\<open>Our first milestone was to obtain a proper extension using forcing.
+Its original proof didn't required the previous developments involving
 the relativization of material on cardinal arithmetic. Now it is
 derived from a stronger result, namely @{thm [source] extensions_of_ctms}
 below.\<close>
 
 thm extensions_of_ctms_ZF
 text\<open>@{thm [display] extensions_of_ctms_ZF}\<close>
 (*
   M \<approx> \<omega> \<Longrightarrow>
   Transset(M) \<Longrightarrow>
   M \<Turnstile> ZF \<Longrightarrow>
   \<exists>N. M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZF \<and> M \<noteq> N \<and>
     (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N) \<and> ((M, [] \<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N \<Turnstile> ZFC)
 *)
 
-txt\<open>We can finally state our main results, namely, the existence of models
+text\<open>We can finally state our main results, namely, the existence of models
 for $\ZFC + \CH$ and $\ZFC + \neg\CH$ under the assumption of a ctm of $\ZFC$.\<close>
 
 thm ctm_ZFC_imp_ctm_not_CH
 text\<open>@{thm [display] ctm_ZFC_imp_ctm_not_CH}\<close>
 (*
   M \<approx> \<omega> \<Longrightarrow>
   Transset(M) \<Longrightarrow>
   M \<Turnstile> ZFC \<Longrightarrow>
   \<exists>N. M \<subseteq> N \<and>
     N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<and>
     (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
 *)
 
 thm ctm_ZFC_imp_ctm_CH
 text\<open>@{thm [display] ctm_ZFC_imp_ctm_CH}\<close>
 (*
   M \<approx> \<omega> \<Longrightarrow>
   Transset(M) \<Longrightarrow>
   M \<Turnstile> ZFC \<Longrightarrow>
   \<exists>N. M \<subseteq> N \<and>
       N \<approx> \<omega> \<and>
       Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
 *)
 
-txt\<open>These results can be strengthened by enumerating four finite sets of
+text\<open>These results can be strengthened by enumerating five finite sets of
 replacement instances which are sufficient to develop forcing and for
 the construction of the aforementioned models: \<^term>\<open>instances1_fms\<close>
-through \<^term>\<open>instances4_fms\<close>, which are then collected into
-\<^term>\<open>overhead\<close>. For example, we have:\<close>
+through \<^term>\<open>instances4_fms\<close>, and \<^term>\<open>instances_ground_fms\<close> which are
+then collected into the $35$-element set \<^term>\<open>overhead\<close>.
+For example, we have:\<close>
 
 thm instances1_fms_def
 text\<open>@{thm [display] instances1_fms_def}\<close>
 (*
 instances1_fms \<equiv>
-{ wfrec_Hfrc_at_fm, list_repl1_intf_fm, list_repl2_intf_fm,
- formula_repl2_intf_fm, eclose_repl2_intf_fm, powapply_repl_fm,
- phrank_repl_fm, wfrec_rank_fm, trans_repl_HVFrom_fm, wfrec_Hcheck_fm,
- repl_PHcheck_fm, check_replacement_fm, G_dot_in_M_fm, repl_opname_check_fm,
- tl_repl_intf_fm, formula_repl1_intf_fm, eclose_repl1_intf_fm }
+{ list_repl1_intf_fm, list_repl2_intf_fm, formula_repl1_intf_fm, formula_repl2_intf_fm,
+ eclose_repl1_intf_fm, eclose_repl2_intf_fm, wfrec_rank_fm, trans_repl_HVFrom_fm,
+ tl_repl_intf_fm }
 *)
 
 thm overhead_def
 text\<open>@{thm [display] overhead_def}\<close>
 (*
-overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances3_fms \<union> instances4_fms
+overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances3_fms \<union>
+  instances4_fms \<union> instances_ground_fms
+*)
+
+text\<open>One further instance is needed to force $\CH$:\<close>
+
+thm overhead_CH_def
+text\<open>@{thm [display] overhead_CH_def}\<close>
+(*
+overhead_CH \<equiv> overhead \<union> {replacement_dcwit_repl_body_fm}
 *)
 
 thm extensions_of_ctms
 text\<open>@{thm [display] extensions_of_ctms}\<close>
 (*
-M \<approx> \<omega> \<Longrightarrow>
 Transset(M) \<Longrightarrow>
-M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms} \<Longrightarrow>
+M \<Turnstile> \<cdot>Z\<cdot> \<union>
+     {\<cdot>Replacement(p)\<cdot> .
+      p \<in> instances1_fms \<union> instances2_fms \<union> instances_ground_fms} \<Longrightarrow>
 \<Phi> \<subseteq> formula \<Longrightarrow>
 M \<Turnstile> {\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>} \<Longrightarrow>
 \<exists>N. M \<subseteq> N \<and>
     N \<approx> \<omega> \<and>
     Transset(N) \<and>
     M \<noteq> N \<and>
     (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N) \<and>
-    ((M, [] \<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and>
-    N \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}
+    ((M, [] \<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and> N \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}
 *)
 
 thm ctm_of_not_CH
 text\<open>@{thm [display] ctm_of_not_CH}\<close>
 (*
 M \<approx> \<omega> \<Longrightarrow>
 Transset(M) \<Longrightarrow>
 M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<Longrightarrow>
 \<Phi> \<subseteq> formula \<Longrightarrow>
 M \<Turnstile> {\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>} \<Longrightarrow>
 \<exists>N. M \<subseteq> N \<and>
     N \<approx> \<omega> \<and>
     Transset(N) \<and>
     N \<Turnstile> ZC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
-    (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)*)
+    (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
+*)
 
 thm ctm_of_CH
 text\<open>@{thm [display] ctm_of_CH}\<close>
 (*
 M \<approx> \<omega> \<Longrightarrow>
 Transset(M) \<Longrightarrow>
-M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<Longrightarrow>
+M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH} \<Longrightarrow>
 \<Phi> \<subseteq> formula \<Longrightarrow>
 M \<Turnstile> {\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>} \<Longrightarrow>
 \<exists>N. M \<subseteq> N \<and>
     N \<approx> \<omega> \<and>
     Transset(N) \<and>
     N \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>} \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
     (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
 *)
 
-txt\<open>In the above three statements, the function \<^term>\<open>ground_repl_fm\<close>
-takes an element \<^term>\<open>\<phi>\<close>of \<^term>\<open>formula\<close> and returns the
+text\<open>In the above three statements, the function \<^term>\<open>ground_repl_fm\<close>
+takes an element \<^term>\<open>\<phi>\<close> of \<^term>\<open>formula\<close> and returns the
 replacement instance in the ground model that produces the
 \<^term>\<open>\<phi>\<close>-replacement instance in the generic extension. The next
 result is stated in the context \<^locale>\<open>G_generic1\<close>, which assumes
 the existence of a generic filter.\<close>
 
 context G_generic1
 begin
 
 thm sats_ground_repl_fm_imp_sats_ZF_replacement_fm
 text\<open>@{thm [display] sats_ground_repl_fm_imp_sats_ZF_replacement_fm}\<close>
 (*
-\<phi> \<in> formula \<Longrightarrow> M, [] \<Turnstile> \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> \<Longrightarrow> M[G], [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>
+  \<phi> \<in> formula \<Longrightarrow>
+  M, [] \<Turnstile> \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> \<Longrightarrow> M[G], [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>
 *)
 
 end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Demonstrations.thy b/thys/Independence_CH/Demonstrations.thy
--- a/thys/Independence_CH/Demonstrations.thy
+++ b/thys/Independence_CH/Demonstrations.thy
@@ -1,166 +1,168 @@
 section\<open>Some demonstrations\<close>
 
 theory Demonstrations
   imports
     Definitions_Main
 begin
 
-txt\<open>The following theory is only intended to explore some details of the
+text\<open>The following theory is only intended to explore some details of the
 formalization and to show the appearance of relevant internalized formulas.
 It is \<^bold>\<open>not\<close> intended as the entry point of the session. For that purpose,
 consult \<^theory>\<open>Independence_CH.Definitions_Main\<close>\<close>
 
 locale Demo = M_trivial + M_AC +
   fixes t\<^sub>1 t\<^sub>2
   assumes
     ts_in_nat[simp]: "t\<^sub>1\<in>\<omega>" "t\<^sub>2\<in>\<omega>"
     and
     power_infty: "power_ax(M)" "M(\<omega>)"
 begin
 
-txt\<open>The next fake lemma is intended to explore the instances of the axiom
+text\<open>The next fake lemma is intended to explore the instances of the axiom
 schemes that are needed to build our forcing models. They are categorized as
-plain replacements (using \<^term>\<open>strong_replacement\<close>), “lambda-replacements” with
+plain replacements (using \<^term>\<open>strong_replacement\<close>), “lambda-replacements”
 using a higher order function, replacements  to perform
 transfinite and general well-founded recursion (using \<^term>\<open>transrec_replacement\<close> and
 \<^term>\<open>wfrec_replacement\<close> respectively) and for the construction of fixpoints
 (using \<^term>\<open>iterates_replacement\<close>). Lastly, separations instances.\<close>
 
 lemma
   assumes
     sorried_replacements:
     "\<And>P. strong_replacement(M,P)"
     "\<And>F. lam_replacement(M,F)"
     "\<And>Q S. iterates_replacement(M,Q,S)"
     "\<And>Q S. wfrec_replacement(M,Q,S)"
     "\<And>Q S. transrec_replacement(M,Q,S)"
     and
-    sorried_separations:
-    "\<And>Q. separation(M,Q)"shows "M_master(M)"
+    sorried_separations: "\<And>Q. separation(M,Q)"
+  shows
+    "M_master(M)"
   apply unfold_locales
                       apply
     (simp_all add:
       sorried_replacements(1-2)
       sorried_separations
       power_infty)
   oops
 
 \<comment> \<open>NOTE: Only for pretty-printing purposes, overrides previous
   fundamental notations\<close>
 no_notation mem (infixl \<open>\<in>\<close> 50)
 no_notation conj  (infixr \<open>\<and>\<close> 35)
 no_notation disj (infixr \<open>\<or>\<close> 30)
 no_notation iff (infixr \<open>\<longleftrightarrow>\<close> 25)
 no_notation imp (infixr \<open>\<longrightarrow>\<close> 25)
 no_notation not (\<open>\<not> _\<close> [40] 40)
 no_notation All (\<open>'(\<forall>_')\<close>)
 no_notation Ex (\<open>'(\<exists>_')\<close>)
 
 no_notation Member (\<open>\<cdot>_ \<in>/ _\<cdot>\<close>)
 no_notation Equal (\<open>\<cdot>_ =/ _\<cdot>\<close>)
 no_notation Nand (\<open>\<cdot>\<not>'(_ \<and>/ _')\<cdot>\<close>)
 no_notation And (\<open>\<cdot>_ \<and>/ _\<cdot>\<close>)
 no_notation Or (\<open>\<cdot>_ \<or>/ _\<cdot>\<close>)
 no_notation Iff (\<open>\<cdot>_ \<leftrightarrow>/ _\<cdot>\<close>)
 no_notation Implies (\<open>\<cdot>_ \<rightarrow>/ _\<cdot>\<close>)
 no_notation Neg (\<open>\<cdot>\<not>_\<cdot>\<close>)
 no_notation Forall (\<open>'(\<cdot>\<forall>(/_)\<cdot>')\<close>)
 no_notation Exists (\<open>'(\<cdot>\<exists>(/_)\<cdot>')\<close>)
 
 notation Member (infixl \<open>\<in>\<close> 50)
 notation Equal (infixl \<open>\<equiv>\<close> 50)
 notation Nand (\<open>\<not>'(_ \<and>/ _')\<close>)
 notation And  (infixr \<open>\<and>\<close> 35)
 notation Or (infixr \<open>\<or>\<close> 30)
 notation Iff (infixr \<open>\<longleftrightarrow>\<close> 25)
 notation Implies (infixr \<open>\<longrightarrow>\<close> 25)
 notation Neg (\<open>\<not> _\<close> [40] 40)
 notation Forall (\<open>'(\<forall>_')\<close>)
 notation Exists (\<open>'(\<exists>_')\<close>)
 
 lemma "forces(t\<^sub>1\<in>t\<^sub>2) = (0 \<in> 1 \<and> forces_mem_fm(1, 2, 0, t\<^sub>1+\<^sub>\<omega>4, t\<^sub>2+\<^sub>\<omega>4))"
   unfolding forces_def by simp
 
 (*
 \<comment> \<open>Prefix abbreviated notation\<close>
 notation Member (\<open>M\<close>)
 notation Equal (\<open>Eq\<close>)
 notation Nand (\<open>Na\<close>)
 notation And  (\<open>A\<close>)
 notation Or (\<open>O\<close>)
 notation Iff (\<open>If\<close>)
 notation Implies (\<open>Im\<close>)
 notation Neg (\<open>Ne\<close>)
 notation Forall (\<open>Fo\<close>)
 notation Exists (\<open>Ex\<close>)
 *)
 
 (* forces_mem_fm(1, 2, 0, t\<^sub>1+\<^sub>\<omega>4, t\<^sub>1+\<^sub>\<omega>4)
    = forces_mem_fm(1, 2, 0, succ(succ(succ(succ(t\<^sub>1)))), succ(succ(succ(succ(t\<^sub>2)))))
    = \<dots> *)
 
 definition forces_0_mem_1 where "forces_0_mem_1\<equiv>forces_mem_fm(1,2,0,t\<^sub>1+\<^sub>\<omega>4,t\<^sub>2+\<^sub>\<omega>4)"
 thm forces_0_mem_1_def[
     unfolded frc_at_fm_def ftype_fm_def
     name1_fm_def name2_fm_def snd_snd_fm_def hcomp_fm_def
     ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def
     is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
     is_If_fm_def least_fm_def Replace_fm_def Collect_fm_def
     fm_definitions,simplified]
   (* NOTE: in view of the above, @{thm fm_definitions} might be incomplete *)
 
 named_theorems incr_bv_new_simps
 
 schematic_goal incr_bv_Neg(* [incr_bv_new_simps] *):
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow> incr_bv(Neg(\<phi>))`n = ?x"
   unfolding Neg_def by simp
 
 schematic_goal incr_bv_Exists [incr_bv_new_simps]:
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow> incr_bv(Exists(\<phi>))`n = ?x"
   unfolding Exists_def by (simp add: incr_bv_Neg)
 (*
 schematic_goal incr_bv_And [incr_bv_new_simps]:
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(And(\<phi>,\<psi>))`n = ?x"
   unfolding And_def by (simp add: incr_bv_Neg)
 
 schematic_goal incr_bv_Or [incr_bv_new_simps]:
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(Or(\<phi>,\<psi>))`n = ?x"
   unfolding Or_def by (simp add: incr_bv_Neg)
 
 schematic_goal incr_bv_Implies [incr_bv_new_simps]:
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(Implies(\<phi>,\<psi>))`n = ?x"
   unfolding Implies_def by (simp add: incr_bv_Neg)
 *)
 
 \<comment> \<open>The two renamings involved in the definition of \<^term>\<open>forces\<close> depend on
 the recursive function \<^term>\<open>incr_bv\<close>. Here we have an apparently
 exponential bottleneck, since all the propositional connectives (even \<^term>\<open>Neg\<close>)
 duplicate the appearances of \<^term>\<open>incr_bv\<close>.
 
-Not even the double negation of an atomic formula can be managed by the system.\<close>
+Not even the double negation of an atomic formula can be managed by the
+system (in version 2021-1).\<close>
 (* 
 
 schematic_goal "forces(\<not>\<not>0\<in>1) = ?x"
   unfolding forces_def Neg_def
    by (simp add:ren_forces_nand_def ren_forces_forall_def 
       frc_at_fm_def ftype_fm_def
       name1_fm_def name2_fm_def snd_snd_fm_def hcomp_fm_def
       ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def
       is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
       is_If_fm_def least_fm_def Collect_fm_def
       fm_definitions incr_bv_Neg incr_bv_Exists)
 (* exception Size raised (line 183 of "./basis/LibrarySupport.sml") *)
 
 *)
 
 (*
 declare is_ContHyp_fm_def[fm_definitions del]
 
 thm is_ContHyp_fm_def[unfolded is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
    is_If_fm_def least_fm_def Replace_fm_def Collect_fm_def
    fm_definitions, simplified] *)
 
 end \<comment> \<open>\<^locale>\<open>Demo\<close>\<close>
 
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Edrel.thy b/thys/Independence_CH/Edrel.thy
--- a/thys/Independence_CH/Edrel.thy
+++ b/thys/Independence_CH/Edrel.thy
@@ -1,257 +1,255 @@
 theory Edrel
   imports
     Transitive_Models.ZF_Miscellanea
     Transitive_Models.Recursion_Thms
 
 begin
 
 subsection\<open>The well-founded relation \<^term>\<open>ed\<close>\<close>
 
 lemma eclose_sing : "x \<in> eclose(a) \<Longrightarrow> x \<in> eclose({a})"
   using subsetD[OF mem_eclose_subset]
   by simp
 
 lemma ecloseE :
   assumes  "x \<in> eclose(A)"
   shows  "x \<in> A \<or> (\<exists> B \<in> A . x \<in> eclose(B))"
   using assms
 proof (induct rule:eclose_induct_down)
   case (1 y)
   then
   show ?case
     using arg_into_eclose by auto
 next
   case (2 y z)
   from \<open>y \<in> A \<or> (\<exists>B\<in>A. y \<in> eclose(B))\<close>
   consider (inA) "y \<in> A" | (exB) "(\<exists>B\<in>A. y \<in> eclose(B))"
     by auto
   then show ?case
   proof (cases)
     case inA
     then
     show ?thesis using 2 arg_into_eclose by auto
   next
     case exB
     then obtain B where "y \<in> eclose(B)" "B\<in>A"
       by auto
     then
     show ?thesis using 2 ecloseD[of y B z] by auto
   qed
 qed
 
 lemma eclose_singE : "x \<in> eclose({a}) \<Longrightarrow> x = a \<or> x \<in> eclose(a)"
   by(blast dest: ecloseE)
 
 lemma in_eclose_sing :
   assumes "x \<in> eclose({a})" "a \<in> eclose(z)"
   shows "x \<in> eclose({z})"
 proof -
   from \<open>x\<in>eclose({a})\<close>
   consider "x=a" | "x\<in>eclose(a)"
     using eclose_singE by auto
   then
   show ?thesis
     using eclose_sing mem_eclose_trans assms
     by (cases, auto)
 qed
 
 lemma in_dom_in_eclose :
   assumes "x \<in> domain(z)"
   shows "x \<in> eclose(z)"
 proof -
   from assms
   obtain y where "\<langle>x,y\<rangle> \<in> z"
     unfolding domain_def by auto
   then
   show ?thesis
     unfolding Pair_def
     using ecloseD[of "{x,x}"] ecloseD[of "{{x,x},{x,y}}"] arg_into_eclose
     by auto
 qed
 
 text\<open>term\<open>ed\<close> is the well-founded relation on which \<^term>\<open>val\<close> is defined.\<close>
-definition
-  ed :: "[i,i] \<Rightarrow> o" where
+definition ed :: "[i,i] \<Rightarrow> o" where
   "ed(x,y) \<equiv> x \<in> domain(y)"
 
-definition
-  edrel :: "i \<Rightarrow> i" where
+definition edrel :: "i \<Rightarrow> i" where
   "edrel(A) \<equiv> Rrel(ed,A)"
 
 lemma edI[intro!]: "t\<in>domain(x) \<Longrightarrow> ed(t,x)"
   unfolding ed_def .
 
 lemma edD[dest!]: "ed(t,x) \<Longrightarrow> t\<in>domain(x)"
   unfolding ed_def .
 
 lemma rank_ed:
   assumes "ed(y,x)"
   shows "succ(rank(y)) \<le> rank(x)"
 proof
   from assms
   obtain p where "\<langle>y,p\<rangle>\<in>x" by auto
   moreover
   obtain s where "y\<in>s" "s\<in>\<langle>y,p\<rangle>" unfolding Pair_def by auto
   ultimately
   have "rank(y) < rank(s)" "rank(s) < rank(\<langle>y,p\<rangle>)" "rank(\<langle>y,p\<rangle>) < rank(x)"
     using rank_lt by blast+
   then
   show "rank(y) < rank(x)"
     using lt_trans by blast
 qed
 
-lemma edrel_dest [dest]: "x \<in> edrel(A) \<Longrightarrow> \<exists> a\<in> A. \<exists> b \<in> A. x =\<langle>a,b\<rangle>"
+lemma edrel_dest [dest]: "x \<in> edrel(A) \<Longrightarrow> \<exists> a \<in> A. \<exists> b \<in> A. x =\<langle>a,b\<rangle>"
   by(auto simp add:ed_def edrel_def Rrel_def)
 
 lemma edrelD : "x \<in> edrel(A) \<Longrightarrow> \<exists> a\<in> A. \<exists> b \<in> A. x =\<langle>a,b\<rangle> \<and> a \<in> domain(b)"
   by(auto simp add:ed_def edrel_def Rrel_def)
 
 lemma edrelI [intro!]: "x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x \<in> domain(y) \<Longrightarrow> \<langle>x,y\<rangle>\<in>edrel(A)"
   by (simp add:ed_def edrel_def Rrel_def)
 
 lemma edrel_trans: "Transset(A) \<Longrightarrow> y\<in>A \<Longrightarrow> x \<in> domain(y) \<Longrightarrow> \<langle>x,y\<rangle>\<in>edrel(A)"
   by (rule edrelI, auto simp add:Transset_def domain_def Pair_def)
 
 lemma domain_trans: "Transset(A) \<Longrightarrow> y\<in>A \<Longrightarrow> x \<in> domain(y) \<Longrightarrow> x\<in>A"
   by (auto simp add: Transset_def domain_def Pair_def)
 
 lemma relation_edrel : "relation(edrel(A))"
   by(auto simp add: relation_def)
 
 lemma field_edrel : "field(edrel(A))\<subseteq>A"
   by blast
 
 lemma edrel_sub_memrel: "edrel(A) \<subseteq> trancl(Memrel(eclose(A)))"
 proof
   let
     ?r="trancl(Memrel(eclose(A)))"
   fix z
   assume "z\<in>edrel(A)"
   then
   obtain x y where "x\<in>A" "y\<in>A" "z=\<langle>x,y\<rangle>" "x\<in>domain(y)"
     using edrelD
     by blast
   moreover from this
   obtain u v where "x\<in>u" "u\<in>v" "v\<in>y"
     unfolding domain_def Pair_def by auto
   moreover from calculation
   have "x\<in>eclose(A)" "y\<in>eclose(A)" "y\<subseteq>eclose(A)"
     using arg_into_eclose Transset_eclose[unfolded Transset_def]
     by simp_all
   moreover from calculation
   have "v\<in>eclose(A)"
     by auto
   moreover from calculation
   have "u\<in>eclose(A)"
     using Transset_eclose[unfolded Transset_def]
     by auto
   moreover from calculation
   have"\<langle>x,u\<rangle>\<in>?r" "\<langle>u,v\<rangle>\<in>?r" "\<langle>v,y\<rangle>\<in>?r"
     by (auto simp add: r_into_trancl)
   moreover from this
   have "\<langle>x,y\<rangle>\<in>?r"
     using trancl_trans[OF _ trancl_trans[of _ v _ y]]
     by simp
   ultimately
   show "z\<in>?r"
     by simp
 qed
 
 lemma wf_edrel : "wf(edrel(A))"
-  using wf_subset [of "trancl(Memrel(eclose(A)))"] edrel_sub_memrel
+  using wf_subset[of "trancl(Memrel(eclose(A)))"] edrel_sub_memrel
     wf_trancl wf_Memrel
   by auto
 
 lemma ed_induction:
   assumes "\<And>x. \<lbrakk>\<And>y.  ed(y,x) \<Longrightarrow> Q(y) \<rbrakk> \<Longrightarrow> Q(x)"
   shows "Q(a)"
 proof(induct rule: wf_induct2[OF wf_edrel[of "eclose({a})"] ,of a "eclose({a})"])
   case 1
   then show ?case using arg_into_eclose by simp
 next
   case 2
   then show ?case using field_edrel .
 next
   case (3 x)
   then
   show ?case
     using assms[of x] edrelI domain_trans[OF Transset_eclose 3(1)] by blast
 qed
 
 lemma dom_under_edrel_eclose: "edrel(eclose({x})) -`` {x} = domain(x)"
 proof(intro equalityI)
   show "edrel(eclose({x})) -`` {x} \<subseteq> domain(x)"
     unfolding edrel_def Rrel_def ed_def
     by auto
 next
   show "domain(x) \<subseteq> edrel(eclose({x})) -`` {x}"
     unfolding edrel_def Rrel_def
     using in_dom_in_eclose eclose_sing arg_into_eclose
     by blast
 qed
 
 lemma ed_eclose : "\<langle>y,z\<rangle> \<in> edrel(A) \<Longrightarrow> y \<in> eclose(z)"
   by(drule edrelD,auto simp add:domain_def in_dom_in_eclose)
 
 lemma tr_edrel_eclose : "\<langle>y,z\<rangle> \<in> edrel(eclose({x}))^+ \<Longrightarrow> y \<in> eclose(z)"
   by(rule trancl_induct,(simp add: ed_eclose mem_eclose_trans)+)
 
 lemma restrict_edrel_eq :
   assumes "z \<in> domain(x)"
   shows "edrel(eclose({x})) \<inter> eclose({z})\<times>eclose({z}) = edrel(eclose({z}))"
 proof(intro equalityI subsetI)
   let ?ec="\<lambda> y . edrel(eclose({y}))"
   let ?ez="eclose({z})"
   let ?rr="?ec(x) \<inter> ?ez \<times> ?ez"
   fix y
   assume "y \<in> ?rr"
   then
   obtain a b where "\<langle>a,b\<rangle> \<in> ?rr" "a \<in> ?ez" "b \<in> ?ez" "\<langle>a,b\<rangle> \<in> ?ec(x)" "y=\<langle>a,b\<rangle>"
     by blast
   moreover from this
   have "a \<in> domain(b)"
     using edrelD by blast
   ultimately
   show "y \<in> edrel(eclose({z}))"
     by blast
 next
   let ?ec="\<lambda> y . edrel(eclose({y}))"
   let ?ez="eclose({z})"
   let ?rr="?ec(x) \<inter> ?ez \<times> ?ez"
   fix y
   assume "y \<in> edrel(?ez)"
   then
   obtain a b where "a \<in> ?ez" "b \<in> ?ez" "y=\<langle>a,b\<rangle>" "a \<in> domain(b)"
     using edrelD by blast
   moreover
   from this assms
   have "z \<in> eclose(x)"
     using in_dom_in_eclose by simp
   moreover
   from assms calculation
   have "a \<in> eclose({x})" "b \<in> eclose({x})"
     using in_eclose_sing by simp_all
   moreover from calculation
   have "\<langle>a,b\<rangle> \<in> edrel(eclose({x}))"
     by blast
   ultimately
   show "y \<in> ?rr"
     by simp
 qed
 
 lemma tr_edrel_subset :
   assumes "z \<in> domain(x)"
   shows   "tr_down(edrel(eclose({x})),z) \<subseteq> eclose({z})"
 proof(intro subsetI)
   let ?r="\<lambda> x . edrel(eclose({x}))"
   fix y
   assume "y \<in> tr_down(?r(x),z)"
   then
   have "\<langle>y,z\<rangle> \<in> ?r(x)^+"
     using tr_downD by simp
   with assms
   show "y \<in> eclose({z})"
     using tr_edrel_eclose eclose_sing by simp
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Fm_Definitions.thy b/thys/Independence_CH/Fm_Definitions.thy
--- a/thys/Independence_CH/Fm_Definitions.thy
+++ b/thys/Independence_CH/Fm_Definitions.thy
@@ -1,1017 +1,1021 @@
 section\<open>Concepts involved in instances of Replacement\<close>
 theory Fm_Definitions
   imports
     Transitive_Models.Renaming_Auto
     Transitive_Models.Aleph_Relative
     FrecR_Arities
 begin
 
-txt\<open>In this theory we put every concept that should be synthesized in a formula
+(* Really, I have no idea why is this needed again. At the end of the
+   imported theories, notation works just fine. *)
+no_notation Aleph (\<open>\<aleph>_\<close> [90] 90)
+
+text\<open>In this theory we put every concept that should be synthesized in a formula
 to have an instance of replacement.
 
 The automatic synthesis of a concept /foo/ requires that every concept used to
 define /foo/ is already synthesized. We try to use our meta-programs to synthesize
 concepts: given the absolute concept /foo/ we relativize in relational form
 obtaining /is\_foo/ and the we synthesize the formula /is\_foo\_fm/.
 The meta-program that synthesizes formulas also produce satisfactions lemmas.
 
 Having one file to collect every formula needed for replacements breaks
 the reading flow: we need to introduce the concept in this theory in order
 to use the meta-programs; moreover there are some concepts for which we prove
 here the satisfaction lemmas manually, while for others we prove them
 on its theory.
 \<close>
 
 declare arity_subset_fm [simp del] arity_ordinal_fm[simp del, arity] arity_transset_fm[simp del]
   FOL_arities[simp del]
 
-txt\<open>Formulas for particular replacement instances\<close>
+synthesize "setdiff" from_definition "setdiff" assuming "nonempty"
+arity_theorem for "setdiff_fm"
+
+synthesize "is_converse" from_definition assuming "nonempty"
+arity_theorem for "is_converse_fm"
+
+relationalize "first_rel" "is_first" external
+synthesize "first_fm" from_definition "is_first" assuming "nonempty"
+
+relationalize "minimum_rel" "is_minimum" external
+definition is_minimum' where
+  "is_minimum'(M,R,X,u) \<equiv> (M(u) \<and> u \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> u \<longrightarrow> a \<in> R) \<and> pair(M, u, v, a))) \<and>
+    (\<exists>x[M].
+        (M(x) \<and> x \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> x \<longrightarrow> a \<in> R) \<and> pair(M, x, v, a))) \<and>
+        (\<forall>y[M]. M(y) \<and> y \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> y \<longrightarrow> a \<in> R) \<and> pair(M, y, v, a)) \<longrightarrow> y = x)) \<or>
+    \<not> (\<exists>x[M]. (M(x) \<and> x \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> x \<longrightarrow> a \<in> R) \<and> pair(M, x, v, a))) \<and>
+               (\<forall>y[M]. M(y) \<and> y \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> y \<longrightarrow> a \<in> R) \<and> pair(M, y, v, a)) \<longrightarrow> y = x)) \<and>
+    empty(M, u)"
+
+synthesize "minimum" from_definition "is_minimum'" assuming "nonempty"
+arity_theorem for "minimum_fm"
+
+lemma is_lambda_iff_sats[iff_sats]:
+  assumes is_F_iff_sats:
+    "!!a0 a1 a2.
+        [|a0\<in>Aa; a1\<in>Aa; a2\<in>Aa|]
+        ==> is_F(a1, a0) \<longleftrightarrow> sats(Aa, is_F_fm, Cons(a0,Cons(a1,Cons(a2,env))))"
+  shows
+    "nth(A, env) = Ab \<Longrightarrow>
+    nth(r, env) = ra \<Longrightarrow>
+    A \<in> nat \<Longrightarrow>
+    r \<in> nat \<Longrightarrow>
+    env \<in> list(Aa) \<Longrightarrow>
+    is_lambda(##Aa, Ab, is_F, ra) \<longleftrightarrow> Aa, env \<Turnstile> lambda_fm(is_F_fm,A, r)"
+  using sats_lambda_fm[OF assms, of A r] by simp
+
+\<comment> \<open>same as @{thm sats_is_wfrec_fm}, but changing length assumptions to
+    \<^term>\<open>0\<close> being in the model\<close>
+lemma sats_is_wfrec_fm':
+  assumes MH_iff_sats:
+    "!!a0 a1 a2 a3 a4.
+        [|a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A; a4\<in>A|]
+        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
+  shows
+    "[|x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A); 0 \<in> A|]
+       ==> sats(A, is_wfrec_fm(p,x,y,z), env) \<longleftrightarrow>
+           is_wfrec(##A, MH, nth(x,env), nth(y,env), nth(z,env))"
+  using MH_iff_sats [THEN iff_sym] nth_closed sats_is_recfun_fm
+  by (simp add: is_wfrec_fm_def is_wfrec_def) blast
+
+lemma is_wfrec_iff_sats'[iff_sats]:
+  assumes MH_iff_sats:
+    "!!a0 a1 a2 a3 a4.
+        [|a0\<in>Aa; a1\<in>Aa; a2\<in>Aa; a3\<in>Aa; a4\<in>Aa|]
+        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
+    "nth(x, env) = xx" "nth(y, env) = yy" "nth(z, env) = zz"
+    "x \<in> nat" "y \<in> nat" "z \<in> nat" "env \<in> list(Aa)" "0 \<in> Aa"
+  shows
+    "is_wfrec(##Aa, MH, xx, yy, zz) \<longleftrightarrow> Aa, env \<Turnstile> is_wfrec_fm(p,x,y,z)"
+  using assms(2-4) sats_is_wfrec_fm'[OF assms(1,5-9)] by simp
+
+lemma is_wfrec_on_iff_sats[iff_sats]:
+  assumes MH_iff_sats:
+    "!!a0 a1 a2 a3 a4.
+        [|a0\<in>Aa; a1\<in>Aa; a2\<in>Aa; a3\<in>Aa; a4\<in>Aa|]
+        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
+  shows
+    "nth(x, env) = xx \<Longrightarrow>
+    nth(y, env) = yy \<Longrightarrow>
+    nth(z, env) = zz \<Longrightarrow>
+    x \<in> nat \<Longrightarrow>
+    y \<in> nat \<Longrightarrow>
+    z \<in> nat \<Longrightarrow>
+    env \<in> list(Aa) \<Longrightarrow>
+    0 \<in> Aa \<Longrightarrow> is_wfrec_on(##Aa, MH, aa,xx, yy, zz) \<longleftrightarrow> Aa, env \<Turnstile> is_wfrec_fm(p,x,y,z)"
+  using assms sats_is_wfrec_fm'[OF assms] unfolding is_wfrec_on_def by simp
+
+text\<open>Formulas for particular replacement instances\<close>
 
 text\<open>Now we introduce some definitions used in the definition of check; which
 is defined by well-founded recursion using replacement in the recursive call.\<close>
 
 \<comment> \<open>The well-founded relation for defining check.\<close>
 definition
   rcheck :: "i \<Rightarrow> i" where
   "rcheck(x) \<equiv> Memrel(eclose({x}))^+"
 
 relativize "rcheck" "is_rcheck"
 synthesize "is_rcheck" from_definition
 arity_theorem for "is_rcheck_fm"
 
 \<comment> \<open>The function used for the replacement.\<close>
 definition
   PHcheck :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
   "PHcheck(M,o,f,y,p) \<equiv> M(p) \<and> (\<exists>fy[M]. fun_apply(M,f,y,fy) \<and> pair(M,fy,o,p))"
 
 synthesize "PHcheck" from_definition assuming "nonempty"
 arity_theorem for "PHcheck_fm"
 
 \<comment> \<open>The recursive call for check. We could use the meta-program relationalize for
 this; but it makes some proofs more involved.\<close>
 definition
   is_Hcheck :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
   "is_Hcheck(M,o,z,f,hc)  \<equiv> is_Replace(M,z,PHcheck(M,o,f),hc)"
 
 synthesize "is_Hcheck" from_definition assuming "nonempty"
 
 lemma arity_is_Hcheck_fm:
   assumes "m\<in>nat" "n\<in>nat" "p\<in>nat" "o\<in>nat"
   shows "arity(is_Hcheck_fm(m,n,p,o)) = succ(o) \<union> succ(n) \<union> succ(p) \<union> succ(m) "
   unfolding is_Hcheck_fm_def
   using assms arity_Replace_fm[rule_format,OF PHcheck_fm_type _ _ _ arity_PHcheck_fm]
     pred_Un_distrib Un_assoc Un_nat_type
   by simp
 
 \<comment> \<open>The relational version of check is hand-made because our automatic tool
 does not handle \<^term>\<open>wfrec\<close>.\<close>
 definition
   is_check :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
   "is_check(M,o,x,z) \<equiv> \<exists>rch[M]. is_rcheck(M,x,rch) \<and>
       is_wfrec(M,is_Hcheck(M,o),rch,x,z)"
 
 \<comment> \<open>Finally, we internalize the formula.\<close>
 definition
   check_fm :: "[i,i,i] \<Rightarrow> i" where
-  "check_fm(x,o,z) \<equiv> Exists(And(is_rcheck_fm(1+\<^sub>\<omega>x,0),
+  "check_fm(o,x,z) \<equiv> Exists(And(is_rcheck_fm(1+\<^sub>\<omega>x,0),
                       is_wfrec_fm(is_Hcheck_fm(6+\<^sub>\<omega>o,2,1,0),0,1+\<^sub>\<omega>x,1+\<^sub>\<omega>z)))"
 
 lemma check_fm_type[TC]: "x\<in>nat \<Longrightarrow> o\<in>nat \<Longrightarrow> z\<in>nat \<Longrightarrow> check_fm(x,o,z) \<in> formula"
   by (simp add:check_fm_def)
 
 lemma sats_check_fm :
   assumes
     "o\<in>nat" "x\<in>nat" "z\<in>nat" "env\<in>list(M)" "0\<in>M"
   shows
-    "(M , env \<Turnstile> check_fm(x,o,z)) \<longleftrightarrow> is_check(##M,nth(o,env),nth(x,env),nth(z,env))"
+    "(M , env \<Turnstile> check_fm(o,x,z)) \<longleftrightarrow> is_check(##M,nth(o,env),nth(x,env),nth(z,env))"
 proof -
   have sats_is_Hcheck_fm:
     "\<And>a0 a1 a2 a3 a4 a6. \<lbrakk> a0\<in>M; a1\<in>M; a2\<in>M; a3\<in>M; a4\<in>M;a6 \<in>M\<rbrakk> \<Longrightarrow>
          is_Hcheck(##M,a6,a2, a1, a0) \<longleftrightarrow>
          (M , [a0,a1,a2,a3,a4,r,a6]@env \<Turnstile> is_Hcheck_fm(6,2,1,0))" if "r\<in>M" for r
     using that assms
     by simp
   then
   have "(M , [r]@env \<Turnstile> is_wfrec_fm(is_Hcheck_fm(6+\<^sub>\<omega>o,2,1,0),0,1+\<^sub>\<omega>x,1+\<^sub>\<omega>z))
         \<longleftrightarrow> is_wfrec(##M,is_Hcheck(##M,nth(o,env)),r,nth(x,env),nth(z,env))"
     if "r\<in>M" for r
     using that assms is_wfrec_iff_sats'[symmetric]
     by simp
   then
   show ?thesis
     unfolding is_check_def check_fm_def
     using assms is_rcheck_iff_sats[symmetric]
     by simp
 qed
 
 lemma iff_sats_check_fm[iff_sats] :
   assumes
     "nth(o, env) = oa" "nth(x, env) = xa" "nth(z, env) = za" "o \<in> nat" "x \<in> nat" "z \<in> nat" "env \<in> list(A)" "0 \<in> A"
-  shows "is_check(##A, oa,xa, za) \<longleftrightarrow> A, env \<Turnstile> check_fm(x,o, z)"
+  shows "is_check(##A, oa,xa, za) \<longleftrightarrow> A, env \<Turnstile> check_fm(o,x,z)"
   using assms sats_check_fm[symmetric]
   by auto
 
 lemma arity_check_fm[arity]:
   assumes "m\<in>nat" "n\<in>nat" "o\<in>nat"
   shows "arity(check_fm(m,n,o)) = succ(o) \<union> succ(n) \<union> succ(m) "
   unfolding check_fm_def
   using assms arity_is_wfrec_fm[rule_format,OF _ _ _ _ _ arity_is_Hcheck_fm]
     pred_Un_distrib Un_assoc arity_tran_closure_fm
   by (auto simp add:arity)
 
 notation check_fm (\<open>\<cdot>_\<^sup>v_ is _\<cdot>\<close>)
 
-subsection\<open>Names for forcing the Axiom of Choice.\<close>
-definition
-  upair_name :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
-  "upair_name(\<tau>,\<rho>,on) \<equiv> Upair(\<langle>\<tau>,on\<rangle>,\<langle>\<rho>,on\<rangle>)"
-
-relativize "upair_name" "is_upair_name"
-synthesize "upair_name" from_definition "is_upair_name"
-arity_theorem for "upair_name_fm"
-
-definition
-  opair_name :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
-  "opair_name(\<tau>,\<rho>,on) \<equiv> upair_name(upair_name(\<tau>,\<tau>,on),upair_name(\<tau>,\<rho>,on),on)"
-
-relativize "opair_name" "is_opair_name"
-synthesize "opair_name" from_definition "is_opair_name"
-arity_theorem for "opair_name_fm"
-
-definition
-  is_opname_check :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
-  "is_opname_check(M,on,s,x,y) \<equiv> \<exists>chx[M]. \<exists>sx[M]. is_check(M,on,x,chx) \<and>
-        fun_apply(M,s,x,sx) \<and> is_opair_name(M,chx,sx,on,y)"
-
-synthesize "is_opname_check" from_definition assuming "nonempty"
-arity_theorem for "is_opname_check_fm"
-
 \<comment> \<open>The pair of elements belongs to some set. The intended set is the preorder.\<close>
 definition
   is_leq :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
   "is_leq(A,l,q,p) \<equiv> \<exists>qp[A]. (pair(A,q,p,qp) \<and> qp\<in>l)"
 
 synthesize "is_leq" from_definition assuming "nonempty"
 arity_theorem for "is_leq_fm"
 
 abbreviation
   fm_leq :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_\<preceq>\<^bsup>_\<^esup>_\<cdot>\<close>) where
   "fm_leq(A,l,B) \<equiv> is_leq_fm(l,A,B)"
 
 subsection\<open>Formulas used to prove some generic instances.\<close>
 
 definition \<rho>_repl :: "i\<Rightarrow>i" where
   "\<rho>_repl(l) \<equiv> rsum({\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>}, id(l), 2, 3, l)"
 
 lemma f_type : "{\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>} \<in> 2 \<rightarrow> 3"
   using Pi_iff unfolding function_def by auto
 
 \<comment> \<open>thm\<open>Internalize.sum_type\<close> clashes with thm\<open>Renaming.sum_type\<close>.\<close>
 hide_fact Internalize.sum_type
 
 lemma ren_type :
   assumes "l\<in>nat"
   shows "\<rho>_repl(l) : 2+\<^sub>\<omega>l \<rightarrow> 3+\<^sub>\<omega>l"
   using sum_type[of 2 3 l l "{\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>}" "id(l)"] f_type assms id_type
   unfolding \<rho>_repl_def by auto
 
 definition Lambda_in_M_fm where [simp]:"Lambda_in_M_fm(\<phi>,len) \<equiv>
   \<cdot>(\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and>
    ren(\<phi>) ` (2 +\<^sub>\<omega> len) ` (3 +\<^sub>\<omega> len) ` \<rho>_repl(len) \<cdot>\<cdot>) \<and> \<cdot>0 \<in> len +\<^sub>\<omega> 2\<cdot>\<cdot>"
 
 lemma Lambda_in_M_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> len\<in>nat \<Longrightarrow> Lambda_in_M_fm(\<phi>,len) \<in>formula"
   using ren_tc[of \<phi> "2+\<^sub>\<omega>len" "3+\<^sub>\<omega>len" "\<rho>_repl(len)"] ren_type
   unfolding Lambda_in_M_fm_def
   by simp
 
 definition \<rho>_pair_repl :: "i\<Rightarrow>i" where
   "\<rho>_pair_repl(l) \<equiv> rsum({\<langle>0, 0\<rangle>, \<langle>1, 1\<rangle>, \<langle>2, 3\<rangle>}, id(l), 3, 4, l)"
 
 definition LambdaPair_in_M_fm where "LambdaPair_in_M_fm(\<phi>,len) \<equiv>
   \<cdot>(\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and>
              ren((\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>fst(2) is 0\<cdot> \<and> \<cdot>\<cdot>snd(2) is 1\<cdot> \<and> ren(\<phi>) ` (3 +\<^sub>\<omega> len) ` (4 +\<^sub>\<omega> len) ` \<rho>_pair_repl(len) \<cdot>\<cdot>\<cdot>)\<cdot>)) ` (2 +\<^sub>\<omega> len) `
              (3 +\<^sub>\<omega> len) `
              \<rho>_repl(len) \<cdot>\<cdot>) \<and>
           \<cdot>0 \<in> len +\<^sub>\<omega> 2\<cdot>\<cdot> "
 
 lemma f_type' : "{\<langle>0,0 \<rangle>, \<langle>1, 1\<rangle>, \<langle>2, 3\<rangle>} \<in> 3 \<rightarrow> 4"
   using Pi_iff unfolding function_def by auto
 
 lemma ren_type' :
   assumes "l\<in>nat"
   shows "\<rho>_pair_repl(l) : 3+\<^sub>\<omega>l \<rightarrow> 4+\<^sub>\<omega>l"
   using sum_type[of 3 4 l l "{\<langle>0, 0\<rangle>, \<langle>1, 1\<rangle>, \<langle>2, 3\<rangle>}" "id(l)"] f_type' assms id_type
   unfolding \<rho>_pair_repl_def by auto
 
 lemma LambdaPair_in_M_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> len\<in>nat \<Longrightarrow> LambdaPair_in_M_fm(\<phi>,len) \<in>formula"
   using ren_tc[OF _ _ _ ren_type',of \<phi> "len"] Lambda_in_M_fm_type
   unfolding LambdaPair_in_M_fm_def
   by simp
 
 subsection\<open>The relation \<^term>\<open>frecrel\<close>\<close>
 
 definition
   frecrelP :: "[i\<Rightarrow>o,i] \<Rightarrow> o" where
   "frecrelP(M,xy) \<equiv> (\<exists>x[M]. \<exists>y[M]. pair(M,x,y,xy) \<and> is_frecR(M,x,y))"
 
 synthesize "frecrelP" from_definition
 arity_theorem for "frecrelP_fm"
 
 definition
   is_frecrel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
   "is_frecrel(M,A,r) \<equiv> \<exists>A2[M]. cartprod(M,A,A,A2) \<and> is_Collect(M,A2, frecrelP(M) ,r)"
 
 synthesize "frecrel" from_definition "is_frecrel"
 arity_theorem for "frecrel_fm"
 
 definition
   names_below :: "i \<Rightarrow> i \<Rightarrow> i" where
   "names_below(P,x) \<equiv> 2\<times>ecloseN(x)\<times>ecloseN(x)\<times>P"
 
 lemma names_belowsD:
   assumes "x \<in> names_below(P,z)"
   obtains f n1 n2 p where
     "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
   using assms unfolding names_below_def by auto
 
 synthesize "number2" from_definition
 
 lemma number2_iff :
   "(A)(c) \<Longrightarrow> number2(A,c) \<longleftrightarrow> (\<exists>b[A]. \<exists>a[A]. successor(A, b, c) \<and> successor(A, a, b) \<and> empty(A, a))"
   unfolding number2_def number1_def by auto
 arity_theorem for "number2_fm"
 
 reldb_add "ecloseN" "is_ecloseN"
 relativize "names_below" "is_names_below"
 synthesize "is_names_below" from_definition
 arity_theorem for "is_names_below_fm"
 
 definition
   is_tuple :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "is_tuple(M,z,t1,t2,p,t) \<equiv> \<exists>t1t2p[M]. \<exists>t2p[M]. pair(M,t2,p,t2p) \<and> pair(M,t1,t2p,t1t2p) \<and>
                                                   pair(M,z,t1t2p,t)"
 
 synthesize "is_tuple" from_definition
 arity_theorem for "is_tuple_fm"
 
 subsection\<open>Definition of Forces\<close>
 
 subsubsection\<open>Definition of \<^term>\<open>forces\<close> for equality and membership\<close>
-text\<open>$p\forces \tau = \theta$ if every $q\leqslant p$ both $q\forces \sigma \in \tau$
-and $q\forces \sigma \in \theta$ for every $\sigma \in \dom(\tau)\cup \dom(\theta)$.\<close>
+text\<open>$p\forces \tau = \theta$ if for every $q\leqslant p$ both $q\forces \sigma \in \tau$
+and $q\forces \sigma \in \theta$ hold for all $\sigma \in \dom(\tau)\cup \dom(\theta)$.\<close>
 definition
   eq_case :: "[i,i,i,i,i,i] \<Rightarrow> o" where
   "eq_case(\<tau>,\<theta>,p,P,leq,f) \<equiv> \<forall>\<sigma>. \<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<longrightarrow>
       (\<forall>q. q\<in>P \<and> \<langle>q,p\<rangle>\<in>leq \<longrightarrow> (f`\<langle>1,\<sigma>,\<tau>,q\<rangle>=1  \<longleftrightarrow> f`\<langle>1,\<sigma>,\<theta>,q\<rangle> =1))"
 
 relativize "eq_case" "is_eq_case"
 synthesize "eq_case" from_definition "is_eq_case"
 
 text\<open>$p\forces \tau \in \theta$ if for every $v\leqslant p$
-  there exists $q$, $r$, and $\sigma$ such that
+  there exist $q$, $r$, and $\sigma$ such that
   $v\leqslant q$, $q\leqslant r$, $\langle \sigma,r\rangle \in \tau$, and
   $q\forces \pi = \sigma$.\<close>
 definition
   mem_case :: "[i,i,i,i,i,i] \<Rightarrow> o" where
   "mem_case(\<tau>,\<theta>,p,P,leq,f) \<equiv> \<forall>v\<in>P. \<langle>v,p\<rangle>\<in>leq \<longrightarrow>
     (\<exists>q. \<exists>\<sigma>. \<exists>r. r\<in>P \<and> q\<in>P \<and> \<langle>q,v\<rangle>\<in>leq \<and> \<langle>\<sigma>,r\<rangle> \<in> \<theta> \<and> \<langle>q,r\<rangle>\<in>leq \<and>  f`\<langle>0,\<tau>,\<sigma>,q\<rangle> = 1)"
 
 relativize "mem_case" "is_mem_case"
 synthesize "mem_case" from_definition "is_mem_case"
 arity_theorem intermediate for "eq_case_fm"
 lemma arity_eq_case_fm[arity]:
   assumes
     "n1\<in>nat" "n2\<in>nat" "p\<in>nat" "P\<in>nat" "leq\<in>nat" "f\<in>nat"
   shows
     "arity(eq_case_fm(n1,n2,p,P,leq,f)) =
     succ(n1) \<union> succ(n2) \<union> succ(p) \<union> succ(P) \<union> succ(leq) \<union> succ(f)"
   using assms arity_eq_case_fm'
   by auto
 
 arity_theorem intermediate for "mem_case_fm"
 lemma arity_mem_case_fm[arity] :
   assumes
     "n1\<in>nat" "n2\<in>nat" "p\<in>nat" "P\<in>nat" "leq\<in>nat" "f\<in>nat"
   shows
     "arity(mem_case_fm(n1,n2,p,P,leq,f)) =
     succ(n1) \<union> succ(n2) \<union> succ(p) \<union> succ(P) \<union> succ(leq) \<union> succ(f)"
   using assms arity_mem_case_fm'
   by auto
 
 definition
   Hfrc :: "[i,i,i,i] \<Rightarrow> o" where
   "Hfrc(P,leq,fnnc,f) \<equiv> \<exists>ft. \<exists>\<tau>. \<exists>\<theta>. \<exists>p. p\<in>P \<and> fnnc = \<langle>ft,\<tau>,\<theta>,p\<rangle> \<and>
      (  ft = 0 \<and>  eq_case(\<tau>,\<theta>,p,P,leq,f)
       \<or> ft = 1 \<and> mem_case(\<tau>,\<theta>,p,P,leq,f))"
 
 relativize "Hfrc" "is_Hfrc"
 synthesize "Hfrc" from_definition "is_Hfrc"
 
 definition
   is_Hfrc_at :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "is_Hfrc_at(M,P,leq,fnnc,f,b) \<equiv>
             (empty(M,b) \<and> \<not> is_Hfrc(M,P,leq,fnnc,f))
           \<or> (number1(M,b) \<and> is_Hfrc(M,P,leq,fnnc,f))"
 
 synthesize "Hfrc_at" from_definition "is_Hfrc_at"
 arity_theorem intermediate for "Hfrc_fm"
 
 lemma arity_Hfrc_fm[arity] :
   assumes
     "P\<in>nat" "leq\<in>nat" "fnnc\<in>nat" "f\<in>nat"
   shows
     "arity(Hfrc_fm(P,leq,fnnc,f)) = succ(P) \<union> succ(leq) \<union> succ(fnnc) \<union> succ(f)"
   using assms arity_Hfrc_fm'
   by auto
 
 arity_theorem for "Hfrc_at_fm"
 
 subsubsection\<open>The well-founded relation \<^term>\<open>forcerel\<close>\<close>
 definition
   forcerel :: "i \<Rightarrow> i \<Rightarrow> i" where
   "forcerel(P,x) \<equiv> frecrel(names_below(P,x))^+"
 
 definition
   is_forcerel :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
   "is_forcerel(M,P,x,z) \<equiv> \<exists>r[M]. \<exists>nb[M]. tran_closure(M,r,z) \<and>
                         (is_names_below(M,P,x,nb) \<and> is_frecrel(M,nb,r))"
 synthesize "is_forcerel" from_definition
 arity_theorem for "is_forcerel_fm"
 
 subsection\<open>\<^term>\<open>frc_at\<close>, forcing for atomic formulas\<close>
 definition
   frc_at :: "[i,i,i] \<Rightarrow> i" where
   "frc_at(P,leq,fnnc) \<equiv> wfrec(frecrel(names_below(P,fnnc)),fnnc,
                               \<lambda>x f. bool_of_o(Hfrc(P,leq,x,f)))"
 
 \<comment> \<open>The relational form is defined manually because it uses \<^term>\<open>wfrec\<close>.\<close>
 definition
   is_frc_at :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
   "is_frc_at(M,P,leq,x,z) \<equiv> \<exists>r[M]. is_forcerel(M,P,x,r) \<and>
                                     is_wfrec(M,is_Hfrc_at(M,P,leq),r,x,z)"
 
 definition
   frc_at_fm :: "[i,i,i,i] \<Rightarrow> i" where
   "frc_at_fm(p,l,x,z) \<equiv> Exists(And(is_forcerel_fm(succ(p),succ(x),0),
           is_wfrec_fm(Hfrc_at_fm(6+\<^sub>\<omega>p,6+\<^sub>\<omega>l,2,1,0),0,succ(x),succ(z))))"
 
 lemma frc_at_fm_type [TC] :
   "\<lbrakk>p\<in>nat;l\<in>nat;x\<in>nat;z\<in>nat\<rbrakk> \<Longrightarrow> frc_at_fm(p,l,x,z)\<in>formula"
   unfolding frc_at_fm_def by simp
 
 lemma arity_frc_at_fm[arity] :
   assumes "p\<in>nat" "l\<in>nat" "x\<in>nat" "z\<in>nat"
   shows "arity(frc_at_fm(p,l,x,z)) = succ(p) \<union> succ(l) \<union> succ(x) \<union> succ(z)"
 proof -
   let ?\<phi> = "Hfrc_at_fm(6 +\<^sub>\<omega> p, 6 +\<^sub>\<omega> l, 2, 1, 0)"
   note assms
   moreover from this
   have  "arity(?\<phi>) = (7+\<^sub>\<omega>p) \<union> (7+\<^sub>\<omega>l)" "?\<phi> \<in> formula"
     using arity_Hfrc_at_fm ord_simp_union
     by auto
   moreover from calculation
   have "arity(is_wfrec_fm(?\<phi>, 0, succ(x), succ(z))) = 2+\<^sub>\<omega>p \<union> (2+\<^sub>\<omega>l) \<union> (2+\<^sub>\<omega>x) \<union> (2+\<^sub>\<omega>z)"
     using arity_is_wfrec_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _ _ \<open>arity(?\<phi>) = _\<close>] pred_Un_distrib pred_succ_eq
       union_abs1
     by auto
   moreover from assms
   have "arity(is_forcerel_fm(succ(p),succ(x),0)) = 2+\<^sub>\<omega>p \<union> (2+\<^sub>\<omega>x)"
     using arity_is_forcerel_fm ord_simp_union
     by auto
   ultimately
   show ?thesis
     unfolding frc_at_fm_def
     using arity_is_forcerel_fm pred_Un_distrib
     by (auto simp:FOL_arities)
 qed
 
 lemma sats_frc_at_fm :
   assumes
     "p\<in>nat" "l\<in>nat" "i\<in>nat" "j\<in>nat" "env\<in>list(A)" "i < length(env)" "j < length(env)"
   shows
     "(A , env \<Turnstile> frc_at_fm(p,l,i,j)) \<longleftrightarrow>
      is_frc_at(##A,nth(p,env),nth(l,env),nth(i,env),nth(j,env))"
 proof -
   {
     fix r pp ll
     assume "r\<in>A"
     have "is_Hfrc_at(##A,nth(p,env),nth(l,env),a2, a1, a0) \<longleftrightarrow>
          (A, [a0,a1,a2,a3,a4,r]@env \<Turnstile> Hfrc_at_fm(6+\<^sub>\<omega>p,6+\<^sub>\<omega>l,2,1,0))"
       if "a0\<in>A" "a1\<in>A" "a2\<in>A" "a3\<in>A" "a4\<in>A" for a0 a1 a2 a3 a4
       using  that assms \<open>r\<in>A\<close>
         Hfrc_at_iff_sats[of "6+\<^sub>\<omega>p" "6+\<^sub>\<omega>l" 2 1 0 "[a0,a1,a2,a3,a4,r]@env" A]  by simp
     with \<open>r\<in>A\<close>
     have "(A,[r]@env \<Turnstile> is_wfrec_fm(Hfrc_at_fm(6+\<^sub>\<omega>p, 6+\<^sub>\<omega>l,2,1,0),0, i+\<^sub>\<omega>1, j+\<^sub>\<omega>1)) \<longleftrightarrow>
          is_wfrec(##A, is_Hfrc_at(##A, nth(p,env), nth(l,env)), r,nth(i, env), nth(j, env))"
       using assms sats_is_wfrec_fm
       by simp
   }
   moreover
   have "(A, Cons(r, env) \<Turnstile> is_forcerel_fm(succ(p), succ(i), 0)) \<longleftrightarrow>
         is_forcerel(##A,nth(p,env),nth(i,env),r)" if "r\<in>A" for r
     using assms sats_is_forcerel_fm that
     by simp
   ultimately
   show ?thesis
     unfolding is_frc_at_def frc_at_fm_def
     using assms
     by simp
 qed
 
 lemma frc_at_fm_iff_sats:
   assumes "nth(i,env) = w" "nth(j,env) = x" "nth(k,env) = y" "nth(l,env) = z"
     "i \<in> nat" "j \<in> nat" "k \<in> nat" "l\<in>nat" "env \<in> list(A)" "k<length(env)" "l<length(env)"
   shows "is_frc_at(##A, w, x, y,z) \<longleftrightarrow> (A , env \<Turnstile> frc_at_fm(i,j,k,l))"
   using assms sats_frc_at_fm
   by simp
 
 declare frc_at_fm_iff_sats [iff_sats]
 
 definition
   forces_eq' :: "[i,i,i,i,i] \<Rightarrow> o" where
   "forces_eq'(P,l,p,t1,t2) \<equiv> frc_at(P,l,\<langle>0,t1,t2,p\<rangle>) = 1"
 
 definition
   forces_mem' :: "[i,i,i,i,i] \<Rightarrow> o" where
   "forces_mem'(P,l,p,t1,t2) \<equiv> frc_at(P,l,\<langle>1,t1,t2,p\<rangle>) = 1"
 
 definition
   forces_neq' :: "[i,i,i,i,i] \<Rightarrow> o" where
   "forces_neq'(P,l,p,t1,t2) \<equiv> \<not> (\<exists>q\<in>P. \<langle>q,p\<rangle>\<in>l \<and> forces_eq'(P,l,q,t1,t2))"
 
 definition
   forces_nmem' :: "[i,i,i,i,i] \<Rightarrow> o" where
   "forces_nmem'(P,l,p,t1,t2) \<equiv> \<not> (\<exists>q\<in>P. \<langle>q,p\<rangle>\<in>l \<and> forces_mem'(P,l,q,t1,t2))"
 
 \<comment> \<open>The following definitions are explicitly defined to avoid the expansion
 of concepts.\<close>
 definition
   is_forces_eq' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "is_forces_eq'(M,P,l,p,t1,t2) \<equiv> \<exists>o[M]. \<exists>z[M]. \<exists>t[M]. number1(M,o) \<and> empty(M,z) \<and>
                                 is_tuple(M,z,t1,t2,p,t) \<and> is_frc_at(M,P,l,t,o)"
 
 definition
   is_forces_mem' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "is_forces_mem'(M,P,l,p,t1,t2) \<equiv> \<exists>o[M]. \<exists>t[M]. number1(M,o) \<and>
                                 is_tuple(M,o,t1,t2,p,t) \<and> is_frc_at(M,P,l,t,o)"
 
 definition
   is_forces_neq' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "is_forces_neq'(M,P,l,p,t1,t2) \<equiv>
       \<not> (\<exists>q[M]. q\<in>P \<and> (\<exists>qp[M]. pair(M,q,p,qp) \<and> qp\<in>l \<and> is_forces_eq'(M,P,l,q,t1,t2)))"
 
 definition
   is_forces_nmem' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "is_forces_nmem'(M,P,l,p,t1,t2) \<equiv>
       \<not> (\<exists>q[M]. \<exists>qp[M]. q\<in>P \<and> pair(M,q,p,qp) \<and> qp\<in>l \<and> is_forces_mem'(M,P,l,q,t1,t2))"
 
 synthesize "forces_eq" from_definition "is_forces_eq'"
 synthesize "forces_mem" from_definition "is_forces_mem'"
 synthesize "forces_neq" from_definition "is_forces_neq'" assuming "nonempty"
 synthesize "forces_nmem" from_definition "is_forces_nmem'" assuming "nonempty"
 
 context
   notes Un_assoc[simp] Un_trasposition_aux2[simp]
 begin
 arity_theorem for "forces_eq_fm"
 arity_theorem for "forces_mem_fm"
 arity_theorem for "forces_neq_fm"
 arity_theorem for "forces_nmem_fm"
 end
 
 subsection\<open>Forcing for general formulas\<close>
 
 definition
   ren_forces_nand :: "i\<Rightarrow>i" where
   "ren_forces_nand(\<phi>) \<equiv> Exists(And(Equal(0,1),iterates(\<lambda>p. incr_bv(p)`1 , 2, \<phi>)))"
 
 lemma ren_forces_nand_type[TC] :
   "\<phi>\<in>formula \<Longrightarrow> ren_forces_nand(\<phi>) \<in>formula"
   unfolding ren_forces_nand_def
   by simp
 
 lemma arity_ren_forces_nand :
   assumes "\<phi>\<in>formula"
   shows "arity(ren_forces_nand(\<phi>)) \<le> succ(arity(\<phi>))"
 proof -
   consider (lt) "1<arity(\<phi>)" | (ge) "\<not> 1 < arity(\<phi>)"
     by auto
   then
   show ?thesis
   proof cases
     case lt
     with \<open>\<phi>\<in>_\<close>
     have "2 < succ(arity(\<phi>))" "2<arity(\<phi>)+\<^sub>\<omega>2"
       using succ_ltI by auto
     with \<open>\<phi>\<in>_\<close>
     have "arity(iterates(\<lambda>p. incr_bv(p)`1,2,\<phi>)) = 2+\<^sub>\<omega>arity(\<phi>)"
       using arity_incr_bv_lemma lt
       by auto
     with \<open>\<phi>\<in>_\<close>
     show ?thesis
       unfolding ren_forces_nand_def
       using lt pred_Un_distrib union_abs1 Un_assoc[symmetric] Un_le_compat
       by (simp add:FOL_arities)
   next
     case ge
     with \<open>\<phi>\<in>_\<close>
     have "arity(\<phi>) \<le> 1" "pred(arity(\<phi>)) \<le> 1"
       using not_lt_iff_le le_trans[OF le_pred]
       by simp_all
     with \<open>\<phi>\<in>_\<close>
     have "arity(iterates(\<lambda>p. incr_bv(p)`1,2,\<phi>)) = (arity(\<phi>))"
       using arity_incr_bv_lemma ge
       by simp
     with \<open>arity(\<phi>) \<le> 1\<close> \<open>\<phi>\<in>_\<close> \<open>pred(_) \<le> 1\<close>
     show ?thesis
       unfolding ren_forces_nand_def
       using  pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
       by (simp add:FOL_arities)
   qed
 qed
 
 lemma sats_ren_forces_nand:
   "[q,P,leq,o,p] @ env \<in> list(M) \<Longrightarrow> \<phi>\<in>formula \<Longrightarrow>
    (M, [q,p,P,leq,o] @ env \<Turnstile> ren_forces_nand(\<phi>)) \<longleftrightarrow> (M, [q,P,leq,o] @ env \<Turnstile> \<phi>)"
   unfolding ren_forces_nand_def
   using sats_incr_bv_iff [of _ _ M _ "[q]"]
   by simp
 
 
 definition
   ren_forces_forall :: "i\<Rightarrow>i" where
   "ren_forces_forall(\<phi>) \<equiv>
       Exists(Exists(Exists(Exists(Exists(
         And(Equal(0,6),And(Equal(1,7),And(Equal(2,8),And(Equal(3,9),
         And(Equal(4,5),iterates(\<lambda>p. incr_bv(p)`5 , 5, \<phi>)))))))))))"
 
 lemma arity_ren_forces_all :
   assumes "\<phi>\<in>formula"
   shows "arity(ren_forces_forall(\<phi>)) = 5 \<union> arity(\<phi>)"
 proof -
   consider (lt) "5<arity(\<phi>)" | (ge) "\<not> 5 < arity(\<phi>)"
     by auto
   then
   show ?thesis
   proof cases
     case lt
     with \<open>\<phi>\<in>_\<close>
     have "5 < succ(arity(\<phi>))" "5<arity(\<phi>)+\<^sub>\<omega>2"  "5<arity(\<phi>)+\<^sub>\<omega>3"  "5<arity(\<phi>)+\<^sub>\<omega>4"
       using succ_ltI by auto
     with \<open>\<phi>\<in>_\<close>
     have "arity(iterates(\<lambda>p. incr_bv(p)`5,5,\<phi>)) = 5+\<^sub>\<omega>arity(\<phi>)"
       using arity_incr_bv_lemma lt
       by simp
     with \<open>\<phi>\<in>_\<close>
     show ?thesis
       unfolding ren_forces_forall_def
       using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
       by (simp add:FOL_arities)
   next
     case ge
     with \<open>\<phi>\<in>_\<close>
     have "arity(\<phi>) \<le> 5" "pred^5(arity(\<phi>)) \<le> 5"
       using not_lt_iff_le le_trans[OF le_pred]
       by simp_all
     with \<open>\<phi>\<in>_\<close>
     have "arity(iterates(\<lambda>p. incr_bv(p)`5,5,\<phi>)) = arity(\<phi>)"
       using arity_incr_bv_lemma ge
       by simp
     with \<open>arity(\<phi>) \<le> 5\<close> \<open>\<phi>\<in>_\<close> \<open>pred^5(_) \<le> 5\<close>
     show ?thesis
       unfolding ren_forces_forall_def
       using  pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
       by (simp add:FOL_arities)
   qed
 qed
 
 lemma ren_forces_forall_type[TC] :
   "\<phi>\<in>formula \<Longrightarrow> ren_forces_forall(\<phi>) \<in>formula"
   unfolding ren_forces_forall_def by simp
 
 lemma sats_ren_forces_forall :
   "[x,P,leq,o,p] @ env \<in> list(M) \<Longrightarrow> \<phi>\<in>formula \<Longrightarrow>
     (M, [x,p,P,leq,o] @ env \<Turnstile> ren_forces_forall(\<phi>)) \<longleftrightarrow> (M, [p,P,leq,o,x] @ env \<Turnstile> \<phi>)"
   unfolding ren_forces_forall_def
   using sats_incr_bv_iff [of _ _ M _ "[p,P,leq,o,x]"]
   by simp
 
 subsubsection\<open>The primitive recursion\<close>
 
 consts forces' :: "i\<Rightarrow>i"
 primrec
   "forces'(Member(x,y)) = forces_mem_fm(1,2,0,x+\<^sub>\<omega>4,y+\<^sub>\<omega>4)"
   "forces'(Equal(x,y))  = forces_eq_fm(1,2,0,x+\<^sub>\<omega>4,y+\<^sub>\<omega>4)"
   "forces'(Nand(p,q))   =
         Neg(Exists(And(Member(0,2),And(is_leq_fm(3,0,1),And(ren_forces_nand(forces'(p)),
                                          ren_forces_nand(forces'(q)))))))"
   "forces'(Forall(p))   = Forall(ren_forces_forall(forces'(p)))"
 
 
 definition
   forces :: "i\<Rightarrow>i" where
   "forces(\<phi>) \<equiv> And(Member(0,1),forces'(\<phi>))"
 
 lemma forces'_type [TC]:  "\<phi>\<in>formula \<Longrightarrow> forces'(\<phi>) \<in> formula"
   by (induct \<phi> set:formula; simp)
 
 lemma forces_type[TC] : "\<phi>\<in>formula \<Longrightarrow> forces(\<phi>) \<in> formula"
   unfolding forces_def by simp
 
 subsection\<open>The arity of \<^term>\<open>forces\<close>\<close>
 
 lemma arity_forces_at:
   assumes  "x \<in> nat" "y \<in> nat"
   shows "arity(forces(Member(x, y))) = (succ(x) \<union> succ(y)) +\<^sub>\<omega> 4"
     "arity(forces(Equal(x, y))) = (succ(x) \<union> succ(y)) +\<^sub>\<omega> 4"
   unfolding forces_def
   using assms arity_forces_mem_fm arity_forces_eq_fm succ_Un_distrib ord_simp_union
   by (auto simp:FOL_arities,(rule_tac le_anti_sym,simp_all,(rule_tac not_le_anti_sym,simp_all))+)
 
 lemma arity_forces':
   assumes "\<phi>\<in>formula"
   shows "arity(forces'(\<phi>)) \<le> arity(\<phi>) +\<^sub>\<omega> 4"
   using assms
 proof (induct set:formula)
   case (Member x y)
   then
   show ?case
     using arity_forces_mem_fm succ_Un_distrib ord_simp_union leI not_le_iff_lt
     by simp
 next
   case (Equal x y)
   then
   show ?case
     using arity_forces_eq_fm succ_Un_distrib ord_simp_union leI not_le_iff_lt
     by simp
 next
   case (Nand \<phi> \<psi>)
   let ?\<phi>' = "ren_forces_nand(forces'(\<phi>))"
   let ?\<psi>' = "ren_forces_nand(forces'(\<psi>))"
   have "arity(is_leq_fm(3, 0, 1)) = 4"
     using arity_is_leq_fm succ_Un_distrib ord_simp_union
     by simp
   have "3 \<le> (4+\<^sub>\<omega>arity(\<phi>)) \<union> (4+\<^sub>\<omega>arity(\<psi>))" (is "_ \<le> ?rhs")
     using ord_simp_union by simp
   from \<open>\<phi>\<in>_\<close> Nand
   have "pred(arity(?\<phi>')) \<le> ?rhs"  "pred(arity(?\<psi>')) \<le> ?rhs"
   proof -
     from \<open>\<phi>\<in>_\<close> \<open>\<psi>\<in>_\<close>
     have A:"pred(arity(?\<phi>')) \<le> arity(forces'(\<phi>))"
       "pred(arity(?\<psi>')) \<le> arity(forces'(\<psi>))"
       using pred_mono[OF _  arity_ren_forces_nand] pred_succ_eq
       by simp_all
     from Nand
     have "3 \<union> arity(forces'(\<phi>)) \<le> arity(\<phi>) +\<^sub>\<omega> 4"
       "3 \<union> arity(forces'(\<psi>)) \<le> arity(\<psi>) +\<^sub>\<omega> 4"
       using Un_le by simp_all
     with Nand
     show "pred(arity(?\<phi>')) \<le> ?rhs"
       "pred(arity(?\<psi>')) \<le> ?rhs"
       using le_trans[OF A(1)] le_trans[OF A(2)] le_Un_iff
       by simp_all
   qed
   with Nand \<open>_=4\<close>
   show ?case
     using pred_Un_distrib Un_assoc[symmetric] succ_Un_distrib union_abs1 Un_leI3[OF \<open>3 \<le> ?rhs\<close>]
     by (simp add:FOL_arities)
 next
   case (Forall \<phi>)
   let ?\<phi>' = "ren_forces_forall(forces'(\<phi>))"
   show ?case
   proof (cases "arity(\<phi>) = 0")
     case True
     with Forall
     show ?thesis
     proof -
       from Forall True
       have "arity(forces'(\<phi>)) \<le> 5"
         using le_trans[of _ 4 5] by auto
       with \<open>\<phi>\<in>_\<close>
       have "arity(?\<phi>') \<le> 5"
         using arity_ren_forces_all[OF forces'_type[OF \<open>\<phi>\<in>_\<close>]] union_abs2
         by auto
       with Forall True
       show ?thesis
         using pred_mono[OF _ \<open>arity(?\<phi>') \<le> 5\<close>]
         by simp
     qed
   next
     case False
     with Forall
     show ?thesis
     proof -
       from Forall False
       have "arity(?\<phi>') = 5 \<union> arity(forces'(\<phi>))"
         "arity(forces'(\<phi>)) \<le> 5 +\<^sub>\<omega> arity(\<phi>)"
         "4 \<le> 3+\<^sub>\<omega>arity(\<phi>)"
         using Ord_0_lt arity_ren_forces_all
           le_trans[OF _ add_le_mono[of 4 5, OF _ le_refl]]
         by auto
       with \<open>\<phi>\<in>_\<close>
       have "5 \<union> arity(forces'(\<phi>)) \<le> 5+\<^sub>\<omega>arity(\<phi>)"
         using ord_simp_union by auto
       with \<open>\<phi>\<in>_\<close> \<open>arity(?\<phi>') = 5 \<union> _\<close>
       show ?thesis
         using pred_Un_distrib succ_pred_eq[OF _ \<open>arity(\<phi>)\<noteq>0\<close>]
           pred_mono[OF _ Forall(2)] Un_le[OF \<open>4\<le>3+\<^sub>\<omega>arity(\<phi>)\<close>]
         by simp
     qed
   qed
 qed
 
 lemma arity_forces :
   assumes "\<phi>\<in>formula"
   shows "arity(forces(\<phi>)) \<le> 4+\<^sub>\<omega>arity(\<phi>)"
   unfolding forces_def
   using assms arity_forces' le_trans ord_simp_union FOL_arities by auto
 
 lemma arity_forces_le :
   assumes "\<phi>\<in>formula" "n\<in>nat" "arity(\<phi>) \<le> n"
   shows "arity(forces(\<phi>)) \<le> 4+\<^sub>\<omega>n"
   using assms le_trans[OF _ add_le_mono[OF le_refl[of 5] \<open>arity(\<phi>)\<le>_\<close>]] arity_forces
   by auto
 
 definition rename_split_fm where
   "rename_split_fm(\<phi>) \<equiv> (\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>snd(9) is 0\<cdot> \<and> \<cdot>\<cdot>fst(9) is 4\<cdot> \<and> \<cdot>\<cdot>1=11\<cdot> \<and>
     \<cdot>\<cdot>2=12\<cdot> \<and> \<cdot>\<cdot>3=13\<cdot> \<and> \<cdot>\<cdot>5=7\<cdot> \<and>
     (\<lambda>p. incr_bv(p)`6)^8(forces(\<phi>)) \<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)"
 
 lemma rename_split_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> rename_split_fm(\<phi>)\<in>formula"
   unfolding rename_split_fm_def by simp
 
 schematic_goal arity_rename_split_fm: "\<phi>\<in>formula \<Longrightarrow> arity(rename_split_fm(\<phi>)) = ?m"
   using arity_forces[of \<phi>] forces_type unfolding rename_split_fm_def
   by (simp add:arity Un_assoc[symmetric] union_abs1)
 
 lemma arity_rename_split_fm_le:
   assumes "\<phi>\<in>formula"
   shows "arity(rename_split_fm(\<phi>)) \<le> 8 \<union> (6 +\<^sub>\<omega> arity(\<phi>))"
 proof -
   from assms
   have arity_forces_6: "\<not> 1 < arity(\<phi>) \<Longrightarrow> 6 \<le> n \<Longrightarrow> arity(forces(\<phi>)) \<le> n" for n
     using le_trans lt_trans[of _ 5 n] not_lt_iff_le[of 1 "arity(\<phi>)"]
     by (auto intro!:le_trans[OF arity_forces])
   have pred1_arity_forces: "\<not> 1 < arity(\<phi>) \<Longrightarrow> pred^n(arity(forces(\<phi>))) \<le> 8" if "n\<in>nat" for n
     using that pred_le[of 7] le_succ[THEN [2] le_trans] arity_forces_6
     by (induct rule:nat_induct) auto
   have arity_forces_le_succ6: "pred^n(arity(forces(\<phi>))) \<le> succ(succ(succ(succ(succ(succ(arity(\<phi>)))))))"
     if "n\<in>nat" for n
     using that assms arity_forces[of \<phi>, THEN le_trans,
         OF _ le_succ, THEN le_trans, OF _ _ le_succ] le_trans[OF pred_le[OF _ le_succ]]
     by (induct rule:nat_induct) auto
   note trivial_arities = arity_forces_6
     arity_forces_le_succ6[of 1, simplified] arity_forces_le_succ6[of 2, simplified]
     arity_forces_le_succ6[of 3, simplified] arity_forces_le_succ6[of 4, simplified]
     arity_forces_le_succ6[of 5, simplified] arity_forces_le_succ6[of 6, simplified]
     pred1_arity_forces[of 1, simplified] pred1_arity_forces[of 2, simplified]
     pred1_arity_forces[of 3, simplified] pred1_arity_forces[of 4, simplified]
     pred1_arity_forces[of 5, simplified] pred1_arity_forces[of 6, simplified]
   show ?thesis
     using assms arity_forces[of \<phi>] arity_forces[of \<phi>, THEN le_trans, OF _ le_succ]
       arity_forces[of \<phi>, THEN le_trans, OF _ le_succ, THEN le_trans, OF _ _ le_succ]
     unfolding rename_split_fm_def
     by (simp add:arity Un_assoc[symmetric] union_abs1 arity_forces[of \<phi>] forces_type)
       ((subst arity_incr_bv_lemma; auto simp: arity ord_simp_union forces_type trivial_arities)+)
 qed
 
 definition body_ground_repl_fm where
   "body_ground_repl_fm(\<phi>) \<equiv> (\<cdot>\<exists>(\<cdot>\<exists>\<cdot>is_Vset_fm(2, 0) \<and> \<cdot>\<cdot>1 \<in> 0\<cdot> \<and> rename_split_fm(\<phi>) \<cdot>\<cdot>\<cdot>)\<cdot>)"
 
 lemma body_ground_repl_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> body_ground_repl_fm(\<phi>)\<in>formula"
   unfolding body_ground_repl_fm_def by simp
 
 lemma arity_body_ground_repl_fm_le:
   notes le_trans[trans]
   assumes "\<phi>\<in>formula"
   shows "arity(body_ground_repl_fm(\<phi>)) \<le> 6 \<union> (arity(\<phi>) +\<^sub>\<omega> 4)"
 proof -
   from \<open>\<phi>\<in>formula\<close>
   have ineq: "n \<union> pred(pred(arity(rename_split_fm(\<phi>))))
     \<le> m \<union> pred(pred(8 \<union> (arity(\<phi>) +\<^sub>\<omega>6 )))" if "n \<le> m" "n\<in>nat" "m\<in>nat" for n m
     using that arity_rename_split_fm_le[of \<phi>, THEN [2] pred_mono, THEN [2] pred_mono,
         THEN [2] Un_mono[THEN subset_imp_le, OF _ le_imp_subset]] le_imp_subset
     by auto
   moreover
   have eq1: "pred(pred(pred(4 \<union> 2 \<union> pred(pred(pred(
     pred(pred(pred(pred(pred(9 \<union> 1 \<union> 3 \<union> 2))))))))))) = 1"
     by (auto simp:pred_Un_distrib)
   ultimately
   have "pred(pred(pred(4 \<union> 2 \<union> pred(pred(pred(
     pred(pred(pred(pred(pred(9 \<union> 1 \<union> 3 \<union> 2))))))))))) \<union>
     pred(pred(arity(rename_split_fm(\<phi>)))) \<le>
     1 \<union> pred(pred(8 \<union> (arity(\<phi>) +\<^sub>\<omega>6 )))"
     by auto
   also from \<open>\<phi>\<in>formula\<close>
   have "1 \<union> pred(pred(8 \<union> (arity(\<phi>) +\<^sub>\<omega>6 ))) \<le> 6 \<union> (4+\<^sub>\<omega>arity(\<phi>))"
     by (auto simp:pred_Un_distrib Un_assoc[symmetric] ord_simp_union)
   finally
   show ?thesis
     using  \<open>\<phi>\<in>formula\<close> unfolding body_ground_repl_fm_def
     by (simp add:arity pred_Un_distrib, subst arity_transrec_fm[of "is_HVfrom_fm(8,2,1,0)" 3 1])
       (simp add:arity pred_Un_distrib,simp_all,
         auto simp add:eq1 arity_is_HVfrom_fm[of 8 2 1 0])
 qed
 
 definition ground_repl_fm where
   "ground_repl_fm(\<phi>) \<equiv> least_fm(body_ground_repl_fm(\<phi>), 1)"
 
 lemma ground_repl_fm_type[TC]:
   "\<phi>\<in>formula \<Longrightarrow> ground_repl_fm(\<phi>) \<in> formula"
   unfolding ground_repl_fm_def by simp
 
 lemma arity_ground_repl_fm:
   assumes "\<phi>\<in>formula"
   shows "arity(ground_repl_fm(\<phi>)) \<le> 5 \<union> (3 +\<^sub>\<omega> arity(\<phi>))"
 proof -
   from assms
   have "pred(arity(body_ground_repl_fm(\<phi>))) \<le> 5 \<union> (3 +\<^sub>\<omega> arity(\<phi>))"
     using arity_body_ground_repl_fm_le pred_mono succ_Un_distrib
     by (rule_tac pred_le) auto
   with assms
   have "2 \<union> pred(arity(body_ground_repl_fm(\<phi>))) \<le> 5 \<union> (3 +\<^sub>\<omega> arity(\<phi>))"
     using Un_le le_Un_iff by auto
   then
   show ?thesis
     using assms arity_forces arity_body_ground_repl_fm_le
     unfolding least_fm_def ground_repl_fm_def
     apply (auto simp add:arity Un_assoc[symmetric])
     apply (simp add: pred_Un Un_assoc, simp add: Un_assoc[symmetric] union_abs1 pred_Un)
     by(simp only: Un_commute, subst Un_commute, simp add:ord_simp_union,force)
 qed
 
-simple_rename "ren_F" src "[x_P, x_leq, x_o, x_f, y_c, x_bc, p, x, b]"
-  tgt "[x_bc, y_c,b,x, x_P, x_leq, x_o, x_f, p]"
-
-simple_rename "ren_G" src "[x,x_P, x_leq, x_one, x_f,x_p,y,x_B]"
-  tgt "[x,y,x_P, x_leq, x_one, x_f,x_p,x_B]"
-
-simple_rename "ren_F_aux" src "[q,x_P, x_leq, x_one, f_dot, x_a, x_bc,x_p,x_b]"
-  tgt "[x_bc, q, x_b, x_P, x_leq, x_one, f_dot,x_a,x_p]"
-
-simple_rename "ren_G_aux" src "[ x_b, x_P, x_leq, x_one, f_dot,x_a,x_p,y]"
-  tgt "[ x_b, y, x_P, x_leq, x_one, f_dot,x_a,x_p]"
-
-definition ccc_fun_closed_lemma_aux2_fm where [simp]:
-  "ccc_fun_closed_lemma_aux2_fm \<equiv> ren(Collect_fm(1, (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> ren(\<cdot>\<cdot>0\<preceq>\<^bsup>2\<^esup>7\<cdot>
-  \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot> ) ` 9 ` 9 ` ren_F_aux_fn\<cdot>\<cdot>), 7)) ` 8 ` 8 ` ren_G_aux_fn"
+synthesize "is_ordermap" from_definition assuming "nonempty"
 
-lemma ccc_fun_closed_lemma_aux2_fm_type [TC] :
-  "ccc_fun_closed_lemma_aux2_fm \<in> formula"
-proof -
-  let ?\<psi>="\<cdot>\<cdot>0\<preceq>\<^bsup>2\<^esup>7\<cdot>  \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot> "
-  let ?G="(\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> ren(?\<psi>) ` 9 ` 9 ` ren_F_aux_fn\<cdot>\<cdot>)"
-  have "ren(?\<psi>)`9`9`ren_F_aux_fn \<in> formula"
-    using ren_tc ren_F_aux_thm check_fm_type is_leq_fm_type ren_F_aux_fn_def pred_le
-    by simp_all
-  then
-  show ?thesis
-    using ren_tc ren_G_aux_thm ren_G_aux_fn_def
-    by simp
-qed
-
-definition ccc_fun_closed_lemma_fm where [simp]:
-  "ccc_fun_closed_lemma_fm \<equiv> ren(Collect_fm(7, (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v6 is 0\<cdot> \<and>
-   ren((\<cdot>\<exists>\<cdot>\<cdot>0 \<in> 1\<cdot> \<and> \<cdot>\<cdot>0\<preceq>\<^bsup>2\<^esup>7\<cdot> \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot>\<cdot>\<cdot>)) ` 9 ` 9 ` ren_F_fn\<cdot>\<cdot>)\<cdot>\<cdot>), 6))
-   ` 8 ` 8 ` ren_G_fn"
-
-lemma ccc_fun_closed_lemma_fm_type [TC] :
-  "ccc_fun_closed_lemma_fm \<in> formula"
-proof -
-  let ?\<psi>="(\<cdot>\<exists>\<cdot>\<cdot>0 \<in> 1\<cdot> \<and> \<cdot> \<cdot>0 \<preceq>\<^bsup>2\<^esup> 7\<cdot> \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot>\<cdot>\<cdot>)"
-  let ?G="(\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v6 is 0\<cdot> \<and> ren(?\<psi>) ` 9 ` 9 ` ren_F_fn\<cdot>\<cdot>)\<cdot>\<cdot>)"
-  have "ren(?\<psi>)`9`9`ren_F_fn \<in> formula"
-    using ren_tc ren_F_thm check_fm_type is_leq_fm_type ren_F_fn_def pred_le
-    by simp_all
-  then
-  show ?thesis
-    using ren_tc ren_G_thm ren_G_fn_def
-    by simp
-qed
+synthesize "is_ordertype" from_definition assuming "nonempty"
 
 definition is_order_body
-  where "is_order_body(M,X,x,z) \<equiv> \<exists>A[M]. cartprod(M,X,X,A) \<and> subset(M,x,A) \<and> M(z) \<and> M(x) \<and>
-           is_well_ord(M,X, x) \<and> is_ordertype(M,X, x,z)"
+  where "is_order_body(M,X,x,z) \<equiv>
+           is_well_ord(M,X,x) \<and> is_ordertype(M,X,x,z)"
 
 synthesize "is_order_body" from_definition assuming "nonempty"
+arity_theorem for "is_order_body_fm"
 
 definition omap_wfrec_body where
   "omap_wfrec_body(A,r) \<equiv> (\<cdot>\<exists>\<cdot>image_fm(2, 0, 1) \<and> pred_set_fm(9+\<^sub>\<omega>A, 3,9+\<^sub>\<omega>r, 0) \<cdot>\<cdot>)"
 
 lemma type_omap_wfrec_body_fm :"A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> omap_wfrec_body(A,r)\<in>formula"
   unfolding omap_wfrec_body_def by simp
 
 lemma arity_omap_wfrec_aux : "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> arity(omap_wfrec_body(A,r)) = (9+\<^sub>\<omega>A) \<union> (9+\<^sub>\<omega>r)"
   unfolding omap_wfrec_body_def
   using arity_image_fm arity_pred_set_fm pred_Un_distrib union_abs2[of 3] union_abs1
   by (simp add:FOL_arities, auto simp add:Un_assoc[symmetric] union_abs1)
 
 lemma arity_omap_wfrec: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>
   arity(is_wfrec_fm(omap_wfrec_body(A,r),r+\<^sub>\<omega>3, 1, 0)) = (4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)"
   using Arities.arity_is_wfrec_fm[OF _ _ _ _ _ arity_omap_wfrec_aux,of A r "3+\<^sub>\<omega>r" 1 0]
     pred_Un_distrib union_abs1 union_abs2 type_omap_wfrec_body_fm
   by auto
 
 lemma arity_isordermap: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
    arity(is_ordermap_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
   unfolding is_ordermap_fm_def
   using arity_lambda_fm[where i="(4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)",OF _ _ _ _ arity_omap_wfrec,
       unfolded omap_wfrec_body_def] pred_Un_distrib union_abs1
   by auto
 
 
 lemma arity_is_ordertype: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
    arity(is_ordertype_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
   unfolding is_ordertype_fm_def
   using arity_isordermap arity_image_fm pred_Un_distrib FOL_arities
   by auto
 
-arity_theorem for "is_order_body_fm"
-
 lemma arity_is_order_body: "arity(is_order_body_fm(2,0,1)) = 3"
   using arity_is_order_body_fm arity_is_ordertype ord_simp_union
   by (simp add:FOL_arities)
 
 definition H_order_pred where
   "H_order_pred(A,r) \<equiv>  \<lambda>x f . f `` Order.pred(A, x, r)"
 
 relationalize "H_order_pred" "is_H_order_pred"
 
 synthesize "is_H_order_pred" from_definition assuming "nonempty"
 
 definition order_pred_wfrec_body where
   "order_pred_wfrec_body(M,A,r,z,x) \<equiv> \<exists>y[M].
                 pair(M, x, y, z) \<and>
                 (\<exists>f[M].
                     (\<forall>z[M].
                         z \<in> f \<longleftrightarrow>
                         (\<exists>xa[M].
                             \<exists>y[M].
                                \<exists>xaa[M].
                                   \<exists>sx[M].
                                      \<exists>r_sx[M].
                                         \<exists>f_r_sx[M].
                                            pair(M, xa, y, z) \<and>
                                            pair(M, xa, x, xaa) \<and>
                                            upair(M, xa, xa, sx) \<and>
                                            pre_image(M, r, sx, r_sx) \<and>
                                            restriction(M, f, r_sx, f_r_sx) \<and>
                                            xaa \<in> r \<and> (\<exists>a[M]. image(M, f_r_sx, a, y) \<and> pred_set(M, A, xa, r, a)))) \<and>
                     (\<exists>a[M]. image(M, f, a, y) \<and> pred_set(M, A, x, r, a)))"
 
 
 synthesize "order_pred_wfrec_body" from_definition
 arity_theorem for "order_pred_wfrec_body_fm"
+synthesize "is_jump_cardinal_body_rel" from_definition assuming "nonempty"
+arity_theorem for "is_jump_cardinal_body_rel_fm"
+synthesize "is_jump_cardinal_body'_rel" from_definition assuming "nonempty"
+arity_theorem for "is_jump_cardinal_body'_rel_fm"
 
 definition replacement_is_order_body_fm where "replacement_is_order_body_fm \<equiv> is_order_body_fm(2,0,1)"
 definition wfrec_replacement_order_pred_fm where "wfrec_replacement_order_pred_fm \<equiv> order_pred_wfrec_body_fm(3,2,1,0)"
-definition replacement_is_jump_cardinal_body_fm where "replacement_is_jump_cardinal_body_fm \<equiv> is_jump_cardinal_body'_fm(0,1)"
+definition replacement_is_jump_cardinal_body_fm where "replacement_is_jump_cardinal_body_fm \<equiv> is_jump_cardinal_body'_rel_fm(0,1)"
 definition replacement_is_aleph_fm where "replacement_is_aleph_fm \<equiv> \<cdot>\<cdot>0 is ordinal\<cdot> \<and> \<cdot>\<aleph>(0) is 1\<cdot>\<cdot>"
 
 definition
   funspace_succ_rep_intf where
   "funspace_succ_rep_intf \<equiv> \<lambda>p z n. \<exists>f b. p = <f,b> & z = {cons(<n,b>, f)}"
 
 relativize functional "funspace_succ_rep_intf" "funspace_succ_rep_intf_rel"
 
 \<comment> \<open>The definition obtained next uses \<^term>\<open>is_cons\<close> instead of \<^term>\<open>upair\<close>
   as in Paulson's \<^file>\<open>~~/src/ZF/Constructible/Relative.thy\<close>.\<close>
 relationalize "funspace_succ_rep_intf_rel" "is_funspace_succ_rep_intf"
 
 synthesize "is_funspace_succ_rep_intf" from_definition
 
 arity_theorem for "is_funspace_succ_rep_intf_fm"
 
-definition
-  PHrank :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
-  "PHrank(M,f,y,z) \<equiv> (\<exists>fy[M]. fun_apply(M,f,y,fy) \<and> successor(M,fy,z))"
-
-synthesize "PHrank" from_definition assuming "nonempty"
-
 definition wfrec_Hfrc_at_fm where "wfrec_Hfrc_at_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(Hfrc_at_fm(8, 9, 2, 1, 0), 5, 1, 0) \<cdot>\<cdot>)"
 definition list_repl1_intf_fm where "list_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(list_functor_fm(13, 1, 0), 10, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
 definition list_repl2_intf_fm where "list_repl2_intf_fm \<equiv> \<cdot>\<cdot>0 \<in> 4\<cdot> \<and> is_iterates_fm(list_functor_fm(13, 1, 0), 3, 0, 1) \<cdot>"
 definition formula_repl2_intf_fm where "formula_repl2_intf_fm \<equiv> \<cdot>\<cdot>0 \<in> 3\<cdot> \<and> is_iterates_fm(formula_functor_fm(1, 0), 2, 0, 1) \<cdot>"
 definition eclose_repl2_intf_fm where "eclose_repl2_intf_fm \<equiv> \<cdot>\<cdot>0 \<in> 3\<cdot> \<and> is_iterates_fm(\<cdot>\<Union>1 is 0\<cdot>, 2, 0, 1) \<cdot>"
 definition powapply_repl_fm where "powapply_repl_fm \<equiv> is_Powapply_fm(2,0,1)"
-definition phrank_repl_fm where "phrank_repl_fm \<equiv> PHrank_fm(2,0,1)"
 definition wfrec_rank_fm where "wfrec_rank_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(is_Hrank_fm(2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
 definition trans_repl_HVFrom_fm where "trans_repl_HVFrom_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(is_HVfrom_fm(8, 2, 1, 0), 4, 1, 0) \<cdot>\<cdot>)"
 definition wfrec_Hcheck_fm where "wfrec_Hcheck_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(is_Hcheck_fm(8, 2, 1, 0), 4, 1, 0) \<cdot>\<cdot>) "
 definition repl_PHcheck_fm where "repl_PHcheck_fm \<equiv> PHcheck_fm(2,3,0,1)"
-definition check_replacement_fm where "check_replacement_fm \<equiv> \<cdot>check_fm(0,2,1) \<and> \<cdot>0 \<in> 3\<cdot>\<cdot>"
-definition G_dot_in_M_fm where "G_dot_in_M_fm \<equiv>  \<cdot>(\<cdot>\<exists>\<cdot>\<cdot>1\<^sup>v3 is 0\<cdot> \<and> pair_fm(0, 1, 2) \<cdot>\<cdot>) \<and> \<cdot>0 \<in> 3\<cdot>\<cdot>"
-definition repl_opname_check_fm where "repl_opname_check_fm \<equiv> \<cdot>is_opname_check_fm(3,2,0,1) \<and> \<cdot>0 \<in> 4\<cdot>\<cdot>"
 definition tl_repl_intf_fm where "tl_repl_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(tl_fm(1,0), 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
 definition formula_repl1_intf_fm where "formula_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(formula_functor_fm(1,0), 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
-definition eclose_repl1_intf_fm where "eclose_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(big_union_fm(1,0), 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
+definition eclose_repl1_intf_fm where "eclose_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(\<cdot>\<Union>1 is 0\<cdot>, 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
 
 definition replacement_assm where
   "replacement_assm(M,env,\<phi>) \<equiv> \<phi> \<in> formula \<longrightarrow> env \<in> list(M) \<longrightarrow>
   arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
     strong_replacement(##M,\<lambda>x y. (M , [x,y]@env \<Turnstile> \<phi>))"
 
 definition ground_replacement_assm where
   "ground_replacement_assm(M,env,\<phi>) \<equiv> replacement_assm(M,env,ground_repl_fm(\<phi>))"
 
 end
diff --git a/thys/Independence_CH/Forces_Definition.thy b/thys/Independence_CH/Forces_Definition.thy
--- a/thys/Independence_CH/Forces_Definition.thy
+++ b/thys/Independence_CH/Forces_Definition.thy
@@ -1,858 +1,854 @@
 section\<open>The definition of \<^term>\<open>forces\<close>\<close>
 
 theory Forces_Definition
   imports
     Forcing_Data
 begin
 
 text\<open>This is the core of our development.\<close>
 
 subsection\<open>The relation \<^term>\<open>frecrel\<close>\<close>
 
 lemma names_belowsD:
   assumes "x \<in> names_below(P,z)"
   obtains f n1 n2 p where
     "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
   using assms unfolding names_below_def by auto
 
 context forcing_data1
 begin
 
 (* Absoluteness of components *)
 lemma ftype_abs:
   "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_ftype(##M,x,y) \<longleftrightarrow> y = ftype(x)"
-  unfolding ftype_def  is_ftype_def by (simp add:absolut)
+  unfolding ftype_def is_ftype_def by (simp add:absolut)
 
 lemma name1_abs:
   "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_name1(##M,x,y) \<longleftrightarrow> y = name1(x)"
   unfolding name1_def is_name1_def
   by (rule is_hcomp_abs[OF fst_abs],simp_all add: fst_snd_closed[simplified] absolut)
 
 lemma snd_snd_abs:
   "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_snd_snd(##M,x,y) \<longleftrightarrow> y = snd(snd(x))"
   unfolding is_snd_snd_def
   by (rule is_hcomp_abs[OF snd_abs],
       simp_all add: conjunct2[OF fst_snd_closed,simplified] absolut)
 
 lemma name2_abs:
   "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_name2(##M,x,y) \<longleftrightarrow> y = name2(x)"
   unfolding name2_def is_name2_def
   by (rule is_hcomp_abs[OF fst_abs snd_snd_abs],simp_all add:absolut conjunct2[OF fst_snd_closed,simplified])
 
 lemma cond_of_abs:
   "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_cond_of(##M,x,y) \<longleftrightarrow> y = cond_of(x)"
   unfolding cond_of_def is_cond_of_def
   by (rule is_hcomp_abs[OF snd_abs snd_snd_abs];simp_all add:fst_snd_closed[simplified])
 
 lemma tuple_abs:
   "\<lbrakk>z\<in>M;t1\<in>M;t2\<in>M;p\<in>M;t\<in>M\<rbrakk> \<Longrightarrow>
    is_tuple(##M,z,t1,t2,p,t) \<longleftrightarrow> t = \<langle>z,t1,t2,p\<rangle>"
   unfolding is_tuple_def using pair_in_M_iff by simp
 
 lemmas components_abs = ftype_abs name1_abs name2_abs cond_of_abs
   tuple_abs
 
 lemma comp_in_M:
   "p \<preceq> q \<Longrightarrow> p\<in>M"
   "p \<preceq> q \<Longrightarrow> q\<in>M"
-  using leq_in_M transitivity[of _ leq] pair_in_M_iff by auto
+  using transitivity[of _ leq] pair_in_M_iff by auto
 
 (* Absoluteness of Hfrc *)
 
 lemma eq_case_abs [simp]:
   assumes "t1\<in>M" "t2\<in>M" "p\<in>M" "f\<in>M"
   shows "is_eq_case(##M,t1,t2,p,P,leq,f) \<longleftrightarrow> eq_case(t1,t2,p,P,leq,f)"
 proof -
   have "q \<preceq> p \<Longrightarrow> q\<in>M" for q
     using comp_in_M by simp
   moreover
   have "\<langle>s,y\<rangle>\<in>t \<Longrightarrow> s\<in>domain(t)" if "t\<in>M" for s y t
     using that unfolding domain_def by auto
   ultimately
   have
     "(\<forall>s\<in>M. s \<in> domain(t1) \<or> s \<in> domain(t2) \<longrightarrow> (\<forall>q\<in>M. q\<in>P \<and> q \<preceq> p \<longrightarrow>
                               (f ` \<langle>1, s, t1, q\<rangle> =1 \<longleftrightarrow> f ` \<langle>1, s, t2, q\<rangle>=1))) \<longleftrightarrow>
     (\<forall>s. s \<in> domain(t1) \<or> s \<in> domain(t2) \<longrightarrow> (\<forall>q. q\<in>P \<and> q \<preceq> p \<longrightarrow>
                                   (f ` \<langle>1, s, t1, q\<rangle> =1 \<longleftrightarrow> f ` \<langle>1, s, t2, q\<rangle>=1)))"
     using assms domain_trans[OF trans_M,of t1] domain_trans[OF trans_M,of t2]
     by auto
   then
   show ?thesis
     unfolding eq_case_def is_eq_case_def
-    using assms pair_in_M_iff nat_into_M domain_closed apply_closed leq_in_M zero_in_M Un_closed
+    using assms pair_in_M_iff nat_into_M domain_closed apply_closed zero_in_M Un_closed
     by (simp add:components_abs)
 qed
 
 lemma mem_case_abs [simp]:
   assumes "t1\<in>M" "t2\<in>M" "p\<in>M" "f\<in>M"
   shows "is_mem_case(##M,t1,t2,p,P,leq,f) \<longleftrightarrow> mem_case(t1,t2,p,P,leq,f)"
 proof
   {
     fix v
     assume "v\<in>P" "v \<preceq> p" "is_mem_case(##M,t1,t2,p,P,leq,f)"
     moreover
     from this
     have "v\<in>M" "\<langle>v,p\<rangle> \<in> M" "(##M)(v)"
       using transitivity[OF _ P_in_M,of v] transitivity[OF _ leq_in_M]
       by simp_all
     moreover
     from calculation assms
     obtain q r s where
       "r \<in> P \<and> q \<in> P \<and> \<langle>q, v\<rangle> \<in> M \<and> \<langle>s, r\<rangle> \<in> M \<and> \<langle>q, r\<rangle> \<in> M \<and> 0 \<in> M \<and>
        \<langle>0, t1, s, q\<rangle> \<in> M \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
       unfolding is_mem_case_def by (auto simp add:components_abs)
     then
     have "\<exists>q s r. r \<in> P \<and> q \<in> P \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
       by auto
   }
   then
   show "mem_case(t1, t2, p, P, leq, f)" if "is_mem_case(##M, t1, t2, p, P, leq, f)"
     unfolding mem_case_def using that assms by auto
 next
   { fix v
     assume "v \<in> M" "v \<in> P" "\<langle>v, p\<rangle> \<in> M" "v \<preceq> p" "mem_case(t1, t2, p, P, leq, f)"
     moreover
     from this
     obtain q s r where "r \<in> P \<and> q \<in> P \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
       unfolding mem_case_def by auto
     moreover
     from this \<open>t2\<in>M\<close>
     have "r\<in>M" "q\<in>M" "s\<in>M" "r \<in> P \<and> q \<in> P \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
-      using transitivity domainI[of s r] P_in_M domain_closed
+      using transitivity domainI[of s r] domain_closed
       by auto
     moreover
     note \<open>t1\<in>M\<close>
     ultimately
     have "\<exists>q\<in>M . \<exists>s\<in>M. \<exists>r\<in>M.
          r \<in> P \<and> q \<in> P \<and> \<langle>q, v\<rangle> \<in> M \<and> \<langle>s, r\<rangle> \<in> M \<and> \<langle>q, r\<rangle> \<in> M \<and> 0 \<in> M \<and>
          \<langle>0, t1, s, q\<rangle> \<in> M \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
       using pair_in_M_iff zero_in_M by auto
   }
   then
   show "is_mem_case(##M, t1, t2, p, P, leq, f)" if "mem_case(t1, t2, p, P, leq, f)"
     unfolding is_mem_case_def
     using assms that zero_in_M pair_in_M_iff apply_closed nat_into_M
     by (auto simp add:components_abs)
 qed
 
 lemma Hfrc_abs:
   "\<lbrakk>fnnc\<in>M; f\<in>M\<rbrakk> \<Longrightarrow>
    is_Hfrc(##M,P,leq,fnnc,f) \<longleftrightarrow> Hfrc(P,leq,fnnc,f)"
   unfolding is_Hfrc_def Hfrc_def using pair_in_M_iff zero_in_M
   by (auto simp add:components_abs)
 
 lemma Hfrc_at_abs:
   "\<lbrakk>fnnc\<in>M; f\<in>M ; z\<in>M\<rbrakk> \<Longrightarrow>
    is_Hfrc_at(##M,P,leq,fnnc,f,z) \<longleftrightarrow>  z = bool_of_o(Hfrc(P,leq,fnnc,f)) "
   unfolding is_Hfrc_at_def using Hfrc_abs
   by auto
 
 lemma components_closed :
   "x\<in>M \<Longrightarrow> (##M)(ftype(x))"
   "x\<in>M \<Longrightarrow> (##M)(name1(x))"
   "x\<in>M \<Longrightarrow> (##M)(name2(x))"
   "x\<in>M \<Longrightarrow> (##M)(cond_of(x))"
   unfolding ftype_def name1_def name2_def cond_of_def using fst_snd_closed by simp_all
 
 lemma ecloseN_closed:
   "(##M)(A) \<Longrightarrow> (##M)(ecloseN(A))"
   "(##M)(A) \<Longrightarrow> (##M)(eclose_n(name1,A))"
   "(##M)(A) \<Longrightarrow> (##M)(eclose_n(name2,A))"
   unfolding ecloseN_def eclose_n_def
   using components_closed eclose_closed singleton_closed Un_closed by auto
 
 lemma eclose_n_abs :
   assumes "x\<in>M" "ec\<in>M"
   shows "is_eclose_n(##M,is_name1,ec,x) \<longleftrightarrow> ec = eclose_n(name1,x)"
     "is_eclose_n(##M,is_name2,ec,x) \<longleftrightarrow> ec = eclose_n(name2,x)"
   unfolding is_eclose_n_def eclose_n_def
   using assms name1_abs name2_abs eclose_abs singleton_closed components_closed
   by auto
 
 
 lemma ecloseN_abs :
   "\<lbrakk>x\<in>M;ec\<in>M\<rbrakk> \<Longrightarrow> is_ecloseN(##M,x,ec) \<longleftrightarrow> ec = ecloseN(x)"
   unfolding is_ecloseN_def ecloseN_def
   using eclose_n_abs Un_closed union_abs ecloseN_closed
   by auto
 
 lemma frecR_abs :
   "x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> frecR(x,y) \<longleftrightarrow> is_frecR(##M,x,y)"
   unfolding frecR_def is_frecR_def
   using zero_in_M domain_closed Un_closed components_closed nat_into_M
   by (auto simp add: components_abs)
 
 lemma frecrelP_abs :
   "z\<in>M \<Longrightarrow> frecrelP(##M,z) \<longleftrightarrow> (\<exists>x y. z = \<langle>x,y\<rangle> \<and> frecR(x,y))"
   using pair_in_M_iff frecR_abs unfolding frecrelP_def by auto
 
 lemma frecrel_abs:
   assumes "A\<in>M" "r\<in>M"
   shows "is_frecrel(##M,A,r) \<longleftrightarrow>  r = frecrel(A)"
 proof -
   from \<open>A\<in>M\<close>
   have "z\<in>M" if "z\<in>A\<times>A" for z
     using cartprod_closed transitivity that by simp
   then
   have "Collect(A\<times>A,frecrelP(##M)) = Collect(A\<times>A,\<lambda>z. (\<exists>x y. z = \<langle>x,y\<rangle> \<and> frecR(x,y)))"
     using Collect_cong[of "A\<times>A" "A\<times>A" "frecrelP(##M)"] assms frecrelP_abs by simp
   with assms
   show ?thesis
     unfolding is_frecrel_def def_frecrel using cartprod_closed
     by simp
 qed
 
 lemma frecrel_closed:
   assumes "x\<in>M"
   shows "frecrel(x)\<in>M"
 proof -
   have "Collect(x\<times>x,\<lambda>z. (\<exists>x y. z = \<langle>x,y\<rangle> \<and> frecR(x,y)))\<in>M"
     using Collect_in_M[of "frecrelP_fm(0)" "[]"] arity_frecrelP_fm sats_frecrelP_fm
       frecrelP_abs \<open>x\<in>M\<close> cartprod_closed
     by simp
   then
   show ?thesis
     unfolding frecrel_def Rrel_def frecrelP_def by simp
 qed
 
 lemma field_frecrel : "field(frecrel(names_below(P,x))) \<subseteq> names_below(P,x)"
   unfolding frecrel_def
   using field_Rrel by simp
 
 lemma forcerelD : "uv \<in> forcerel(P,x) \<Longrightarrow> uv\<in> names_below(P,x) \<times> names_below(P,x)"
   unfolding forcerel_def
   using trancl_type field_frecrel by blast
 
 lemma wf_forcerel :
   "wf(forcerel(P,x))"
   unfolding forcerel_def using wf_trancl wf_frecrel .
 
 lemma restrict_trancl_forcerel:
   assumes "frecR(w,y)"
   shows "restrict(f,frecrel(names_below(P,x))-``{y})`w
        = restrict(f,forcerel(P,x)-``{y})`w"
   unfolding forcerel_def frecrel_def using assms restrict_trancl_Rrel[of frecR]
   by simp
 
 lemma names_belowI :
   assumes "frecR(\<langle>ft,n1,n2,p\<rangle>,\<langle>a,b,c,d\<rangle>)" "p\<in>P"
   shows "\<langle>ft,n1,n2,p\<rangle> \<in> names_below(P,\<langle>a,b,c,d\<rangle>)" (is "?x \<in> names_below(_,?y)")
 proof -
   from assms
   have "ft \<in> 2" "a \<in> 2"
     unfolding frecR_def by (auto simp add:components_simp)
   from assms
-  consider (e) "n1 \<in> domain(b) \<union> domain(c) \<and> (n2 = b \<or> n2 =c)"
-    | (m) "n1 = b \<and> n2 \<in> domain(c)"
+  consider (eq) "n1 \<in> domain(b) \<union> domain(c) \<and> (n2 = b \<or> n2 =c)"
+    | (mem) "n1 = b \<and> n2 \<in> domain(c)"
     unfolding frecR_def by (auto simp add:components_simp)
   then show ?thesis
   proof cases
-    case e
+    case eq
     then
     have "n1 \<in> eclose(b) \<or> n1 \<in> eclose(c)"
       using Un_iff in_dom_in_eclose by auto
-    with e
+    with eq
     have "n1 \<in> ecloseN(?y)" "n2 \<in> ecloseN(?y)"
       using ecloseNI components_in_eclose by auto
     with \<open>ft\<in>2\<close> \<open>p\<in>P\<close>
     show ?thesis
       unfolding names_below_def by  auto
   next
-    case m
+    case mem
     then
     have "n1 \<in> ecloseN(?y)" "n2 \<in> ecloseN(?y)"
-      using mem_eclose_trans  ecloseNI
-        in_dom_in_eclose components_in_eclose by auto
+      using mem_eclose_trans ecloseNI in_dom_in_eclose components_in_eclose
+      by auto
     with \<open>ft\<in>2\<close> \<open>p\<in>P\<close>
     show ?thesis
       unfolding names_below_def
       by auto
   qed
 qed
 
 lemma names_below_tr :
   assumes "x\<in> names_below(P,y)" "y\<in> names_below(P,z)"
   shows "x\<in> names_below(P,z)"
 proof -
   let ?A="\<lambda>y . names_below(P,y)"
   note assms
   moreover from this
   obtain fx x1 x2 px where "x = \<langle>fx,x1,x2,px\<rangle>" "fx\<in>2" "x1\<in>ecloseN(y)" "x2\<in>ecloseN(y)" "px\<in>P"
     unfolding names_below_def by auto
   moreover from calculation
   obtain fy y1 y2 py where "y = \<langle>fy,y1,y2,py\<rangle>" "fy\<in>2" "y1\<in>ecloseN(z)" "y2\<in>ecloseN(z)" "py\<in>P"
     unfolding names_below_def by auto
   moreover from calculation
   have "x1\<in>ecloseN(z)" "x2\<in>ecloseN(z)"
     using ecloseN_mono names_simp by auto
   ultimately
   have "x\<in>?A(z)"
     unfolding names_below_def by simp
   then
   show ?thesis using subsetI by simp
 qed
 
 lemma arg_into_names_below2 :
   assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
   shows  "x \<in> names_below(P,y)"
 proof -
   from assms
   have "x\<in>names_below(P,z)" "y\<in>names_below(P,z)" "frecR(x,y)"
     unfolding frecrel_def Rrel_def
     by auto
   obtain f n1 n2 p where "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
     using \<open>x\<in>names_below(P,z)\<close>
     unfolding names_below_def by auto
   moreover
   obtain fy m1 m2 q where "q\<in>P" "y = \<langle>fy,m1,m2,q\<rangle>"
     using \<open>y\<in>names_below(P,z)\<close>
     unfolding names_below_def by auto
   moreover
   note \<open>frecR(x,y)\<close>
   ultimately
   show ?thesis
     using names_belowI by simp
 qed
 
 lemma arg_into_names_below :
   assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
   shows  "x \<in> names_below(P,x)"
 proof -
   from assms
   have "x\<in>names_below(P,z)"
     unfolding frecrel_def Rrel_def
     by auto
   from \<open>x\<in>names_below(P,z)\<close>
   obtain f n1 n2 p where
     "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
     unfolding names_below_def by auto
   then
   have "n1\<in>ecloseN(x)" "n2\<in>ecloseN(x)"
     using components_in_eclose by simp_all
   with \<open>f\<in>2\<close> \<open>p\<in>P\<close> \<open>x = \<langle>f,n1,n2,p\<rangle>\<close>
   show ?thesis
     unfolding names_below_def by simp
 qed
 
 lemma forcerel_arg_into_names_below :
   assumes "\<langle>x,y\<rangle> \<in> forcerel(P,z)"
   shows  "x \<in> names_below(P,x)"
   using assms
   unfolding forcerel_def
   by(rule trancl_induct;auto simp add: arg_into_names_below)
 
 lemma names_below_mono :
   assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
   shows "names_below(P,x) \<subseteq> names_below(P,y)"
 proof -
   from assms
   have "x\<in>names_below(P,y)"
     using arg_into_names_below2 by simp
   then
   show ?thesis
     using names_below_tr subsetI by simp
 qed
 
 lemma frecrel_mono :
   assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
   shows "frecrel(names_below(P,x)) \<subseteq> frecrel(names_below(P,y))"
   unfolding frecrel_def
   using Rrel_mono names_below_mono assms by simp
 
 lemma forcerel_mono2 :
   assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
   shows "forcerel(P,x) \<subseteq> forcerel(P,y)"
   unfolding forcerel_def
   using trancl_mono frecrel_mono assms by simp
 
 lemma forcerel_mono_aux :
   assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P, w))^+"
   shows "forcerel(P,x) \<subseteq> forcerel(P,y)"
   using assms
   by (rule trancl_induct,simp_all add: subset_trans forcerel_mono2)
 
 lemma forcerel_mono :
   assumes "\<langle>x,y\<rangle> \<in> forcerel(P,z)"
   shows "forcerel(P,x) \<subseteq> forcerel(P,y)"
   using forcerel_mono_aux assms unfolding forcerel_def by simp
 
 lemma forcerel_eq_aux: "x \<in> names_below(P, w) \<Longrightarrow> \<langle>x,y\<rangle> \<in> forcerel(P,z) \<Longrightarrow>
   (y \<in> names_below(P, w) \<longrightarrow> \<langle>x,y\<rangle> \<in> forcerel(P,w))"
   unfolding forcerel_def
 proof(rule_tac a=x and b=y and P="\<lambda> y . y \<in> names_below(P, w) \<longrightarrow> \<langle>x,y\<rangle> \<in> frecrel(names_below(P,w))^+" in trancl_induct,simp)
   let ?A="\<lambda> a . names_below(P, a)"
   let ?R="\<lambda> a . frecrel(?A(a))"
   let ?fR="\<lambda> a .forcerel(a)"
   show "u\<in>?A(w) \<longrightarrow> \<langle>x,u\<rangle>\<in>?R(w)^+" if "x\<in>?A(w)" "\<langle>x,y\<rangle>\<in>?R(z)^+" "\<langle>x,u\<rangle>\<in>?R(z)"  for  u
     using that frecrelD frecrelI r_into_trancl
     unfolding names_below_def by simp
   {
     fix u v
     assume "x \<in> ?A(w)"
       "\<langle>x, y\<rangle> \<in> ?R(z)^+"
       "\<langle>x, u\<rangle> \<in> ?R(z)^+"
       "\<langle>u, v\<rangle> \<in> ?R(z)"
       "u \<in> ?A(w) \<Longrightarrow> \<langle>x, u\<rangle> \<in> ?R(w)^+"
     then
     have "v \<in> ?A(w) \<Longrightarrow> \<langle>x, v\<rangle> \<in> ?R(w)^+"
     proof -
       assume "v \<in>?A(w)"
       from \<open>\<langle>u,v\<rangle>\<in>_\<close>
       have "u\<in>?A(v)"
         using arg_into_names_below2 by simp
       with \<open>v \<in>?A(w)\<close>
       have "u\<in>?A(w)"
         using names_below_tr by simp
       with \<open>v\<in>_\<close> \<open>\<langle>u,v\<rangle>\<in>_\<close>
       have "\<langle>u,v\<rangle>\<in> ?R(w)"
         using frecrelD frecrelI r_into_trancl unfolding names_below_def by simp
       with \<open>u \<in> ?A(w) \<Longrightarrow> \<langle>x, u\<rangle> \<in> ?R(w)^+\<close> \<open>u\<in>?A(w)\<close>
       have "\<langle>x, u\<rangle> \<in> ?R(w)^+"
         by simp
       with \<open>\<langle>u,v\<rangle>\<in> ?R(w)\<close>
       show "\<langle>x,v\<rangle>\<in> ?R(w)^+" using trancl_trans r_into_trancl
         by simp
     qed
   }
   then
   show "v \<in> ?A(w) \<longrightarrow> \<langle>x, v\<rangle> \<in> ?R(w)^+"
     if "x \<in> ?A(w)"
       "\<langle>x, y\<rangle> \<in> ?R(z)^+"
       "\<langle>x, u\<rangle> \<in> ?R(z)^+"
       "\<langle>u, v\<rangle> \<in> ?R(z)"
       "u \<in> ?A(w) \<longrightarrow> \<langle>x, u\<rangle> \<in> ?R(w)^+" for u v
     using that
     by simp
 qed
 
 lemma forcerel_eq :
   assumes "\<langle>z,x\<rangle> \<in> forcerel(P,x)"
   shows "forcerel(P,z) = forcerel(P,x) \<inter> names_below(P,z)\<times>names_below(P,z)"
   using assms forcerel_eq_aux forcerelD forcerel_mono[of z x x] subsetI
   by auto
 
 lemma forcerel_below_aux :
   assumes "\<langle>z,x\<rangle> \<in> forcerel(P,x)" "\<langle>u,z\<rangle> \<in> forcerel(P,x)"
   shows "u \<in> names_below(P,z)"
   using assms(2)
   unfolding forcerel_def
 proof(rule trancl_induct)
   show  "u \<in> names_below(P,y)" if " \<langle>u, y\<rangle> \<in> frecrel(names_below(P, x))" for y
     using that vimage_singleton_iff arg_into_names_below2 by simp
 next
   show "u \<in> names_below(P,z)"
     if "\<langle>u, y\<rangle> \<in> frecrel(names_below(P, x))^+"
       "\<langle>y, z\<rangle> \<in> frecrel(names_below(P, x))"
       "u \<in> names_below(P, y)"
     for y z
     using that arg_into_names_below2[of y z x] names_below_tr by simp
 qed
 
 lemma forcerel_below :
   assumes "\<langle>z,x\<rangle> \<in> forcerel(P,x)"
   shows "forcerel(P,x) -`` {z} \<subseteq> names_below(P,z)"
   using vimage_singleton_iff assms forcerel_below_aux by auto
 
 lemma relation_forcerel :
   shows "relation(forcerel(P,z))" "trans(forcerel(P,z))"
   unfolding forcerel_def using relation_trancl trans_trancl by simp_all
 
 lemma Hfrc_restrict_trancl: "bool_of_o(Hfrc(P, leq, y, restrict(f,frecrel(names_below(P,x))-``{y})))
          = bool_of_o(Hfrc(P, leq, y, restrict(f,(frecrel(names_below(P,x))^+)-``{y})))"
   unfolding Hfrc_def bool_of_o_def eq_case_def mem_case_def
   using restrict_trancl_forcerel frecRI1 frecRI2 frecRI3
   unfolding forcerel_def
   by simp
 
 (* Recursive definition of forces for atomic formulas using a transitive relation *)
 lemma frc_at_trancl: "frc_at(P,leq,z) = wfrec(forcerel(P,z),z,\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f)))"
   unfolding frc_at_def forcerel_def using wf_eq_trancl Hfrc_restrict_trancl by simp
 
 lemma forcerelI1 :
   assumes "n1 \<in> domain(b) \<or> n1 \<in> domain(c)" "p\<in>P" "d\<in>P"
   shows "\<langle>\<langle>1, n1, b, p\<rangle>, \<langle>0,b,c,d\<rangle>\<rangle>\<in> forcerel(P,\<langle>0,b,c,d\<rangle>)"
 proof -
   let ?x="\<langle>1, n1, b, p\<rangle>"
   let ?y="\<langle>0,b,c,d\<rangle>"
   from assms
   have "frecR(?x,?y)"
     using frecRI1 by simp
   then
   have "?x\<in>names_below(P,?y)" "?y \<in> names_below(P,?y)"
     using names_belowI  assms components_in_eclose
     unfolding names_below_def by auto
   with \<open>frecR(?x,?y)\<close>
   show ?thesis
     unfolding forcerel_def frecrel_def
     using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
     by auto
 qed
 
 lemma forcerelI2 :
   assumes "n1 \<in> domain(b) \<or> n1 \<in> domain(c)" "p\<in>P" "d\<in>P"
   shows "\<langle>\<langle>1, n1, c, p\<rangle>, \<langle>0,b,c,d\<rangle>\<rangle>\<in> forcerel(P,\<langle>0,b,c,d\<rangle>)"
 proof -
   let ?x="\<langle>1, n1, c, p\<rangle>"
   let ?y="\<langle>0,b,c,d\<rangle>"
   note assms
   moreover from this
   have "frecR(?x,?y)"
     using frecRI2 by simp
   moreover from calculation
   have "?x\<in>names_below(P,?y)" "?y \<in> names_below(P,?y)"
     using names_belowI components_in_eclose
     unfolding names_below_def by auto
   ultimately
   show ?thesis
     unfolding forcerel_def frecrel_def
     using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
     by auto
 qed
 
 lemma forcerelI3 :
   assumes "\<langle>n2, r\<rangle> \<in> c" "p\<in>P" "d\<in>P" "r \<in> P"
   shows "\<langle>\<langle>0, b, n2, p\<rangle>,\<langle>1, b, c, d\<rangle>\<rangle> \<in> forcerel(P,\<langle>1,b,c,d\<rangle>)"
 proof -
   let ?x="\<langle>0, b, n2, p\<rangle>"
   let ?y="\<langle>1, b, c, d\<rangle>"
   note assms
   moreover from this
   have "frecR(?x,?y)"
     using frecRI3 by simp
   moreover from calculation
   have "?x\<in>names_below(P,?y)"  "?y \<in> names_below(P,?y)"
     using names_belowI components_in_eclose
     unfolding names_below_def by auto
   ultimately
   show ?thesis
     unfolding forcerel_def frecrel_def
     using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
     by auto
 qed
 
 lemmas forcerelI = forcerelI1[THEN vimage_singleton_iff[THEN iffD2]]
   forcerelI2[THEN vimage_singleton_iff[THEN iffD2]]
   forcerelI3[THEN vimage_singleton_iff[THEN iffD2]]
 
 lemma  aux_def_frc_at:
   assumes "z \<in> forcerel(P,x) -`` {x}"
   shows "wfrec(forcerel(P,x), z, H) =  wfrec(forcerel(P,z), z, H)"
 proof -
   let ?A="names_below(P,z)"
   from assms
   have "\<langle>z,x\<rangle> \<in> forcerel(P,x)"
     using vimage_singleton_iff by simp
   moreover from this
   have "z \<in> ?A"
     using forcerel_arg_into_names_below by simp
   moreover from calculation
   have "forcerel(P,z) = forcerel(P,x) \<inter> (?A\<times>?A)"
     "forcerel(P,x) -`` {z} \<subseteq> ?A"
     using forcerel_eq forcerel_below
     by auto
   moreover from calculation
   have "wfrec(forcerel(P,x), z, H) = wfrec[?A](forcerel(P,x), z, H)"
     using wfrec_trans_restr[OF relation_forcerel(1) wf_forcerel relation_forcerel(2), of x z ?A]
     by simp
   ultimately
   show ?thesis
     using wfrec_restr_eq by simp
 qed
 
 subsection\<open>Recursive expression of \<^term>\<open>frc_at\<close>\<close>
 
 lemma def_frc_at :
   assumes "p\<in>P"
   shows
     "frc_at(P,leq,\<langle>ft,n1,n2,p\<rangle>) =
    bool_of_o( p \<in>P \<and>
   (  ft = 0 \<and>  (\<forall>s. s\<in>domain(n1) \<union> domain(n2) \<longrightarrow>
         (\<forall>q. q\<in>P \<and> q \<preceq> p \<longrightarrow> (frc_at(P,leq,\<langle>1,s,n1,q\<rangle>) =1 \<longleftrightarrow> frc_at(P,leq,\<langle>1,s,n2,q\<rangle>) =1)))
    \<or> ft = 1 \<and> ( \<forall>v\<in>P. v \<preceq> p \<longrightarrow>
     (\<exists>q. \<exists>s. \<exists>r. r\<in>P \<and> q\<in>P \<and> q \<preceq> v \<and> \<langle>s,r\<rangle> \<in> n2 \<and> q \<preceq> r \<and>  frc_at(P,leq,\<langle>0,n1,s,q\<rangle>) = 1))))"
 proof -
   let ?r="\<lambda>y. forcerel(P,y)" and ?Hf="\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f))"
   let ?t="\<lambda>y. ?r(y) -`` {y}"
   let ?arg="\<langle>ft,n1,n2,p\<rangle>"
   from wf_forcerel
   have wfr: "\<forall>w . wf(?r(w))" ..
   with wfrec [of "?r(?arg)" ?arg ?Hf]
   have "frc_at(P,leq,?arg) = ?Hf( ?arg, \<lambda>x\<in>?r(?arg) -`` {?arg}. wfrec(?r(?arg), x, ?Hf))"
     using frc_at_trancl by simp
   also
   have " ... = ?Hf( ?arg, \<lambda>x\<in>?r(?arg) -`` {?arg}. frc_at(P,leq,x))"
     using aux_def_frc_at frc_at_trancl by simp
   finally
   show ?thesis
     unfolding Hfrc_def mem_case_def eq_case_def
     using forcerelI  assms
     by auto
 qed
 
 
 subsection\<open>Absoluteness of \<^term>\<open>frc_at\<close>\<close>
 
 lemma forcerel_in_M :
   assumes "x\<in>M"
   shows "forcerel(P,x)\<in>M"
   unfolding forcerel_def def_frecrel names_below_def
 proof -
   let ?Q = "2 \<times> ecloseN(x) \<times> ecloseN(x) \<times> P"
   have "?Q \<times> ?Q \<in> M"
-    using \<open>x\<in>M\<close> P_in_M nat_into_M ecloseN_closed cartprod_closed by simp
+    using \<open>x\<in>M\<close> nat_into_M ecloseN_closed cartprod_closed by simp
   moreover
   have "separation(##M,\<lambda>z. frecrelP(##M,z))"
     using separation_in_ctm[of "frecrelP_fm(0)",OF _ _ _ sats_frecrelP_fm]
       arity_frecrelP_fm frecrelP_fm_type
     by auto
   moreover from this
   have "separation(##M,\<lambda>z. \<exists>x y. z = \<langle>x, y\<rangle> \<and> frecR(x, y))"
     using separation_cong[OF frecrelP_abs]
     by force
   ultimately
   show "{z \<in> ?Q \<times> ?Q . \<exists>x y. z = \<langle>x, y\<rangle> \<and> frecR(x, y)}^+ \<in> M"
     using separation_closed frecrelP_abs trancl_closed
     by simp
 qed
 
 lemma relation2_Hfrc_at_abs:
   "relation2(##M,is_Hfrc_at(##M,P,leq),\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f)))"
   unfolding relation2_def using Hfrc_at_abs
   by simp
 
 lemma Hfrc_at_closed :
   "\<forall>x\<in>M. \<forall>g\<in>M. function(g) \<longrightarrow> bool_of_o(Hfrc(P,leq,x,g))\<in>M"
   unfolding bool_of_o_def using zero_in_M nat_into_M[of 1] by simp
 
 lemma wfrec_Hfrc_at :
   assumes "X\<in>M"
   shows "wfrec_replacement(##M,is_Hfrc_at(##M,P,leq),forcerel(P,X))"
 proof -
   have 0:"is_Hfrc_at(##M,P,leq,a,b,c) \<longleftrightarrow>
         sats(M,Hfrc_at_fm(8,9,2,1,0),[c,b,a,d,e,y,x,z,P,leq,forcerel(P,X)])"
     if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
     for a b c d e y x z
-    using that P_in_M leq_in_M \<open>X\<in>M\<close> forcerel_in_M
-      Hfrc_at_iff_sats[of concl:M P leq a b c 8 9 2 1 0
-        "[c,b,a,d,e,y,x,z,P,leq,forcerel(P,X)]"] by simp
+    using that \<open>X\<in>M\<close> forcerel_in_M
+      Hfrc_at_iff_sats[of concl:M P leq a b c 8 9 2 1 0]
+    by simp
   have 1:"sats(M,is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0),[y,x,z,P,leq,forcerel(P,X)]) \<longleftrightarrow>
                    is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y)"
     if "x\<in>M" "y\<in>M" "z\<in>M" for x y z
-    using that \<open>X\<in>M\<close> forcerel_in_M P_in_M leq_in_M sats_is_wfrec_fm[OF 0]
+    using that \<open>X\<in>M\<close> forcerel_in_M sats_is_wfrec_fm[OF 0]
     by simp
   let
     ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0)))"
   have satsf:"sats(M, ?f, [x,z,P,leq,forcerel(P,X)]) \<longleftrightarrow>
               (\<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y))"
     if "x\<in>M" "z\<in>M" for x z
-    using that 1 \<open>X\<in>M\<close> forcerel_in_M P_in_M leq_in_M by (simp del:pair_abs)
+    using that 1 \<open>X\<in>M\<close> forcerel_in_M by (simp del:pair_abs)
   have artyf:"arity(?f) = 5"
     using arity_wfrec_replacement_fm[where p="Hfrc_at_fm(8,9,2,1,0)" and i=10]
       arity_Hfrc_at_fm ord_simp_union
     by simp
   moreover
   have "?f\<in>formula" by simp
   ultimately
   have "strong_replacement(##M,\<lambda>x z. sats(M,?f,[x,z,P,leq,forcerel(P,X)]))"
-    using replacement_ax1(1) 1 artyf \<open>X\<in>M\<close> forcerel_in_M P_in_M leq_in_M
-    unfolding replacement_assm_def by simp
+    using ZF_ground_replacements(1) 1 artyf \<open>X\<in>M\<close> forcerel_in_M
+    unfolding replacement_assm_def wfrec_Hfrc_at_fm_def by simp
   then
   have "strong_replacement(##M,\<lambda>x z.
           \<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y))"
     using repl_sats[of M ?f "[P,leq,forcerel(P,X)]"] satsf by (simp del:pair_abs)
   then
   show ?thesis unfolding wfrec_replacement_def by simp
 qed
 
 lemma names_below_abs :
   "\<lbrakk>Q\<in>M;x\<in>M;nb\<in>M\<rbrakk> \<Longrightarrow> is_names_below(##M,Q,x,nb) \<longleftrightarrow> nb = names_below(Q,x)"
   unfolding is_names_below_def names_below_def
   using succ_in_M_iff zero_in_M cartprod_closed ecloseN_abs ecloseN_closed
   by auto
 
 lemma names_below_closed:
   "\<lbrakk>Q\<in>M;x\<in>M\<rbrakk> \<Longrightarrow> names_below(Q,x) \<in> M"
   unfolding names_below_def
   using zero_in_M cartprod_closed ecloseN_closed succ_in_M_iff
   by simp
 
 lemma "names_below_productE" :
   assumes "Q \<in> M" "x \<in> M"
     "\<And>A1 A2 A3 A4. A1 \<in> M \<Longrightarrow> A2 \<in> M \<Longrightarrow> A3 \<in> M \<Longrightarrow> A4 \<in> M \<Longrightarrow> R(A1 \<times> A2 \<times> A3 \<times> A4)"
   shows "R(names_below(Q,x))"
   unfolding names_below_def using assms nat_into_M ecloseN_closed[of x] by auto
 
 lemma forcerel_abs :
   "\<lbrakk>x\<in>M;z\<in>M\<rbrakk> \<Longrightarrow> is_forcerel(##M,P,x,z) \<longleftrightarrow> z = forcerel(P,x)"
   unfolding is_forcerel_def forcerel_def
-  using frecrel_abs names_below_abs trancl_abs P_in_M ecloseN_closed names_below_closed
+  using frecrel_abs names_below_abs trancl_abs ecloseN_closed names_below_closed
     names_below_productE[of concl:"\<lambda>p. is_frecrel(##M,p,_) \<longleftrightarrow>  _ = frecrel(p)"] frecrel_closed
   by simp
 
 lemma frc_at_abs:
   assumes "fnnc\<in>M" "z\<in>M"
   shows "is_frc_at(##M,P,leq,fnnc,z) \<longleftrightarrow> z = frc_at(P,leq,fnnc)"
 proof -
   from assms
   have "(\<exists>r\<in>M. is_forcerel(##M,P,fnnc, r) \<and> is_wfrec(##M, is_Hfrc_at(##M, P, leq), r, fnnc, z))
         \<longleftrightarrow> is_wfrec(##M, is_Hfrc_at(##M, P, leq), forcerel(P,fnnc), fnnc, z)"
     using forcerel_abs forcerel_in_M by simp
   then
   show ?thesis
     unfolding frc_at_trancl is_frc_at_def
     using assms wfrec_Hfrc_at[of fnnc] wf_forcerel relation_forcerel forcerel_in_M
       Hfrc_at_closed relation2_Hfrc_at_abs
       trans_wfrec_abs[of "forcerel(P,fnnc)" fnnc z "is_Hfrc_at(##M,P,leq)" "\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f))"]
     by (simp flip:setclass_iff)
 qed
 
 lemma forces_eq'_abs :
   "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_eq'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_eq'(P,leq,p,t1,t2)"
   unfolding is_forces_eq'_def forces_eq'_def
   using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)
 
 lemma forces_mem'_abs :
   "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_mem'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_mem'(P,leq,p,t1,t2)"
   unfolding is_forces_mem'_def forces_mem'_def
   using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)
 
 lemma forces_neq'_abs :
   assumes "p\<in>M" "t1\<in>M" "t2\<in>M"
   shows "is_forces_neq'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_neq'(P,leq,p,t1,t2)"
 proof -
   have "q\<in>M" if "q\<in>P" for q
-    using that transitivity P_in_M by simp
+    using that transitivity by simp
   with assms
   show ?thesis
     unfolding is_forces_neq'_def forces_neq'_def
     using forces_eq'_abs pair_in_M_iff
     by (auto simp add:components_abs,blast)
 qed
 
-
 lemma forces_nmem'_abs :
   assumes "p\<in>M" "t1\<in>M" "t2\<in>M"
   shows "is_forces_nmem'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_nmem'(P,leq,p,t1,t2)"
 proof -
   have "q\<in>M" if "q\<in>P" for q
-    using that transitivity P_in_M by simp
+    using that transitivity by simp
   with assms
   show ?thesis
     unfolding is_forces_nmem'_def forces_nmem'_def
     using forces_mem'_abs pair_in_M_iff
     by (auto simp add:components_abs,blast)
 qed
 
-subsection\<open>Forcing for general formulas\<close>
-
 lemma leq_abs:
   "\<lbrakk> l\<in>M ; q\<in>M ; p\<in>M \<rbrakk> \<Longrightarrow> is_leq(##M,l,q,p) \<longleftrightarrow> \<langle>q,p\<rangle>\<in>l"
   unfolding is_leq_def using pair_in_M_iff by simp
 
 (* TODO: MOVE THIS to an appropriate place: subsubsection\<open>The primitive recursion\<close> *)
 
 subsection\<open>Forcing for atomic formulas in context\<close>
 
 definition
   forces_eq :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ = _')\<close> [36,1,1] 60) where
   "forces_eq \<equiv> forces_eq'(P,leq)"
 
 definition
   forces_mem :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ \<in> _')\<close> [36,1,1] 60) where
   "forces_mem \<equiv> forces_mem'(P,leq)"
 
 (* frc_at(P,leq,\<langle>0,t1,t2,p\<rangle>) = 1*)
 abbreviation is_forces_eq
   where "is_forces_eq \<equiv> is_forces_eq'(##M,P,leq)"
 
 (* frc_at(P,leq,\<langle>1,t1,t2,p\<rangle>) = 1*)
 abbreviation
   is_forces_mem :: "[i,i,i] \<Rightarrow> o" where
   "is_forces_mem \<equiv> is_forces_mem'(##M,P,leq)"
 
 lemma def_forces_eq: "p\<in>P \<Longrightarrow> p forces\<^sub>a (t1 = t2) \<longleftrightarrow>
       (\<forall>s\<in>domain(t1) \<union> domain(t2). \<forall>q. q\<in>P \<and> q \<preceq> p \<longrightarrow>
       (q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)))"
   unfolding forces_eq_def forces_mem_def forces_eq'_def forces_mem'_def
   using def_frc_at[of p 0 t1 t2 ]
   unfolding bool_of_o_def
   by auto
 
 lemma def_forces_mem: "p\<in>P \<Longrightarrow> p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow>
      (\<forall>v\<in>P. v \<preceq> p \<longrightarrow>
       (\<exists>q. \<exists>s. \<exists>r. r\<in>P \<and> q\<in>P \<and> q \<preceq> v \<and> \<langle>s,r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> q forces\<^sub>a (t1 = s)))"
   unfolding forces_eq'_def forces_mem'_def forces_eq_def forces_mem_def
   using def_frc_at[of p 1 t1 t2]
   unfolding bool_of_o_def
   by auto
 
 lemma forces_eq_abs :
   "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_eq(p,t1,t2) \<longleftrightarrow> p forces\<^sub>a (t1 = t2)"
   unfolding forces_eq_def
   using forces_eq'_abs by simp
 
 lemma forces_mem_abs :
   "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_mem(p,t1,t2) \<longleftrightarrow> p forces\<^sub>a (t1 \<in> t2)"
   unfolding forces_mem_def
   using forces_mem'_abs
   by simp
 
 definition
   forces_neq :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ \<noteq> _')\<close> [36,1,1] 60) where
   "p forces\<^sub>a (t1 \<noteq> t2) \<equiv> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 = t2))"
 
 definition
   forces_nmem :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ \<notin> _')\<close> [36,1,1] 60) where
   "p forces\<^sub>a (t1 \<notin> t2) \<equiv> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 \<in> t2))"
 
 lemma forces_neq :
   "p forces\<^sub>a (t1 \<noteq> t2) \<longleftrightarrow> forces_neq'(P,leq,p,t1,t2)"
   unfolding forces_neq_def forces_neq'_def forces_eq_def by simp
 
 lemma forces_nmem :
   "p forces\<^sub>a (t1 \<notin> t2) \<longleftrightarrow> forces_nmem'(P,leq,p,t1,t2)"
   unfolding forces_nmem_def forces_nmem'_def forces_mem_def by simp
 
 abbreviation Forces :: "[i, i, i] \<Rightarrow> o"  ("_ \<tturnstile> _ _" [36,36,36] 60) where
   "p \<tturnstile> \<phi> env   \<equiv>   M, ([p,P,leq,\<one>] @ env) \<Turnstile> forces(\<phi>)"
 
 lemma sats_forces_Member :
   assumes  "x\<in>nat" "y\<in>nat" "env\<in>list(M)"
     "nth(x,env)=xx" "nth(y,env)=yy" "q\<in>M"
   shows "q \<tturnstile> \<cdot>x \<in> y\<cdot> env \<longleftrightarrow> q \<in> P \<and> is_forces_mem(q, xx, yy)"
   unfolding forces_def
-  using assms P_in_M leq_in_M one_in_M
+  using assms
   by simp
 
 lemma sats_forces_Equal :
   assumes "a\<in>nat" "b\<in>nat" "env\<in>list(M)" "nth(a,env)=x" "nth(b,env)=y" "q\<in>M"
   shows "q \<tturnstile> \<cdot>a = b\<cdot> env \<longleftrightarrow> q \<in> P \<and> is_forces_eq(q, x, y)"
   unfolding forces_def
-  using assms P_in_M leq_in_M one_in_M
+  using assms
   by simp
 
 lemma sats_forces_Nand :
   assumes "\<phi>\<in>formula" "\<psi>\<in>formula" "env\<in>list(M)" "p\<in>M"
   shows "p \<tturnstile> \<cdot>\<not>(\<phi> \<and> \<psi>)\<cdot> env \<longleftrightarrow>
-    p\<in>P \<and> \<not>(\<exists>q\<in>M. q\<in>P \<and> is_leq(##M,leq,q,p) \<and>
-    (M,[q,P,leq,\<one>]@env \<Turnstile> forces(\<phi>)) \<and> (M,[q,P,leq,\<one>]@env \<Turnstile> forces(\<psi>)))"
+    p\<in>P \<and> \<not>(\<exists>q\<in>M. q\<in>P \<and> is_leq(##M,leq,q,p) \<and> (q \<tturnstile> \<phi> env) \<and> (q \<tturnstile> \<psi> env))"
   unfolding forces_def
-  using sats_is_leq_fm_auto assms sats_ren_forces_nand P_in_M leq_in_M one_in_M zero_in_M
+  using sats_is_leq_fm_auto assms sats_ren_forces_nand zero_in_M
   by simp
 
 lemma sats_forces_Neg :
   assumes "\<phi>\<in>formula" "env\<in>list(M)" "p\<in>M"
   shows "p \<tturnstile> \<cdot>\<not>\<phi>\<cdot> env \<longleftrightarrow>
-         (p\<in>P \<and> \<not>(\<exists>q\<in>M. q\<in>P \<and> is_leq(##M,leq,q,p) \<and> (M, [q, P, leq, \<one>] @ env \<Turnstile> forces(\<phi>))))"
+         (p\<in>P \<and> \<not>(\<exists>q\<in>M. q\<in>P \<and> is_leq(##M,leq,q,p) \<and> (q \<tturnstile> \<phi> env)))"
   unfolding Neg_def using assms sats_forces_Nand
   by simp
 
 lemma sats_forces_Forall :
   assumes "\<phi>\<in>formula" "env\<in>list(M)" "p\<in>M"
-  shows "p \<tturnstile> (\<cdot>\<forall>\<phi>\<cdot>) env \<longleftrightarrow> p \<in> P \<and> (\<forall>x\<in>M. M,[p,P,leq,\<one>,x] @ env \<Turnstile> forces(\<phi>))"
-  unfolding forces_def using assms sats_ren_forces_forall P_in_M leq_in_M one_in_M
+  shows "p \<tturnstile> (\<cdot>\<forall>\<phi>\<cdot>) env \<longleftrightarrow> p \<in> P \<and> (\<forall>x\<in>M. p \<tturnstile> \<phi> ([x] @ env))"
+  unfolding forces_def using assms sats_ren_forces_forall
   by simp
 
 end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Forcing_Data.thy b/thys/Independence_CH/Forcing_Data.thy
--- a/thys/Independence_CH/Forcing_Data.thy
+++ b/thys/Independence_CH/Forcing_Data.thy
@@ -1,143 +1,161 @@
 section\<open>Transitive set models of ZF\<close>
 text\<open>This theory defines locales for countable transitive models of $\ZF$,
 and on top of that, one that includes a forcing notion. Weakened versions
 of both locales are included, that only assume finitely many replacement
 instances.\<close>
 
 theory Forcing_Data
   imports
     Forcing_Notions
     Cohen_Posets_Relative
-    Interface
+    ZF_Trans_Interpretations
 begin
 
-locale M_ctm1 = M_ZF1_trans +
-  fixes enum
-  assumes M_countable:      "enum\<in>bij(nat,M)"
-
-locale M_ctm1_AC = M_ctm1 + M_ZFC1_trans
+no_notation Aleph (\<open>\<aleph>_\<close> [90] 90)
 
 subsection\<open>A forcing locale and generic filters\<close>
 
-txt\<open>Ideally, countability should be separated from the assumption of this locale.
-The fact is that our present proofs of the "definition of forces" (and many
+text\<open>Ideally, countability should be separated from the assumption of this locale.
+The fact is that our present proofs of the “definition of forces” (and many
 consequences) and of the lemma for “forcing a value” of function
 unnecessarily depend on the countability of the ground model. \<close>
 
-locale forcing_data1 = forcing_notion + M_ctm1 +
+locale forcing_data1 = forcing_notion + M_ctm1 + M_ZF_ground_trans +
   assumes P_in_M:           "P \<in> M"
     and leq_in_M:         "leq \<in> M"
 
+locale forcing_data2 = forcing_data1 + M_ctm2
+
+locale forcing_data3 = forcing_data2 + M_ctm3_AC
+
+locale forcing_data4 = forcing_data3 + M_ctm4_AC
+
 context forcing_data1
 begin
 
-(* P \<subseteq> M *)
-lemma P_sub_M : "P\<subseteq>M"
+lemma P_sub_M : "P \<subseteq> M"
   using transitivity P_in_M by auto
 
 definition
   M_generic :: "i\<Rightarrow>o" where
   "M_generic(G) \<equiv> filter(G) \<and> (\<forall>D\<in>M. D\<subseteq>P \<and> dense(D)\<longrightarrow>D\<inter>G\<noteq>0)"
 
-lemma M_genericD [dest]: "M_generic(G) \<Longrightarrow> x\<in>G \<Longrightarrow> x\<in>P"
-  unfolding M_generic_def by (blast dest:filterD)
-
-lemma M_generic_leqD [dest]: "M_generic(G) \<Longrightarrow> p\<in>G \<Longrightarrow> q\<in>P \<Longrightarrow> p\<preceq>q \<Longrightarrow> q\<in>G"
-  unfolding M_generic_def by (blast dest:filter_leqD)
-
-lemma M_generic_compatD [dest]: "M_generic(G) \<Longrightarrow> p\<in>G \<Longrightarrow> r\<in>G \<Longrightarrow> \<exists>q\<in>G. q\<preceq>p \<and> q\<preceq>r"
-  unfolding M_generic_def by (blast dest:low_bound_filter)
-
-lemma M_generic_denseD [dest]: "M_generic(G) \<Longrightarrow> dense(D) \<Longrightarrow> D\<subseteq>P \<Longrightarrow> D\<in>M \<Longrightarrow> \<exists>q\<in>G. q\<in>D"
-  unfolding M_generic_def by blast
-
-lemma G_nonempty: "M_generic(G) \<Longrightarrow> G\<noteq>0"
-  using P_in_M P_dense subset_refl[of P]
-  unfolding M_generic_def
-  by auto
-
-lemma one_in_G :
-  assumes "M_generic(G)"
-  shows  "\<one> \<in> G"
-proof -
-  from assms
-  have "G\<subseteq>P"
-    unfolding M_generic_def filter_def by simp
-  from \<open>M_generic(G)\<close>
-  have "increasing(G)"
-    unfolding M_generic_def filter_def by simp
-  with \<open>G\<subseteq>P\<close> \<open>M_generic(G)\<close>
-  show ?thesis
-    using G_nonempty one_in_P one_max
-    unfolding increasing_def by blast
-qed
-
-lemma G_subset_M: "M_generic(G) \<Longrightarrow> G \<subseteq> M"
-  using transitivity[OF _ P_in_M] by auto
-
 declare iff_trans [trans]
 
 lemma generic_filter_existence:
   "p\<in>P \<Longrightarrow> \<exists>G. p\<in>G \<and> M_generic(G)"
 proof -
   assume "p\<in>P"
   let ?D="\<lambda>n\<in>nat. (if (enum`n\<subseteq>P \<and> dense(enum`n))  then enum`n else P)"
   have "\<forall>n\<in>nat. ?D`n \<in> Pow(P)"
     by auto
   then
   have "?D:nat\<rightarrow>Pow(P)"
     using lam_type by auto
   have "\<forall>n\<in>nat. dense(?D`n)"
   proof(intro ballI)
     fix n
     assume "n\<in>nat"
     then
     have "dense(?D`n) \<longleftrightarrow> dense(if enum`n \<subseteq> P \<and> dense(enum`n) then enum`n else P)"
       by simp
     also
     have "... \<longleftrightarrow>  (\<not>(enum`n \<subseteq> P \<and> dense(enum`n)) \<longrightarrow> dense(P)) "
       using split_if by simp
     finally
     show "dense(?D`n)"
       using P_dense \<open>n\<in>nat\<close> by auto
   qed
   with \<open>?D\<in>_\<close>
   interpret cg: countable_generic P leq \<one> ?D
     by (unfold_locales, auto)
   from \<open>p\<in>P\<close>
   obtain G where 1: "p\<in>G \<and> filter(G) \<and> (\<forall>n\<in>nat.(?D`n)\<inter>G\<noteq>0)"
     using cg.countable_rasiowa_sikorski[where M="\<lambda>_. M"]  P_sub_M
       M_countable[THEN bij_is_fun] M_countable[THEN bij_is_surj, THEN surj_range]
     unfolding cg.D_generic_def by blast
   then
   have "(\<forall>D\<in>M. D\<subseteq>P \<and> dense(D)\<longrightarrow>D\<inter>G\<noteq>0)"
   proof (intro ballI impI)
     fix D
     assume "D\<in>M" and 2: "D \<subseteq> P \<and> dense(D) "
     moreover
     have "\<forall>y\<in>M. \<exists>x\<in>nat. enum`x= y"
       using M_countable and  bij_is_surj unfolding surj_def by (simp)
     moreover from calculation
     obtain n where Eq10: "n\<in>nat \<and> enum`n = D"
       by auto
     moreover from calculation if_P
     have "?D`n = D"
       by simp
     moreover
     note 1
     ultimately
     show "D\<inter>G\<noteq>0"
       by auto
   qed
   with 1
   show ?thesis
     unfolding M_generic_def by auto
 qed
 
 lemma one_in_M: "\<one> \<in> M"
   using one_in_P P_in_M transitivity
   by simp
 
+declare P_in_M [simp,intro]
+declare one_in_M [simp,intro]
+declare leq_in_M [simp,intro]
+declare one_in_P [intro]
+
 end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
 
+locale G_generic1 = forcing_data1 +
+  fixes G :: "i"
+  assumes generic : "M_generic(G)"
+begin
+
+lemma G_nonempty: "G\<noteq>0"
+  using generic subset_refl[of P] P_dense
+  unfolding M_generic_def
+  by auto
+
+lemma M_genericD [dest]: "x\<in>G \<Longrightarrow> x\<in>P"
+  using generic
+  unfolding M_generic_def by (blast dest:filterD)
+
+lemma M_generic_leqD [dest]: "p\<in>G \<Longrightarrow> q\<in>P \<Longrightarrow> p\<preceq>q \<Longrightarrow> q\<in>G"
+  using generic
+  unfolding M_generic_def by (blast dest:filter_leqD)
+
+lemma M_generic_compatD [dest]: "p\<in>G \<Longrightarrow> r\<in>G \<Longrightarrow> \<exists>q\<in>G. q\<preceq>p \<and> q\<preceq>r"
+  using generic
+  unfolding M_generic_def by (blast dest:low_bound_filter)
+
+lemma M_generic_denseD [dest]: "dense(D) \<Longrightarrow> D\<subseteq>P \<Longrightarrow> D\<in>M \<Longrightarrow> \<exists>q\<in>G. q\<in>D"
+  using generic
+  unfolding M_generic_def by blast
+
+lemma G_subset_P: "G\<subseteq>P"
+  using generic
+  unfolding M_generic_def filter_def by simp
+
+lemma one_in_G : "\<one> \<in> G"
+proof -
+  have "increasing(G)"
+    using generic
+    unfolding M_generic_def filter_def by simp
+  then
+  show ?thesis
+    using G_nonempty one_max
+    unfolding increasing_def by blast
+qed
+
+lemma G_subset_M: "G \<subseteq> M"
+  using generic transitivity[OF _ P_in_M] by auto
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+locale G_generic1_AC = G_generic1 + M_ctm1_AC
+
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Forcing_Main.thy b/thys/Independence_CH/Forcing_Main.thy
--- a/thys/Independence_CH/Forcing_Main.thy
+++ b/thys/Independence_CH/Forcing_Main.thy
@@ -1,245 +1,169 @@
 section\<open>The main theorem\<close>
 
 theory Forcing_Main
   imports
     Ordinals_In_MG
     Choice_Axiom
-    ZF_Trans_Interpretations
+    Succession_Poset
 
 begin
 
 subsection\<open>The generic extension is countable\<close>
 
 lemma (in forcing_data1) surj_nat_MG : "\<exists>f. f \<in> surj(\<omega>,M[G])"
 proof -
-  let ?f="\<lambda>n\<in>\<omega>. val(P,G,enum`n)"
-  have "x \<in> \<omega> \<Longrightarrow> val(P,G, enum ` x)\<in> M[G]" for x
-    using GenExt_iff[THEN iffD2, of _ G] bij_is_fun[OF M_countable] by force
+  let ?f="\<lambda>n\<in>\<omega>. val(G,enum`n)"
+  have "x \<in> \<omega> \<Longrightarrow> val(G, enum ` x)\<in> M[G]" for x
+    using GenExtI bij_is_fun[OF M_countable]
+    by simp
   then
   have "?f: \<omega> \<rightarrow> M[G]"
-    using lam_type[of \<omega> "\<lambda>n. val(P,G,enum`n)" "\<lambda>_.M[G]"] by simp
+    using lam_type[of \<omega> "\<lambda>n. val(G,enum`n)" "\<lambda>_.M[G]"] by simp
   moreover
   have "\<exists>n\<in>\<omega>. ?f`n = x" if "x\<in>M[G]" for x
     using that GenExt_iff[of _ G] bij_is_surj[OF M_countable]
     unfolding surj_def by auto
   ultimately
   show ?thesis
     unfolding surj_def by blast
 qed
 
 lemma (in G_generic1) MG_eqpoll_nat: "M[G] \<approx> \<omega>"
 proof -
   obtain f where "f \<in> surj(\<omega>,M[G])"
     using surj_nat_MG by blast
   then
   have "M[G] \<lesssim> \<omega>"
     using well_ord_surj_imp_lepoll well_ord_Memrel[of \<omega>] by simp
   moreover
   have "\<omega> \<lesssim> M[G]"
     using ext.nat_into_M subset_imp_lepoll by (auto del:lepollI)
   ultimately
   show ?thesis
     using eqpollI by simp
 qed
 
 subsection\<open>Extensions of ctms of fragments of $\ZFC$\<close>
 
-lemma M_satT_imp_M_ZF2: "(M \<Turnstile> ZF) \<Longrightarrow> M_ZF2(M)"
-proof -
-  assume "M \<Turnstile> ZF"
-  then
-  have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
-    "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
-    unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
-    using ZFC_fm_sats[of M] by simp_all
-  {
-    fix \<phi> env
-    assume "\<phi> \<in> formula" "env\<in>list(M)"
-    moreover from \<open>M \<Turnstile> ZF\<close>
-    have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
-      "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
-      unfolding ZF_def ZF_schemes_def by auto
-    moreover from calculation
-    have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
-      "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
-      using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
-  }
-  with fin
-  show "M_ZF2(M)"
-    by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
-qed
-
-lemma M_satT_imp_M_ZFC2:
-  shows "(M \<Turnstile> ZFC) \<longrightarrow> M_ZFC2(M)"
-proof -
-  have "(M \<Turnstile> ZF) \<and> choice_ax(##M) \<longrightarrow> M_ZFC2(M)"
-    using M_satT_imp_M_ZF2[of M] unfolding M_ZF2_def M_ZFC1_def M_ZFC2_def
-      M_ZC_basic_def M_ZF1_def M_AC_def by auto
-  then
-  show ?thesis
-    unfolding ZFC_def by auto
-qed
-
-lemma M_satT_instances12_imp_M_ZF2:
-  assumes "(M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms})"
-  shows "M_ZF2(M)"
-proof -
-  from assms
-  have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
-    "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
-    unfolding ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
-    using ZFC_fm_sats[of M] by simp_all
-  moreover
-  {
-    fix \<phi> env
-    from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
-    have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
-      unfolding Zermelo_fms_def ZF_def instances1_fms_def
-        instances2_fms_def by auto
-    moreover
-    assume "\<phi> \<in> formula" "env\<in>list(M)"
-    ultimately
-    have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
-      using sats_ZF_separation_fm_iff by simp_all
-  }
-  moreover
-  {
-    fix \<phi> env
-    assume "\<phi> \<in> instances1_fms \<union> instances2_fms" "env\<in>list(M)"
-    moreover from this and \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
-    have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
-    ultimately
-    have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
-      using sats_ZF_replacement_fm_iff[of \<phi>] instances1_fms_type instances2_fms_type by auto
-  }
-  ultimately
-  show ?thesis
-    unfolding instances1_fms_def instances2_fms_def
-    by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
-qed
-
 context G_generic1
 begin
 
 lemma sats_ground_repl_fm_imp_sats_ZF_replacement_fm:
   assumes
     "\<phi>\<in>formula" "M, [] \<Turnstile> \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot>"
   shows
     "M[G], [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>"
   using assms sats_ZF_replacement_fm_iff
   by (auto simp:replacement_assm_def ground_replacement_assm_def
       intro:strong_replacement_in_MG[simplified])
 
 lemma satT_ground_repl_fm_imp_satT_ZF_replacement_fm:
   assumes
     "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
   shows
     "M[G] \<Turnstile> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}"
   using assms sats_ground_repl_fm_imp_sats_ZF_replacement_fm
   by auto
 
 end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 theorem extensions_of_ctms:
   assumes
-    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}"
+    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms \<union> instances_ground_fms}"
     "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
   shows
     "\<exists>N.
       M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> M\<noteq>N \<and>
       (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)) \<and>
       ((M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and> N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}"
 proof -
-  from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
-  interpret M_ZF2 M
-    using M_satT_instances12_imp_M_ZF2
+  from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> _\<close> \<open>Transset(M)\<close>
+  interpret M_ZF_ground_trans M
+    using M_satT_imp_M_ZF_ground_trans
     by simp
-  from \<open>Transset(M)\<close>
-  interpret M_ZF1_trans M
-    using M_satT_imp_M_ZF2
-    by unfold_locales
   from \<open>M \<approx> \<omega>\<close>
   obtain enum where "enum \<in> bij(\<omega>,M)"
     using eqpoll_sym unfolding eqpoll_def by blast
   then
-  interpret M_ctm2 M enum by unfold_locales simp_all
+  interpret M_ctm2 M enum by unfold_locales
   interpret forcing_data1 "2\<^bsup><\<omega>\<^esup>" seqle 0 M enum
     using nat_into_M seqspace_closed seqle_in_M
     by unfold_locales simp
-  obtain G where "M_generic(G)" "M \<noteq> M\<^bsup>s\<^esup>[G]"
+  obtain G where "M_generic(G)" "M \<noteq> M[G]"
     using cohen_extension_is_proper
     by blast
-  txt\<open>Recall that \<^term>\<open>M\<^bsup>s\<^esup>[G]\<close> denotes the generic extension \<^term>\<open>M\<^bsup>2\<^bsup><\<omega>\<^esup>\<^esup>[G]\<close>
+  text\<open>Recall that \<^term>\<open>M[G]\<close> denotes the generic extension
   of \<^term>\<open>M\<close> using the poset of sequences \<^term>\<open>2\<^bsup><\<omega>\<^esup>\<close>.\<close>
   then
-  interpret G_generic1 "2\<^bsup><\<omega>\<^esup>" seqle 0 _ enum G by unfold_locales
-  interpret MG: M_Z_basic "M\<^bsup>s\<^esup>[G]"
+  interpret G_generic2 "2\<^bsup><\<omega>\<^esup>" seqle 0 _ enum G by unfold_locales
+  interpret MG: M_Z_basic "M[G]"
     using generic pairing_in_MG
       Union_MG  extensionality_in_MG power_in_MG
       foundation_in_MG replacement_assm_MG
       separation_in_MG infinity_in_MG replacement_ax1
     by unfold_locales simp
-  have "M, []\<Turnstile> \<cdot>AC\<cdot> \<Longrightarrow> M\<^bsup>s\<^esup>[G], [] \<Turnstile> \<cdot>AC\<cdot>"
+  have "M, []\<Turnstile> \<cdot>AC\<cdot> \<Longrightarrow> M[G], [] \<Turnstile> \<cdot>AC\<cdot>"
   proof -
     assume "M, [] \<Turnstile> \<cdot>AC\<cdot>"
     then
     have "choice_ax(##M)"
       unfolding ZF_choice_fm_def using ZF_choice_auto by simp
     then
-    have "choice_ax(##M\<^bsup>s\<^esup>[G])" using choice_in_MG by simp
+    have "choice_ax(##M[G])" using choice_in_MG by simp
     then
-    show "M\<^bsup>s\<^esup>[G], [] \<Turnstile> \<cdot>AC\<cdot>"
+    show "M[G], [] \<Turnstile> \<cdot>AC\<cdot>"
       using ZF_choice_auto sats_ZFC_iff_sats_ZF_AC
       unfolding ZF_choice_fm_def by simp
   qed
   moreover
-  note \<open>M \<noteq> M\<^bsup>s\<^esup>[G]\<close> \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
+  note \<open>M \<noteq> M[G]\<close> \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
   moreover
-  have "Transset(M\<^bsup>s\<^esup>[G])" using Transset_MG .
+  have "Transset(M[G])" using Transset_MG .
   moreover
-  have "M \<subseteq> M\<^bsup>s\<^esup>[G]" using M_subset_MG[OF one_in_G] generic by simp
+  have "M \<subseteq> M[G]" using M_subset_MG[OF one_in_G] generic by simp
   ultimately
   show ?thesis
     using Ord_MG_iff MG_eqpoll_nat ext.M_satT_Zermelo_fms
       satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
-    by (rule_tac x="M\<^bsup>s\<^esup>[G]" in exI, auto)
+    by (rule_tac x="M[G]" in exI, auto)
 qed
 
-lemma ZF_replacement_instances12_sub_ZF: "{\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms} \<subseteq> ZF"
-  using instances1_fms_type instances2_fms_type unfolding ZF_def ZF_schemes_def by auto
+lemma ZF_replacement_instances12_sub_ZF: "{\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms \<union> instances_ground_fms} \<subseteq> ZF"
+  using instances1_fms_type instances2_fms_type instances_ground_fms_type
+  unfolding ZF_def ZF_schemes_def by auto
 
 theorem extensions_of_ctms_ZF:
   assumes
     "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZF"
   shows
     "\<exists>N.
       M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZF \<and> M\<noteq>N \<and>
       (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)) \<and>
       ((M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N \<Turnstile> ZFC)"
 proof -
   from assms
   have "\<exists>N.
       M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> M\<noteq>N \<and>
       (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)) \<and>
       ((M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and> N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula}"
     using extensions_of_ctms[of M formula] satT_ZF_imp_satT_Z[of M]
       satT_mono[OF _ ground_repl_fm_sub_ZF, of M]
       satT_mono[OF _ ZF_replacement_instances12_sub_ZF, of M]
     by (auto simp: satT_Un_iff)
   then
   obtain N where "N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula}" "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)"
     "M \<noteq> N" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
     "(M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>"
     by blast
   moreover from \<open>N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula}\<close>
   have "N \<Turnstile> ZF"
     using satT_Z_ZF_replacement_imp_satT_ZF by auto
   moreover from this and \<open>(M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>\<close>
   have "(M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N \<Turnstile> ZFC"
     using sats_ZFC_iff_sats_ZF_AC by simp
   ultimately
   show ?thesis
     by auto
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Forcing_Notions.thy b/thys/Independence_CH/Forcing_Notions.thy
--- a/thys/Independence_CH/Forcing_Notions.thy
+++ b/thys/Independence_CH/Forcing_Notions.thy
@@ -1,424 +1,429 @@
 section\<open>Forcing notions\<close>
 text\<open>This theory defines a locale for forcing notions, that is,
  preorders with a distinguished maximum element.\<close>
 
 theory Forcing_Notions
   imports
     "ZF-Constructible.Relative"
     "Delta_System_Lemma.ZF_Library"
 begin
 
+hide_const (open) Order.pred
+
 subsection\<open>Basic concepts\<close>
 text\<open>We say that two elements $p,q$ are
   \<^emph>\<open>compatible\<close> if they have a lower bound in $P$\<close>
 definition compat_in :: "i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
   "compat_in(A,r,p,q) \<equiv> \<exists>d\<in>A . \<langle>d,p\<rangle>\<in>r \<and> \<langle>d,q\<rangle>\<in>r"
 
 lemma compat_inI :
   "\<lbrakk> d\<in>A ; \<langle>d,p\<rangle>\<in>r ; \<langle>d,g\<rangle>\<in>r \<rbrakk> \<Longrightarrow> compat_in(A,r,p,g)"
   by (auto simp add: compat_in_def)
 
 lemma refl_compat:
   "\<lbrakk> refl(A,r) ; \<langle>p,q\<rangle> \<in> r | p=q | \<langle>q,p\<rangle> \<in> r ; p\<in>A ; q\<in>A\<rbrakk> \<Longrightarrow> compat_in(A,r,p,q)"
   by (auto simp add: refl_def compat_inI)
 
 lemma  chain_compat:
   "refl(A,r) \<Longrightarrow> linear(A,r) \<Longrightarrow>  (\<forall>p\<in>A.\<forall>q\<in>A. compat_in(A,r,p,q))"
   by (simp add: refl_compat linear_def)
 
 lemma subset_fun_image: "f:N\<rightarrow>P \<Longrightarrow> f``N\<subseteq>P"
   by (auto simp add: image_fun apply_funtype)
 
 lemma refl_monot_domain: "refl(B,r) \<Longrightarrow> A\<subseteq>B \<Longrightarrow> refl(A,r)"
   unfolding refl_def by blast
 
 locale forcing_notion =
   fixes P leq one
   assumes one_in_P:       "one \<in> P"
     and leq_preord:       "preorder_on(P,leq)"
     and one_max:          "\<forall>p\<in>P. \<langle>p,one\<rangle>\<in>leq"
 begin
 
 notation one (\<open>\<one>\<close>)
 
 abbreviation Leq :: "[i, i] \<Rightarrow> o"  (infixl "\<preceq>" 50)
   where "x \<preceq> y \<equiv> \<langle>x,y\<rangle>\<in>leq"
 
 lemma refl_leq:
   "r\<in>P \<Longrightarrow> r\<preceq>r"
   using leq_preord unfolding preorder_on_def refl_def by simp
 
 text\<open>A set $D$ is \<^emph>\<open>dense\<close> if every element $p\in P$ has a lower
 bound in $D$.\<close>
 definition
   dense :: "i\<Rightarrow>o" where
   "dense(D) \<equiv> \<forall>p\<in>P. \<exists>d\<in>D . d\<preceq>p"
 
 text\<open>There is also a weaker definition which asks for
 a lower bound in $D$ only for the elements below some fixed
 element $q$.\<close>
 definition
   dense_below :: "i\<Rightarrow>i\<Rightarrow>o" where
   "dense_below(D,q) \<equiv> \<forall>p\<in>P. p\<preceq>q \<longrightarrow> (\<exists>d\<in>D. d\<in>P \<and> d\<preceq>p)"
 
 lemma P_dense: "dense(P)"
   by (insert leq_preord, auto simp add: preorder_on_def refl_def dense_def)
 
 definition
   increasing :: "i\<Rightarrow>o" where
   "increasing(F) \<equiv> \<forall>x\<in>F. \<forall> p \<in> P . x\<preceq>p \<longrightarrow> p\<in>F"
 
 definition
   compat :: "i\<Rightarrow>i\<Rightarrow>o" where
   "compat(p,q) \<equiv> compat_in(P,leq,p,q)"
 
 lemma leq_transD:  "a\<preceq>b \<Longrightarrow> b\<preceq>c \<Longrightarrow> a \<in> P\<Longrightarrow> b \<in> P\<Longrightarrow> c \<in> P\<Longrightarrow> a\<preceq>c"
   using leq_preord trans_onD unfolding preorder_on_def by blast
 
 lemma leq_transD':  "A\<subseteq>P \<Longrightarrow> a\<preceq>b \<Longrightarrow> b\<preceq>c \<Longrightarrow> a \<in> A \<Longrightarrow> b \<in> P\<Longrightarrow> c \<in> P\<Longrightarrow> a\<preceq>c"
   using leq_preord trans_onD subsetD unfolding preorder_on_def by blast
 
 lemma compatD[dest!]: "compat(p,q) \<Longrightarrow> \<exists>d\<in>P. d\<preceq>p \<and> d\<preceq>q"
   unfolding compat_def compat_in_def .
 
 abbreviation Incompatible :: "[i, i] \<Rightarrow> o"  (infixl "\<bottom>" 50)
   where "p \<bottom> q \<equiv> \<not> compat(p,q)"
 
 lemma compatI[intro!]: "d\<in>P \<Longrightarrow> d\<preceq>p \<Longrightarrow> d\<preceq>q \<Longrightarrow> compat(p,q)"
   unfolding compat_def compat_in_def by blast
 
+lemma Incompatible_imp_not_eq: "\<lbrakk> p \<bottom> q; p\<in>P; q\<in>P \<rbrakk>\<Longrightarrow> p \<noteq> q"
+  using refl_leq by blast
+
 lemma denseD [dest]: "dense(D) \<Longrightarrow> p\<in>P \<Longrightarrow>  \<exists>d\<in>D. d\<preceq> p"
   unfolding dense_def by blast
 
 lemma denseI [intro!]: "\<lbrakk> \<And>p. p\<in>P \<Longrightarrow> \<exists>d\<in>D. d\<preceq> p \<rbrakk> \<Longrightarrow> dense(D)"
   unfolding dense_def by blast
 
 lemma dense_belowD [dest]:
   assumes "dense_below(D,p)" "q\<in>P" "q\<preceq>p"
   shows "\<exists>d\<in>D. d\<in>P \<and> d\<preceq>q"
   using assms unfolding dense_below_def by simp
 
 lemma dense_belowI [intro!]:
   assumes "\<And>q. q\<in>P \<Longrightarrow> q\<preceq>p \<Longrightarrow> \<exists>d\<in>D. d\<in>P \<and> d\<preceq>q"
   shows "dense_below(D,p)"
   using assms unfolding dense_below_def by simp
 
 lemma dense_below_cong: "p\<in>P \<Longrightarrow> D = D' \<Longrightarrow> dense_below(D,p) \<longleftrightarrow> dense_below(D',p)"
   by blast
 
 lemma dense_below_cong': "p\<in>P \<Longrightarrow> \<lbrakk>\<And>x. x\<in>P \<Longrightarrow> Q(x) \<longleftrightarrow> Q'(x)\<rbrakk> \<Longrightarrow>
            dense_below({q\<in>P. Q(q)},p) \<longleftrightarrow> dense_below({q\<in>P. Q'(q)},p)"
   by blast
 
 lemma dense_below_mono: "p\<in>P \<Longrightarrow> D \<subseteq> D' \<Longrightarrow> dense_below(D,p) \<Longrightarrow> dense_below(D',p)"
   by blast
 
 lemma dense_below_under:
   assumes "dense_below(D,p)" "p\<in>P" "q\<in>P" "q\<preceq>p"
   shows "dense_below(D,q)"
   using assms leq_transD by blast
 
 lemma ideal_dense_below:
   assumes "\<And>q. q\<in>P \<Longrightarrow> q\<preceq>p \<Longrightarrow> q\<in>D"
   shows "dense_below(D,p)"
   using assms refl_leq by blast
 
 lemma dense_below_dense_below:
   assumes "dense_below({q\<in>P. dense_below(D,q)},p)" "p\<in>P"
   shows "dense_below(D,p)"
   using assms leq_transD refl_leq  by blast
 
 text\<open>A filter is an increasing set $G$ with all its elements
 being compatible in $G$.\<close>
 definition
   filter :: "i\<Rightarrow>o" where
   "filter(G) \<equiv> G\<subseteq>P \<and> increasing(G) \<and> (\<forall>p\<in>G. \<forall>q\<in>G. compat_in(G,leq,p,q))"
 
 lemma filterD : "filter(G) \<Longrightarrow> x \<in> G \<Longrightarrow> x \<in> P"
   by (auto simp add : subsetD filter_def)
 
 lemma filter_leqD : "filter(G) \<Longrightarrow> x \<in> G \<Longrightarrow> y \<in> P \<Longrightarrow> x\<preceq>y \<Longrightarrow> y \<in> G"
   by (simp add: filter_def increasing_def)
 
 lemma filter_imp_compat: "filter(G) \<Longrightarrow> p\<in>G \<Longrightarrow> q\<in>G \<Longrightarrow> compat(p,q)"
   unfolding filter_def compat_in_def compat_def by blast
 
 lemma low_bound_filter: \<comment> \<open>says the compatibility is attained inside G\<close>
   assumes "filter(G)" and "p\<in>G" and "q\<in>G"
   shows "\<exists>r\<in>G. r\<preceq>p \<and> r\<preceq>q"
   using assms
   unfolding compat_in_def filter_def by blast
 
 text\<open>We finally introduce the upward closure of a set
 and prove that the closure of $A$ is a filter if its elements are
 compatible in $A$.\<close>
 definition
   upclosure :: "i\<Rightarrow>i" where
   "upclosure(A) \<equiv> {p\<in>P.\<exists>a\<in>A. a\<preceq>p}"
 
 lemma  upclosureI [intro] : "p\<in>P \<Longrightarrow> a\<in>A \<Longrightarrow> a\<preceq>p \<Longrightarrow> p\<in>upclosure(A)"
   by (simp add:upclosure_def, auto)
 
 lemma  upclosureE [elim] :
   "p\<in>upclosure(A) \<Longrightarrow> (\<And>x a. x\<in>P \<Longrightarrow> a\<in>A \<Longrightarrow> a\<preceq>x \<Longrightarrow> R) \<Longrightarrow> R"
   by (auto simp add:upclosure_def)
 
 lemma  upclosureD [dest] :
   "p\<in>upclosure(A) \<Longrightarrow> \<exists>a\<in>A.(a\<preceq>p) \<and> p\<in>P"
   by (simp add:upclosure_def)
 
 lemma upclosure_increasing :
   assumes "A\<subseteq>P"
   shows "increasing(upclosure(A))"
   unfolding increasing_def upclosure_def
   using leq_transD'[OF \<open>A\<subseteq>P\<close>] by auto
 
 lemma  upclosure_in_P: "A \<subseteq> P \<Longrightarrow> upclosure(A) \<subseteq> P"
   using subsetI upclosure_def by simp
 
 lemma  A_sub_upclosure: "A \<subseteq> P \<Longrightarrow> A\<subseteq>upclosure(A)"
   using subsetI leq_preord
   unfolding upclosure_def preorder_on_def refl_def by auto
 
 lemma  elem_upclosure: "A\<subseteq>P \<Longrightarrow> x\<in>A  \<Longrightarrow> x\<in>upclosure(A)"
   by (blast dest:A_sub_upclosure)
 
 lemma  closure_compat_filter:
   assumes "A\<subseteq>P" "(\<forall>p\<in>A.\<forall>q\<in>A. compat_in(A,leq,p,q))"
   shows "filter(upclosure(A))"
   unfolding filter_def
 proof(auto)
   show "increasing(upclosure(A))"
     using assms upclosure_increasing by simp
 next
   let ?UA="upclosure(A)"
   show "compat_in(upclosure(A), leq, p, q)" if "p\<in>?UA" "q\<in>?UA" for p q
   proof -
     from that
     obtain a b where 1:"a\<in>A" "b\<in>A" "a\<preceq>p" "b\<preceq>q" "p\<in>P" "q\<in>P"
       using upclosureD[OF \<open>p\<in>?UA\<close>] upclosureD[OF \<open>q\<in>?UA\<close>] by auto
     with assms(2)
     obtain d where "d\<in>A" "d\<preceq>a" "d\<preceq>b"
       unfolding compat_in_def by auto
     with 1
     have "d\<preceq>p" "d\<preceq>q" "d\<in>?UA"
       using A_sub_upclosure[THEN subsetD] \<open>A\<subseteq>P\<close>
         leq_transD'[of A d a] leq_transD'[of A d b] by auto
     then
     show ?thesis unfolding compat_in_def by auto
   qed
 qed
 
 lemma  aux_RS1:  "f \<in> N \<rightarrow> P \<Longrightarrow> n\<in>N \<Longrightarrow> f`n \<in> upclosure(f ``N)"
   using elem_upclosure[OF subset_fun_image] image_fun
   by (simp, blast)
 
 lemma decr_succ_decr:
   assumes "f \<in> nat \<rightarrow> P" "preorder_on(P,leq)"
     "\<forall>n\<in>nat.  \<langle>f ` succ(n), f ` n\<rangle> \<in> leq"
     "m\<in>nat"
   shows "n\<in>nat \<Longrightarrow> n\<le>m \<Longrightarrow> \<langle>f ` m, f ` n\<rangle> \<in> leq"
   using \<open>m\<in>_\<close>
 proof(induct m)
   case 0
   then show ?case using assms refl_leq by simp
 next
   case (succ x)
   then
   have 1:"f`succ(x) \<preceq> f`x" "f`n\<in>P" "f`x\<in>P" "f`succ(x)\<in>P"
     using assms by simp_all
   consider (lt) "n<succ(x)" | (eq) "n=succ(x)"
     using succ le_succ_iff by auto
   then
   show ?case
   proof(cases)
     case lt
     with 1 show ?thesis using leI succ leq_transD by auto
   next
     case eq
     with 1 show ?thesis using refl_leq by simp
   qed
 qed
 
 lemma decr_seq_linear:
   assumes "refl(P,leq)" "f \<in> nat \<rightarrow> P"
     "\<forall>n\<in>nat.  \<langle>f ` succ(n), f ` n\<rangle> \<in> leq"
     "trans[P](leq)"
   shows "linear(f `` nat, leq)"
 proof -
   have "preorder_on(P,leq)"
     unfolding preorder_on_def using assms by simp
   {
     fix n m
     assume "n\<in>nat" "m\<in>nat"
     then
     have "f`m \<preceq> f`n \<or> f`n \<preceq> f`m"
     proof(cases "m\<le>n")
       case True
       with \<open>n\<in>_\<close> \<open>m\<in>_\<close>
       show ?thesis
         using decr_succ_decr[of f n m] assms leI \<open>preorder_on(P,leq)\<close> by simp
     next
       case False
       with \<open>n\<in>_\<close> \<open>m\<in>_\<close>
       show ?thesis
         using decr_succ_decr[of f m n] assms leI not_le_iff_lt \<open>preorder_on(P,leq)\<close> by simp
     qed
   }
   then
   show ?thesis
     unfolding linear_def using ball_image_simp assms by auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>forcing_notion\<close>\<close>
 
 subsection\<open>Towards Rasiowa-Sikorski Lemma (RSL)\<close>
 locale countable_generic = forcing_notion +
   fixes \<D>
   assumes countable_subs_of_P:  "\<D> \<in> nat\<rightarrow>Pow(P)"
     and     seq_of_denses:        "\<forall>n \<in> nat. dense(\<D>`n)"
 
 begin
 
 definition
   D_generic :: "i\<Rightarrow>o" where
   "D_generic(G) \<equiv> filter(G) \<and> (\<forall>n\<in>nat.(\<D>`n)\<inter>G\<noteq>0)"
 
 text\<open>The next lemma identifies a sufficient condition for obtaining
 RSL.\<close>
 lemma RS_sequence_imp_rasiowa_sikorski:
   assumes
     "p\<in>P" "f : nat\<rightarrow>P" "f ` 0 = p"
     "\<And>n. n\<in>nat \<Longrightarrow> f ` succ(n)\<preceq> f ` n \<and> f ` succ(n) \<in> \<D> ` n"
   shows
     "\<exists>G. p\<in>G \<and> D_generic(G)"
 proof -
   note assms
   moreover from this
   have "f``nat  \<subseteq> P"
     by (simp add:subset_fun_image)
   moreover from calculation
   have "refl(f``nat, leq) \<and> trans[P](leq)"
     using leq_preord unfolding preorder_on_def by (blast intro:refl_monot_domain)
   moreover from calculation
   have "\<forall>n\<in>nat.  f ` succ(n)\<preceq> f ` n" by (simp)
   moreover from calculation
   have "linear(f``nat, leq)"
     using leq_preord and decr_seq_linear unfolding preorder_on_def by (blast)
   moreover from calculation
   have "(\<forall>p\<in>f``nat.\<forall>q\<in>f``nat. compat_in(f``nat,leq,p,q))"
     using chain_compat by (auto)
   ultimately
   have "filter(upclosure(f``nat))" (is "filter(?G)")
     using closure_compat_filter by simp
   moreover
   have "\<forall>n\<in>nat. \<D> ` n \<inter> ?G \<noteq> 0"
   proof
     fix n
     assume "n\<in>nat"
     with assms
     have "f`succ(n) \<in> ?G \<and> f`succ(n) \<in> \<D> ` n"
       using aux_RS1 by simp
     then
     show "\<D> ` n \<inter> ?G \<noteq> 0"  by blast
   qed
   moreover from assms
   have "p \<in> ?G"
     using aux_RS1 by auto
   ultimately
   show ?thesis unfolding D_generic_def by auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>countable_generic\<close>\<close>
 
 text\<open>Now, the following recursive definition will fulfill the
 requirements of lemma \<^term>\<open>RS_sequence_imp_rasiowa_sikorski\<close> \<close>
 
 consts RS_seq :: "[i,i,i,i,i,i] \<Rightarrow> i"
 primrec
   "RS_seq(0,P,leq,p,enum,\<D>) = p"
   "RS_seq(succ(n),P,leq,p,enum,\<D>) =
     enum`(\<mu> m. \<langle>enum`m, RS_seq(n,P,leq,p,enum,\<D>)\<rangle> \<in> leq \<and> enum`m \<in> \<D> ` n)"
 
 context countable_generic
 begin
 
 lemma countable_RS_sequence_aux:
   fixes p enum
   defines "f(n) \<equiv> RS_seq(n,P,leq,p,enum,\<D>)"
     and   "Q(q,k,m) \<equiv> enum`m\<preceq> q \<and> enum`m \<in> \<D> ` k"
   assumes "n\<in>nat" "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
     "\<And>x k. x\<in>P \<Longrightarrow> k\<in>nat \<Longrightarrow>  \<exists>q\<in>P. q\<preceq> x \<and> q \<in> \<D> ` k"
   shows
     "f(succ(n)) \<in> P \<and> f(succ(n))\<preceq> f(n) \<and> f(succ(n)) \<in> \<D> ` n"
   using \<open>n\<in>nat\<close>
 proof (induct)
   case 0
   from assms
   obtain q where "q\<in>P" "q\<preceq> p" "q \<in> \<D> ` 0" by blast
   moreover from this and \<open>P \<subseteq> range(enum)\<close>
   obtain m where "m\<in>nat" "enum`m = q"
     using Pi_rangeD[OF \<open>enum:nat\<rightarrow>M\<close>] by blast
   moreover
   have "\<D>`0 \<subseteq> P"
     using apply_funtype[OF countable_subs_of_P] by simp
   moreover note \<open>p\<in>P\<close>
   ultimately
   show ?case
     using LeastI[of "Q(p,0)" m] unfolding Q_def f_def by auto
 next
   case (succ n)
   with assms
   obtain q where "q\<in>P" "q\<preceq> f(succ(n))" "q \<in> \<D> ` succ(n)" by blast
   moreover from this and \<open>P \<subseteq> range(enum)\<close>
   obtain m where "m\<in>nat" "enum`m\<preceq> f(succ(n))" "enum`m \<in> \<D> ` succ(n)"
     using Pi_rangeD[OF \<open>enum:nat\<rightarrow>M\<close>] by blast
   moreover note succ
   moreover from calculation
   have "\<D>`succ(n) \<subseteq> P"
     using apply_funtype[OF countable_subs_of_P] by auto
   ultimately
   show ?case
     using LeastI[of "Q(f(succ(n)),succ(n))" m] unfolding Q_def f_def by auto
 qed
 
 lemma countable_RS_sequence:
   fixes p enum
   defines "f \<equiv> \<lambda>n\<in>nat. RS_seq(n,P,leq,p,enum,\<D>)"
     and   "Q(q,k,m) \<equiv> enum`m\<preceq> q \<and> enum`m \<in> \<D> ` k"
   assumes "n\<in>nat" "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
   shows
     "f`0 = p" "f`succ(n)\<preceq> f`n \<and> f`succ(n) \<in> \<D> ` n" "f`succ(n) \<in> P"
 proof -
   from assms
   show "f`0 = p" by simp
   {
     fix x k
     assume "x\<in>P" "k\<in>nat"
     then
     have "\<exists>q\<in>P. q\<preceq> x \<and> q \<in> \<D> ` k"
       using seq_of_denses apply_funtype[OF countable_subs_of_P]
       unfolding dense_def by blast
   }
   with assms
   show "f`succ(n)\<preceq> f`n \<and> f`succ(n) \<in> \<D> ` n" "f`succ(n)\<in>P"
     unfolding f_def using countable_RS_sequence_aux by simp_all
 qed
 
 lemma RS_seq_type:
   assumes "n \<in> nat" "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
   shows "RS_seq(n,P,leq,p,enum,\<D>) \<in> P"
   using assms countable_RS_sequence(1,3)
   by (induct;simp)
 
 lemma RS_seq_funtype:
   assumes "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
   shows "(\<lambda>n\<in>nat. RS_seq(n,P,leq,p,enum,\<D>)): nat \<rightarrow> P"
   using assms lam_type RS_seq_type by auto
 
 lemmas countable_rasiowa_sikorski =
   RS_sequence_imp_rasiowa_sikorski[OF _ RS_seq_funtype countable_RS_sequence(1,2)]
 
 end \<comment> \<open>\<^locale>\<open>countable_generic\<close>\<close>
 
 end
diff --git a/thys/Independence_CH/Forcing_Theorems.thy b/thys/Independence_CH/Forcing_Theorems.thy
--- a/thys/Independence_CH/Forcing_Theorems.thy
+++ b/thys/Independence_CH/Forcing_Theorems.thy
@@ -1,1516 +1,1528 @@
 section\<open>The Forcing Theorems\<close>
 
 theory Forcing_Theorems
   imports
     Cohen_Posets_Relative
     Forces_Definition
     Names
 
 begin
 
 context forcing_data1
 begin
 
 subsection\<open>The forcing relation in context\<close>
 
 lemma separation_forces :
   assumes
     fty: "\<phi>\<in>formula" and
     far: "arity(\<phi>)\<le>length(env)" and
     envty: "env\<in>list(M)"
   shows
     "separation(##M,\<lambda>p. (p \<tturnstile> \<phi> env))"
-  using separation_ax arity_forces far fty P_in_M leq_in_M one_in_M envty arity_forces_le
+  using separation_ax arity_forces far fty envty arity_forces_le
     transitivity[of _ P]
   by simp
 
 lemma Collect_forces :
   assumes
     "\<phi>\<in>formula" and
     "arity(\<phi>)\<le>length(env)" and
     "env\<in>list(M)"
   shows
     "{p\<in>P . p \<tturnstile> \<phi> env} \<in> M"
-  using assms separation_forces separation_closed P_in_M
+  using assms separation_forces separation_closed
   by simp
 
 lemma forces_mem_iff_dense_below:  "p\<in>P \<Longrightarrow> p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow> dense_below(
     {q\<in>P. \<exists>s. \<exists>r. r\<in>P \<and> \<langle>s,r\<rangle> \<in> t2 \<and> q\<preceq>r \<and> q forces\<^sub>a (t1 = s)}
     ,p)"
   using def_forces_mem[of p t1 t2] by blast
 
 subsection\<open>Kunen 2013, Lemma IV.2.37(a)\<close>
 
 lemma strengthening_eq:
   assumes "p\<in>P" "r\<in>P" "r\<preceq>p" "p forces\<^sub>a (t1 = t2)"
   shows "r forces\<^sub>a (t1 = t2)"
   using assms def_forces_eq[of _ t1 t2] leq_transD by blast
     (* Long proof *)
     (*
 proof -
   {
     fix s q
     assume "q\<preceq> r" "q\<in>P"
     with assms
     have "q\<preceq>p"
       using leq_preord unfolding preorder_on_def trans_on_def by blast
     moreover
     note \<open>q\<in>P\<close> assms
     moreover
     assume "s\<in>domain(t1) \<union> domain(t2)"
     ultimately
     have "q forces\<^sub>a ( s \<in>  t1) \<longleftrightarrow> q forces\<^sub>a ( s \<in>  t2)"
       using def_forces_eq[of p t1 t2] by simp
   }
   with \<open>r\<in>P\<close>
   show ?thesis using def_forces_eq[of r t1 t2] by blast
 qed
 *)
 
 subsection\<open>Kunen 2013, Lemma IV.2.37(a)\<close>
 lemma strengthening_mem:
   assumes "p\<in>P" "r\<in>P" "r\<preceq>p" "p forces\<^sub>a (t1 \<in> t2)"
   shows "r forces\<^sub>a (t1 \<in> t2)"
   using assms forces_mem_iff_dense_below dense_below_under by auto
 
 subsection\<open>Kunen 2013, Lemma IV.2.37(b)\<close>
 lemma density_mem:
   assumes "p\<in>P"
   shows "p forces\<^sub>a (t1 \<in> t2)  \<longleftrightarrow> dense_below({q\<in>P. q forces\<^sub>a (t1 \<in> t2)},p)"
 proof
   assume "p forces\<^sub>a (t1 \<in> t2)"
   with assms
   show "dense_below({q\<in>P. q forces\<^sub>a (t1 \<in> t2)},p)"
     using forces_mem_iff_dense_below strengthening_mem[of p] ideal_dense_below by auto
 next
   assume "dense_below({q \<in> P . q forces\<^sub>a ( t1 \<in>  t2)}, p)"
   with assms
   have "dense_below({q\<in>P.
     dense_below({q'\<in>P. \<exists>s r. r \<in> P \<and> \<langle>s,r\<rangle>\<in>t2 \<and> q'\<preceq>r \<and> q' forces\<^sub>a (t1 = s)},q)
     },p)"
     using forces_mem_iff_dense_below by simp
   with assms
   show "p forces\<^sub>a (t1 \<in> t2)"
     using dense_below_dense_below forces_mem_iff_dense_below[of p t1 t2] by blast
 qed
 
 lemma aux_density_eq:
   assumes
     "dense_below(
     {q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow> q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)}
     ,p)"
     "q forces\<^sub>a (s \<in> t1)" "q\<in>P" "p\<in>P" "q\<preceq>p"
   shows
     "dense_below({r\<in>P. r forces\<^sub>a (s \<in> t2)},q)"
 proof
   fix r
   assume "r\<in>P" "r\<preceq>q"
   moreover from this and \<open>p\<in>P\<close> \<open>q\<preceq>p\<close> \<open>q\<in>P\<close>
   have "r\<preceq>p"
     using leq_transD by simp
   moreover
   note \<open>q forces\<^sub>a (s \<in> t1)\<close> \<open>dense_below(_,p)\<close> \<open>q\<in>P\<close>
   ultimately
   obtain q1 where "q1\<preceq>r" "q1\<in>P" "q1 forces\<^sub>a (s \<in> t2)"
     using strengthening_mem[of q _ s t1] refl_leq leq_transD[of _ r q] by blast
   then
   show "\<exists>d\<in>{r \<in> P . r forces\<^sub>a ( s \<in>  t2)}. d \<in> P \<and> d\<preceq> r"
     by blast
 qed
 
 (* Kunen 2013, Lemma IV.2.37(b) *)
 lemma density_eq:
   assumes "p\<in>P"
   shows "p forces\<^sub>a (t1 = t2)  \<longleftrightarrow> dense_below({q\<in>P. q forces\<^sub>a (t1 = t2)},p)"
 proof
   assume "p forces\<^sub>a (t1 = t2)"
   with \<open>p\<in>P\<close>
   show "dense_below({q\<in>P. q forces\<^sub>a (t1 = t2)},p)"
     using strengthening_eq ideal_dense_below by auto
 next
   assume "dense_below({q\<in>P. q forces\<^sub>a (t1 = t2)},p)"
   {
     fix s q
     let ?D1="{q'\<in>P. \<forall>s\<in>domain(t1) \<union> domain(t2). \<forall>q. q \<in> P \<and> q\<preceq>q' \<longrightarrow>
            q forces\<^sub>a (s \<in> t1)\<longleftrightarrow>q forces\<^sub>a (s \<in> t2)}"
     let ?D2="{q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow> q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)}"
     assume "s\<in>domain(t1) \<union> domain(t2)"
     then
     have "?D1\<subseteq>?D2" by blast
     with \<open>dense_below(_,p)\<close>
     have "dense_below({q'\<in>P. \<forall>s\<in>domain(t1) \<union> domain(t2). \<forall>q. q \<in> P \<and> q\<preceq>q' \<longrightarrow>
            q forces\<^sub>a (s \<in> t1)\<longleftrightarrow>q forces\<^sub>a (s \<in> t2)},p)"
       using dense_below_cong'[OF \<open>p\<in>P\<close> def_forces_eq[of _ t1 t2]] by simp
     with \<open>p\<in>P\<close> \<open>?D1\<subseteq>?D2\<close>
     have "dense_below({q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow>
             q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)},p)"
       using dense_below_mono by simp
     moreover from this (* Automatic tools can't handle this symmetry
                           in order to apply aux_density_eq below *)
     have  "dense_below({q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow>
             q forces\<^sub>a (s \<in> t2) \<longleftrightarrow> q forces\<^sub>a (s \<in> t1)},p)"
       by blast
     moreover
     assume "q \<in> P" "q\<preceq>p"
     moreover
     note \<open>p\<in>P\<close>
     ultimately (*We can omit the next step but it is slower *)
     have "q forces\<^sub>a (s \<in> t1) \<Longrightarrow> dense_below({r\<in>P. r forces\<^sub>a (s \<in> t2)},q)"
       "q forces\<^sub>a (s \<in> t2) \<Longrightarrow> dense_below({r\<in>P. r forces\<^sub>a (s \<in> t1)},q)"
       using aux_density_eq by simp_all
     then
     have "q forces\<^sub>a ( s \<in>  t1) \<longleftrightarrow> q forces\<^sub>a ( s \<in>  t2)"
       using density_mem[OF \<open>q\<in>P\<close>] by blast
   }
   with \<open>p\<in>P\<close>
   show "p forces\<^sub>a (t1 = t2)" using def_forces_eq by blast
 qed
 
 subsection\<open>Kunen 2013, Lemma IV.2.38\<close>
 lemma not_forces_neq:
   assumes "p\<in>P"
   shows "p forces\<^sub>a (t1 = t2) \<longleftrightarrow> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 \<noteq> t2))"
   using assms density_eq unfolding forces_neq_def by blast
 
 lemma not_forces_nmem:
   assumes "p\<in>P"
   shows "p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 \<notin> t2))"
   using assms density_mem unfolding forces_nmem_def by blast
 
 subsection\<open>The relation of forcing and atomic formulas\<close>
 lemma Forces_Equal:
   assumes
     "p\<in>P" "t1\<in>M" "t2\<in>M" "env\<in>list(M)" "nth(n,env) = t1" "nth(m,env) = t2" "n\<in>nat" "m\<in>nat"
   shows
     "(p \<tturnstile> Equal(n,m) env) \<longleftrightarrow> p forces\<^sub>a (t1 = t2)"
-  using assms sats_forces_Equal forces_eq_abs transitivity P_in_M
+  using assms sats_forces_Equal forces_eq_abs transitivity
   by simp
 
 lemma Forces_Member:
   assumes
     "p\<in>P" "t1\<in>M" "t2\<in>M" "env\<in>list(M)" "nth(n,env) = t1" "nth(m,env) = t2" "n\<in>nat" "m\<in>nat"
   shows
     "(p \<tturnstile> Member(n,m) env) \<longleftrightarrow> p forces\<^sub>a (t1 \<in> t2)"
-  using assms sats_forces_Member forces_mem_abs transitivity P_in_M
+  using assms sats_forces_Member forces_mem_abs transitivity
   by simp
 
 lemma Forces_Neg:
   assumes
     "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula"
   shows
     "(p \<tturnstile> Neg(\<phi>) env) \<longleftrightarrow> \<not>(\<exists>q\<in>M. q\<in>P \<and> q\<preceq>p \<and> (q \<tturnstile> \<phi> env))"
-  using assms sats_forces_Neg transitivity P_in_M pair_in_M_iff leq_in_M leq_abs
+  using assms sats_forces_Neg transitivity pair_in_M_iff leq_abs
   by simp
 
 subsection\<open>The relation of forcing and connectives\<close>
 
 lemma Forces_Nand:
   assumes
     "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
   shows
     "(p \<tturnstile> Nand(\<phi>,\<psi>) env) \<longleftrightarrow> \<not>(\<exists>q\<in>M. q\<in>P \<and> q\<preceq>p \<and> (q \<tturnstile> \<phi> env) \<and> (q \<tturnstile> \<psi> env))"
-  using assms sats_forces_Nand transitivity
-    P_in_M pair_in_M_iff leq_in_M leq_abs by simp
+  using assms sats_forces_Nand transitivity pair_in_M_iff leq_abs by simp
 
 lemma Forces_And_aux:
   assumes
     "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
   shows
     "p \<tturnstile> And(\<phi>,\<psi>) env   \<longleftrightarrow>
     (\<forall>q\<in>M. q\<in>P \<and> q\<preceq>p \<longrightarrow> (\<exists>r\<in>M. r\<in>P \<and> r\<preceq>q \<and> (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)))"
   unfolding And_def using assms Forces_Neg Forces_Nand by (auto simp only:)
 
 lemma Forces_And_iff_dense_below:
   assumes
     "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
   shows
     "(p \<tturnstile> And(\<phi>,\<psi>) env) \<longleftrightarrow> dense_below({r\<in>P. (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env) },p)"
   unfolding dense_below_def using Forces_And_aux assms
   by (auto dest:transitivity[OF _ P_in_M]; rename_tac q; drule_tac x=q in bspec)+
 
 lemma Forces_Forall:
   assumes
     "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula"
   shows
     "(p \<tturnstile> Forall(\<phi>) env) \<longleftrightarrow> (\<forall>x\<in>M. (p \<tturnstile> \<phi> ([x] @ env)))"
   using sats_forces_Forall assms transitivity[OF _ P_in_M]
   by simp
 
-(* "x\<in>val(P,G,\<pi>) \<Longrightarrow> \<exists>\<theta>. \<exists>p\<in>G.  \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x" *)
+(* "x\<in>val(G,\<pi>) \<Longrightarrow> \<exists>\<theta>. \<exists>p\<in>G.  \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(G,\<theta>) = x" *)
 bundle some_rules =  elem_of_val_pair [dest]
 
 context
   includes some_rules
 begin
 
-lemma elem_of_valI: "\<exists>\<theta>. \<exists>p\<in>P. p\<in>G \<and> \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x \<Longrightarrow> x\<in>val(P,G,\<pi>)"
+lemma elem_of_valI: "\<exists>\<theta>. \<exists>p\<in>P. p\<in>G \<and> \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(G,\<theta>) = x \<Longrightarrow> x\<in>val(G,\<pi>)"
   by (subst def_val, auto)
 
-lemma GenExt_iff: "x\<in>M[G] \<longleftrightarrow> (\<exists>\<tau>\<in>M. x = val(P,G,\<tau>))"
+lemma GenExt_iff: "x\<in>M[G] \<longleftrightarrow> (\<exists>\<tau>\<in>M. x = val(G,\<tau>))"
   unfolding GenExt_def by simp
+end
+
+end
+context G_generic1
+  
+begin
 
 subsection\<open>Kunen 2013, Lemma IV.2.29\<close>
 lemma generic_inter_dense_below:
-  assumes "D\<in>M" "M_generic(G)" "dense_below(D,p)" "p\<in>G"
+  assumes "D\<in>M" "dense_below(D,p)" "p\<in>G"
   shows "D \<inter> G \<noteq> 0"
 proof -
   let ?D="{q\<in>P. p\<bottom>q \<or> q\<in>D}"
   have "dense(?D)"
   proof
     fix r
     assume "r\<in>P"
     show "\<exists>d\<in>{q \<in> P . p \<bottom> q \<or> q \<in> D}. d \<preceq> r"
     proof (cases "p \<bottom> r")
       case True
       with \<open>r\<in>P\<close>
         (* Automatic tools can't handle this case for some reason... *)
       show ?thesis using refl_leq[of r] by (intro bexI) (blast+)
     next
       case False
       then
       obtain s where "s\<in>P" "s\<preceq>p" "s\<preceq>r" by blast
       with assms \<open>r\<in>P\<close>
       show ?thesis
-        using dense_belowD[OF assms(3), of s] leq_transD[of _ s r]
+        using dense_belowD[OF assms(2), of s] leq_transD[of _ s r]
         by blast
     qed
   qed
   have "?D\<subseteq>P" by auto
-      (* D\<in>M *)
   let ?d_fm="\<cdot>\<cdot>\<not>compat_in_fm(1, 2, 3, 0) \<cdot> \<or> \<cdot>0 \<in> 4\<cdot>\<cdot>"
-  have 1:"p\<in>M"
-    using \<open>M_generic(G)\<close> M_genericD transitivity[OF _ P_in_M]
-      \<open>p\<in>G\<close> by simp
+  from \<open>p\<in>G\<close>
+  have "p\<in>M"
+    using G_subset_M subsetD by simp
   moreover
   have "?d_fm\<in>formula" by simp
   moreover
   have "arity(?d_fm) = 5"
     by (auto simp add: arity)
-  moreover
+  moreover from \<open>D\<in>M\<close> \<open>p\<in>M\<close>
   have "(M, [q,P,leq,p,D] \<Turnstile> ?d_fm) \<longleftrightarrow> (\<not> is_compat_in(##M,P,leq,p,q) \<or> q\<in>D)"
     if "q\<in>M" for q
-    using that sats_compat_in_fm P_in_M leq_in_M 1 \<open>D\<in>M\<close> zero_in_M
+    using that sats_compat_in_fm zero_in_M
     by simp
-  moreover
+  moreover from \<open>p\<in>M\<close>
   have "(\<not> is_compat_in(##M,P,leq,p,q) \<or> q\<in>D) \<longleftrightarrow> p\<bottom>q \<or> q\<in>D" if "q\<in>M" for q
     unfolding compat_def
-    using that compat_in_abs P_in_M leq_in_M 1
+    using that compat_in_abs
     by simp
   ultimately
   have "?D\<in>M"
-    using Collect_in_M[of ?d_fm "[P,leq,p,D]"] P_in_M leq_in_M \<open>D\<in>M\<close>
+    using Collect_in_M[of ?d_fm "[P,leq,p,D]"] \<open>D\<in>M\<close>
     by simp
-  note asm = \<open>M_generic(G)\<close> \<open>dense(?D)\<close> \<open>?D\<subseteq>P\<close> \<open>?D\<in>M\<close>
-  obtain x where "x\<in>G" "x\<in>?D" using M_generic_denseD[OF asm]
+  note asm = \<open>dense(?D)\<close> \<open>?D\<subseteq>P\<close> \<open>?D\<in>M\<close>
+  obtain x where "x\<in>G" "x\<in>?D" 
+    using M_generic_denseD[OF asm]
     by force (* by (erule bexE) does it, but the other automatic tools don't *)
-  moreover from this and \<open>M_generic(G)\<close>
+  moreover from this
   have "x\<in>D"
     using M_generic_compatD[OF _ \<open>p\<in>G\<close>, of x] refl_leq compatI[of _ p x]
     by force
   ultimately
   show ?thesis by auto
 qed
 
 subsection\<open>Auxiliary results for Lemma IV.2.40(a)\<close>
-lemma IV240a_mem_Collect:
+lemma (in forcing_data1) IV240a_mem_Collect:
   assumes
     "\<pi>\<in>M" "\<tau>\<in>M"
   shows
     "{q\<in>P. \<exists>\<sigma>. \<exists>r. r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>)}\<in>M"
 proof -
   let ?rel_pred= "\<lambda>M x a1 a2 a3 a4. \<exists>\<sigma>[M]. \<exists>r[M]. \<exists>\<sigma>r[M].
                 r\<in>a1 \<and> pair(M,\<sigma>,r,\<sigma>r) \<and> \<sigma>r\<in>a4 \<and> is_leq(M,a2,x,r) \<and> is_forces_eq'(M,a1,a2,x,a3,\<sigma>)"
   let ?\<phi>="Exists(Exists(Exists(And(Member(1,4),And(pair_fm(2,1,0),
           And(Member(0,7),And(is_leq_fm(5,3,1),forces_eq_fm(4,5,3,6,2))))))))"
   have "\<sigma>\<in>M \<and> r\<in>M" if "\<langle>\<sigma>, r\<rangle> \<in> \<tau>"  for \<sigma> r
     using that \<open>\<tau>\<in>M\<close> pair_in_M_iff transitivity[of "\<langle>\<sigma>,r\<rangle>" \<tau>] by simp
   then
   have "?rel_pred(##M,q,P,leq,\<pi>,\<tau>) \<longleftrightarrow> (\<exists>\<sigma>. \<exists>r. r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>))"
     if "q\<in>M" for q
     unfolding forces_eq_def
-    using assms that P_in_M leq_in_M leq_abs forces_eq'_abs pair_in_M_iff
+    using assms that leq_abs forces_eq'_abs pair_in_M_iff
     by auto
   moreover
   have "(M, [q,P,leq,\<pi>,\<tau>] \<Turnstile> ?\<phi>) \<longleftrightarrow> ?rel_pred(##M,q,P,leq,\<pi>,\<tau>)" if "q\<in>M" for q
-    using assms that sats_forces_eq_fm sats_is_leq_fm P_in_M leq_in_M zero_in_M
+    using assms that sats_forces_eq_fm sats_is_leq_fm zero_in_M
     by simp
   moreover
   have "?\<phi>\<in>formula" by simp
   moreover
   have "arity(?\<phi>)=5"
     using arity_forces_eq_fm
     by (simp add:ord_simp_union arity)
   ultimately
   show ?thesis
-    unfolding forces_eq_def using P_in_M leq_in_M assms Collect_in_M[of ?\<phi> "[P,leq,\<pi>,\<tau>]"]
+    unfolding forces_eq_def using assms Collect_in_M[of ?\<phi> "[P,leq,\<pi>,\<tau>]"]
     by simp
 qed
 
 (* Lemma IV.2.40(a), membership *)
 lemma IV240a_mem:
   assumes
-    "M_generic(G)" "p\<in>G" "\<pi>\<in>M" "\<tau>\<in>M" "p forces\<^sub>a (\<pi> \<in> \<tau>)"
+    "p\<in>G" "\<pi>\<in>M" "\<tau>\<in>M" "p forces\<^sub>a (\<pi> \<in> \<tau>)"
     "\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<Longrightarrow> q forces\<^sub>a (\<pi> = \<sigma>) \<Longrightarrow>
-      val(P,G,\<pi>) = val(P,G,\<sigma>)" (* inductive hypothesis *)
+      val(G,\<pi>) = val(G,\<sigma>)" (* inductive hypothesis *)
   shows
-    "val(P,G,\<pi>)\<in>val(P,G,\<tau>)"
+    "val(G,\<pi>)\<in>val(G,\<tau>)"
 proof (intro elem_of_valI)
   let ?D="{q\<in>P. \<exists>\<sigma>. \<exists>r. r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>)}"
-  from \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
+  from \<open>p\<in>G\<close>
   have "p\<in>P" by blast
   moreover
   note \<open>\<pi>\<in>M\<close> \<open>\<tau>\<in>M\<close>
   ultimately
   have "?D \<in> M" using IV240a_mem_Collect by simp
   moreover from assms \<open>p\<in>P\<close>
   have "dense_below(?D,p)"
     using forces_mem_iff_dense_below by simp
   moreover
-  note \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
+  note \<open>p\<in>G\<close>
   ultimately
-  obtain q where "q\<in>G" "q\<in>?D" using generic_inter_dense_below by blast
+  obtain q where "q\<in>G" "q\<in>?D" 
+    using generic_inter_dense_below[of ?D p] by blast
   then
   obtain \<sigma> r where "r\<in>P" "\<langle>\<sigma>,r\<rangle> \<in> \<tau>" "q\<preceq>r" "q forces\<^sub>a (\<pi> = \<sigma>)" by blast
   moreover from this and \<open>q\<in>G\<close> assms
-  have "r \<in> G" "val(P,G,\<pi>) = val(P,G,\<sigma>)" by blast+
+  have "r \<in> G" "val(G,\<pi>) = val(G,\<sigma>)" by blast+
   ultimately
-  show "\<exists> \<sigma>. \<exists>p\<in>P. p \<in> G \<and> \<langle>\<sigma>, p\<rangle> \<in> \<tau> \<and> val(P,G, \<sigma>) = val(P,G, \<pi>)" by auto
+  show "\<exists> \<sigma>. \<exists>p\<in>P. p \<in> G \<and> \<langle>\<sigma>, p\<rangle> \<in> \<tau> \<and> val(G, \<sigma>) = val(G, \<pi>)" by auto
 qed
 
 (* Example IV.2.36 (next two lemmas) *)
 lemma refl_forces_eq:"p\<in>P \<Longrightarrow> p forces\<^sub>a (x = x)"
   using def_forces_eq by simp
 
 lemma forces_memI: "\<langle>\<sigma>,r\<rangle>\<in>\<tau> \<Longrightarrow> p\<in>P \<Longrightarrow> r\<in>P \<Longrightarrow> p\<preceq>r \<Longrightarrow> p forces\<^sub>a (\<sigma> \<in> \<tau>)"
   using refl_forces_eq[of _ \<sigma>] leq_transD refl_leq
   by (blast intro:forces_mem_iff_dense_below[THEN iffD2])
 
 (* Lemma IV.2.40(a), equality, first inclusion *)
 lemma IV240a_eq_1st_incl:
+  includes some_rules
   assumes
-    "M_generic(G)" "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
+    "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
     and
     IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
-        (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<tau>)) \<and>
-        (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<theta>))"
+        (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(G,\<sigma>) \<in> val(G,\<tau>)) \<and>
+        (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(G,\<sigma>) \<in> val(G,\<theta>))"
     (* Strong enough for this case: *)
     (*  IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<Longrightarrow> q forces\<^sub>a (\<sigma> \<in> \<theta>) \<Longrightarrow>
-      val(P,G,\<sigma>) \<in> val(P,G,\<theta>)" *)
+      val(G,\<sigma>) \<in> val(G,\<theta>)" *)
   shows
-    "val(P,G,\<tau>) \<subseteq> val(P,G,\<theta>)"
+    "val(G,\<tau>) \<subseteq> val(G,\<theta>)"
 proof
   fix x
-  assume "x\<in>val(P,G,\<tau>)"
+  assume "x\<in>val(G,\<tau>)"
   then
-  obtain \<sigma> r where "\<langle>\<sigma>,r\<rangle>\<in>\<tau>" "r\<in>G" "val(P,G,\<sigma>)=x" by blast
-  moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+  obtain \<sigma> r where "\<langle>\<sigma>,r\<rangle>\<in>\<tau>" "r\<in>G" "val(G,\<sigma>)=x" by blast
+  moreover from this and \<open>p\<in>G\<close>
   obtain q where "q\<in>G" "q\<preceq>p" "q\<preceq>r" by force
-  moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+  moreover from this and \<open>p\<in>G\<close>
   have "q\<in>P" "p\<in>P" by blast+
-  moreover from calculation and \<open>M_generic(G)\<close>
+  moreover from calculation
   have "q forces\<^sub>a (\<sigma> \<in> \<tau>)"
-    using forces_memI by blast
+    using forces_memI by auto
   moreover
   note \<open>p forces\<^sub>a (\<tau> = \<theta>)\<close>
   ultimately
   have "q forces\<^sub>a (\<sigma> \<in> \<theta>)"
-    using def_forces_eq by blast
-  with \<open>q\<in>P\<close> \<open>q\<in>G\<close> IH[of q \<sigma>] \<open>\<langle>\<sigma>,r\<rangle>\<in>\<tau>\<close> \<open>val(P,G,\<sigma>) = x\<close>
-  show "x\<in>val(P,G,\<theta>)" by (blast)
+    using def_forces_eq by auto
+  with \<open>q\<in>P\<close> \<open>q\<in>G\<close> IH[of q \<sigma>] \<open>\<langle>\<sigma>,r\<rangle>\<in>\<tau>\<close> \<open>val(G,\<sigma>) = x\<close>
+  show "x\<in>val(G,\<theta>)" by blast
 qed
 
 (* Lemma IV.2.40(a), equality, second inclusion--- COPY-PASTE *)
 lemma IV240a_eq_2nd_incl:
+  includes some_rules
   assumes
-    "M_generic(G)" "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
+    "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
     and
     IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
-        (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<tau>)) \<and>
-        (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<theta>))"
+        (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(G,\<sigma>) \<in> val(G,\<tau>)) \<and>
+        (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(G,\<sigma>) \<in> val(G,\<theta>))"
   shows
-    "val(P,G,\<theta>) \<subseteq> val(P,G,\<tau>)"
+    "val(G,\<theta>) \<subseteq> val(G,\<tau>)"
 proof
   fix x
-  assume "x\<in>val(P,G,\<theta>)"
+  assume "x\<in>val(G,\<theta>)"
   then
-  obtain \<sigma> r where "\<langle>\<sigma>,r\<rangle>\<in>\<theta>" "r\<in>G" "val(P,G,\<sigma>)=x" by blast
-  moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+  obtain \<sigma> r where "\<langle>\<sigma>,r\<rangle>\<in>\<theta>" "r\<in>G" "val(G,\<sigma>)=x" by blast
+  moreover from this and \<open>p\<in>G\<close>
   obtain q where "q\<in>G" "q\<preceq>p" "q\<preceq>r" by force
-  moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+  moreover from this and \<open>p\<in>G\<close>
   have "q\<in>P" "p\<in>P" by blast+
-  moreover from calculation and \<open>M_generic(G)\<close>
+  moreover from calculation
   have "q forces\<^sub>a (\<sigma> \<in> \<theta>)"
-    using forces_memI by blast
+    using forces_memI by auto
   moreover
   note \<open>p forces\<^sub>a (\<tau> = \<theta>)\<close>
   ultimately
   have "q forces\<^sub>a (\<sigma> \<in> \<tau>)"
-    using def_forces_eq by blast
-  with \<open>q\<in>P\<close> \<open>q\<in>G\<close> IH[of q \<sigma>] \<open>\<langle>\<sigma>,r\<rangle>\<in>\<theta>\<close> \<open>val(P,G,\<sigma>) = x\<close>
-  show "x\<in>val(P,G,\<tau>)" by (blast)
+    using def_forces_eq by auto
+  with \<open>q\<in>P\<close> \<open>q\<in>G\<close> IH[of q \<sigma>] \<open>\<langle>\<sigma>,r\<rangle>\<in>\<theta>\<close> \<open>val(G,\<sigma>) = x\<close>
+  show "x\<in>val(G,\<tau>)" by blast
 qed
 
 (* Lemma IV.2.40(a), equality, second inclusion--- COPY-PASTE *)
 lemma IV240a_eq:
+  includes some_rules
   assumes
-    "M_generic(G)" "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
+    "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
     and
     IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
-        (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<tau>)) \<and>
-        (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<theta>))"
+        (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(G,\<sigma>) \<in> val(G,\<tau>)) \<and>
+        (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(G,\<sigma>) \<in> val(G,\<theta>))"
   shows
-    "val(P,G,\<tau>) = val(P,G,\<theta>)"
+    "val(G,\<tau>) = val(G,\<theta>)"
   using IV240a_eq_1st_incl[OF assms] IV240a_eq_2nd_incl[OF assms] IH by blast
 
 subsection\<open>Induction on names\<close>
 
-lemma core_induction:
+lemma (in forcing_data1) core_induction:
   assumes
     "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<sigma>,q)\<rbrakk> \<Longrightarrow> Q(1,\<tau>,\<theta>,p)"
     "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(1,\<sigma>,\<tau>,q) \<and> Q(1,\<sigma>,\<theta>,q)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<theta>,p)"
     "ft \<in> 2" "p \<in> P"
   shows
     "Q(ft,\<tau>,\<theta>,p)"
 proof -
   {
     fix ft p \<tau> \<theta>
     have "Transset(eclose({\<tau>,\<theta>}))" (is "Transset(?e)")
       using Transset_eclose by simp
     have "\<tau> \<in> ?e" "\<theta> \<in> ?e"
       using arg_into_eclose by simp_all
     moreover
     assume "ft \<in> 2" "p \<in> P"
     ultimately
     have "\<langle>ft,\<tau>,\<theta>,p\<rangle>\<in> 2\<times>?e\<times>?e\<times>P" (is "?a\<in>2\<times>?e\<times>?e\<times>P") by simp
     then
     have "Q(ftype(?a), name1(?a), name2(?a), cond_of(?a))"
       using core_induction_aux[of ?e P Q ?a,OF \<open>Transset(?e)\<close> assms(1,2) \<open>?a\<in>_\<close>]
       by (clarify) (blast)
     then have "Q(ft,\<tau>,\<theta>,p)" by (simp add:components_simp)
   }
   then show ?thesis using assms by simp
 qed
 
-lemma forces_induction_with_conds:
+lemma (in forcing_data1) forces_induction_with_conds:
   assumes
     "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(q,\<tau>,\<sigma>)\<rbrakk> \<Longrightarrow> R(p,\<tau>,\<theta>)"
     "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> R(q,\<sigma>,\<tau>) \<and> R(q,\<sigma>,\<theta>)\<rbrakk> \<Longrightarrow> Q(p,\<tau>,\<theta>)"
     "p \<in> P"
   shows
     "Q(p,\<tau>,\<theta>) \<and> R(p,\<tau>,\<theta>)"
 proof -
   let ?Q="\<lambda>ft \<tau> \<theta> p. (ft = 0 \<longrightarrow> Q(p,\<tau>,\<theta>)) \<and> (ft = 1 \<longrightarrow> R(p,\<tau>,\<theta>))"
   from assms(1)
   have "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> ?Q(0,\<tau>,\<sigma>,q)\<rbrakk> \<Longrightarrow> ?Q(1,\<tau>,\<theta>,p)"
     by simp
   moreover from assms(2)
   have "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> ?Q(1,\<sigma>,\<tau>,q) \<and> ?Q(1,\<sigma>,\<theta>,q)\<rbrakk> \<Longrightarrow> ?Q(0,\<tau>,\<theta>,p)"
     by simp
   moreover
   note \<open>p\<in>P\<close>
   ultimately
   have "?Q(ft,\<tau>,\<theta>,p)" if "ft\<in>2" for ft
     by (rule core_induction[OF _ _ that, of ?Q])
   then
   show ?thesis by auto
 qed
 
-lemma forces_induction:
+lemma (in forcing_data1) forces_induction:
   assumes
     "\<And>\<tau> \<theta>. \<lbrakk>\<And>\<sigma>. \<sigma>\<in>domain(\<theta>) \<Longrightarrow> Q(\<tau>,\<sigma>)\<rbrakk> \<Longrightarrow> R(\<tau>,\<theta>)"
     "\<And>\<tau> \<theta>. \<lbrakk>\<And>\<sigma>. \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> R(\<sigma>,\<tau>) \<and> R(\<sigma>,\<theta>)\<rbrakk> \<Longrightarrow> Q(\<tau>,\<theta>)"
   shows
     "Q(\<tau>,\<theta>) \<and> R(\<tau>,\<theta>)"
 proof (intro forces_induction_with_conds[OF _ _ one_in_P ])
   fix \<tau> \<theta> p
   assume "q \<in> P \<Longrightarrow> \<sigma> \<in> domain(\<theta>) \<Longrightarrow> Q(\<tau>, \<sigma>)" for q \<sigma>
   with assms(1)
   show "R(\<tau>,\<theta>)"
     using one_in_P by simp
 next
   fix \<tau> \<theta> p
   assume "q \<in> P \<Longrightarrow> \<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> R(\<sigma>,\<tau>) \<and> R(\<sigma>,\<theta>)" for q \<sigma>
   with assms(2)
   show "Q(\<tau>,\<theta>)"
     using one_in_P by simp
 qed
 
 subsection\<open>Lemma IV.2.40(a), in full\<close>
 lemma IV240a:
-  assumes
-    "M_generic(G)"
   shows
-    "(\<tau>\<in>M \<longrightarrow> \<theta>\<in>M \<longrightarrow> (\<forall>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>) \<longrightarrow> val(P,G,\<tau>) = val(P,G,\<theta>))) \<and>
-     (\<tau>\<in>M \<longrightarrow> \<theta>\<in>M \<longrightarrow> (\<forall>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>) \<longrightarrow> val(P,G,\<tau>) \<in> val(P,G,\<theta>)))"
+    "(\<tau>\<in>M \<longrightarrow> \<theta>\<in>M \<longrightarrow> (\<forall>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>) \<longrightarrow> val(G,\<tau>) = val(G,\<theta>))) \<and>
+     (\<tau>\<in>M \<longrightarrow> \<theta>\<in>M \<longrightarrow> (\<forall>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>) \<longrightarrow> val(G,\<tau>) \<in> val(G,\<theta>)))"
     (is "?Q(\<tau>,\<theta>) \<and> ?R(\<tau>,\<theta>)")
 proof (intro forces_induction[of ?Q ?R] impI)
   fix \<tau> \<theta>
   assume "\<tau>\<in>M" "\<theta>\<in>M"  "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> ?Q(\<tau>,\<sigma>)" for \<sigma>
   moreover from this
-  have "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> q forces\<^sub>a (\<tau> = \<sigma>) \<Longrightarrow> val(P,G, \<tau>) = val(P,G, \<sigma>)"
+  have "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> q forces\<^sub>a (\<tau> = \<sigma>) \<Longrightarrow> val(G, \<tau>) = val(G, \<sigma>)"
     if "q\<in>P" "q\<in>G" for q \<sigma>
     using that domain_closed[of \<theta>] transitivity by auto
-  moreover
-  note assms
   ultimately
-  show "\<forall>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>) \<longrightarrow> val(P,G,\<tau>) \<in> val(P,G,\<theta>)"
-    using IV240a_mem domain_closed transitivity by (simp)
+  show "\<forall>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>) \<longrightarrow> val(G,\<tau>) \<in> val(G,\<theta>)"
+    using IV240a_mem domain_closed transitivity by simp
 next
   fix \<tau> \<theta>
-  assume "\<tau>\<in>M" "\<theta>\<in>M" "\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> ?R(\<sigma>,\<tau>) \<and> ?R(\<sigma>,\<theta>)" for \<sigma>
+  assume "\<tau>\<in>M" "\<theta>\<in>M" and d:"\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> ?R(\<sigma>,\<tau>) \<and> ?R(\<sigma>,\<theta>)" for \<sigma>
   moreover from this
-  have IH':"\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> q\<in>G \<Longrightarrow>
-            (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G, \<sigma>) \<in> val(P,G, \<tau>)) \<and>
-            (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G, \<sigma>) \<in> val(P,G, \<theta>))" for q \<sigma>
-    by (auto intro:  transitivity[OF _ domain_closed[simplified]])
-  ultimately
-  show "\<forall>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>) \<longrightarrow> val(P,G,\<tau>) = val(P,G,\<theta>)"
-    using IV240a_eq[OF assms(1) _ _ IH'] by (simp)
+  have IH':"(q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(G, \<sigma>) \<in> val(G, \<tau>)) \<and>
+            (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(G, \<sigma>) \<in> val(G, \<theta>))" 
+    if "\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>)" "q\<in>G" for q \<sigma>
+  proof -
+    from d that
+    have A:"?R(\<sigma>,\<tau>)" "?R(\<sigma>,\<theta>)"
+      by auto
+    from \<open>\<tau>\<in>_\<close> \<open>\<theta>\<in>M\<close> \<open>q\<in>G\<close> \<open>\<sigma>\<in>_\<close>
+     show ?thesis
+      using transitivity[of \<sigma>] domain_closed A[rule_format,of q]
+      by auto
+  qed
+  show "\<forall>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>) \<longrightarrow> val(G,\<tau>) = val(G,\<theta>)"
+    using IV240a_eq[OF _ _ IH'] by simp
 qed
 
 subsection\<open>Lemma IV.2.40(b)\<close>
   (* Lemma IV.2.40(b), membership *)
 lemma IV240b_mem:
+  includes some_rules
   assumes
-    "M_generic(G)" "val(P,G,\<pi>)\<in>val(P,G,\<tau>)" "\<pi>\<in>M" "\<tau>\<in>M"
+    "val(G,\<pi>)\<in>val(G,\<tau>)" "\<pi>\<in>M" "\<tau>\<in>M"
     and
-    IH:"\<And>\<sigma>. \<sigma>\<in>domain(\<tau>) \<Longrightarrow> val(P,G,\<pi>) = val(P,G,\<sigma>) \<Longrightarrow>
+    IH:"\<And>\<sigma>. \<sigma>\<in>domain(\<tau>) \<Longrightarrow> val(G,\<pi>) = val(G,\<sigma>) \<Longrightarrow>
       \<exists>p\<in>G. p forces\<^sub>a (\<pi> = \<sigma>)" (* inductive hypothesis *)
   shows
     "\<exists>p\<in>G. p forces\<^sub>a (\<pi> \<in> \<tau>)"
 proof -
-  from \<open>val(P,G,\<pi>)\<in>val(P,G,\<tau>)\<close>
-  obtain \<sigma> r where "r\<in>G" "\<langle>\<sigma>,r\<rangle>\<in>\<tau>" "val(P,G,\<pi>) = val(P,G,\<sigma>)" by auto
+  from \<open>val(G,\<pi>)\<in>val(G,\<tau>)\<close>
+  obtain \<sigma> r where "r\<in>G" "\<langle>\<sigma>,r\<rangle>\<in>\<tau>" "val(G,\<pi>) = val(G,\<sigma>)" by auto
   moreover from this and IH
   obtain p' where "p'\<in>G" "p' forces\<^sub>a (\<pi> = \<sigma>)" by blast
-  moreover
-  note \<open>M_generic(G)\<close>
   ultimately
-  obtain p where "p\<preceq>r" "p\<in>G" "p forces\<^sub>a (\<pi> = \<sigma>)"
-    using M_generic_compatD strengthening_eq[of p'] by blast
-  moreover
-  note \<open>M_generic(G)\<close>
+  obtain p where "p\<preceq>r" "p\<preceq>p'" "p\<in>G" "p forces\<^sub>a (\<pi> = \<sigma>)"
+    using M_generic_compatD strengthening_eq[of p'] M_genericD by auto
   moreover from calculation
   have "q forces\<^sub>a (\<pi> = \<sigma>)" if "q\<in>P" "q\<preceq>p" for q
     using that strengthening_eq by blast
   moreover
   note \<open>\<langle>\<sigma>,r\<rangle>\<in>\<tau>\<close> \<open>r\<in>G\<close>
   ultimately
   have "r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>)" if "q\<in>P" "q\<preceq>p" for q
     using that leq_transD[of _ p r] by blast
   then
   have "dense_below({q\<in>P. \<exists>s r. r\<in>P \<and> \<langle>s,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = s)},p)"
     using refl_leq by blast
   moreover
-  note \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
+  note \<open>p\<in>G\<close>
   moreover from calculation
   have "p forces\<^sub>a (\<pi> \<in> \<tau>)"
     using forces_mem_iff_dense_below by blast
   ultimately
   show ?thesis by blast
 qed
 
-end \<comment> \<open>includes some\_rules\<close>
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+context forcing_data1
+begin
 
 lemma Collect_forces_eq_in_M:
   assumes "\<tau> \<in> M" "\<theta> \<in> M"
   shows "{p\<in>P. p forces\<^sub>a (\<tau> = \<theta>)} \<in> M"
   using assms Collect_in_M[of "forces_eq_fm(1,2,0,3,4)" "[P,leq,\<tau>,\<theta>]"]
-    arity_forces_eq_fm P_in_M leq_in_M sats_forces_eq_fm forces_eq_abs forces_eq_fm_type
+    arity_forces_eq_fm sats_forces_eq_fm forces_eq_abs forces_eq_fm_type
   by (simp add: union_abs1 Un_commute)
 
 lemma IV240b_eq_Collects:
   assumes "\<tau> \<in> M" "\<theta> \<in> M"
   shows "{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)}\<in>M" and
     "{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)}\<in>M"
 proof -
   let ?rel_pred="\<lambda>M x a1 a2 a3 a4.
         \<exists>\<sigma>[M]. \<exists>u[M]. \<exists>da3[M]. \<exists>da4[M]. is_domain(M,a3,da3) \<and> is_domain(M,a4,da4) \<and>
           union(M,da3,da4,u) \<and> \<sigma>\<in>u \<and> is_forces_mem'(M,a1,a2,x,\<sigma>,a3) \<and>
           is_forces_nmem'(M,a1,a2,x,\<sigma>,a4)"
   let ?\<phi>="Exists(Exists(Exists(Exists(And(domain_fm(7,1),And(domain_fm(8,0),
           And(union_fm(1,0,2),And(Member(3,2),And(forces_mem_fm(5,6,4,3,7),
                               forces_nmem_fm(5,6,4,3,8))))))))))"
   have 1:"\<sigma>\<in>M" if "\<langle>\<sigma>,y\<rangle>\<in>\<delta>" "\<delta>\<in>M" for \<sigma> \<delta> y
     using that pair_in_M_iff transitivity[of "\<langle>\<sigma>,y\<rangle>" \<delta>] by simp
   have abs1:"?rel_pred(##M,p,P,leq,\<tau>,\<theta>) \<longleftrightarrow>
         (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). forces_mem'(P,leq,p,\<sigma>,\<tau>) \<and> forces_nmem'(P,leq,p,\<sigma>,\<theta>))"
     if "p\<in>M" for p
     unfolding forces_mem_def forces_nmem_def
-    using assms that forces_mem'_abs forces_nmem'_abs P_in_M leq_in_M
+    using assms that forces_mem'_abs forces_nmem'_abs
       domain_closed Un_closed
     by (auto simp add:1[of _ _ \<tau>] 1[of _ _ \<theta>])
   have abs2:"?rel_pred(##M,p,P,leq,\<theta>,\<tau>) \<longleftrightarrow> (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>).
         forces_nmem'(P,leq,p,\<sigma>,\<tau>) \<and> forces_mem'(P,leq,p,\<sigma>,\<theta>))" if "p\<in>M" for p
     unfolding forces_mem_def forces_nmem_def
-    using assms that forces_mem'_abs forces_nmem'_abs P_in_M leq_in_M
+    using assms that forces_mem'_abs forces_nmem'_abs
       domain_closed Un_closed
     by (auto simp add:1[of _ _ \<tau>] 1[of _ _ \<theta>])
   have fsats1:"(M,[p,P,leq,\<tau>,\<theta>] \<Turnstile> ?\<phi>) \<longleftrightarrow> ?rel_pred(##M,p,P,leq,\<tau>,\<theta>)" if "p\<in>M" for p
-    using that assms sats_forces_mem_fm sats_forces_nmem_fm P_in_M leq_in_M zero_in_M
+    using that assms sats_forces_mem_fm sats_forces_nmem_fm zero_in_M
       domain_closed Un_closed by simp
   have fsats2:"(M,[p,P,leq,\<theta>,\<tau>] \<Turnstile> ?\<phi>) \<longleftrightarrow> ?rel_pred(##M,p,P,leq,\<theta>,\<tau>)" if "p\<in>M" for p
-    using that assms sats_forces_mem_fm sats_forces_nmem_fm P_in_M leq_in_M zero_in_M
+    using that assms sats_forces_mem_fm sats_forces_nmem_fm zero_in_M
       domain_closed Un_closed by simp
   have fty:"?\<phi>\<in>formula" by simp
   have farit:"arity(?\<phi>)=5"
     by (simp add:ord_simp_union arity)
   show
     "{p \<in> P . \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)} \<in> M"
     and "{p \<in> P . \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)} \<in> M"
     unfolding forces_mem_def
-    using abs1 fty fsats1 farit P_in_M leq_in_M assms forces_nmem
+    using abs1 fty fsats1 farit assms forces_nmem
       Collect_in_M[of ?\<phi> "[P,leq,\<tau>,\<theta>]"]
-    using abs2 fty fsats2 farit P_in_M leq_in_M assms forces_nmem domain_closed Un_closed
+    using abs2 fty fsats2 farit assms forces_nmem domain_closed Un_closed
       Collect_in_M[of ?\<phi> "[P,leq,\<theta>,\<tau>]"]
     by simp_all
 qed
 
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+context G_generic1
+begin
+
 (* Lemma IV.2.40(b), equality *)
 lemma IV240b_eq:
+  includes some_rules
   assumes
-    "M_generic(G)" "val(P,G,\<tau>) = val(P,G,\<theta>)" "\<tau>\<in>M" "\<theta>\<in>M"
+    "val(G,\<tau>) = val(G,\<theta>)" "\<tau>\<in>M" "\<theta>\<in>M"
     and
     IH:"\<And>\<sigma>. \<sigma>\<in>domain(\<tau>)\<union>domain(\<theta>) \<Longrightarrow>
-      (val(P,G,\<sigma>)\<in>val(P,G,\<tau>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<tau>))) \<and>
-      (val(P,G,\<sigma>)\<in>val(P,G,\<theta>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<theta>)))"
+      (val(G,\<sigma>)\<in>val(G,\<tau>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<tau>))) \<and>
+      (val(G,\<sigma>)\<in>val(G,\<theta>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<theta>)))"
     (* inductive hypothesis *)
   shows
     "\<exists>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>)"
 proof -
   let ?D1="{p\<in>P. p forces\<^sub>a (\<tau> = \<theta>)}"
   let ?D2="{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)}"
   let ?D3="{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)}"
   let ?D="?D1 \<union> ?D2 \<union> ?D3"
   note assms
   moreover from this
   have "domain(\<tau>) \<union> domain(\<theta>)\<in>M" (is "?B\<in>M") using domain_closed Un_closed by auto
   moreover from calculation
   have "?D2\<in>M" and "?D3\<in>M" using IV240b_eq_Collects by simp_all
   ultimately
   have "?D\<in>M" using Collect_forces_eq_in_M Un_closed by auto
   moreover
   have "dense(?D)"
   proof
     fix p
     assume "p\<in>P"
     have "\<exists>d\<in>P. (d forces\<^sub>a (\<tau> = \<theta>) \<or>
             (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). d forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> d forces\<^sub>a (\<sigma> \<notin> \<theta>)) \<or>
             (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). d forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> d forces\<^sub>a (\<sigma> \<in> \<theta>))) \<and>
            d \<preceq> p"
     proof (cases "p forces\<^sub>a (\<tau> = \<theta>)")
       case True
       with \<open>p\<in>P\<close>
       show ?thesis using refl_leq by blast
     next
       case False
       moreover note \<open>p\<in>P\<close>
       moreover from calculation
       obtain \<sigma> q where "\<sigma>\<in>domain(\<tau>)\<union>domain(\<theta>)" "q\<in>P" "q\<preceq>p"
         "(q forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> \<not> q forces\<^sub>a (\<sigma> \<in> \<theta>)) \<or>
          (\<not> q forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> q forces\<^sub>a (\<sigma> \<in> \<theta>))"
         using def_forces_eq by blast
       moreover from this
       obtain r where "r\<preceq>q" "r\<in>P"
         "(r forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> r forces\<^sub>a (\<sigma> \<notin> \<theta>)) \<or>
          (r forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> r forces\<^sub>a (\<sigma> \<in> \<theta>))"
         using not_forces_nmem strengthening_mem by blast
       ultimately
       show ?thesis using leq_transD by blast
     qed
     then
-    show "\<exists>d\<in>?D1 \<union> ?D2 \<union> ?D3. d \<preceq> p" by blast
+    show "\<exists>d\<in>?D . d \<preceq> p" by blast
   qed
   moreover
   have "?D \<subseteq> P"
     by auto
-  moreover
-  note \<open>M_generic(G)\<close>
   ultimately
   obtain p where "p\<in>G" "p\<in>?D"
-    unfolding M_generic_def by blast
+    using M_generic_denseD[of ?D] by blast
   then
   consider
     (1) "p forces\<^sub>a (\<tau> = \<theta>)" |
     (2) "\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)" |
     (3) "\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)"
     by blast
   then
   show ?thesis
   proof (cases)
     case 1
     with \<open>p\<in>G\<close>
     show ?thesis by blast
   next
     case 2
     then
     obtain \<sigma> where "\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)" "p forces\<^sub>a (\<sigma> \<in> \<tau>)" "p forces\<^sub>a (\<sigma> \<notin> \<theta>)"
       by blast
     moreover from this and \<open>p\<in>G\<close> and assms
-    have "val(P,G,\<sigma>)\<in>val(P,G,\<tau>)"
-      using IV240a[of G \<sigma> \<tau>] transitivity[OF _ domain_closed[simplified]] by blast
-    moreover note IH \<open>val(P,G,\<tau>) = _\<close>
+    have "val(G,\<sigma>)\<in>val(G,\<tau>)"
+      using IV240a[of \<sigma> \<tau>] transitivity[OF _ domain_closed[simplified]] by force
+    moreover note \<open>val(G,\<tau>) = _\<close>
     ultimately
-    obtain q where "q\<in>G" "q forces\<^sub>a (\<sigma> \<in> \<theta>)" by auto
-    moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+    obtain q where "q\<in>G" "q forces\<^sub>a (\<sigma> \<in> \<theta>)" 
+      using IH[OF \<open>\<sigma>\<in>_\<close>]
+      by auto
+    moreover from this and \<open>p\<in>G\<close>
     obtain r where "r\<in>P" "r\<preceq>p" "r\<preceq>q"
       by blast
-    moreover
-    note \<open>M_generic(G)\<close>
     ultimately
     have "r forces\<^sub>a (\<sigma> \<in> \<theta>)"
       using strengthening_mem by blast
     with \<open>r\<preceq>p\<close> \<open>p forces\<^sub>a (\<sigma> \<notin> \<theta>)\<close> \<open>r\<in>P\<close>
     have "False"
       unfolding forces_nmem_def by blast
     then
     show ?thesis by simp
   next (* copy-paste from case 2 mutatis mutandis*)
     case 3
     then
     obtain \<sigma> where "\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)" "p forces\<^sub>a (\<sigma> \<in> \<theta>)" "p forces\<^sub>a (\<sigma> \<notin> \<tau>)"
       by blast
     moreover from this and \<open>p\<in>G\<close> and assms
-    have "val(P,G,\<sigma>)\<in>val(P,G,\<theta>)"
-      using IV240a[of G \<sigma> \<theta>] transitivity[OF _ domain_closed[simplified]] by blast
-    moreover note IH \<open>val(P,G,\<tau>) = _\<close>
+    have "val(G,\<sigma>)\<in>val(G,\<theta>)"
+      using IV240a[of \<sigma> \<theta>] transitivity[OF _ domain_closed[simplified]] by force
+    moreover note \<open>val(G,\<tau>) = _\<close>
     ultimately
-    obtain q where "q\<in>G" "q forces\<^sub>a (\<sigma> \<in> \<tau>)" by auto
-    moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+    obtain q where "q\<in>G" "q forces\<^sub>a (\<sigma> \<in> \<tau>)" 
+      using IH[OF \<open>\<sigma>\<in>_\<close>]
+      by auto
+    moreover from this and \<open>p\<in>G\<close>
     obtain r where "r\<in>P" "r\<preceq>p" "r\<preceq>q"
       by blast
-    moreover
-    note \<open>M_generic(G)\<close>
     ultimately
     have "r forces\<^sub>a (\<sigma> \<in> \<tau>)"
       using strengthening_mem by blast
     with \<open>r\<preceq>p\<close> \<open>p forces\<^sub>a (\<sigma> \<notin> \<tau>)\<close> \<open>r\<in>P\<close>
     have "False"
       unfolding forces_nmem_def by blast
     then
     show ?thesis by simp
   qed
 qed
 
 (* Lemma IV.2.40(b), full *)
 lemma IV240b:
-  assumes
-    "M_generic(G)"
-  shows
-    "(\<tau>\<in>M\<longrightarrow>\<theta>\<in>M\<longrightarrow>val(P,G,\<tau>) = val(P,G,\<theta>) \<longrightarrow> (\<exists>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>))) \<and>
-     (\<tau>\<in>M\<longrightarrow>\<theta>\<in>M\<longrightarrow>val(P,G,\<tau>) \<in> val(P,G,\<theta>) \<longrightarrow> (\<exists>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>)))"
+    "(\<tau>\<in>M\<longrightarrow>\<theta>\<in>M\<longrightarrow>val(G,\<tau>) = val(G,\<theta>) \<longrightarrow> (\<exists>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>))) \<and>
+     (\<tau>\<in>M\<longrightarrow>\<theta>\<in>M\<longrightarrow>val(G,\<tau>) \<in> val(G,\<theta>) \<longrightarrow> (\<exists>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>)))"
     (is "?Q(\<tau>,\<theta>) \<and> ?R(\<tau>,\<theta>)")
 proof (intro forces_induction)
   fix \<tau> \<theta> p
   assume "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> ?Q(\<tau>, \<sigma>)" for \<sigma>
-  with assms
-  show "?R(\<tau>, \<theta>)"
-    using IV240b_mem domain_closed transitivity by (simp)
+  then  show "?R(\<tau>, \<theta>)"
+    using IV240b_mem domain_closed transitivity by simp
 next
   fix \<tau> \<theta> p
   assume "\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> ?R(\<sigma>,\<tau>) \<and> ?R(\<sigma>,\<theta>)" for \<sigma>
   moreover from this
   have IH':"\<tau>\<in>M \<Longrightarrow> \<theta>\<in>M \<Longrightarrow> \<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
-          (val(P,G, \<sigma>) \<in> val(P,G, \<tau>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<tau>))) \<and>
-          (val(P,G, \<sigma>) \<in> val(P,G, \<theta>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<theta>)))" for \<sigma>
+          (val(G, \<sigma>) \<in> val(G, \<tau>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<tau>))) \<and>
+          (val(G, \<sigma>) \<in> val(G, \<theta>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<theta>)))" for \<sigma>
     using domain_trans[OF trans_M]
-    by (blast)
+    by blast
   ultimately
   show "?Q(\<tau>,\<theta>)"
-    using IV240b_eq[OF assms(1)] by (auto)
+    using IV240b_eq by auto
 qed
 
-lemma map_val_in_MG:
-  assumes
-    "env\<in>list(M)"
-  shows
-    "map(val(P,G),env)\<in>list(M[G])"
-  unfolding GenExt_def using assms map_type2 by simp
-
 lemma truth_lemma_mem:
   assumes
-    "env\<in>list(M)" "M_generic(G)"
+    "env\<in>list(M)"
     "n\<in>nat" "m\<in>nat" "n<length(env)" "m<length(env)"
   shows
-    "(\<exists>p\<in>G. p \<tturnstile> Member(n,m) env)  \<longleftrightarrow>  M[G], map(val(P,G),env) \<Turnstile> Member(n,m)"
-  using assms IV240a[OF assms(2), of "nth(n,env)" "nth(m,env)"]
-    IV240b[OF assms(2), of "nth(n,env)" "nth(m,env)"]
-    P_in_M leq_in_M one_in_M
+    "(\<exists>p\<in>G. p \<tturnstile> Member(n,m) env)  \<longleftrightarrow>  M[G], map(val(G),env) \<Turnstile> Member(n,m)"
+  using assms IV240a[of "nth(n,env)" "nth(m,env)"]
+    IV240b[of "nth(n,env)" "nth(m,env)"]
+    M_genericD
     Forces_Member[of _  "nth(n,env)" "nth(m,env)" env n m] map_val_in_MG
-  by (auto)
+  by auto
 
 lemma truth_lemma_eq:
   assumes
-    "env\<in>list(M)" "M_generic(G)"
+    "env\<in>list(M)"
     "n\<in>nat" "m\<in>nat" "n<length(env)" "m<length(env)"
   shows
-    "(\<exists>p\<in>G. p \<tturnstile> Equal(n,m) env)  \<longleftrightarrow>  M[G], map(val(P,G),env) \<Turnstile> Equal(n,m)"
-  using assms IV240a(1)[OF assms(2), of "nth(n,env)" "nth(m,env)"]
-    IV240b(1)[OF assms(2), of "nth(n,env)" "nth(m,env)"]
-    P_in_M leq_in_M one_in_M
+    "(\<exists>p\<in>G. p \<tturnstile> Equal(n,m) env)  \<longleftrightarrow>  M[G], map(val(G),env) \<Turnstile> Equal(n,m)"
+  using assms IV240a(1)[of "nth(n,env)" "nth(m,env)"]
+    IV240b(1)[of "nth(n,env)" "nth(m,env)"]
+    M_genericD
     Forces_Equal[of _  "nth(n,env)" "nth(m,env)" env n m] map_val_in_MG
-  by (auto)
+  by auto
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 lemma arities_at_aux:
   assumes
     "n \<in> nat" "m \<in> nat" "env \<in> list(M)" "succ(n) \<union> succ(m) \<le> length(env)"
   shows
     "n < length(env)" "m < length(env)"
   using assms succ_leE[OF Un_leD1, of n "succ(m)" "length(env)"]
     succ_leE[OF Un_leD2, of "succ(n)" m "length(env)"] by auto
 
 subsection\<open>The Strenghtening Lemma\<close>
 
+context forcing_data1
+begin
+
 lemma strengthening_lemma:
   assumes
     "p\<in>P" "\<phi>\<in>formula" "r\<in>P" "r\<preceq>p"
     "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
   shows
     "p \<tturnstile> \<phi> env \<Longrightarrow> r \<tturnstile> \<phi> env"
   using assms(2-)
 proof (induct arbitrary:env)
   case (Member n m)
   then
   have "n<length(env)" "m<length(env)"
     using arities_at_aux by simp_all
   moreover
   assume "env\<in>list(M)"
   moreover
   note assms Member
   ultimately
   show ?case
     using Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m]
       strengthening_mem[of p r "nth(n,env)" "nth(m,env)"] by simp
 next
   case (Equal n m)
   then
   have "n<length(env)" "m<length(env)"
     using arities_at_aux by simp_all
   moreover
   assume "env\<in>list(M)"
   moreover
   note assms Equal
   ultimately
   show ?case
     using Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m]
       strengthening_eq[of p r "nth(n,env)" "nth(m,env)"] by simp
 next
   case (Nand \<phi> \<psi>)
   with assms
   show ?case
     using Forces_Nand transitivity[OF _ P_in_M] pair_in_M_iff
       transitivity[OF _ leq_in_M] leq_transD by auto
 next
   case (Forall \<phi>)
   with assms
   have "p \<tturnstile> \<phi> ([x] @ env)" if "x\<in>M" for x
     using that Forces_Forall by simp
   with Forall
   have "r \<tturnstile> \<phi> ([x] @ env)" if "x\<in>M" for x
     using that pred_le2 by (simp)
   with assms Forall
   show ?case
     using Forces_Forall by simp
 qed
 
 subsection\<open>The Density Lemma\<close>
 
 lemma arity_Nand_le:
   assumes "\<phi> \<in> formula" "\<psi> \<in> formula" "arity(Nand(\<phi>, \<psi>)) \<le> length(env)" "env\<in>list(A)"
   shows "arity(\<phi>) \<le> length(env)" "arity(\<psi>) \<le> length(env)"
   using assms
   by (rule_tac Un_leD1, rule_tac [5] Un_leD2, auto)
 
 lemma dense_below_imp_forces:
   assumes
     "p\<in>P" "\<phi>\<in>formula"
     "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
   shows
     "dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p) \<Longrightarrow> (p \<tturnstile> \<phi> env)"
   using assms(2-)
 proof (induct arbitrary:env)
   case (Member n m)
   then
   have "n<length(env)" "m<length(env)"
     using arities_at_aux by simp_all
   moreover
   assume "env\<in>list(M)"
   moreover
   note assms Member
   ultimately
   show ?case
     using Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m]
       density_mem[of p "nth(n,env)" "nth(m,env)"] by simp
 next
   case (Equal n m)
   then
   have "n<length(env)" "m<length(env)"
     using arities_at_aux by simp_all
   moreover
   assume "env\<in>list(M)"
   moreover
   note assms Equal
   ultimately
   show ?case
     using Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m]
       density_eq[of p "nth(n,env)" "nth(m,env)"] by simp
 next
   case (Nand \<phi> \<psi>)
   {
     fix q
     assume "q\<in>M" "q\<in>P" "q\<preceq> p" "q \<tturnstile> \<phi> env"
     moreover
     note Nand
     moreover from calculation
     obtain d where "d\<in>P" "d \<tturnstile> Nand(\<phi>, \<psi>) env" "d\<preceq> q"
       using dense_belowI by auto
     moreover from calculation
     have "\<not>(d\<tturnstile> \<psi> env)" if "d \<tturnstile> \<phi> env"
       using that Forces_Nand refl_leq transitivity[OF _ P_in_M, of d] by auto
     moreover
     note arity_Nand_le[of \<phi> \<psi>]
     moreover from calculation
     have "d \<tturnstile> \<phi> env"
       using strengthening_lemma[of q \<phi> d env] Un_leD1 by auto
     ultimately
     have "\<not> (q \<tturnstile> \<psi> env)"
       using strengthening_lemma[of q \<psi> d env] by auto
   }
   with \<open>p\<in>P\<close>
   show ?case
     using Forces_Nand[symmetric, OF _ Nand(6,1,3)] by blast
 next
   case (Forall \<phi>)
   have "dense_below({q\<in>P. q \<tturnstile> \<phi> ([a]@env)},p)" if "a\<in>M" for a
   proof
     fix r
     assume "r\<in>P" "r\<preceq>p"
     with \<open>dense_below(_,p)\<close>
     obtain q where "q\<in>P" "q\<preceq>r" "q \<tturnstile> Forall(\<phi>) env"
       by blast
     moreover
     note Forall \<open>a\<in>M\<close>
     moreover from calculation
     have "q \<tturnstile> \<phi> ([a]@env)"
       using Forces_Forall by simp
     ultimately
     show "\<exists>d \<in> {q\<in>P. q \<tturnstile> \<phi> ([a]@env)}. d \<in> P \<and> d\<preceq>r"
       by auto
   qed
   moreover
   note Forall(2)[of "Cons(_,env)"] Forall(1,3-5)
   ultimately
   have "p \<tturnstile> \<phi> ([a]@env)" if "a\<in>M" for a
     using that pred_le2 by simp
   with assms Forall
   show ?case using Forces_Forall by simp
 qed
 
 lemma density_lemma:
   assumes
     "p\<in>P" "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
   shows
     "p \<tturnstile> \<phi> env   \<longleftrightarrow>   dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p)"
 proof
   assume "dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p)"
   with assms
   show  "(p \<tturnstile> \<phi> env)"
     using dense_below_imp_forces by simp
 next
   assume "p \<tturnstile> \<phi> env"
   with assms
   show "dense_below({q\<in>P. q \<tturnstile> \<phi> env},p)"
     using strengthening_lemma refl_leq by auto
 qed
 
 subsection\<open>The Truth Lemma\<close>
 
 lemma Forces_And:
   assumes
     "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
     "arity(\<phi>) \<le> length(env)" "arity(\<psi>) \<le> length(env)"
   shows
     "p \<tturnstile> And(\<phi>,\<psi>) env   \<longleftrightarrow>  (p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)"
 proof
   assume "p \<tturnstile> And(\<phi>, \<psi>) env"
   with assms
   have "dense_below({r \<in> P . (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)}, p)"
     using Forces_And_iff_dense_below by simp
   then
   have "dense_below({r \<in> P . (r \<tturnstile> \<phi> env)}, p)" "dense_below({r \<in> P . (r \<tturnstile> \<psi> env)}, p)"
     by blast+
   with assms
   show "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)"
     using density_lemma[symmetric] by simp
 next
   assume "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)"
   have "dense_below({r \<in> P . (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)}, p)"
   proof (intro dense_belowI bexI conjI, assumption)
     fix q
     assume "q\<in>P" "q\<preceq> p"
     with assms \<open>(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)\<close>
     show "q\<in>{r \<in> P . (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)}" "q\<preceq> q"
       using strengthening_lemma refl_leq by auto
   qed
   with assms
   show "p \<tturnstile> And(\<phi>,\<psi>) env"
     using Forces_And_iff_dense_below by simp
 qed
 
 lemma Forces_Nand_alt:
   assumes
     "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
     "arity(\<phi>) \<le> length(env)" "arity(\<psi>) \<le> length(env)"
   shows
     "(p \<tturnstile> Nand(\<phi>,\<psi>) env) \<longleftrightarrow> (p \<tturnstile> Neg(And(\<phi>,\<psi>)) env)"
   using assms Forces_Nand Forces_And Forces_Neg by auto
 
-lemma truth_lemma_Neg:
+end
+
+context G_generic1
+begin
+
+lemma  truth_lemma_Neg:
   assumes
-    "\<phi>\<in>formula" "M_generic(G)" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)" and
-    IH: "(\<exists>p\<in>G. p \<tturnstile> \<phi> env) \<longleftrightarrow> M[G], map(val(P,G),env) \<Turnstile> \<phi>"
+    "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)" and
+    IH: "(\<exists>p\<in>G. p \<tturnstile> \<phi> env) \<longleftrightarrow> M[G], map(val(G),env) \<Turnstile> \<phi>"
   shows
-    "(\<exists>p\<in>G. p \<tturnstile> Neg(\<phi>) env)  \<longleftrightarrow>  M[G], map(val(P,G),env) \<Turnstile> Neg(\<phi>)"
+    "(\<exists>p\<in>G. p \<tturnstile> Neg(\<phi>) env)  \<longleftrightarrow>  M[G], map(val(G),env) \<Turnstile> Neg(\<phi>)"
 proof (intro iffI, elim bexE, rule ccontr)
   (* Direct implication by contradiction *)
   fix p
-  assume "p\<in>G" "p \<tturnstile> Neg(\<phi>) env" "\<not>(M[G],map(val(P,G),env) \<Turnstile> Neg(\<phi>))"
+  assume "p\<in>G" "p \<tturnstile> Neg(\<phi>) env" "\<not>(M[G],map(val(G),env) \<Turnstile> Neg(\<phi>))"
   moreover
   note assms
   moreover from calculation
-  have "M[G], map(val(P,G),env) \<Turnstile> \<phi>"
-    using map_val_in_MG by simp
+  have "M[G], map(val(G),env) \<Turnstile> \<phi>" "p\<in>P"
+    using map_val_in_MG by auto
   with IH
-  obtain r where "r \<tturnstile> \<phi> env" "r\<in>G" by blast
-  moreover from this and \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
-  obtain q where "q\<preceq>p" "q\<preceq>r" "q\<in>G"
+  obtain r where "r \<tturnstile> \<phi> env" "r\<in>G" "r\<in>P" by blast
+  moreover from this and \<open>p\<in>G\<close>
+  obtain q where "q\<preceq>p" "q\<preceq>r" "q\<in>G" "q\<in>P" "q\<in>M"
+    using transitivity[OF _ P_in_M]
     by blast
   moreover from calculation
   have "q \<tturnstile> \<phi> env"
-    using strengthening_lemma[where \<phi>=\<phi>] by blast
-  ultimately
-  show "False"
-    using Forces_Neg[where \<phi>=\<phi>] transitivity[OF _ P_in_M] by blast
+    using strengthening_lemma
+    by simp
+  with assms \<open>p \<tturnstile> _ _\<close> \<open>q\<preceq>p\<close> \<open>q\<in>M\<close> \<open>p\<in>P\<close> \<open>q\<in>P\<close>
+   show "False"
+    using Forces_Neg
+    by auto
 next
-  assume "M[G], map(val(P,G),env) \<Turnstile> Neg(\<phi>)"
+  assume "M[G], map(val(G),env) \<Turnstile> Neg(\<phi>)"
   with assms
-  have "\<not> (M[G], map(val(P,G),env) \<Turnstile> \<phi>)"
+  have "\<not> (M[G], map(val(G),env) \<Turnstile> \<phi>)"
     using map_val_in_MG by simp
   let ?D="{p\<in>P. (p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env)}"
-  have "separation(##M,\<lambda>p. (p \<tturnstile> \<phi> env))"
-    using separation_ax[of "forces(\<phi>)"] arity_forces assms P_in_M leq_in_M one_in_M arity_forces_le
-    by simp
-  moreover
-  have "separation(##M,\<lambda>p. (p \<tturnstile> \<cdot>\<not>\<phi>\<cdot> env))"
-    using separation_ax[of "forces( \<cdot>\<not>\<phi>\<cdot> )"] arity_forces assms P_in_M leq_in_M one_in_M arity_forces_le
-    by simp
-  ultimately
-  have "separation(##M,\<lambda>p. (p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env))"
-    using separation_disj by simp
-  then
+  from assms
   have "?D \<in> M"
-    using separation_closed P_in_M by simp
+    using separation_disj separation_closed separation_forces by simp
   moreover
   have "?D \<subseteq> P" by auto
   moreover
   have "dense(?D)"
   proof
     fix q
     assume "q\<in>P"
+    with assms
     show "\<exists>d\<in>{p \<in> P . (p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env)}. d\<preceq> q"
-    proof (cases "q \<tturnstile> Neg(\<phi>) env")
-      case True
-      with \<open>q\<in>P\<close>
-      show ?thesis using refl_leq by blast
-    next
-      case False
-      with \<open>q\<in>P\<close> and assms
-      show ?thesis using Forces_Neg by auto
-    qed
+      using refl_leq Forces_Neg by (cases "q \<tturnstile> Neg(\<phi>) env", auto)
   qed
-  moreover
-  note \<open>M_generic(G)\<close>
   ultimately
   obtain p where "p\<in>G" "(p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env)"
     by blast
   then
   consider (1) "p \<tturnstile> \<phi> env" | (2) "p \<tturnstile> Neg(\<phi>) env" by blast
   then
   show "\<exists>p\<in>G. (p \<tturnstile> Neg(\<phi>) env)"
   proof (cases)
     case 1
-    with \<open>\<not> (M[G],map(val(P,G),env) \<Turnstile> \<phi>)\<close> \<open>p\<in>G\<close> IH
+    with \<open>\<not> (M[G],map(val(G),env) \<Turnstile> \<phi>)\<close> \<open>p\<in>G\<close> IH
     show ?thesis
       by blast
   next
     case 2
     with \<open>p\<in>G\<close>
     show ?thesis by blast
   qed
 qed
 
 lemma truth_lemma_And:
   assumes
     "env\<in>list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
-    "arity(\<phi>)\<le>length(env)" "arity(\<psi>) \<le> length(env)" "M_generic(G)"
+    "arity(\<phi>)\<le>length(env)" "arity(\<psi>) \<le> length(env)"
     and
-    IH: "(\<exists>p\<in>G. p \<tturnstile> \<phi> env)  \<longleftrightarrow>   M[G], map(val(P,G),env) \<Turnstile> \<phi>"
-    "(\<exists>p\<in>G. p \<tturnstile> \<psi> env)  \<longleftrightarrow>   M[G], map(val(P,G),env) \<Turnstile> \<psi>"
+    IH: "(\<exists>p\<in>G. p \<tturnstile> \<phi> env)  \<longleftrightarrow>   M[G], map(val(G),env) \<Turnstile> \<phi>"
+    "(\<exists>p\<in>G. p \<tturnstile> \<psi> env)  \<longleftrightarrow>   M[G], map(val(G),env) \<Turnstile> \<psi>"
   shows
-    "(\<exists>p\<in>G. (p \<tturnstile> And(\<phi>,\<psi>) env)) \<longleftrightarrow> M[G] , map(val(P,G),env) \<Turnstile> And(\<phi>,\<psi>)"
+    "(\<exists>p\<in>G. (p \<tturnstile> And(\<phi>,\<psi>) env)) \<longleftrightarrow> M[G] , map(val(G),env) \<Turnstile> And(\<phi>,\<psi>)"
   using assms map_val_in_MG Forces_And[OF M_genericD assms(1-5)]
 proof (intro iffI, elim bexE)
   fix p
   assume "p\<in>G" "p \<tturnstile> And(\<phi>,\<psi>) env"
   with assms
-  show "M[G], map(val(P,G),env) \<Turnstile> And(\<phi>,\<psi>)"
-    using Forces_And[OF M_genericD, of _ _ _ \<phi> \<psi>] map_val_in_MG by auto
+  show "M[G], map(val(G),env) \<Turnstile> And(\<phi>,\<psi>)"
+    using Forces_And[of  _ _ \<phi> \<psi>] map_val_in_MG M_genericD by auto
 next
-  assume "M[G], map(val(P,G),env) \<Turnstile> And(\<phi>,\<psi>)"
+  assume "M[G], map(val(G),env) \<Turnstile> And(\<phi>,\<psi>)"
   moreover
   note assms
   moreover from calculation
-  obtain q r where "q \<tturnstile> \<phi> env" "r \<tturnstile> \<psi> env" "q\<in>G" "r\<in>G"
-    using map_val_in_MG Forces_And[OF M_genericD assms(1-5)] by auto
+  obtain q r where "q \<tturnstile> \<phi> env" "r \<tturnstile> \<psi> env" "q\<in>G" "r\<in>G" "r\<in>P" "q\<in>P"
+    using map_val_in_MG Forces_And[OF M_genericD assms(1-5)] M_genericD by auto
   moreover from calculation
   obtain p where "p\<preceq>q" "p\<preceq>r" "p\<in>G"
-    by blast
+    by auto
   moreover from calculation
   have "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)" (* can't solve as separate goals *)
-    using strengthening_lemma by (blast)
+    using strengthening_lemma[OF M_genericD] by force
   ultimately
   show "\<exists>p\<in>G. (p \<tturnstile> And(\<phi>,\<psi>) env)"
     using Forces_And[OF M_genericD assms(1-5)] by auto
 qed
 
+end
+
 definition
   ren_truth_lemma :: "i\<Rightarrow>i" where
   "ren_truth_lemma(\<phi>) \<equiv>
     Exists(Exists(Exists(Exists(Exists(
     And(Equal(0,5),And(Equal(1,8),And(Equal(2,9),And(Equal(3,10),And(Equal(4,6),
     iterates(\<lambda>p. incr_bv(p)`5 , 6, \<phi>)))))))))))"
 
 lemma ren_truth_lemma_type[TC] :
   "\<phi>\<in>formula \<Longrightarrow> ren_truth_lemma(\<phi>) \<in>formula"
   unfolding ren_truth_lemma_def
   by simp
 
 lemma arity_ren_truth :
   assumes "\<phi>\<in>formula"
   shows "arity(ren_truth_lemma(\<phi>)) \<le> 6 \<union> succ(arity(\<phi>))"
 proof -
   consider (lt) "5 <arity(\<phi>)" | (ge) "\<not> 5 < arity(\<phi>)"
     by auto
   then
   show ?thesis
   proof cases
     case lt
     consider (a) "5<arity(\<phi>)+\<^sub>\<omega>5"  | (b) "arity(\<phi>)+\<^sub>\<omega>5 \<le> 5"
       using not_lt_iff_le \<open>\<phi>\<in>_\<close> by force
     then
     show ?thesis
     proof cases
       case a
       with \<open>\<phi>\<in>_\<close> lt
       have "5 < succ(arity(\<phi>))" "5<arity(\<phi>)+\<^sub>\<omega>2"  "5<arity(\<phi>)+\<^sub>\<omega>3"  "5<arity(\<phi>)+\<^sub>\<omega>4"
         using succ_ltI by auto
       with \<open>\<phi>\<in>_\<close>
       have c:"arity(iterates(\<lambda>p. incr_bv(p)`5,5,\<phi>)) = 5+\<^sub>\<omega>arity(\<phi>)" (is "arity(?\<phi>') = _")
         using arity_incr_bv_lemma lt a
         by simp
       with \<open>\<phi>\<in>_\<close>
       have "arity(incr_bv(?\<phi>')`5) = 6+\<^sub>\<omega>arity(\<phi>)"
         using arity_incr_bv_lemma[of ?\<phi>' 5] a by auto
       with \<open>\<phi>\<in>_\<close>
       show ?thesis
         unfolding ren_truth_lemma_def
         using pred_Un_distrib union_abs1 Un_assoc[symmetric] a c union_abs2
         by (simp add:arity)
     next
       case b
       with \<open>\<phi>\<in>_\<close> lt
       have "5 < succ(arity(\<phi>))" "5<arity(\<phi>)+\<^sub>\<omega>2"  "5<arity(\<phi>)+\<^sub>\<omega>3"  "5<arity(\<phi>)+\<^sub>\<omega>4" "5<arity(\<phi>)+\<^sub>\<omega>5"
         using succ_ltI by auto
       with \<open>\<phi>\<in>_\<close>
       have "arity(iterates(\<lambda>p. incr_bv(p)`5,6,\<phi>)) = 6+\<^sub>\<omega>arity(\<phi>)" (is "arity(?\<phi>') = _")
         using arity_incr_bv_lemma lt
         by simp
       with \<open>\<phi>\<in>_\<close>
       show ?thesis
         unfolding ren_truth_lemma_def
         using pred_Un_distrib union_abs1 Un_assoc[symmetric]  union_abs2
         by (simp add:arity)
     qed
   next
     case ge
     with \<open>\<phi>\<in>_\<close>
     have "arity(\<phi>) \<le> 5" "pred^5(arity(\<phi>)) \<le> 5"
       using not_lt_iff_le le_trans[OF le_pred]
       by auto
     with \<open>\<phi>\<in>_\<close>
     have "arity(iterates(\<lambda>p. incr_bv(p)`5,6,\<phi>)) = arity(\<phi>)" "arity(\<phi>)\<le>6" "pred^5(arity(\<phi>)) \<le> 6"
       using arity_incr_bv_lemma ge le_trans[OF \<open>arity(\<phi>)\<le>5\<close>] le_trans[OF \<open>pred^5(arity(\<phi>))\<le>5\<close>]
       by auto
     with \<open>arity(\<phi>) \<le> 5\<close> \<open>\<phi>\<in>_\<close> \<open>pred^5(_) \<le> 5\<close>
     show ?thesis
       unfolding ren_truth_lemma_def
       using  pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
       by (simp add:arity)
   qed
 qed
 
 lemma sats_ren_truth_lemma:
   "[q,b,d,a1,a2,a3] @ env \<in> list(M) \<Longrightarrow> \<phi> \<in> formula \<Longrightarrow>
    (M, [q,b,d,a1,a2,a3] @ env \<Turnstile> ren_truth_lemma(\<phi>) ) \<longleftrightarrow>
    (M, [q,a1,a2,a3,b] @ env \<Turnstile> \<phi>)"
   unfolding ren_truth_lemma_def
   by (insert sats_incr_bv_iff [of _ _ M _ "[q,a1,a2,a3,b]"], simp)
 
+context forcing_data1
+begin
+
 lemma truth_lemma' :
   assumes
     "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>) \<le> succ(length(env))"
   shows
     "separation(##M,\<lambda>d. \<exists>b\<in>M. \<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env)))"
 proof -
   let ?rel_pred="\<lambda>M x a1 a2 a3. \<exists>b\<in>M. \<forall>q\<in>M. q\<in>a1 \<and> is_leq(##M,a2,q,x) \<longrightarrow>
                   \<not>(M, [q,a1,a2,a3,b] @ env \<Turnstile> forces(\<phi>))"
   let ?\<psi>="Exists(Forall(Implies(And(Member(0,3),is_leq_fm(4,0,2)),
           Neg(ren_truth_lemma(forces(\<phi>))))))"
   have "q\<in>M" if "q\<in>P" for q using that transitivity[OF _ P_in_M] by simp
   then
   have 1:"\<forall>q\<in>M. q\<in>P \<and> R(q) \<longrightarrow> Q(q) \<Longrightarrow> (\<forall>q\<in>P. R(q) \<longrightarrow> Q(q))" for R Q
     by auto
   then
   have "\<lbrakk>b \<in> M; \<forall>q\<in>M. q \<in> P \<and> q \<preceq> d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env))\<rbrakk> \<Longrightarrow>
          \<exists>c\<in>M. \<forall>q\<in>P. q \<preceq> d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([c]@env))" for b d
     by (rule bexI,simp_all)
   then
   have "?rel_pred(M,d,P,leq,\<one>) \<longleftrightarrow> (\<exists>b\<in>M. \<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env)))" if "d\<in>M" for d
-    using that leq_abs leq_in_M P_in_M one_in_M assms
+    using that leq_abs assms
     by auto
   moreover
   have "?\<psi>\<in>formula" using assms by simp
   moreover
   have "(M, [d,P,leq,\<one>]@env \<Turnstile> ?\<psi>) \<longleftrightarrow> ?rel_pred(M,d,P,leq,\<one>)" if "d\<in>M" for d
-    using assms that P_in_M leq_in_M one_in_M sats_is_leq_fm sats_ren_truth_lemma zero_in_M
+    using assms that sats_is_leq_fm sats_ren_truth_lemma zero_in_M
     by simp
   moreover
   have "arity(?\<psi>) \<le> 4+\<^sub>\<omega>length(env)"
   proof -
     have eq:"arity(is_leq_fm(4, 0, 2)) = 5"
       using arity_is_leq_fm succ_Un_distrib ord_simp_union
       by simp
     with \<open>\<phi>\<in>_\<close>
     have "arity(?\<psi>) = 3 \<union> (pred^2(arity(ren_truth_lemma(forces(\<phi>)))))"
       using union_abs1 pred_Un_distrib by (simp add:arity)
     moreover
     have "... \<le> 3 \<union> (pred(pred(6 \<union> succ(arity(forces(\<phi>))))))" (is "_ \<le> ?r")
       using  \<open>\<phi>\<in>_\<close> Un_le_compat[OF le_refl[of 3]]
         le_imp_subset arity_ren_truth[of "forces(\<phi>)"]
         pred_mono
       by auto
     finally
     have "arity(?\<psi>) \<le> ?r" by simp
     have i:"?r \<le> 4 \<union> pred(arity(forces(\<phi>)))"
       using pred_Un_distrib pred_succ_eq \<open>\<phi>\<in>_\<close> Un_assoc[symmetric] union_abs1 by simp
     have h:"4 \<union> pred(arity(forces(\<phi>))) \<le> 4 \<union> (4+\<^sub>\<omega>length(env))"
       using  \<open>env\<in>_\<close> add_commute \<open>\<phi>\<in>_\<close>
         Un_le_compat[of 4 4,OF _ pred_mono[OF _ arity_forces_le[OF _ _ \<open>arity(\<phi>)\<le>_\<close>]] ]
         \<open>env\<in>_\<close> by auto
     with \<open>\<phi>\<in>_\<close> \<open>env\<in>_\<close>
     show ?thesis
       using le_trans[OF  \<open>arity(?\<psi>) \<le> ?r\<close>  le_trans[OF i h]] ord_simp_union by simp
   qed
   ultimately
-  show ?thesis using assms P_in_M leq_in_M one_in_M
+  show ?thesis using assms
       separation_ax[of "?\<psi>" "[P,leq,\<one>]@env"]
       separation_cong[of "##M" "\<lambda>y. (M, [y,P,leq,\<one>]@env \<Turnstile>?\<psi>)"]
     by simp
 qed
 
+end
+
+context G_generic1
+begin
 
 lemma truth_lemma:
   assumes
-    "\<phi>\<in>formula" "M_generic(G)"
+    "\<phi>\<in>formula"
     "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
   shows
-    "(\<exists>p\<in>G. p \<tturnstile> \<phi> env)   \<longleftrightarrow>   M[G], map(val(P,G),env) \<Turnstile> \<phi>"
+    "(\<exists>p\<in>G. p \<tturnstile> \<phi> env)   \<longleftrightarrow>   M[G], map(val(G),env) \<Turnstile> \<phi>"
   using assms
 proof (induct arbitrary:env)
   case (Member x y)
   then
   show ?case
-    using assms truth_lemma_mem[OF \<open>env\<in>list(M)\<close> assms(2) \<open>x\<in>nat\<close> \<open>y\<in>nat\<close>]
-      arities_at_aux by simp
+    using truth_lemma_mem[OF \<open>env\<in>list(M)\<close> \<open>x\<in>nat\<close> \<open>y\<in>nat\<close>] arities_at_aux 
+    by simp
 next
   case (Equal x y)
   then
   show ?case
-    using assms truth_lemma_eq[OF \<open>env\<in>list(M)\<close> assms(2) \<open>x\<in>nat\<close> \<open>y\<in>nat\<close>]
-      arities_at_aux by simp
+    using truth_lemma_eq[OF \<open>env\<in>list(M)\<close> \<open>x\<in>nat\<close> \<open>y\<in>nat\<close>] arities_at_aux by simp
 next
   case (Nand \<phi> \<psi>)
-  moreover
-  note \<open>M_generic(G)\<close>
-  ultimately
+  then
   show ?case
     using truth_lemma_And truth_lemma_Neg[of "\<cdot>\<phi> \<and> \<psi>\<cdot>"] Forces_Nand_alt
       M_genericD map_val_in_MG arity_Nand_le[of \<phi> \<psi>] FOL_arities by auto
 next
   case (Forall \<phi>)
-  with \<open>M_generic(G)\<close>
+  then
   show ?case
   proof (intro iffI)
     assume "\<exists>p\<in>G. (p \<tturnstile> Forall(\<phi>) env)"
-    with \<open>M_generic(G)\<close>
+    then
     obtain p where "p\<in>G" "p\<in>M" "p\<in>P" "p \<tturnstile> Forall(\<phi>) env"
       using transitivity[OF _ P_in_M] by auto
     with \<open>env\<in>list(M)\<close> \<open>\<phi>\<in>formula\<close>
     have "p \<tturnstile> \<phi> ([x]@env)" if "x\<in>M" for x
       using that Forces_Forall by simp
     with \<open>p\<in>G\<close> \<open>\<phi>\<in>formula\<close> \<open>env\<in>_\<close> \<open>arity(Forall(\<phi>)) \<le> length(env)\<close>
-      Forall(2)[of "Cons(_,env)"] \<open>M_generic(G)\<close>
-    show "M[G], map(val(P,G),env) \<Turnstile>  Forall(\<phi>)"
+      Forall(2)[of "Cons(_,env)"]
+    show "M[G], map(val(G),env) \<Turnstile>  Forall(\<phi>)"
       using pred_le2 map_val_in_MG
       by (auto iff:GenExt_iff)
   next
-    assume "M[G], map(val(P,G),env) \<Turnstile> Forall(\<phi>)"
+    assume "M[G], map(val(G),env) \<Turnstile> Forall(\<phi>)"
     let ?D1="{d\<in>P. (d \<tturnstile> Forall(\<phi>) env)}"
     let ?D2="{d\<in>P. \<exists>b\<in>M. \<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env))}"
     define D where "D \<equiv> ?D1 \<union> ?D2"
+    note \<open>arity(Forall(\<phi>)) \<le> length(env)\<close> \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close>
+    moreover from this
     have ar\<phi>:"arity(\<phi>)\<le>succ(length(env))"
-      using assms \<open>arity(Forall(\<phi>)) \<le> length(env)\<close> \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close> pred_le2
-      by simp
-    then
-    have "arity(Forall(\<phi>)) \<le> length(env)"
-      using pred_le \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close> by simp
-    then
-    have "?D1\<in>M" using Collect_forces ar\<phi> \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close> by simp
+      using pred_le2 by simp
+    moreover from calculation
+    have "?D1\<in>M" using Collect_forces  by simp
     moreover from \<open>env\<in>list(M)\<close> \<open>\<phi>\<in>formula\<close>
     have "?D2\<in>M"
-      using  truth_lemma'[of \<phi>] separation_closed ar\<phi> P_in_M
+      using truth_lemma'[of \<phi>] separation_closed ar\<phi>
       by simp
     ultimately
     have "D\<in>M" unfolding D_def using Un_closed by simp
     moreover
     have "D \<subseteq> P" unfolding D_def by auto
     moreover
     have "dense(D)"
     proof
       fix p
       assume "p\<in>P"
       show "\<exists>d\<in>D. d\<preceq> p"
       proof (cases "p \<tturnstile> Forall(\<phi>) env")
         case True
         with \<open>p\<in>P\<close>
         show ?thesis unfolding D_def using refl_leq by blast
       next
         case False
         with Forall \<open>p\<in>P\<close>
         obtain b where "b\<in>M" "\<not>(p \<tturnstile> \<phi> ([b]@env))"
           using Forces_Forall by blast
         moreover from this \<open>p\<in>P\<close> Forall
         have "\<not>dense_below({q\<in>P. q \<tturnstile> \<phi> ([b]@env)},p)"
           using density_lemma pred_le2  by auto
         moreover from this
         obtain d where "d\<preceq>p" "\<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b] @ env))"
           "d\<in>P" by blast
         ultimately
         show ?thesis unfolding D_def by auto
       qed
     qed
     moreover
-    note \<open>M_generic(G)\<close>
+    note generic
     ultimately
-    obtain d where "d \<in> D"  "d \<in> G" by blast
+    obtain d where "d \<in> D" "d \<in> G" by blast
     then
     consider (1) "d\<in>?D1" | (2) "d\<in>?D2" unfolding D_def by blast
     then
     show "\<exists>p\<in>G. (p \<tturnstile> Forall(\<phi>) env)"
     proof (cases)
       case 1
       with \<open>d\<in>G\<close>
       show ?thesis by blast
     next
       case 2
       then
       obtain b where "b\<in>M" "\<forall>q\<in>P. q\<preceq>d \<longrightarrow>\<not>(q \<tturnstile> \<phi> ([b] @ env))"
         by blast
       moreover from this(1) and  \<open>M[G], _ \<Turnstile>  Forall(\<phi>)\<close> and
-        Forall(2)[of "Cons(b,env)"] Forall(1,3-5) \<open>M_generic(G)\<close>
+        Forall(2)[of "Cons(b,env)"] Forall(1,3-)
       obtain p where "p\<in>G" "p\<in>P" "p \<tturnstile> \<phi> ([b] @ env)"
-        using pred_le2 using map_val_in_MG by (auto iff:GenExt_iff)
+        using pred_le2 map_val_in_MG M_genericD by (auto iff:GenExt_iff)
       moreover
-      note \<open>d\<in>G\<close> \<open>M_generic(G)\<close>
+      note \<open>d\<in>G\<close>
       ultimately
-      obtain q where "q\<in>G" "q\<in>P" "q\<preceq>d" "q\<preceq>p" by blast
+      obtain q where "q\<in>G" "q\<in>P" "q\<preceq>d" "q\<preceq>p"
+        using M_genericD by force
       moreover from this and  \<open>p \<tturnstile> \<phi> ([b] @ env)\<close>
         Forall  \<open>b\<in>M\<close> \<open>p\<in>P\<close>
       have "q \<tturnstile> \<phi> ([b] @ env)"
         using pred_le2 strengthening_lemma by simp
       moreover
       note \<open>\<forall>q\<in>P. q\<preceq>d \<longrightarrow>\<not>(q \<tturnstile> \<phi> ([b] @ env))\<close>
       ultimately
       show ?thesis by simp
     qed
   qed
 qed
 
+end
+
+context forcing_data1
+begin
+
 subsection\<open>The ``Definition of forcing''\<close>
 lemma definition_of_forcing:
   assumes
     "p\<in>P" "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
   shows
     "(p \<tturnstile> \<phi> env) \<longleftrightarrow>
-     (\<forall>G. M_generic(G) \<and> p\<in>G  \<longrightarrow>  M[G], map(val(P,G),env) \<Turnstile> \<phi>)"
+     (\<forall>G. M_generic(G) \<and> p\<in>G \<longrightarrow> M[G], map(val(G),env) \<Turnstile> \<phi>)"
 proof (intro iffI allI impI, elim conjE)
   fix G
   assume "(p \<tturnstile> \<phi> env)" "M_generic(G)" "p \<in> G"
-  with assms
-  show "M[G], map(val(P,G),env) \<Turnstile> \<phi>"
-    using truth_lemma[of \<phi>] by blast
+  moreover from this
+  interpret G_generic1 P leq \<one> M enum G 
+    by (unfold_locales,simp)
+  from calculation assms
+  show "M[G], map(val(G),env) \<Turnstile> \<phi>"
+    using truth_lemma[of \<phi>] by auto
 next
-  assume 1: "\<forall>G.(M_generic(G)\<and> p\<in>G)\<longrightarrow> M[G] , map(val(P,G),env) \<Turnstile> \<phi>"
+  assume 1: "\<forall>G.(M_generic(G)\<and> p\<in>G) \<longrightarrow> M[G] , map(val(G),env) \<Turnstile> \<phi>"
   {
     fix r
     assume 2: "r\<in>P" "r\<preceq>p"
     then
     obtain G where "r\<in>G" "M_generic(G)"
       text\<open>Here we're using countability (via the existence of
         generic filters) of \<^term>\<open>M\<close> as a shortcut.\<close>
       using generic_filter_existence by auto
-    moreover from calculation 2 \<open>p\<in>P\<close>
+    moreover from this
+    interpret G_generic1 P leq \<one> M enum G 
+      by (unfold_locales,simp)
+    from calculation 2 \<open>p\<in>P\<close>
     have "p\<in>G"
       unfolding M_generic_def using filter_leqD by simp
     moreover note 1
     ultimately
-    have "M[G], map(val(P,G),env) \<Turnstile> \<phi>"
+    have "M[G], map(val(G),env) \<Turnstile> \<phi>"
       by simp
-    with assms \<open>M_generic(G)\<close>
+    moreover
+    note assms
+    moreover from calculation
     obtain s where "s\<in>G" "(s \<tturnstile> \<phi> env)"
       using truth_lemma[of \<phi>] by blast
-    moreover from this and  \<open>M_generic(G)\<close> \<open>r\<in>G\<close>
-    obtain q where "q\<in>G" "q\<preceq>s" "q\<preceq>r"
+    moreover from this \<open>r\<in>G\<close>
+    obtain q where "q\<in>G" "q\<preceq>s" "q\<preceq>r" "s\<in>P" "q\<in>P"
       by blast
-    moreover from calculation \<open>s\<in>G\<close> \<open>M_generic(G)\<close>
-    have "s\<in>P" "q\<in>P"
-      unfolding M_generic_def filter_def by auto
-    moreover
-    note assms
     ultimately
     have "\<exists>q\<in>P. q\<preceq>r \<and> (q \<tturnstile> \<phi> env)"
-      using strengthening_lemma by blast
+      using strengthening_lemma[of s] by auto
   }
   then
   have "dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p)"
     unfolding dense_below_def by blast
   with assms
   show "(p \<tturnstile> \<phi> env)"
     using density_lemma by blast
 qed
 
 lemmas definability = forces_type
 
 end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Infinity_Axiom.thy b/thys/Independence_CH/Infinity_Axiom.thy
--- a/thys/Independence_CH/Infinity_Axiom.thy
+++ b/thys/Independence_CH/Infinity_Axiom.thy
@@ -1,37 +1,30 @@
 section\<open>The Axiom of Infinity in $M[G]$\<close>
 theory Infinity_Axiom
-  imports Separation_Axiom Union_Axiom Pairing_Axiom
+  imports Union_Axiom Pairing_Axiom
 begin
+sublocale G_generic1 \<subseteq> forcing_data1
+  by unfold_locales
 
 context G_generic1 begin
 
 interpretation mg_triv: M_trivial"##M[G]"
-  using transitivity_MG zero_in_MG generic Union_MG pairing_in_MG
+  using transitivity_MG zero_in_MG[of G] generic Union_MG pairing_in_MG
   by unfold_locales auto
 
 lemma infinity_in_MG : "infinity_ax(##M[G])"
 proof -
-  from infinity_ax
-  obtain I where "I\<in>M" "0 \<in> I" "\<forall>y\<in>M. y \<in> I \<longrightarrow> succ(y) \<in> I"
-    unfolding infinity_ax_def  by auto
-  then
-  have "check(I) \<in> M"
-    using check_in_M by simp
-  then
-  have "I\<in> M[G]"
-    using valcheck generic one_in_G one_in_P GenExtI[of "check(I)" G] by simp
-  moreover from this \<open>I\<in>M[G]\<close> \<open>\<forall>y\<in>M. y \<in> I \<longrightarrow> succ(y) \<in> I\<close>
-  have "succ(y) \<in> I \<inter> M[G]" if "y \<in> I" for y
-    using that transitivity_MG transitivity[OF _ \<open>I\<in>M\<close>] by blast
-  moreover
-  note \<open>0\<in>I\<close>
+  have "\<omega> \<in> M[G]"
+    using M_subset_MG one_in_G nat_in_M by auto
+  moreover from this
+  have "succ(y) \<in> \<omega> \<inter> M[G]" if "y \<in> \<omega>" for y
+    using that transitivity_MG by blast
   ultimately
   show ?thesis
-    using transitivity_MG[of _ I]
+    using transitivity_MG[of 0 \<omega>]
     unfolding infinity_ax_def
     by auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Interface.thy b/thys/Independence_CH/Interface.thy
--- a/thys/Independence_CH/Interface.thy
+++ b/thys/Independence_CH/Interface.thy
@@ -1,1535 +1,1717 @@
 section\<open>Interface between set models and Constructibility\<close>
 
 text\<open>This theory provides an interface between Paulson's
 relativization results and set models of ZFC. In particular,
 it is used to prove that the locale \<^term>\<open>forcing_data\<close> is
 a sublocale of all relevant locales in \<^session>\<open>ZF-Constructible\<close>
 (\<^term>\<open>M_trivial\<close>, \<^term>\<open>M_basic\<close>, \<^term>\<open>M_eclose\<close>, etc).
 
 In order to interpret the locales in \<^session>\<open>ZF-Constructible\<close> we
 introduce new locales, each stronger than the previous one, assuming
 only the instances of Replacement needed to interpret the subsequent
 locales of that session. From the start we assume Separation for
 every internalized formula (with one parameter, but this is not a
 problem since we can use pairing).\<close>
 
 theory Interface
   imports
     Fm_Definitions
     Transitive_Models.Cardinal_AC_Relative
-    Transitive_Models.M_Basic_No_Repl
 begin
 
 locale M_Z_basic =
   fixes M
   assumes
     upair_ax:      "upair_ax(##M)" and
     Union_ax:      "Union_ax(##M)" and
     power_ax:      "power_ax(##M)" and
     extensionality:"extensionality(##M)" and
     foundation_ax: "foundation_ax(##M)" and
     infinity_ax:   "infinity_ax(##M)" and
     separation_ax: "\<phi> \<in> formula \<Longrightarrow> env \<in> list(M) \<Longrightarrow>
                     arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<Longrightarrow>
                     separation(##M,\<lambda>x. (M, [x] @ env \<Turnstile> \<phi>))"
 
 locale M_transset =
   fixes M
   assumes
     trans_M:       "Transset(M)"
 
 locale M_Z_trans = M_Z_basic + M_transset
 
 locale M_ZF1 = M_Z_basic +
   assumes
     replacement_ax1:
-    "replacement_assm(M,env,wfrec_Hfrc_at_fm)"
     "replacement_assm(M,env,list_repl1_intf_fm)"
     "replacement_assm(M,env,list_repl2_intf_fm)"
+    "replacement_assm(M,env,formula_repl1_intf_fm)"
     "replacement_assm(M,env,formula_repl2_intf_fm)"
+    "replacement_assm(M,env,eclose_repl1_intf_fm)"
     "replacement_assm(M,env,eclose_repl2_intf_fm)"
-    "replacement_assm(M,env,powapply_repl_fm)"
-    "replacement_assm(M,env,phrank_repl_fm)"
     "replacement_assm(M,env,wfrec_rank_fm)"
     "replacement_assm(M,env,trans_repl_HVFrom_fm)"
-    "replacement_assm(M,env,wfrec_Hcheck_fm)"
-    "replacement_assm(M,env,repl_PHcheck_fm)"
-    "replacement_assm(M,env,check_replacement_fm)"
-    "replacement_assm(M,env,G_dot_in_M_fm)"
-    "replacement_assm(M,env,repl_opname_check_fm)"
     "replacement_assm(M,env,tl_repl_intf_fm)"
-    "replacement_assm(M,env,formula_repl1_intf_fm)"
-    "replacement_assm(M,env,eclose_repl1_intf_fm)"
 
 definition instances1_fms where "instances1_fms \<equiv>
-  { wfrec_Hfrc_at_fm,
-    list_repl1_intf_fm,
+  { list_repl1_intf_fm,
     list_repl2_intf_fm,
+    formula_repl1_intf_fm,
     formula_repl2_intf_fm,
+    eclose_repl1_intf_fm,
     eclose_repl2_intf_fm,
-    powapply_repl_fm,
-    phrank_repl_fm,
     wfrec_rank_fm,
     trans_repl_HVFrom_fm,
-    wfrec_Hcheck_fm,
-    repl_PHcheck_fm,
-    check_replacement_fm,
-    G_dot_in_M_fm,
-    repl_opname_check_fm,
-    tl_repl_intf_fm,
-    formula_repl1_intf_fm,
-    eclose_repl1_intf_fm }"
+    tl_repl_intf_fm
+ }"
 
-txt\<open>This set has 17 internalized formulas.\<close>
+text\<open>This set has 9 internalized formulas.\<close>
 
-lemmas replacement_instances1_defs = tl_repl_intf_fm_def formula_repl1_intf_fm_def
-  eclose_repl1_intf_fm_def wfrec_Hfrc_at_fm_def
-  list_repl1_intf_fm_def list_repl2_intf_fm_def formula_repl2_intf_fm_def
-  eclose_repl2_intf_fm_def powapply_repl_fm_def phrank_repl_fm_def wfrec_rank_fm_def
-  trans_repl_HVFrom_fm_def wfrec_Hcheck_fm_def repl_PHcheck_fm_def check_replacement_fm_def
-  G_dot_in_M_fm_def repl_opname_check_fm_def
+lemmas replacement_instances1_defs =
+  list_repl1_intf_fm_def list_repl2_intf_fm_def
+  formula_repl1_intf_fm_def formula_repl2_intf_fm_def
+  eclose_repl1_intf_fm_def eclose_repl2_intf_fm_def
+  wfrec_rank_fm_def trans_repl_HVFrom_fm_def tl_repl_intf_fm_def
 
 lemma instances1_fms_type[TC]: "instances1_fms \<subseteq> formula"
+  using Lambda_in_M_fm_type
   unfolding replacement_instances1_defs instances1_fms_def by simp
 
 declare (in M_ZF1) replacement_instances1_defs[simp]
 
 locale M_ZF1_trans = M_ZF1 + M_Z_trans
 
 context M_Z_trans
 begin
 
 lemmas transitivity = Transset_intf[OF trans_M]
 
 subsection\<open>Interface with \<^term>\<open>M_trivial\<close>\<close>
 
 lemma zero_in_M:  "0 \<in> M"
 proof -
   obtain z where "empty(##M,z)"  "z\<in>M"
     using empty_intf[OF infinity_ax]
     by auto
   moreover from this
   have "z=0"
     using transitivity empty_def
     by auto
   ultimately
   show ?thesis
     by simp
 qed
 
 lemma separation_in_ctm :
   assumes
     "\<phi> \<in> formula" "env\<in>list(M)"
     "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" and
     satsQ: "\<And>x. x\<in>M \<Longrightarrow> (M, [x]@env \<Turnstile> \<phi>) \<longleftrightarrow> Q(x)"
   shows
     "separation(##M,Q)"
   using assms separation_ax satsQ transitivity
     separation_cong[of "##M" "\<lambda>y. (M, [y]@env \<Turnstile> \<phi>)" "Q"]
   by simp
 
 end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
 
 locale M_ZC_basic = M_Z_basic + M_AC "##M"
 
 locale M_ZFC1 = M_ZF1 + M_ZC_basic
 
 locale M_ZFC1_trans = M_ZF1_trans + M_ZFC1
 
 sublocale M_Z_trans \<subseteq> M_trans "##M"
   using transitivity zero_in_M exI[of "\<lambda>x. x\<in>M"]
   by unfold_locales simp_all
 
 sublocale M_Z_trans \<subseteq> M_trivial "##M"
   using upair_ax Union_ax by unfold_locales
 
 subsection\<open>Interface with \<^term>\<open>M_basic\<close>\<close>
 
 definition Intersection where
   "Intersection(N,B,x) \<equiv> (\<forall>y[N]. y\<in>B \<longrightarrow> x\<in>y)"
 
 synthesize "Intersection" from_definition "Intersection" assuming "nonempty"
 arity_theorem for "Intersection_fm"
 
 definition CartProd where
   "CartProd(N,B,C,z) \<equiv> (\<exists>x[N]. x\<in>B \<and> (\<exists>y[N]. y\<in>C \<and> pair(N,x,y,z)))"
 
 synthesize "CartProd" from_definition "CartProd" assuming "nonempty"
 arity_theorem for "CartProd_fm"
 
-definition Image where
-  "Image(N,B,r,y) \<equiv> (\<exists>p[N]. p\<in>r \<and> (\<exists>x[N]. x\<in>B \<and> pair(N,x,y,p)))"
+definition ImageSep where
+  "ImageSep(N,B,r,y) \<equiv> (\<exists>p[N]. p\<in>r \<and> (\<exists>x[N]. x\<in>B \<and> pair(N,x,y,p)))"
 
-synthesize "Image" from_definition "Image" assuming "nonempty"
-arity_theorem for "Image_fm"
+synthesize "ImageSep" from_definition  assuming "nonempty"
+arity_theorem for "ImageSep_fm"
 
 definition Converse where
   "Converse(N,R,z) \<equiv> \<exists>p[N]. p\<in>R \<and> (\<exists>x[N].\<exists>y[N]. pair(N,x,y,p) \<and> pair(N,y,x,z))"
 
 synthesize "Converse" from_definition "Converse" assuming "nonempty"
 arity_theorem for "Converse_fm"
 
 definition Restrict where
   "Restrict(N,A,z) \<equiv> \<exists>x[N]. x\<in>A \<and> (\<exists>y[N]. pair(N,x,y,z))"
 
 synthesize "Restrict" from_definition "Restrict" assuming "nonempty"
 arity_theorem for "Restrict_fm"
 
 definition Comp where
   "Comp(N,R,S,xz) \<equiv> \<exists>x[N]. \<exists>y[N]. \<exists>z[N]. \<exists>xy[N]. \<exists>yz[N].
               pair(N,x,z,xz) \<and> pair(N,x,y,xy) \<and> pair(N,y,z,yz) \<and> xy\<in>S \<and> yz\<in>R"
 
 synthesize "Comp" from_definition "Comp" assuming "nonempty"
 arity_theorem for "Comp_fm"
 
 definition Pred where
   "Pred(N,R,X,y) \<equiv> \<exists>p[N]. p\<in>R \<and> pair(N,y,X,p)"
 
 synthesize "Pred" from_definition "Pred" assuming "nonempty"
 arity_theorem for "Pred_fm"
 
 definition is_Memrel where
   "is_Memrel(N,z) \<equiv> \<exists>x[N]. \<exists>y[N]. pair(N,x,y,z) \<and> x \<in> y"
 
 synthesize "is_Memrel" from_definition "is_Memrel" assuming "nonempty"
 arity_theorem for "is_Memrel_fm"
 
 definition RecFun where
   "RecFun(N,r,f,g,a,b,x) \<equiv> \<exists>xa[N]. \<exists>xb[N].
                     pair(N,x,a,xa) \<and> xa \<in> r \<and> pair(N,x,b,xb) \<and> xb \<in> r \<and>
                     (\<exists>fx[N]. \<exists>gx[N]. fun_apply(N,f,x,fx) \<and> fun_apply(N,g,x,gx) \<and>
                                      fx \<noteq> gx)"
 
 synthesize "RecFun" from_definition "RecFun" assuming "nonempty"
 arity_theorem for "RecFun_fm"
 
 arity_theorem for "rtran_closure_mem_fm"
 
 synthesize "wellfounded_trancl" from_definition assuming "nonempty"
 arity_theorem for "wellfounded_trancl_fm"
 
 context M_Z_trans
 begin
 
 lemma inter_sep_intf :
   assumes "A\<in>M"
   shows "separation(##M,\<lambda>x . \<forall>y\<in>M . y\<in>A \<longrightarrow> x\<in>y)"
   using assms separation_in_ctm[of "Intersection_fm(1,0)" "[A]" "Intersection(##M,A)"]
     Intersection_iff_sats[of 1 "[_,A]" A 0 _ M] arity_Intersection_fm Intersection_fm_type
     ord_simp_union zero_in_M
   unfolding Intersection_def
   by simp
 
 lemma diff_sep_intf :
   assumes "B\<in>M"
   shows "separation(##M,\<lambda>x . x\<notin>B)"
   using assms separation_in_ctm[of "Neg(Member(0,1))" "[B]" "\<lambda>x . x\<notin>B"] ord_simp_union
   by simp
 
 lemma cartprod_sep_intf :
   assumes "A\<in>M" and "B\<in>M"
   shows "separation(##M,\<lambda>z. \<exists>x\<in>M. x\<in>A \<and> (\<exists>y\<in>M. y\<in>B \<and> pair(##M,x,y,z)))"
   using assms separation_in_ctm[of "CartProd_fm(1,2,0)" "[A,B]" "CartProd(##M,A,B)"]
     CartProd_iff_sats[of 1 "[_,A,B]" A 2 B 0 _ M] arity_CartProd_fm  CartProd_fm_type
     ord_simp_union zero_in_M
   unfolding CartProd_def
   by simp
 
 lemma image_sep_intf :
   assumes "A\<in>M" and "B\<in>M"
   shows "separation(##M, \<lambda>y. \<exists>p\<in>M. p\<in>B \<and> (\<exists>x\<in>M. x\<in>A \<and> pair(##M,x,y,p)))"
-  using assms separation_in_ctm[of "Image_fm(1,2,0)" "[A,B]" "Image(##M,A,B)"]
-    Image_iff_sats[of 1 "[_,A,B]" _ 2 _ 0 _ M] arity_Image_fm Image_fm_type
+  using assms separation_in_ctm[of "ImageSep_fm(1,2,0)" "[A,B]" "ImageSep(##M,A,B)"]
+    ImageSep_iff_sats[of 1 "[_,A,B]" _ 2 _ 0 _ M] arity_ImageSep_fm ImageSep_fm_type
     ord_simp_union zero_in_M
-  unfolding Image_def
+  unfolding ImageSep_def
   by simp
 
 lemma converse_sep_intf :
   assumes "R\<in>M"
   shows "separation(##M,\<lambda>z. \<exists>p\<in>M. p\<in>R \<and> (\<exists>x\<in>M.\<exists>y\<in>M. pair(##M,x,y,p) \<and> pair(##M,y,x,z)))"
   using assms separation_in_ctm[of "Converse_fm(1,0)" "[R]" "Converse(##M,R)"]
     Converse_iff_sats[of 1 "[_,R]" _ 0 _ M] arity_Converse_fm Converse_fm_type
     ord_simp_union zero_in_M
   unfolding Converse_def
   by simp
 
 lemma restrict_sep_intf :
   assumes "A\<in>M"
   shows "separation(##M,\<lambda>z. \<exists>x\<in>M. x\<in>A \<and> (\<exists>y\<in>M. pair(##M,x,y,z)))"
   using assms separation_in_ctm[of "Restrict_fm(1,0)" "[A]" "Restrict(##M,A)"]
     Restrict_iff_sats[of 1 "[_,A]" _ 0 _ M] arity_Restrict_fm Restrict_fm_type
     ord_simp_union zero_in_M
   unfolding Restrict_def
   by simp
 
 lemma comp_sep_intf :
   assumes "R\<in>M" and "S\<in>M"
   shows "separation(##M,\<lambda>xz. \<exists>x\<in>M. \<exists>y\<in>M. \<exists>z\<in>M. \<exists>xy\<in>M. \<exists>yz\<in>M.
            pair(##M,x,z,xz) \<and> pair(##M,x,y,xy) \<and> pair(##M,y,z,yz) \<and> xy\<in>S \<and> yz\<in>R)"
   using assms separation_in_ctm[of "Comp_fm(1,2,0)" "[R,S]" "Comp(##M,R,S)"]
     Comp_iff_sats[of 1 "[_,R,S]" _ 2 _ 0 _ M] arity_Comp_fm Comp_fm_type
     ord_simp_union zero_in_M
   unfolding Comp_def
   by simp
 
 lemma pred_sep_intf:
   assumes "R\<in>M" and "X\<in>M"
   shows "separation(##M, \<lambda>y. \<exists>p\<in>M. p\<in>R \<and> pair(##M,y,X,p))"
   using assms separation_in_ctm[of "Pred_fm(1,2,0)" "[R,X]" "Pred(##M,R,X)"]
     Pred_iff_sats[of 1 "[_,R,X]" _ 2 _ 0 _ M] arity_Pred_fm Pred_fm_type
     ord_simp_union zero_in_M
   unfolding Pred_def
   by simp
 
 lemma memrel_sep_intf:
   "separation(##M, \<lambda>z. \<exists>x\<in>M. \<exists>y\<in>M. pair(##M,x,y,z) \<and> x \<in> y)"
   using separation_in_ctm[of "is_Memrel_fm(0)" "[]" "is_Memrel(##M)"]
     is_Memrel_iff_sats[of 0 "[_]" _ M] arity_is_Memrel_fm is_Memrel_fm_type
     ord_simp_union zero_in_M
   unfolding is_Memrel_def
   by simp
 
 lemma is_recfun_sep_intf :
   assumes "r\<in>M" "f\<in>M" "g\<in>M" "a\<in>M" "b\<in>M"
   shows "separation(##M,\<lambda>x. \<exists>xa\<in>M. \<exists>xb\<in>M.
                     pair(##M,x,a,xa) \<and> xa \<in> r \<and> pair(##M,x,b,xb) \<and> xb \<in> r \<and>
                     (\<exists>fx\<in>M. \<exists>gx\<in>M. fun_apply(##M,f,x,fx) \<and> fun_apply(##M,g,x,gx) \<and>
                                      fx \<noteq> gx))"
   using assms separation_in_ctm[of "RecFun_fm(1,2,3,4,5,0)" "[r,f,g,a,b]" "RecFun(##M,r,f,g,a,b)"]
     RecFun_iff_sats[of 1 "[_,r,f,g,a,b]" _ 2 _ 3 _ 4 _ 5 _ 0 _ M] arity_RecFun_fm RecFun_fm_type
     ord_simp_union zero_in_M
   unfolding RecFun_def
   by simp
 
 lemmas M_basic_sep_instances =
   inter_sep_intf diff_sep_intf cartprod_sep_intf
   image_sep_intf converse_sep_intf restrict_sep_intf
   pred_sep_intf memrel_sep_intf comp_sep_intf is_recfun_sep_intf
+
 end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
 
 sublocale M_Z_trans \<subseteq> M_basic_no_repl "##M"
   using power_ax M_basic_sep_instances
   by unfold_locales simp_all
 
 lemma Replace_eq_Collect:
   assumes "\<And>x y y'. x\<in>A \<Longrightarrow> P(x,y) \<Longrightarrow> P(x,y') \<Longrightarrow> y=y'" "{y . x \<in> A, P(x, y)} \<subseteq> B"
   shows "{y . x \<in> A, P(x, y)} = {y\<in>B . \<exists>x\<in>A. P(x,y)}"
   using assms by blast
 
 context M_Z_trans
 begin
 
 lemma Pow_inter_M_closed: assumes "A \<in> M" shows "Pow(A) \<inter> M \<in> M"
 proof -
   have "{a \<in> Pow(A) . a \<in> M} = Pow(A) \<inter> M" by auto
   then
   show ?thesis
     using power_ax powerset_abs assms unfolding power_ax_def
     by auto
 qed
 
 lemma Pow'_inter_M_closed: assumes "A \<in> M" shows "{a \<in> Pow(A) . a \<in> M} \<in> M"
   using power_ax powerset_abs assms unfolding power_ax_def by auto
 
 end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
 
 context M_basic_no_repl
 begin
 
 lemma Replace_funspace_succ_rep_intf_sub:
   assumes
     "M(A)" "M(n)"
   shows
     "{z . p \<in> A, funspace_succ_rep_intf_rel(M,p,z,n)}
       \<subseteq> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>domain(A) \<union> ({n} \<times> range(A)) \<union> (\<Union>({n} \<times> range(A)))))"
   unfolding funspace_succ_rep_intf_rel_def using assms mem_Pow_rel_abs
   by clarsimp (auto simp: cartprod_def)
 
 lemma funspace_succ_rep_intf_uniq:
   assumes
     "funspace_succ_rep_intf_rel(M,p,z,n)" "funspace_succ_rep_intf_rel(M,p,z',n)"
   shows
     "z = z'"
   using assms unfolding funspace_succ_rep_intf_rel_def by auto
 
 lemma Replace_funspace_succ_rep_intf_eq:
   assumes
     "M(A)" "M(n)"
   shows
     "{z . p \<in> A, funspace_succ_rep_intf_rel(M,p,z,n)} =
      {z \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>domain(A) \<union> ({n} \<times> range(A)) \<union> (\<Union>({n} \<times> range(A))))) .
         \<exists>p\<in>A. funspace_succ_rep_intf_rel(M,p,z,n)}"
   using assms Replace_eq_Collect[OF funspace_succ_rep_intf_uniq, of A,
       OF _ _ Replace_funspace_succ_rep_intf_sub[of A n], of "\<lambda>x y z. x" "\<lambda>x y z. n"]
   by (intro equalityI)
     (auto dest:transM simp:funspace_succ_rep_intf_rel_def)
 
 end \<comment> \<open>\<^locale>\<open>M_basic_no_repl\<close>\<close>
 
 definition fsri where
   "fsri(N,A,B) \<equiv> \<lambda>z. \<exists>p\<in>A. \<exists>f[N]. \<exists>b[N]. p = \<langle>f, b\<rangle> \<and> z = {cons(\<langle>B, b\<rangle>, f)}"
 
 relationalize "fsri" "is_fsri"
 synthesize "is_fsri" from_definition assuming "nonempty"
 arity_theorem for "is_fsri_fm"
 
 
 context M_Z_trans
 begin
 
 lemma separation_fsri:
   "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> separation(##M, is_fsri(##M,A,B))"
   using separation_in_ctm[where env="[A,B]" and \<phi>="is_fsri_fm(1,2,0)"]
     zero_in_M is_fsri_iff_sats[symmetric] arity_is_fsri_fm is_fsri_fm_type
   by (simp_all add: ord_simp_union)
 
 lemma separation_funspace_succ_rep_intf_rel:
   "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> separation(##M, \<lambda>z. \<exists>p\<in>A. funspace_succ_rep_intf_rel(##M,p,z,B))"
   using separation_fsri zero_in_M
   by (rule_tac separation_cong[THEN iffD1, of _ "is_fsri(##M,A,B)"])
     (auto simp flip:setclass_iff dest:transM
       simp:is_fsri_def funspace_succ_rep_intf_rel_def, force)
 
 lemma Replace_funspace_succ_rep_intf_in_M:
   assumes
     "A \<in> M" "n \<in> M"
   shows
     "{z . p \<in> A, funspace_succ_rep_intf_rel(##M,p,z,n)} \<in> M"
 proof -
   have "(##M)({z \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>domain(A) \<union> ({n} \<times> range(A)) \<union> (\<Union>({n} \<times> range(A))))) .
         \<exists>p\<in>A. funspace_succ_rep_intf_rel(##M,p,z,n)})"
     using assms separation_funspace_succ_rep_intf_rel
     by (intro separation_closed) (auto simp flip:setclass_iff)
   with assms
   show ?thesis
     using Replace_funspace_succ_rep_intf_eq by auto
 qed
 
 lemma funspace_succ_rep_intf:
   assumes "n\<in>M"
   shows
     "strong_replacement(##M,
           \<lambda>p z. \<exists>f\<in>M. \<exists>b\<in>M. \<exists>nb\<in>M. \<exists>cnbf\<in>M.
                 pair(##M,f,b,p) \<and> pair(##M,n,b,nb) \<and> is_cons(##M,nb,f,cnbf) \<and>
                 upair(##M,cnbf,cnbf,z))"
-  using assms
+  using assms pair_in_M_iff[simplified] cons_closed[simplified]
   unfolding strong_replacement_def univalent_def
-  apply (simp add:pair_in_M_iff[simplified])
-  apply clarsimp
+  apply (clarsimp, rename_tac A)
   apply (rule_tac x="{z . p \<in> A, funspace_succ_rep_intf_rel(##M,p,z,n)}" in bexI)
    apply (auto simp:funspace_succ_rep_intf_rel_def
       Replace_funspace_succ_rep_intf_in_M[unfolded funspace_succ_rep_intf_rel_def, simplified])
-  apply (rule_tac x="\<langle>f, ba\<rangle>" in bexI)
-   apply (auto dest:transM simp:pair_in_M_iff[simplified] cons_closed[simplified])
   done
 
 end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
 
 sublocale M_Z_trans \<subseteq> M_basic "##M"
   using power_ax M_basic_sep_instances funspace_succ_rep_intf
   by unfold_locales auto
 
 subsection\<open>Interface with \<^term>\<open>M_trancl\<close>\<close>
 
-lemma (in M_ZF1_trans) rtrancl_separation_intf:
+context M_ZF1_trans
+begin
+
+lemma rtrancl_separation_intf:
   assumes "r\<in>M" "A\<in>M"
   shows "separation (##M, rtran_closure_mem(##M,A,r))"
   using assms separation_in_ctm[of "rtran_closure_mem_fm(1,2,0)" "[A,r]" "rtran_closure_mem(##M,A,r)"]
     arity_rtran_closure_mem_fm ord_simp_union zero_in_M
   by simp
 
-context M_ZF1_trans
-begin
-
 lemma wftrancl_separation_intf:
   assumes "r\<in>M" and "Z\<in>M"
   shows "separation (##M, wellfounded_trancl(##M,Z,r))"
   using assms separation_in_ctm[of "wellfounded_trancl_fm(1,2,0)" "[Z,r]" "wellfounded_trancl(##M,Z,r)"]
     arity_wellfounded_trancl_fm ord_simp_union zero_in_M
   by simp
 
 text\<open>To prove \<^term>\<open>nat \<in> M\<close> we get an infinite set \<^term>\<open>I\<close> from \<^term>\<open>infinity_ax\<close>
 closed under \<^term>\<open>0\<close> and \<^term>\<open>succ\<close>; that shows \<^term>\<open>nat\<subseteq>I\<close>. Then we
 can separate \<^term>\<open>I\<close> with the predicate \<^term>\<open>\<lambda>x. x\<in>nat\<close>.\<close>
 lemma finite_sep_intf: "separation(##M, \<lambda>x. x\<in>nat)"
 proof -
   have "(\<forall>v\<in>M. separation(##M,\<lambda>x. (M, [x,v] \<Turnstile> finite_ordinal_fm(0))))"
     using separation_ax arity_finite_ordinal_fm
     by simp
   then
   have "(\<forall>v\<in>M. separation(##M,finite_ordinal(##M)))"
     unfolding separation_def
     by simp
   then
   have "separation(##M,finite_ordinal(##M))"
     using separation_in_ctm zero_in_M
     by auto
   then
   show ?thesis
     unfolding separation_def
     by simp
 qed
 
 lemma nat_subset_I: "\<exists>I\<in>M. nat \<subseteq> I"
 proof -
   have "nat \<subseteq> I"
     if "I\<in>M" and "0\<in>I" and "\<And>x. x\<in>I \<Longrightarrow> succ(x)\<in>I" for I
     using that
     by (rule_tac subsetI,induct_tac x,simp_all)
   moreover
   obtain I where
     "I\<in>M" "0\<in>I" "\<And>x. x\<in>I \<Longrightarrow> succ(x)\<in>I"
     using infinity_ax transitivity
     unfolding infinity_ax_def
     by auto
   ultimately
   show ?thesis
     by auto
 qed
 
 lemma nat_in_M: "nat \<in> M"
 proof -
   have "{x\<in>B . x\<in>A}=A" if "A\<subseteq>B" for A B
     using that by auto
   moreover
   obtain I where
     "I\<in>M" "nat\<subseteq>I"
     using nat_subset_I by auto
   moreover from this
   have "{x\<in>I . x\<in>nat} \<in> M"
     using finite_sep_intf separation_closed[of "\<lambda>x . x\<in>nat"]
     by simp
   ultimately
   show ?thesis
     by simp
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
 
 sublocale M_ZF1_trans \<subseteq> M_trancl "##M"
   using rtrancl_separation_intf wftrancl_separation_intf nat_in_M
     wellfounded_trancl_def
   by unfold_locales auto
 
 subsection\<open>Interface with \<^term>\<open>M_eclose\<close>\<close>
 
 lemma repl_sats:
   assumes
     sat:"\<And>x z. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> (M, Cons(x,Cons(z,env)) \<Turnstile> \<phi>) \<longleftrightarrow> P(x,z)"
   shows
     "strong_replacement(##M,\<lambda>x z. (M, Cons(x,Cons(z,env)) \<Turnstile> \<phi>)) \<longleftrightarrow>
    strong_replacement(##M,P)"
   by (rule strong_replacement_cong,simp add:sat)
 
 arity_theorem for "list_functor_fm"
+arity_theorem for "formula_functor_fm"
+arity_theorem for "Inl_fm"
+arity_theorem for "Inr_fm"
+arity_theorem for "Nil_fm"
+arity_theorem for "Cons_fm"
+arity_theorem for "quasilist_fm"
+arity_theorem for "tl_fm"
+arity_theorem for "big_union_fm"
 
-lemma (in M_ZF1_trans) list_repl1_intf:
+context M_ZF1_trans
+begin
+
+lemma list_repl1_intf:
   assumes "A\<in>M"
   shows "iterates_replacement(##M, is_list_functor(##M,A), 0)"
 proof -
   let ?f="Exists(And(pair_fm(1,0,2),
                is_wfrec_fm(iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0),3,1,0)))"
   have "arity(?f) = 5"
     using arity_iterates_MH_fm[where isF="list_functor_fm(13,1,0)" and i=14]
       arity_wfrec_replacement_fm[where i=11] arity_list_functor_fm ord_simp_union
     by simp
   {
     fix n
     assume "n\<in>nat"
     then
     have "Memrel(succ(n))\<in>M"
       using nat_into_M Memrel_closed
       by simp
     moreover
     note assms zero_in_M
     moreover from calculation
     have "is_list_functor(##M, A, a, b)
        \<longleftrightarrow> (M, [b,a,c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),A,0] \<Turnstile> list_functor_fm(13,1,0))"
       if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "a0\<in>M" "a1\<in>M" "a2\<in>M" "a3\<in>M" "a4\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
       for a b c d a0 a1 a2 a3 a4 y x z
       using that
       by simp
     moreover from calculation
-    have "(M, [a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),A,0] \<Turnstile> 
+    have "(M, [a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),A,0] \<Turnstile>
             iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0)) \<longleftrightarrow>
           iterates_MH(##M,is_list_functor(##M,A),0,a2, a1, a0)"
       if "a0\<in>M" "a1\<in>M" "a2\<in>M" "a3\<in>M" "a4\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
       for a0 a1 a2 a3 a4 y x z
       using that sats_iterates_MH_fm[of M "is_list_functor(##M,A)" _]
       by simp
     moreover from calculation
     have "(M, [y,x,z,Memrel(succ(n)),A,0] \<Turnstile>
               is_wfrec_fm(iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0),3,1,0)) \<longleftrightarrow>
           is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) , Memrel(succ(n)), x, y)"
       if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
       using that sats_is_wfrec_fm
       by simp
     moreover from calculation
     have "(M, [x,z,Memrel(succ(n)),A,0] \<Turnstile> ?f) \<longleftrightarrow>
-        
+
         (\<exists>y\<in>M. pair(##M,x,y,z) \<and>
         is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) , Memrel(succ(n)), x, y))"
       if "x\<in>M" "z\<in>M" for x z
       using that
       by (simp del:pair_abs)
     moreover
     note \<open>arity(?f) = 5\<close>
     moreover from calculation
     have "strong_replacement(##M,\<lambda>x z. (M, [x,z,Memrel(succ(n)),A,0] \<Turnstile> ?f))"
-      using replacement_ax1(2)[unfolded replacement_assm_def]
+      using replacement_ax1(1)[unfolded replacement_assm_def]
       by simp
     moreover from calculation
     have "strong_replacement(##M,\<lambda>x z.
           \<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) ,
                 Memrel(succ(n)), x, y))"
       using repl_sats[of M ?f "[Memrel(succ(n)),A,0]"]
       by (simp del:pair_abs)
   }
   then
   show ?thesis
     unfolding iterates_replacement_def wfrec_replacement_def
     by simp
 qed
 
 text\<open>This lemma obtains \<^term>\<open>iterates_replacement\<close> for predicates
 without parameters.\<close>
-lemma (in M_ZF1_trans) iterates_repl_intf :
+lemma iterates_repl_intf :
   assumes
     "v\<in>M" and
     isfm:"is_F_fm \<in> formula" and
     arty:"arity(is_F_fm)=2" and
     satsf: "\<And>a b env'. \<lbrakk> a\<in>M ; b\<in>M ; env'\<in>list(M) \<rbrakk>
               \<Longrightarrow> is_F(a,b) \<longleftrightarrow> (M,  [b,a]@env' \<Turnstile>  is_F_fm)"
     and is_F_fm_replacement:
     "\<And>env. (\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>) \<in> formula \<Longrightarrow> env \<in> list(M) \<Longrightarrow>
       arity((\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>)) \<le> 2 +\<^sub>\<omega> length(env) \<Longrightarrow>
-     strong_replacement(##M,\<lambda>x y. 
+     strong_replacement(##M,\<lambda>x y.
          M, [x,y] @ env \<Turnstile> (\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>))"
   shows
     "iterates_replacement(##M,is_F,v)"
 proof -
   let ?f="(\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>)"
   have "arity(?f) = 4" "?f\<in>formula"
     using arity_iterates_MH_fm[where isF=is_F_fm and i=2]
       arity_wfrec_replacement_fm[where i=10] isfm arty ord_simp_union
     by simp_all
   {
     fix n
     assume "n\<in>nat"
     then
     have "Memrel(succ(n))\<in>M"
       using nat_into_M Memrel_closed
       by simp
     moreover
     {
       fix a0 a1 a2 a3 a4 y x z
       assume "[a0,a1,a2,a3,a4,y,x,z]\<in>list(M)"
       moreover
       note \<open>v\<in>M\<close> \<open>Memrel(succ(n))\<in>M\<close>
       moreover from calculation
       have "(M, [b,a,c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v] \<Turnstile> is_F_fm) \<longleftrightarrow>
            is_F(a,b)"
         if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" for a b c d
         using that satsf[of a b "[c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v]"]
         by simp
       moreover from calculation
       have "(M, [a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v] \<Turnstile> iterates_MH_fm(is_F_fm,9,2,1,0)) \<longleftrightarrow>
            iterates_MH(##M,is_F,v,a2, a1, a0)"
         using sats_iterates_MH_fm[of M "is_F" "is_F_fm"]
         by simp
     }
     moreover from calculation
     have "(M, [y,x,z,Memrel(succ(n)),v] \<Turnstile> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0)) \<longleftrightarrow>
           is_wfrec(##M, iterates_MH(##M,is_F,v),Memrel(succ(n)), x, y)"
       if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
       using that sats_is_wfrec_fm \<open>v\<in>M\<close> by simp
     moreover from calculation
     have "(M, [x,z,Memrel(succ(n)),v] \<Turnstile> ?f) \<longleftrightarrow>
-        
+
         (\<exists>y\<in>M. pair(##M,x,y,z) \<and>
         is_wfrec(##M, iterates_MH(##M,is_F,v) , Memrel(succ(n)), x, y))"
       if "x\<in>M" "z\<in>M" for x z
       using that \<open>v\<in>M\<close>
       by (simp del:pair_abs)
     moreover
     note \<open>arity(?f) = 4\<close> \<open>?f\<in>formula\<close>
     moreover from calculation \<open>v\<in>_\<close>
     have "strong_replacement(##M,\<lambda>x z. (M, [x,z,Memrel(succ(n)),v] \<Turnstile> ?f))"
       using is_F_fm_replacement
       by simp
     ultimately
     have "strong_replacement(##M,\<lambda>x z.
           \<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, iterates_MH(##M,is_F,v) ,
                 Memrel(succ(n)), x, y))"
       using repl_sats[of M ?f "[Memrel(succ(n)),v]"]
       by (simp del:pair_abs)
   }
   then
   show ?thesis
     unfolding iterates_replacement_def wfrec_replacement_def
     by simp
 qed
 
-arity_theorem for "formula_functor_fm"
-lemma (in M_ZF1_trans) formula_repl1_intf :
-  "iterates_replacement(##M, is_formula_functor(##M), 0)"
+lemma formula_repl1_intf : "iterates_replacement(##M, is_formula_functor(##M), 0)"
   using arity_formula_functor_fm zero_in_M ord_simp_union
     iterates_repl_intf[where is_F_fm="formula_functor_fm(1,0)"]
-    replacement_ax1(16)[unfolded replacement_assm_def]
+    replacement_ax1(3)[unfolded replacement_assm_def]
   by simp
 
-arity_theorem for "Inl_fm"
-arity_theorem for "Inr_fm"
-arity_theorem for "Nil_fm"
-arity_theorem for "Cons_fm"
-arity_theorem for "quasilist_fm"
-arity_theorem for "tl_fm"
-
-lemma (in M_ZF1_trans) tl_repl_intf:
+lemma tl_repl_intf:
   assumes "l \<in> M"
   shows "iterates_replacement(##M,\<lambda>l' t. is_tl(##M,l',t),l)"
   using assms arity_tl_fm ord_simp_union
     iterates_repl_intf[where is_F_fm="tl_fm(1,0)"]
-    replacement_ax1(15)[unfolded replacement_assm_def]
+    replacement_ax1(9)[unfolded replacement_assm_def]
   by simp
 
-arity_theorem for "big_union_fm"
-
-lemma (in M_ZF1_trans) eclose_repl1_intf:
+lemma eclose_repl1_intf:
   assumes "A\<in>M"
   shows "iterates_replacement(##M, big_union(##M), A)"
   using assms arity_big_union_fm
     iterates_repl_intf[where is_F_fm="big_union_fm(1,0)"]
-    replacement_ax1(17)[unfolded replacement_assm_def]
+    replacement_ax1(5)[unfolded replacement_assm_def]
     ord_simp_union
   by simp
 
-lemma (in M_ZF1_trans) list_repl2_intf:
+lemma list_repl2_intf:
   assumes "A\<in>M"
   shows "strong_replacement(##M,\<lambda>n y. n\<in>nat \<and>
             is_iterates(##M, is_list_functor(##M,A), 0, n, y))"
 proof -
   let ?f = "And(Member(0,4),is_iterates_fm(list_functor_fm(13,1,0),3,0,1))"
   note zero_in_M nat_in_M \<open>A\<in>M\<close>
   moreover from this
   have "is_list_functor(##M,A,a,b) \<longleftrightarrow>
         (M, [b,a,c,d,e,f,g,h,i,j,k,n,y,A,0,nat] \<Turnstile> list_functor_fm(13,1,0))"
     if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "f\<in>M""g\<in>M""h\<in>M""i\<in>M""j\<in>M" "k\<in>M" "n\<in>M" "y\<in>M"
     for a b c d e f g h i j k n y
     using that
     by simp
   moreover from calculation
   have "(M, [n,y,A,0,nat] \<Turnstile> is_iterates_fm(list_functor_fm(13,1,0),3,0,1)) \<longleftrightarrow>
            is_iterates(##M, is_list_functor(##M,A), 0, n , y)"
     if "n\<in>M" "y\<in>M" for n y
     using that sats_is_iterates_fm[of M "is_list_functor(##M,A)"]
     by simp
   moreover from calculation
   have "(M, [n,y,A,0,nat] \<Turnstile> ?f) \<longleftrightarrow>
         n\<in>nat \<and> is_iterates(##M, is_list_functor(##M,A), 0, n, y)"
     if "n\<in>M" "y\<in>M" for n y
     using that
     by simp
   moreover
   have "arity(?f) = 5"
     using arity_is_iterates_fm[where p="list_functor_fm(13,1,0)" and i=14]
       arity_list_functor_fm arity_And ord_simp_union
     by simp
   ultimately
   show ?thesis
-    using replacement_ax1(3)[unfolded replacement_assm_def] repl_sats[of M ?f "[A,0,nat]"]
+    using replacement_ax1(2)[unfolded replacement_assm_def] repl_sats[of M ?f "[A,0,nat]"]
     by simp
 qed
 
-lemma (in M_ZF1_trans) formula_repl2_intf:
+lemma formula_repl2_intf:
   "strong_replacement(##M,\<lambda>n y. n\<in>nat \<and> is_iterates(##M, is_formula_functor(##M), 0, n, y))"
 proof -
   let ?f = "And(Member(0,3),is_iterates_fm(formula_functor_fm(1,0),2,0,1))"
   note zero_in_M nat_in_M
   moreover from this
   have "is_formula_functor(##M,a,b) \<longleftrightarrow>
         (M, [b,a,c,d,e,f,g,h,i,j,k,n,y,0,nat] \<Turnstile> formula_functor_fm(1,0))"
     if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "f\<in>M""g\<in>M""h\<in>M""i\<in>M""j\<in>M" "k\<in>M" "n\<in>M" "y\<in>M"
     for a b c d e f g h i j k n y
     using that
     by simp
   moreover from calculation
   have "(M, [n,y,0,nat] \<Turnstile> is_iterates_fm(formula_functor_fm(1,0),2,0,1)) \<longleftrightarrow>
            is_iterates(##M, is_formula_functor(##M), 0, n , y)"
     if "n\<in>M" "y\<in>M" for n y
     using that sats_is_iterates_fm[of M "is_formula_functor(##M)"]
     by simp
   moreover from calculation
   have "(M, [n,y,0,nat] \<Turnstile> ?f) \<longleftrightarrow>
         n\<in>nat \<and> is_iterates(##M, is_formula_functor(##M), 0, n, y)"
     if "n\<in>M" "y\<in>M" for n y
     using that
     by simp
   moreover
   have "arity(?f) = 4"
     using arity_is_iterates_fm[where p="formula_functor_fm(1,0)" and i=2]
       arity_formula_functor_fm arity_And ord_simp_union
     by simp
   ultimately
   show ?thesis
     using replacement_ax1(4)[unfolded replacement_assm_def] repl_sats[of M ?f "[0,nat]"]
     by simp
 qed
 
 
-lemma (in M_ZF1_trans) eclose_repl2_intf:
+lemma eclose_repl2_intf:
   assumes "A\<in>M"
   shows "strong_replacement(##M,\<lambda>n y. n\<in>nat \<and> is_iterates(##M, big_union(##M), A, n, y))"
 proof -
   let ?f = "And(Member(0,3),is_iterates_fm(big_union_fm(1,0),2,0,1))"
   note nat_in_M \<open>A\<in>M\<close>
   moreover from this
   have "big_union(##M,a,b) \<longleftrightarrow>
         (M, [b,a,c,d,e,f,g,h,i,j,k,n,y,A,nat] \<Turnstile> big_union_fm(1,0))"
     if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "f\<in>M""g\<in>M""h\<in>M""i\<in>M""j\<in>M" "k\<in>M" "n\<in>M" "y\<in>M"
     for a b c d e f g h i j k n y
     using that by simp
   moreover from calculation
   have "(M, [n,y,A,nat] \<Turnstile> is_iterates_fm(big_union_fm(1,0),2,0,1)) \<longleftrightarrow>
            is_iterates(##M, big_union(##M), A, n , y)"
     if "n\<in>M" "y\<in>M" for n y
     using that sats_is_iterates_fm[of M "big_union(##M)"]
     by simp
   moreover from calculation
   have "(M, [n,y,A,nat] \<Turnstile> ?f) \<longleftrightarrow>
         n\<in>nat \<and> is_iterates(##M, big_union(##M), A, n, y)"
     if "n\<in>M" "y\<in>M" for n y
     using that
     by simp
   moreover
   have "arity(?f) = 4"
     using arity_is_iterates_fm[where p="big_union_fm(1,0)" and i=2]
       arity_big_union_fm arity_And ord_simp_union
     by simp
   ultimately
   show ?thesis
-    using repl_sats[of M ?f "[A,nat]"] replacement_ax1(5)[unfolded replacement_assm_def]
+    using repl_sats[of M ?f "[A,nat]"] replacement_ax1(6)[unfolded replacement_assm_def]
     by simp
 qed
 
+end \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
+
 sublocale M_ZF1_trans \<subseteq> M_datatypes "##M"
   using list_repl1_intf list_repl2_intf formula_repl1_intf
     formula_repl2_intf tl_repl_intf
   by unfold_locales auto
 
 sublocale M_ZF1_trans \<subseteq> M_eclose "##M"
   using eclose_repl1_intf eclose_repl2_intf
   by unfold_locales auto
 
 text\<open>Interface with \<^locale>\<open>M_eclose\<close>.\<close>
 
-lemma (in M_ZF1_trans) Powapply_repl :
-  assumes "f\<in>M"
-  shows "strong_replacement(##M,\<lambda>x y. y=Powapply_rel(##M,f,x))"
-proof -
-  note assms
-  moreover
-  have "arity(is_Powapply_fm(2,0,1)) = 3"
-    unfolding is_Powapply_fm_def
-    by (simp add:arity ord_simp_union)
-  moreover from calculation
-  have iff:"z=Powapply_rel(##M,f,p) \<longleftrightarrow> (M, [p,z,f] \<Turnstile> is_Powapply_fm(2,0,1) )"
-    if "p\<in>M" "z\<in>M" for p z
-    using that zero_in_M sats_is_Powapply_fm[of 2 0 1 "[p,z,f]" M] is_Powapply_iff
-      replacement_ax1[unfolded replacement_assm_def]
-    by simp
-  ultimately
-  show ?thesis
-    using replacement_ax1(6)[unfolded replacement_assm_def]
-    by (rule_tac strong_replacement_cong[THEN iffD2,OF iff],simp_all)
-qed
+schematic_goal sats_is_Vset_fm_auto:
+  assumes
+    "i\<in>nat" "v\<in>nat" "env\<in>list(A)" "0\<in>A"
+    "i < length(env)" "v < length(env)"
+  shows
+    "is_Vset(##A,nth(i, env),nth(v, env)) \<longleftrightarrow> (A, env \<Turnstile> ?ivs_fm(i,v))"
+  unfolding is_Vset_def is_Vfrom_def
+  by (insert assms; (rule sep_rules is_HVfrom_iff_sats is_transrec_iff_sats | simp)+)
 
-lemma (in M_ZF1_trans) phrank_repl :
-  assumes
-    "f\<in>M"
-  shows
-    "strong_replacement(##M, \<lambda>x y. y = succ(f`x))"
-proof -
-  note assms
-  moreover from this
-  have iff:"y = succ(f ` x) \<longleftrightarrow> M, [x, y, f] \<Turnstile> PHrank_fm(2, 0, 1)" if "x\<in>M" "y\<in>M" for x y
-    using PHrank_iff_sats[of 2 "[x,y,f]" f 0 _ 1 _ M] zero_in_M that
-      apply_closed
-    unfolding PHrank_def
-    by simp
-  moreover
-  have "arity(PHrank_fm(2,0,1)) = 3"
-    unfolding PHrank_fm_def
-    by (simp add:arity ord_simp_union)
-  ultimately
-  show ?thesis
-    using replacement_ax1(7)[unfolded replacement_assm_def]
-    unfolding PHrank_def
-    by(rule_tac strong_replacement_cong[THEN iffD2,OF iff],simp_all)
-qed
+synthesize "is_Vset" from_schematic "sats_is_Vset_fm_auto"
+arity_theorem for "is_Vset_fm"
 
 declare is_Hrank_fm_def[fm_definitions add]
-declare PHrank_fm_def[fm_definitions add]
 
-lemma (in M_ZF1_trans) wfrec_rank :
+context M_ZF1_trans
+begin
+
+lemma wfrec_rank :
   assumes "X\<in>M"
   shows "wfrec_replacement(##M,is_Hrank(##M),rrank(X))"
 proof -
   let ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(is_Hrank_fm(2,1,0),3,1,0)))"
   note assms zero_in_M
   moreover from this
   have
     "is_Hrank(##M,a2, a1, a0) \<longleftrightarrow>
              (M, [a0,a1,a2,a3,a4,y,x,z,rrank(X)] \<Turnstile> is_Hrank_fm(2,1,0))"
     if "a4\<in>M" "a3\<in>M" "a2\<in>M" "a1\<in>M" "a0\<in>M" "y\<in>M" "x\<in>M" "z\<in>M" for a4 a3 a2 a1 a0 y x z
     using that rrank_in_M is_Hrank_iff_sats
     by simp
   moreover from calculation
   have "(M, [y,x,z,rrank(X)] \<Turnstile> is_wfrec_fm(is_Hrank_fm(2,1,0),3,1,0)) \<longleftrightarrow>
    is_wfrec(##M, is_Hrank(##M) ,rrank(X), x, y)"
     if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
     using that rrank_in_M sats_is_wfrec_fm
     by simp
   moreover from calculation
   have "(M, [x,z,rrank(X)] \<Turnstile> ?f) \<longleftrightarrow>
                (\<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, is_Hrank(##M) , rrank(X), x, y))"
     if "x\<in>M" "z\<in>M" for x z
     using that rrank_in_M
     by (simp del:pair_abs)
   moreover
   have "arity(?f) = 3"
     using arity_wfrec_replacement_fm[where p="is_Hrank_fm(2,1,0)" and i=3,simplified]
       arity_is_Hrank_fm[of 2 1 0,simplified] ord_simp_union
     by simp
   moreover from calculation
   have "strong_replacement(##M,\<lambda>x z. (M, [x,z,rrank(X)] \<Turnstile> ?f))"
-    using replacement_ax1(8)[unfolded replacement_assm_def] rrank_in_M
+    using replacement_ax1(7)[unfolded replacement_assm_def] rrank_in_M
     by simp
   ultimately
   show ?thesis
     using repl_sats[of M ?f "[rrank(X)]"]
     unfolding wfrec_replacement_def
     by (simp del:pair_abs)
 qed
 
-schematic_goal sats_is_Vset_fm_auto:
-  assumes
-    "i\<in>nat" "v\<in>nat" "env\<in>list(A)" "0\<in>A"
-    "i < length(env)" "v < length(env)"
-  shows
-    "is_Vset(##A,nth(i, env),nth(v, env)) \<longleftrightarrow> (A, env \<Turnstile> ?ivs_fm(i,v))"
-  unfolding is_Vset_def is_Vfrom_def
-  by (insert assms; (rule sep_rules is_HVfrom_iff_sats is_transrec_iff_sats | simp)+)
-
-synthesize "is_Vset" from_schematic "sats_is_Vset_fm_auto"
-arity_theorem for "is_Vset_fm"
-
-lemma (in M_ZF1_trans) trans_repl_HVFrom :
+lemma trans_repl_HVFrom :
   assumes "A\<in>M" "i\<in>M"
   shows "transrec_replacement(##M,is_HVfrom(##M,A),i)"
 proof -
   let ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(is_HVfrom_fm(8,2,1,0),4,1,0)))"
   note facts = assms zero_in_M
   moreover
   have "\<exists>sa\<in>M. \<exists>esa\<in>M. \<exists>mesa\<in>M.
        upair(##M,a,a,sa) \<and> is_eclose(##M,sa,esa) \<and> membership(##M,esa,mesa)"
     if "a\<in>M" for a
     using that upair_ax eclose_closed Memrel_closed
     unfolding upair_ax_def
     by (simp del:upair_abs)
   moreover
   {
     fix mesa
     assume "mesa\<in>M"
     moreover
     note facts
     moreover from calculation
     have "is_HVfrom(##M,A,a2, a1, a0) \<longleftrightarrow>
       (M, [a0,a1,a2,a3,a4,y,x,z,A,mesa] \<Turnstile> is_HVfrom_fm(8,2,1,0))"
       if "a4\<in>M" "a3\<in>M" "a2\<in>M" "a1\<in>M" "a0\<in>M" "y\<in>M" "x\<in>M" "z\<in>M" for a4 a3 a2 a1 a0 y x z
       using that sats_is_HVfrom_fm
       by simp
     moreover from calculation
     have "(M, [y,x,z,A,mesa] \<Turnstile> is_wfrec_fm(is_HVfrom_fm(8,2,1,0),4,1,0)) \<longleftrightarrow>
          is_wfrec(##M, is_HVfrom(##M,A),mesa, x, y)"
       if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
       using that sats_is_wfrec_fm
       by simp
     moreover from calculation
     have "(M, [x,z,A,mesa] \<Turnstile> ?f) \<longleftrightarrow>
                (\<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, is_HVfrom(##M,A) , mesa, x, y))"
       if "x\<in>M" "z\<in>M" for x z
       using that
       by (simp del:pair_abs)
     moreover
     have "arity(?f) = 4"
       using arity_wfrec_replacement_fm[where p="is_HVfrom_fm(8,2,1,0)" and i=9]
         arity_is_HVfrom_fm ord_simp_union
       by simp
     moreover from calculation
     have "strong_replacement(##M,\<lambda>x z. (M, [x,z,A,mesa] \<Turnstile> ?f))"
-      using replacement_ax1(9)[unfolded replacement_assm_def]
+      using replacement_ax1(8)[unfolded replacement_assm_def]
       by simp
     ultimately
     have "wfrec_replacement(##M,is_HVfrom(##M,A),mesa)"
       using repl_sats[of M ?f "[A,mesa]"]
       unfolding wfrec_replacement_def
       by (simp del:pair_abs)
   }
   ultimately
   show ?thesis
     unfolding transrec_replacement_def
     by simp
 qed
 
-sublocale M_ZF1_trans \<subseteq> M_Vfrom "##M"
-  using power_ax Powapply_repl phrank_repl trans_repl_HVFrom wfrec_rank
-  by unfold_locales auto
-
+end \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
 
 subsection\<open>Interface for proving Collects and Replace in M.\<close>
 context M_ZF1_trans
 begin
 
 lemma Collect_in_M :
   assumes
     "\<phi> \<in> formula" "env\<in>list(M)"
     "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" "A\<in>M" and
     satsQ: "\<And>x. x\<in>M \<Longrightarrow> (M, [x]@env \<Turnstile> \<phi>) \<longleftrightarrow> Q(x)"
   shows
     "{y\<in>A . Q(y)}\<in>M"
 proof -
   have "separation(##M,\<lambda>x. (M, [x] @ env \<Turnstile> \<phi>))"
     using assms separation_ax by simp
   then
   show ?thesis
     using \<open>A\<in>M\<close> satsQ transitivity separation_closed
       separation_cong[of "##M" "\<lambda>y. (M, [y]@env \<Turnstile> \<phi>)" "Q"]
     by simp
 qed
 
 \<comment> \<open>This version has a weaker assumption.\<close>
 lemma separation_in_M :
   assumes
     "\<phi> \<in> formula" "env\<in>list(M)"
     "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" "A\<in>M" and
     satsQ: "\<And>x. x\<in>A \<Longrightarrow> (M, [x]@env \<Turnstile> \<phi>) \<longleftrightarrow> Q(x)"
   shows
     "{y\<in>A . Q(y)} \<in> M"
 proof -
   let ?\<phi>' = "And(\<phi>,Member(0,length(env)+\<^sub>\<omega>1))"
   note assms
   moreover
   have "arity(?\<phi>') \<le> 1 +\<^sub>\<omega> length(env@[A])"
     using assms Un_le le_trans[of "arity(\<phi>)" "1+\<^sub>\<omega>length(env)" "2+\<^sub>\<omega>length(env)"]
     by (force simp:FOL_arities)
   moreover from calculation
   have "?\<phi>'\<in>formula" "nth(length(env), env @ [A]) = A"
     using nth_append
     by auto
   moreover from calculation
   have "\<And> x . x \<in> M \<Longrightarrow> (M, [x]@env@[A] \<Turnstile> ?\<phi>') \<longleftrightarrow> Q(x) \<and> x\<in>A"
     using arity_sats_iff[of _ "[A]" _ "[_]@env"]
     by auto
   ultimately
   show ?thesis
     using Collect_in_M[of ?\<phi>' "env@[A]" _ "\<lambda>x . Q(x) \<and> x\<in>A", OF _ _ _ \<open>A\<in>M\<close>]
     by auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
 
 context M_Z_trans
 begin
 
 lemma strong_replacement_in_ctm:
   assumes
     f_fm:  "\<phi> \<in> formula" and
     f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
     fsats: "\<And>x y. x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> y = f(x)" and
     fclosed: "\<And>x. x\<in>M \<Longrightarrow> f(x) \<in> M" and
     phi_replacement:"replacement_assm(M,env,\<phi>)" and
     "env\<in>list(M)"
   shows "strong_replacement(##M, \<lambda>x y . y = f(x))"
   using assms
     strong_replacement_cong[of "##M" "\<lambda>x y. M,[x,y]@env\<Turnstile>\<phi>" "\<lambda>x y. y = f(x)"]
   unfolding replacement_assm_def
   by auto
 
 lemma strong_replacement_rel_in_ctm :
   assumes
     f_fm:  "\<phi> \<in> formula" and
     f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
     fsats: "\<And>x y. x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> f(x,y)"  and
     phi_replacement:"replacement_assm(M,env,\<phi>)" and
     "env\<in>list(M)"
   shows "strong_replacement(##M, f)"
   using assms
     strong_replacement_cong[of "##M" "\<lambda>x y. M,[x,y]@env\<Turnstile>\<phi>" "f"]
   unfolding replacement_assm_def
   by auto
 
 lemma Replace_in_M :
   assumes
     f_fm:  "\<phi> \<in> formula" and
     f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
     fsats: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> y = f(x)" and
     fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M"  and
     "A\<in>M" "env\<in>list(M)" and
     phi'_replacement:"replacement_assm(M,env@[A], \<cdot>\<phi> \<and> \<cdot>0 \<in> length(env) +\<^sub>\<omega> 2\<cdot>\<cdot> )"
   shows "{f(x) . x\<in>A}\<in>M"
 proof -
   let ?\<phi>' = "And(\<phi>,Member(0,length(env)+\<^sub>\<omega>2))"
   note assms
   moreover from this
   have "arity(?\<phi>') \<le> 2 +\<^sub>\<omega> length(env@[A])"
     using Un_le le_trans[of "arity(\<phi>)" "2+\<^sub>\<omega>(length(env))" "3+\<^sub>\<omega>length(env)"]
     by (force simp:FOL_arities)
   moreover from calculation
   have "?\<phi>'\<in>formula" "nth(length(env), env @ [A]) = A"
     using nth_append by auto
   moreover from calculation
   have "\<And> x y. x \<in> M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env@[A]\<Turnstile>?\<phi>') \<longleftrightarrow> y=f(x) \<and>x\<in>A"
     using arity_sats_iff[of _ "[A]" _ "[_,_]@env"]
     by auto
   moreover from calculation
   have "strong_replacement(##M, \<lambda>x y. M,[x,y]@env@[A] \<Turnstile> ?\<phi>')"
     using phi'_replacement assms(1-6) unfolding replacement_assm_def by simp
   ultimately
   have 4:"strong_replacement(##M, \<lambda>x y. y = f(x) \<and> x\<in>A)"
     using
       strong_replacement_cong[of "##M" "\<lambda>x y. M,[x,y]@env@[A]\<Turnstile>?\<phi>'" "\<lambda>x y. y = f(x) \<and> x\<in>A"]
     by simp
   then
   have "{y . x\<in>A , y = f(x)} \<in> M"
     using \<open>A\<in>M\<close> strong_replacement_closed[OF 4,of A] fclosed by simp
   moreover
   have "{f(x). x\<in>A} = { y . x\<in>A , y = f(x)}"
     by auto
   ultimately
   show ?thesis by simp
 qed
 
 lemma Replace_relativized_in_M :
   assumes
     f_fm:  "\<phi> \<in> formula" and
     f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
     fsats: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,y)" and
     fabs:  "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> is_f(x,y) \<longleftrightarrow> y = f(x)" and
     fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M"  and
     "A\<in>M" "env\<in>list(M)" and
     phi'_replacement:"replacement_assm(M,env@[A], \<cdot>\<phi> \<and> \<cdot>0 \<in> length(env) +\<^sub>\<omega> 2\<cdot>\<cdot> )"
   shows "{f(x) . x\<in>A}\<in>M"
   using assms Replace_in_M[of \<phi>] by auto
 
 lemma ren_action :
   assumes
     "env\<in>list(M)" "x\<in>M" "y\<in>M" "z\<in>M"
   shows "\<forall> i . i < 2+\<^sub>\<omega>length(env) \<longrightarrow>
           nth(i,[x,z]@env) = nth(\<rho>_repl(length(env))`i,[z,x,y]@env)"
 proof -
   let ?f="{\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>}"
   have 1:"(\<And>j. j < length(env) \<Longrightarrow> nth(j, env) = nth(id(length(env)) ` j, env))"
     using assms ltD by simp
   have 2:"nth(j, [x,z]) = nth(?f ` j, [z,x,y])" if "j<2" for j
   proof -
     consider "j=0" | "j=1" using  ltD[OF \<open>j<2\<close>] by auto
     then show ?thesis
     proof(cases)
       case 1
       then show ?thesis using apply_equality f_type by simp
     next
       case 2
       then show ?thesis using apply_equality f_type by simp
     qed
   qed
   show ?thesis
     using sum_action[OF _ _ _ _ f_type id_type _ _ _ _ _ _ _ 2 1,simplified] assms
     unfolding \<rho>_repl_def by simp
 qed
 
 lemma Lambda_in_M :
   assumes
     f_fm:  "\<phi> \<in> formula" and
     f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
     fsats: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,y)" and
     fabs:  "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> is_f(x,y) \<longleftrightarrow> y = f(x)" and
     fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M" and
     "A\<in>M" "env\<in>list(M)" and
     phi'_replacement2: "replacement_assm(M,env@[A],Lambda_in_M_fm(\<phi>,length(env)))"
   shows "(\<lambda>x\<in>A . f(x)) \<in>M"
   unfolding lam_def
 proof -
   let ?ren="\<rho>_repl(length(env))"
   let ?j="2+\<^sub>\<omega>length(env)"
   let ?k="3+\<^sub>\<omega>length(env)"
   let ?\<psi>="ren(\<phi>)`?j`?k`?ren"
   let ?\<phi>'="Exists(And(pair_fm(1,0,2),?\<psi>))"
   let ?p="\<lambda>x y. \<exists>z\<in>M. pair(##M,x,z,y) \<and> is_f(x,z)"
   have "?\<phi>'\<in>formula" "?\<psi>\<in>formula"
     using \<open>env\<in>_\<close> length_type f_fm ren_type ren_tc[of \<phi> "2+\<^sub>\<omega>length(env)" "3+\<^sub>\<omega>length(env)" ?ren]
     by simp_all
   moreover from this
   have "arity(?\<psi>)\<le>3+\<^sub>\<omega>(length(env))" "arity(?\<psi>)\<in>nat"
     using assms arity_ren[OF f_fm _ _ ren_type,of "length(env)"] by simp_all
   then
   have "arity(?\<phi>') \<le> 2+\<^sub>\<omega>(length(env))"
     using Un_le pred_Un_distrib assms pred_le
     by (simp add:arity)
   moreover from this calculation
   have "x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> ?\<phi>') \<longleftrightarrow> ?p(x,y)" for x y
     using \<open>env\<in>_\<close> length_type[OF \<open>env\<in>_\<close>] assms transitivity[OF _ \<open>A\<in>M\<close>]
       sats_iff_sats_ren[OF f_fm _ _ _ _ ren_type f_ar ren_action[rule_format,of _ x y],of _ M ]
     by auto
   moreover
   have "x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> ?p(x,y) \<longleftrightarrow> y = <x,f(x)>" for x y
     using assms transitivity[OF _ \<open>A\<in>_\<close>] fclosed
     by simp
   moreover
   have "\<And> x . x\<in>A \<Longrightarrow> <x,f(x)> \<in> M"
     using transitivity[OF _ \<open>A\<in>M\<close>] pair_in_M_iff fclosed by simp
   ultimately
   show "{\<langle>x,f(x)\<rangle> . x\<in>A } \<in> M"
     using Replace_in_M[of ?\<phi>' env A] phi'_replacement2 \<open>A\<in>M\<close> \<open>env\<in>_\<close>
     by simp
 qed
 
 lemma ren_action' :
   assumes
     "env\<in>list(M)" "x\<in>M" "y\<in>M" "z\<in>M" "u\<in>M"
   shows "\<forall> i . i < 3+\<^sub>\<omega>length(env) \<longrightarrow>
           nth(i,[x,z,u]@env) = nth(\<rho>_pair_repl(length(env))`i,[x,z,y,u]@env)"
 proof -
   let ?f="{\<langle>0, 0\<rangle>, \<langle>1, 1\<rangle>, \<langle>2,3\<rangle>}"
   have 1:"(\<And>j. j < length(env) \<Longrightarrow> nth(j, env) = nth(id(length(env)) ` j, env))"
     using assms ltD by simp
   have 2:"nth(j, [x,z,u]) = nth(?f ` j, [x,z,y,u])" if "j<3" for j
   proof -
     consider "j=0" | "j=1" | "j=2" using  ltD[OF \<open>j<3\<close>] by auto
     then show ?thesis
     proof(cases)
       case 1
       then show ?thesis using apply_equality f_type' by simp
     next
       case 2
       then show ?thesis using apply_equality f_type' by simp
     next
       case 3
       then show ?thesis using apply_equality f_type' by simp
     qed
   qed
   show ?thesis
     using sum_action[OF _ _ _ _ f_type' id_type _ _ _ _ _ _ _ 2 1,simplified] assms
     unfolding \<rho>_pair_repl_def by simp
 qed
 
 lemma LambdaPair_in_M :
   assumes
     f_fm:  "\<phi> \<in> formula" and
     f_ar:  "arity(\<phi>)\<le> 3 +\<^sub>\<omega> length(env)" and
     fsats: "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> (M,[x,z,r]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,z,r)" and
     fabs:  "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> is_f(x,z,r) \<longleftrightarrow> r = f(x,z)" and
     fclosed: "\<And>x z. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> f(x,z) \<in> M" and
     "A\<in>M" "env\<in>list(M)" and
     phi'_replacement3: "replacement_assm(M,env@[A],LambdaPair_in_M_fm(\<phi>,length(env)))"
   shows "(\<lambda>x\<in>A . f(fst(x),snd(x))) \<in>M"
 proof -
   let ?ren="\<rho>_pair_repl(length(env))"
   let ?j="3+\<^sub>\<omega>length(env)"
   let ?k="4+\<^sub>\<omega>length(env)"
   let ?\<psi>="ren(\<phi>)`?j`?k`?ren"
   let ?\<phi>'="Exists(Exists(And(fst_fm(2,0),(And(snd_fm(2,1),?\<psi>)))))"
   let ?p="\<lambda>x y. is_f(fst(x),snd(x),y)"
   have "?\<phi>'\<in>formula" "?\<psi>\<in>formula"
     using \<open>env\<in>_\<close> length_type f_fm ren_type' ren_tc[of \<phi> ?j ?k ?ren]
     by simp_all
   moreover from this
   have "arity(?\<psi>)\<le>4+\<^sub>\<omega>(length(env))" "arity(?\<psi>)\<in>nat"
     using assms arity_ren[OF f_fm _ _ ren_type',of "length(env)"] by simp_all
   moreover from calculation
   have 1:"arity(?\<phi>') \<le> 2+\<^sub>\<omega>(length(env))" "?\<phi>'\<in>formula"
     using Un_le pred_Un_distrib assms pred_le
     by (simp_all add:arity)
   moreover from this calculation
   have 2:"x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> ?\<phi>') \<longleftrightarrow> ?p(x,y)" for x y
     using
       sats_iff_sats_ren[OF f_fm _ _ _ _ ren_type' f_ar
         ren_action'[rule_format,of _ "fst(x)" x "snd(x)" y],simplified]
       \<open>env\<in>_\<close> length_type[OF \<open>env\<in>_\<close>] transitivity[OF _ \<open>A\<in>M\<close>]
       fst_snd_closed pair_in_M_iff fsats[of "fst(x)" "snd(x)" y,symmetric]
       fst_abs snd_abs
     by auto
   moreover from assms
   have 3:"x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> ?p(x,y) \<longleftrightarrow> y = f(fst(x),snd(x))" for x y
     using fclosed fst_snd_closed pair_in_M_iff fabs transitivity
     by auto
   moreover
   have 4:"\<And> x . x\<in>A \<Longrightarrow> <x,f(fst(x),snd(x))> \<in> M" "\<And> x . x\<in>A \<Longrightarrow> f(fst(x),snd(x)) \<in> M"
     using transitivity[OF _ \<open>A\<in>M\<close>] pair_in_M_iff fclosed fst_snd_closed
     by simp_all
   ultimately
   show ?thesis
     using Lambda_in_M[unfolded Lambda_in_M_fm_def, of ?\<phi>', OF _ _ _ _ _ _ _
         phi'_replacement3[unfolded LambdaPair_in_M_fm_def]]
       \<open>env\<in>_\<close> \<open>A\<in>_\<close> by simp
 
 qed
 
 lemma (in M_ZF1_trans) lam_replacement2_in_ctm :
   assumes
     f_fm:  "\<phi> \<in> formula" and
     f_ar:  "arity(\<phi>)\<le> 3 +\<^sub>\<omega> length(env)" and
     fsats: "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> (M,[x,z,r]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,z,r)" and
     fabs:  "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> is_f(x,z,r) \<longleftrightarrow> r = f(x,z)" and
     fclosed: "\<And>x z. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> f(x,z) \<in> M" and
     "env\<in>list(M)" and
     phi'_replacement3: "\<And>A. A\<in>M \<Longrightarrow> replacement_assm(M,env@[A],LambdaPair_in_M_fm(\<phi>,length(env)))"
   shows "lam_replacement(##M , \<lambda>x . f(fst(x),snd(x)))"
   using
     LambdaPair_in_M fabs
     f_ar ord_simp_union transitivity assms fst_snd_closed
   by (rule_tac lam_replacement_iff_lam_closed[THEN iffD2],simp_all)
 
 simple_rename "ren_U" src "[z1,x_P, x_leq, x_o, x_t, z2_c]"
   tgt "[z2_c,z1,z,x_P, x_leq, x_o, x_t]"
 
 simple_rename "ren_V" src "[fz,x_P, x_leq, x_o,x_f, x_t, gz]"
   tgt "[gz,fz,z,x_P, x_leq, x_o,x_f, x_t]"
 
 simple_rename "ren_V3" src "[fz,x_P, x_leq, x_o,x_f, gz, hz]"
   tgt "[hz,gz,fz,z,x_P, x_leq, x_o,x_f]"
 
 lemma separation_sat_after_function_1:
   assumes "[a,b,c,d]\<in>list(M)" and  "\<chi>\<in>formula" and "arity(\<chi>) \<le> 6"
     and
     f_fm:  "f_fm \<in> formula" and
     f_ar:  "arity(f_fm) \<le> 6" and
     fsats: "\<And> fx x. fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[fx,x]@[a, b, c, d] \<Turnstile> f_fm) \<longleftrightarrow> fx=f(x)" and
     fclosed: "\<And>x . x\<in>M \<Longrightarrow> f(x) \<in> M" and
     g_fm:  "g_fm \<in> formula" and
     g_ar:  "arity(g_fm) \<le> 7" and
     gsats: "\<And> gx fx x. gx\<in>M \<Longrightarrow>  fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[gx,fx,x]@[a, b, c, d] \<Turnstile> g_fm) \<longleftrightarrow> gx=g(x)" and
     gclosed: "\<And>x . x\<in>M \<Longrightarrow> g(x) \<in> M"
   shows  "separation(##M, \<lambda>r. M, [f(r), a, b, c, d, g(r)] \<Turnstile> \<chi>)"
 proof -
   note types = assms(1-4)
   let ?\<psi>="ren(\<chi>)`6`7`ren_U_fn"
   let  ?\<psi>'="Exists(And(f_fm,Exists(And(g_fm,?\<psi>))))"
   let ?\<rho>="\<lambda>z.[f(z), a, b, c, d, g(z)]"
   let ?env="[a, b, c, d]"
   let ?\<eta>="\<lambda>z.[g(z),f(z),z]@?env"
   note types
   moreover from this
   have "arity(\<chi>) \<le> 7" "?\<psi>\<in>formula"
     using ord_simp_union ren_tc ren_U_thm(2)[folded ren_U_fn_def] le_trans[of "arity(\<chi>)" 6]
     by simp_all
   moreover from calculation
   have "arity(?\<psi>) \<le> 7" "?\<psi>'\<in>formula"
     using arity_ren ren_U_thm(2)[folded ren_U_fn_def] f_fm g_fm
     by simp_all
   moreover from calculation f_ar g_ar f_fm g_fm
   have "arity(?\<psi>') \<le> 5"
     using ord_simp_union pred_le arity_type
     by (simp add:arity)
   moreover from calculation fclosed gclosed
   have 0:"(M, [f(z), a, b, c, d,  g(z)] \<Turnstile> \<chi>) \<longleftrightarrow> (M,?\<eta>(z)\<Turnstile> ?\<psi>)" if "(##M)(z)" for z
     using sats_iff_sats_ren[of \<chi> 6 7 _ _ "?\<eta>(z)"]
       ren_U_thm(1)[where A=M,folded ren_U_fn_def] ren_U_thm(2)[folded ren_U_fn_def] that
     by simp
   moreover from calculation
   have 1:"(M,?\<eta>(z)\<Turnstile> ?\<psi>) \<longleftrightarrow> M,[z]@?env\<Turnstile>?\<psi>'" if "(##M)(z)" for z
     using that fsats[OF fclosed[of z],of z]  gsats[of "g(z)" "f(z)" z] fclosed gclosed f_fm g_fm
   proof(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp,(auto)[1])
     assume "M, [z] @ [a, b, c, d] \<Turnstile> (\<cdot>\<exists>\<cdot>f_fm \<and> (\<cdot>\<exists>\<cdot>g_fm \<and> ren(\<chi>) ` 6 ` 7 ` ren_U_fn\<cdot>\<cdot>)\<cdot>\<cdot>)"
     then
     have "\<exists>xa\<in>M. (M, [xa, z, a, b, c, d] \<Turnstile> f_fm) \<and>
           (\<exists>x\<in>M. (M, [x, xa, z, a, b, c, d] \<Turnstile> g_fm) \<and>
             (M, [x, xa, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 6 ` 7 ` ren_U_fn))"
       using that calculation by auto
     then
     obtain xa x where "x\<in>M" "xa\<in>M" "M, [xa, z, a, b, c, d] \<Turnstile> f_fm"
       "(M, [x, xa, z, a, b, c, d] \<Turnstile> g_fm)"
       "(M, [x, xa, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 6 ` 7 ` ren_U_fn)"
       using that calculation by auto
     moreover from this
     have "xa=f(z)" "x=g(z)" using fsats[of xa]  gsats[of x xa] that by simp_all
     ultimately
     show "M, [g(z), f(z), z] @ [a, b, c, d] \<Turnstile> ren(\<chi>) ` 6 ` 7 ` ren_U_fn"
       by auto
   qed
   moreover from calculation
   have "separation(##M, \<lambda>z. (M,[z]@?env \<Turnstile> ?\<psi>'))"
     using separation_ax
     by simp_all
   ultimately
   show ?thesis
     by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
 qed
 
 lemma separation_sat_after_function3:
   assumes "[a, b, c, d]\<in>list(M)" and  "\<chi>\<in>formula" and "arity(\<chi>) \<le> 7"
     and
     f_fm:  "f_fm \<in> formula" and
     f_ar:  "arity(f_fm) \<le> 6" and
     fsats: "\<And> fx x. fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[fx,x]@[a, b, c, d] \<Turnstile> f_fm) \<longleftrightarrow> fx=f(x)" and
     fclosed: "\<And>x . x\<in>M \<Longrightarrow> f(x) \<in> M" and
     g_fm:  "g_fm \<in> formula" and
     g_ar:  "arity(g_fm) \<le> 7" and
     gsats: "\<And> gx fx x. gx\<in>M \<Longrightarrow> fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[gx,fx,x]@[a, b, c, d] \<Turnstile> g_fm) \<longleftrightarrow> gx=g(x)" and
     gclosed: "\<And>x . x\<in>M \<Longrightarrow> g(x) \<in> M" and
     h_fm:  "h_fm \<in> formula" and
     h_ar:  "arity(h_fm) \<le> 8" and
     hsats: "\<And> hx gx fx x. hx\<in>M \<Longrightarrow> gx\<in>M \<Longrightarrow> fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[hx,gx,fx,x]@[a, b, c, d] \<Turnstile> h_fm) \<longleftrightarrow> hx=h(x)" and
     hclosed: "\<And>x . x\<in>M \<Longrightarrow> h(x) \<in> M"
   shows  "separation(##M, \<lambda>r. M, [f(r), a, b, c, d, g(r), h(r)] \<Turnstile> \<chi>)"
 proof -
   note types = assms(1-3)
   let ?\<phi>="\<chi>"
   let ?\<psi>="ren(?\<phi>)`7`8`ren_V3_fn"
   let ?\<psi>'="Exists(And(f_fm,Exists(And(g_fm,Exists(And(h_fm,?\<psi>))))))"
   let ?\<rho>="\<lambda>z.[f(z), a, b, c, d,g(z), h(z)]"
   let ?env="[a, b, c, d]"
   let ?\<eta>="\<lambda>z.[h(z),g(z),f(z),z]@?env"
   note types
   moreover from this
   have "?\<phi>\<in>formula" by simp
   moreover from calculation
   have "arity(?\<phi>) \<le> 9" "?\<psi>\<in>formula"
     using ord_simp_union ren_tc ren_V3_thm(2)[folded ren_V3_fn_def] le_trans[of "arity(\<chi>)" 7]
     by simp_all
   moreover from calculation
   have "arity(?\<psi>) \<le> 8" "?\<psi>'\<in>formula"
     using arity_ren ren_V3_thm(2)[folded ren_V3_fn_def] f_fm g_fm h_fm
     by (simp_all)
   moreover from this f_ar g_ar f_fm g_fm h_fm h_ar \<open>?\<psi>'\<in>_\<close>
   have "arity(?\<psi>') \<le> 5"
     using ord_simp_union arity_type nat_into_Ord
     by (simp add:arity,(rule_tac pred_le,simp,rule_tac Un_le,simp)+,simp_all add: \<open>?\<psi>\<in>_\<close>)
   moreover from calculation fclosed gclosed hclosed
   have 0:"(M, ?\<rho>(z) \<Turnstile> ?\<phi>) \<longleftrightarrow> (M,?\<eta>(z)\<Turnstile> ?\<psi>)" if "(##M)(z)" for z
     using sats_iff_sats_ren[of ?\<phi> 7 8 "?\<rho>(z)" M "?\<eta>(z)"]
       ren_V3_thm(1)[where A=M,folded ren_V3_fn_def,simplified] ren_V3_thm(2)[folded ren_V3_fn_def] that
     by simp
   moreover from calculation
   have 1:"(M,?\<eta>(z)\<Turnstile> ?\<psi>) \<longleftrightarrow> M,[z]@?env\<Turnstile>?\<psi>'" if "(##M)(z)" for z
     using that fsats[OF fclosed[of z],of z] gsats[of "g(z)" "f(z)" z]
       hsats[of "h(z)" "g(z)" "f(z)" z]
       fclosed gclosed hclosed f_fm g_fm h_fm
     apply(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp)
      apply(rule_tac conjI,simp,rule_tac rev_bexI[where x="g(z)"],simp)
      apply(rule_tac conjI,simp,rule_tac rev_bexI[where x="h(z)"],simp,rule_tac conjI,simp,simp)
   proof -
     assume "M, [z] @ [a, b, c, d] \<Turnstile> (\<cdot>\<exists>\<cdot>f_fm \<and> (\<cdot>\<exists>\<cdot>g_fm \<and> (\<cdot>\<exists>\<cdot>h_fm \<and> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn\<cdot>\<cdot>)\<cdot>\<cdot>)\<cdot>\<cdot>)"
     with calculation that
     have "\<exists>x\<in>M. (M, [x, z, a, b, c, d] \<Turnstile> f_fm) \<and>
            (\<exists>xa\<in>M. (M, [xa, x, z, a, b, c, d] \<Turnstile> g_fm) \<and> (\<exists>xb\<in>M. (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm) \<and> (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn)))"
       by auto
     with calculation
     obtain x where "x\<in>M" "(M, [x, z, a, b, c, d] \<Turnstile> f_fm)"
       "(\<exists>xa\<in>M. (M, [xa, x, z, a, b, c, d] \<Turnstile> g_fm) \<and> (\<exists>xb\<in>M. (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm) \<and> (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn)))"
       by force
     moreover from this
     have "x=f(z)" using fsats[of x] that by simp
     moreover from calculation
     obtain xa where "xa\<in>M" "(M, [xa, x, z, a, b, c, d] \<Turnstile> g_fm)"
       "(\<exists>xb\<in>M. (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm) \<and> (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn))"
       by auto
     moreover from calculation
     have "xa=g(z)" using gsats[of xa x] that by simp
     moreover from calculation
     obtain xb where "xb\<in>M" "(M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm)"
       "(M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn)"
       by auto
     moreover from calculation
     have "xb=h(z)" using hsats[of xb xa x] that by simp
     ultimately
     show "M, [h(z), g(z), f(z), z] @ [a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn"
       by auto
   qed
   moreover from calculation \<open>?\<psi>'\<in>_\<close>
   have "separation(##M, \<lambda>z. (M,[z]@?env \<Turnstile> ?\<psi>'))"
     using separation_ax
     by simp
   ultimately
   show ?thesis
     by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
 qed
 
 lemma separation_sat_after_function:
   assumes "[a, b, c, d, \<tau>]\<in>list(M)" and  "\<chi>\<in>formula" and "arity(\<chi>) \<le> 7"
     and
     f_fm:  "f_fm \<in> formula" and
     f_ar:  "arity(f_fm) \<le> 7" and
     fsats: "\<And> fx x. fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[fx,x]@[a, b, c, d, \<tau>] \<Turnstile> f_fm) \<longleftrightarrow> fx=f(x)" and
     fclosed: "\<And>x . x\<in>M \<Longrightarrow> f(x) \<in> M" and
     g_fm:  "g_fm \<in> formula" and
     g_ar:  "arity(g_fm) \<le> 8" and
     gsats: "\<And> gx fx x. gx\<in>M \<Longrightarrow>  fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[gx,fx,x]@[a, b, c, d, \<tau>] \<Turnstile> g_fm) \<longleftrightarrow> gx=g(x)" and
     gclosed: "\<And>x . x\<in>M \<Longrightarrow> g(x) \<in> M"
   shows  "separation(##M, \<lambda>r. M, [f(r), a, b, c, d, \<tau>, g(r)] \<Turnstile> \<chi>)"
 proof -
   note types = assms(1-3)
   let ?\<phi>="\<chi>"
   let ?\<psi>="ren(?\<phi>)`7`8`ren_V_fn"
   let  ?\<psi>'="Exists(And(f_fm,Exists(And(g_fm,?\<psi>))))"
   let ?\<rho>="\<lambda>z.[f(z), a, b, c, d, \<tau>, g(z)]"
   let ?env="[a, b, c, d, \<tau>]"
   let ?\<eta>="\<lambda>z.[g(z),f(z),z]@?env"
   note types
   moreover from this
   have "?\<phi>\<in>formula" by simp
   moreover from calculation
   have "arity(?\<phi>) \<le> 8" "?\<psi>\<in>formula"
     using ord_simp_union ren_tc ren_V_thm(2)[folded ren_V_fn_def] le_trans[of "arity(\<chi>)" 7]
     by simp_all
   moreover from calculation
   have "arity(?\<psi>) \<le> 8" "?\<psi>'\<in>formula"
     using arity_ren ren_V_thm(2)[folded ren_V_fn_def] f_fm g_fm
     by (simp_all)
   moreover from calculation f_ar g_ar f_fm g_fm
   have "arity(?\<psi>') \<le> 6"
     using ord_simp_union pred_le arity_type
     by (simp add:arity)
   moreover from calculation fclosed gclosed
   have 0:"(M, ?\<rho>(z) \<Turnstile> ?\<phi>) \<longleftrightarrow> (M,?\<eta>(z)\<Turnstile> ?\<psi>)" if "(##M)(z)" for z
     using sats_iff_sats_ren[of ?\<phi> 7 8 "?\<rho>(z)" _ "?\<eta>(z)"]
       ren_V_thm(1)[where A=M,folded ren_V_fn_def] ren_V_thm(2)[folded ren_V_fn_def] that
     by simp
   moreover from calculation
   have 1:"(M,?\<eta>(z)\<Turnstile> ?\<psi>) \<longleftrightarrow> M,[z]@?env\<Turnstile>?\<psi>'" if "(##M)(z)" for z
     using that fsats[OF fclosed[of z],of z]  gsats[of "g(z)" "f(z)" z]
       fclosed gclosed f_fm g_fm
     apply(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp)
      apply(auto)[1]
   proof -
     assume "M, [z] @ [a, b, c, d, \<tau>] \<Turnstile> (\<cdot>\<exists>\<cdot>f_fm \<and> (\<cdot>\<exists>\<cdot>g_fm \<and> ren(\<chi>) ` 7 ` 8 ` ren_V_fn\<cdot>\<cdot>)\<cdot>\<cdot>)"
     then have "\<exists>xa\<in>M. (M, [xa, z, a, b, c, d, \<tau>] \<Turnstile> f_fm) \<and>
        (\<exists>x\<in>M. (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> g_fm) \<and> (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn))"
       using that calculation by auto
     then
     obtain xa where "xa\<in>M" "M, [xa, z, a, b, c, d, \<tau>] \<Turnstile> f_fm"
       "(\<exists>x\<in>M. (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> g_fm) \<and> (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn))"
       by auto
     moreover from this
     have "xa=f(z)" using fsats[of xa] that by simp
     moreover from calculation
     obtain x where "x\<in>M" "M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> g_fm" "M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn"
       by auto
     moreover from calculation
     have "x=g(z)" using gsats[of x xa] that by simp
     ultimately
     show "M, [g(z), f(z), z] @ [a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn"
       by auto
   qed
   moreover from calculation
   have "separation(##M, \<lambda>z. (M,[z]@?env \<Turnstile> ?\<psi>'))"
     using separation_ax
     by simp_all
   ultimately
   show ?thesis
     by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
 qed
+end
+
+definition separation_assm_fm :: "[i,i,i] \<Rightarrow> i"
+  where
+  "separation_assm_fm(A,x,f_fm) \<equiv> (\<cdot>\<exists> (\<cdot>\<exists> \<cdot>\<cdot>0 \<in> A +\<^sub>\<omega> 2\<cdot> \<and> \<cdot>\<cdot>\<langle>0,1\<rangle> is x+\<^sub>\<omega> 2 \<cdot> \<and> f_fm \<cdot>\<cdot>\<cdot>)\<cdot>)" 
+
+lemma separation_assm_fm_type[TC]: 
+  "A \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> f_fm \<in> formula \<Longrightarrow> separation_assm_fm(A, y,f_fm) \<in> formula"
+  unfolding separation_assm_fm_def
+  by simp
+
+lemma arity_separation_assm_fm : "A \<in> \<omega> \<Longrightarrow> x \<in> \<omega> \<Longrightarrow> f_fm \<in> formula \<Longrightarrow>
+  arity(separation_assm_fm(A, x, f_fm)) = succ(A) \<union> succ(x) \<union> pred(pred(arity(f_fm)))"
+  using pred_Un_distrib
+  unfolding separation_assm_fm_def
+  by (auto simp add:arity)
+
+definition separation_assm_bin_fm where
+  "separation_assm_bin_fm(A,y,f_fm) \<equiv> 
+    (\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>(\<cdot>\<cdot>3 \<in> A +\<^sub>\<omega> 4\<cdot> \<and>  \<cdot>\<langle>3,2\<rangle> is y +\<^sub>\<omega> 4\<cdot>\<cdot> ) \<and> \<cdot>f_fm \<and> \<cdot> \<cdot>fst(3) is 0 \<cdot> \<and> \<cdot>snd(3) is 1\<cdot>\<cdot>\<cdot>\<cdot> ) \<cdot>)\<cdot>)\<cdot>)\<cdot>) "
+
+lemma separation_assm_bin_fm_type[TC]: 
+  "A \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> f_fm \<in> formula \<Longrightarrow> separation_assm_bin_fm(A, y,f_fm) \<in> formula"
+  unfolding separation_assm_bin_fm_def
+  by simp
+
+lemma arity_separation_assm_bin_fm : "A \<in> \<omega> \<Longrightarrow> x \<in> \<omega> \<Longrightarrow> f_fm \<in> formula \<Longrightarrow>
+  arity(separation_assm_bin_fm(A, x, f_fm)) = succ(A) \<union> succ(x) \<union> (pred^4(arity(f_fm)))"
+  using pred_Un_distrib
+  unfolding separation_assm_bin_fm_def
+  by (auto simp add:arity)
+
+context M_Z_trans
+begin
+
+lemma separation_assm_sats : 
+  assumes
+    f_fm:  "\<phi> \<in> formula" and
+    f_ar:  "arity(\<phi>) = 2" and
+    fsats: "\<And>env x y. env\<in>list(M) \<Longrightarrow> x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,y)" and
+    fabs:  "\<And>x y. x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> is_f(x,y) \<longleftrightarrow> y = f(x)" and
+    fclosed: "\<And>x. x\<in>M \<Longrightarrow> f(x) \<in> M" and
+    "A\<in>M"
+  shows "separation(##M, \<lambda>y. \<exists>x \<in> M . x\<in>A \<and> y = \<langle>x, f(x)\<rangle>)"
+proof -
+  let ?\<phi>'="separation_assm_fm(1,0,\<phi>)"
+  let ?p="\<lambda>y. \<exists>x\<in>M . x\<in>A \<and> y = \<langle>x, f(x)\<rangle>"
+  from f_fm
+  have "?\<phi>'\<in>formula"
+     by simp
+  moreover from this f_ar f_fm
+  have "arity(?\<phi>') = 2"
+    using arity_separation_assm_fm[of 1 0 \<phi>] ord_simp_union  
+    by simp
+  moreover from \<open>A\<in>M\<close> calculation
+  have "separation(##M,\<lambda>y . M,[y,A] \<Turnstile> ?\<phi>')"
+    using separation_ax by auto
+  moreover
+  have "y\<in>M \<Longrightarrow> (M,[y,A] \<Turnstile> ?\<phi>') \<longleftrightarrow> ?p(y)" for y
+    using assms transitivity[OF _ \<open>A\<in>M\<close>]
+    unfolding separation_assm_fm_def
+    by auto  
+  ultimately
+  show ?thesis
+    by(rule_tac separation_cong[THEN iffD1],auto)
+qed
+
+lemma separation_assm_bin_sats :
+  assumes
+    f_fm:  "\<phi> \<in> formula" and
+    f_ar:  "arity(\<phi>) = 3" and
+    fsats: "\<And>env x z y. env\<in>list(M) \<Longrightarrow> x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,z,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,z,y)" and
+    fabs:  "\<And>x z y. x\<in>M \<Longrightarrow>  z\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> is_f(x,z,y) \<longleftrightarrow> y = f(x,z)" and
+    fclosed: "\<And>x z . x\<in>M \<Longrightarrow>  z\<in>M \<Longrightarrow> f(x,z) \<in> M" and
+    "A\<in>M"
+  shows "separation(##M, \<lambda>y. \<exists>x \<in> M . x\<in>A \<and> y = \<langle>x, f(fst(x),snd(x))\<rangle>)"
+proof -
+  let ?\<phi>'="separation_assm_bin_fm(1,0,\<phi>)"
+  let ?p="\<lambda>y. \<exists>x\<in>M . x\<in>A \<and> y = \<langle>x, f(fst(x),snd(x))\<rangle>"
+  from f_fm
+  have "?\<phi>'\<in>formula"
+     by simp
+  moreover from this f_ar f_fm
+  have "arity(?\<phi>') = 2"
+    using arity_separation_assm_bin_fm[of 1 0 \<phi>] ord_simp_union  
+    by simp
+  moreover from \<open>A\<in>M\<close> calculation
+  have "separation(##M,\<lambda>y . M,[y,A] \<Turnstile> ?\<phi>')"
+    using separation_ax by auto
+  moreover
+  have "y\<in>M \<Longrightarrow> (M,[y,A] \<Turnstile> ?\<phi>') \<longleftrightarrow> ?p(y)" for y
+    using assms transitivity[OF _ \<open>A\<in>M\<close>] pair_in_M_iff fst_abs snd_abs fst_closed snd_closed
+    unfolding separation_assm_bin_fm_def
+    by auto
+  ultimately
+  show ?thesis
+    by(rule_tac separation_cong[THEN iffD1],auto)
+qed
+
+lemma separation_domain: "A\<in>M \<Longrightarrow>
+    separation(##M, \<lambda>y. \<exists>x \<in> M . x\<in>A \<and> y = \<langle>x, domain(x)\<rangle>)"
+  using separation_assm_sats[of "domain_fm(0,1)"] arity_domain_fm ord_simp_union
+    domain_closed[simplified]
+  by simp
+
+lemma lam_replacement_domain: "lam_replacement(##M, domain)"
+  using lam_replacement_domain' separation_domain transM by simp
+
+lemma separation_Union: "A\<in>M \<Longrightarrow>
+    separation(##M, \<lambda>y. \<exists>x \<in> M . x\<in>A \<and> y = \<langle>x, Union(x)\<rangle>)"
+  using separation_assm_sats[of "big_union_fm(0,1)"] arity_big_union_fm ord_simp_union
+    Union_closed[simplified]
+  by simp
+
+lemma lam_replacement_Union: "lam_replacement(##M, Union)"
+  using lam_replacement_Union' separation_Union transM by simp
+
+lemma separation_fst: "A\<in>M \<Longrightarrow>
+    separation(##M, \<lambda>y. \<exists>x \<in> M . x\<in>A \<and> y = \<langle>x, fst(x)\<rangle>)"
+  using separation_assm_sats[of "fst_fm(0,1)"] arity_fst_fm ord_simp_union
+    fst_closed fst_abs
+  by simp
+
+lemma lam_replacement_fst: "lam_replacement(##M, fst)"
+  using lam_replacement_fst' separation_fst transM by simp
+
+lemma separation_snd: "A\<in>M \<Longrightarrow>
+    separation(##M, \<lambda>y. \<exists>x \<in> M . x\<in>A \<and> y = \<langle>x, snd(x)\<rangle>)"
+  using separation_assm_sats[of "snd_fm(0,1)"] arity_snd_fm ord_simp_union
+    snd_closed[simplified] snd_abs
+  by simp
+
+lemma lam_replacement_snd: "lam_replacement(##M, snd)"
+  using lam_replacement_snd' separation_snd transM by simp
+
+lemma separation_converse: "A\<in>M \<Longrightarrow>
+    separation(##M, \<lambda>y. \<exists>x \<in> M . x\<in>A \<and> y = \<langle>x, converse(x)\<rangle>)"
+  using separation_assm_sats[of "is_converse_fm(0,1)"] arity_is_converse_fm ord_simp_union
+    converse_closed[simplified] nonempty
+  by simp
+
+lemma lam_replacement_converse: "lam_replacement(##M, converse)"
+  using lam_replacement_converse' separation_converse transM by simp
+
+
+text\<open>Binary lambda-replacements\<close>
+
+lemma separation_Upair: "A\<in>M \<Longrightarrow>
+     separation(##M, \<lambda>y. \<exists>x\<in>M. x \<in> A \<and> y = \<langle>x, Upair(fst(x), snd(x))\<rangle>)"
+  using  arity_upair_fm ord_simp_union
+    nonempty Upair_closed upair_abs
+  by(rule_tac separation_assm_bin_sats[of "upair_fm(0,1,2)"],auto)
+
+lemma lam_replacement_Upair: "lam_replacement(##M, \<lambda>x . Upair(fst(x),snd(x)))"
+  using lam_replacement_Upair' separation_Upair 
+  by simp
+
+lemma separation_Diff: "A\<in>M \<Longrightarrow>
+     separation(##M, \<lambda>y. \<exists>x\<in>M. x \<in> A \<and> y = \<langle>x, Diff(fst(x), snd(x))\<rangle>)"
+  using  arity_setdiff_fm ord_simp_union
+    nonempty Diff_closed setdiff_abs
+  by (rule_tac separation_assm_bin_sats[of "setdiff_fm(0,1,2)"],auto)
+
+lemma lam_replacement_Diff: "lam_replacement(##M, \<lambda>x . Diff(fst(x),snd(x)))"
+  using lam_replacement_Diff'' separation_Diff
+  by simp
+
+lemma separation_Image: "A\<in>M \<Longrightarrow>
+     separation(##M, \<lambda>y. \<exists>x\<in>M. x \<in> A \<and> y = \<langle>x, fst(x) `` snd(x)\<rangle>)"
+  using  arity_image_fm ord_simp_union
+    nonempty image_closed image_abs
+  by (rule_tac separation_assm_bin_sats[of "image_fm(0,1,2)"],auto)
+
+lemma lam_replacement_Image: "lam_replacement(##M, \<lambda>x . fst(x) `` snd(x))"
+  using lam_replacement_Image' separation_Image
+  by simp
+
+lemma separation_comp: "A\<in>M \<Longrightarrow>
+     separation(##M, \<lambda>y. \<exists>x\<in>M. x \<in> A \<and> y = \<langle>x, comp(fst(x), snd(x))\<rangle>)"
+  using  arity_composition_fm ord_simp_union
+    nonempty comp_closed composition_abs
+  by (rule_tac separation_assm_bin_sats[of "composition_fm(0,1,2)"],auto)
+
+lemma lam_replacement_comp: "lam_replacement(##M, \<lambda>x . comp(fst(x),snd(x)))"
+  using lam_replacement_comp'' separation_comp
+  by simp
+
+lemma separation_middle_del: "A\<in>M \<Longrightarrow>
+     separation(##M, \<lambda>y. \<exists>x\<in>M. x \<in> A \<and> y = \<langle>x, middle_del(fst(x), snd(x))\<rangle>)"
+ using  arity_is_middle_del_fm ord_simp_union nonempty
+    fst_abs snd_abs fst_closed snd_closed pair_in_M_iff
+  by (rule_tac separation_assm_bin_sats[of "is_middle_del_fm(0,1,2)"],
+      auto simp:is_middle_del_def middle_del_def)
+
+lemma lam_replacement_middle_del: "lam_replacement(##M, \<lambda>r . middle_del(fst(r),snd(r)))"
+  using lam_replacement_middle_del' separation_middle_del
+  by simp
+
+lemma separation_prodRepl: "A\<in>M \<Longrightarrow>
+     separation(##M, \<lambda>y. \<exists>x\<in>M. x \<in> A \<and> y = \<langle>x, prodRepl(fst(x), snd(x))\<rangle>)"
+   using  arity_is_prodRepl_fm ord_simp_union nonempty
+    fst_abs snd_abs fst_closed snd_closed pair_in_M_iff
+  by (rule_tac separation_assm_bin_sats[of "is_prodRepl_fm(0,1,2)"],
+      auto simp:is_prodRepl_def prodRepl_def)
+
+lemma lam_replacement_prodRepl: "lam_replacement(##M, \<lambda>r . prodRepl(fst(r),snd(r)))"
+  using lam_replacement_prodRepl' separation_prodRepl
+  by simp
+
+end  \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
+
+context M_trivial
+begin
+
+lemma first_closed:
+  "M(B) \<Longrightarrow> M(r) \<Longrightarrow> first(u,r,B) \<Longrightarrow> M(u)"
+  using transM[OF first_is_elem] by simp
+
+is_iff_rel for "first"
+  unfolding is_first_def first_rel_def by auto
+
+is_iff_rel for "minimum"
+  unfolding is_minimum_def minimum_rel_def
+  using is_first_iff The_abs nonempty
+  by force
+
+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
+
+context M_Z_trans
+begin
+
+lemma (in M_basic) is_minimum_equivalence :
+  "M(R) \<Longrightarrow> M(X) \<Longrightarrow> M(u) \<Longrightarrow> is_minimum(M,R,X,u) \<longleftrightarrow> is_minimum'(M,R,X,u)"
+  unfolding is_minimum_def is_minimum'_def is_The_def is_first_def by simp
+
+lemma separation_minimum: "A\<in>M \<Longrightarrow>
+     separation(##M, \<lambda>y. \<exists>x\<in>M. x \<in> A \<and> y = \<langle>x, minimum(fst(x), snd(x))\<rangle>)"
+  using  arity_minimum_fm ord_simp_union is_minimum_iff minimum_abs
+    is_minimum_equivalence nonempty minimum_closed minimum_abs
+  by (rule_tac separation_assm_bin_sats[of "minimum_fm(0,1,2)"], auto)
+
+lemma lam_replacement_minimum: "lam_replacement(##M, \<lambda>x . minimum(fst(x),snd(x)))"
+  using lam_replacement_minimum' separation_minimum
+  by simp
 
 end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Internal_ZFC_Axioms.thy b/thys/Independence_CH/Internal_ZFC_Axioms.thy
--- a/thys/Independence_CH/Internal_ZFC_Axioms.thy
+++ b/thys/Independence_CH/Internal_ZFC_Axioms.thy
@@ -1,520 +1,520 @@
 section\<open>The ZFC axioms, internalized\<close>
 theory Internal_ZFC_Axioms
   imports
-    Forcing_Data
+    Fm_Definitions
 
 begin
 
 schematic_goal ZF_union_auto:
     "Union_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfunion)"
   unfolding Union_ax_def
   by ((rule sep_rules | simp)+)
 
 synthesize "ZF_union" from_schematic ZF_union_auto
 notation ZF_union_fm (\<open>\<cdot>Union Ax\<cdot>\<close>)
 
 schematic_goal ZF_power_auto:
     "power_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfpow)"
   unfolding power_ax_def powerset_def subset_def
   by ((rule sep_rules | simp)+)
 
 synthesize "ZF_power" from_schematic ZF_power_auto
 notation ZF_power_fm (\<open>\<cdot>Powerset Ax\<cdot>\<close>)
 
 schematic_goal ZF_pairing_auto:
     "upair_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfpair)"
   unfolding upair_ax_def
   by ((rule sep_rules | simp)+)
 
 synthesize "ZF_pairing" from_schematic ZF_pairing_auto
 notation ZF_pairing_fm (\<open>\<cdot>Pairing\<cdot>\<close>)
 
 schematic_goal ZF_foundation_auto:
     "foundation_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zffound)"
   unfolding foundation_ax_def
   by ((rule sep_rules | simp)+)
 
 synthesize "ZF_foundation" from_schematic ZF_foundation_auto
 notation ZF_foundation_fm (\<open>\<cdot>Foundation\<cdot>\<close>)
 
 schematic_goal ZF_extensionality_auto:
     "extensionality(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfext)"
   unfolding extensionality_def
   by ((rule sep_rules | simp)+)
 
 synthesize "ZF_extensionality" from_schematic ZF_extensionality_auto
 notation ZF_extensionality_fm (\<open>\<cdot>Extensionality\<cdot>\<close>)
 
 schematic_goal ZF_infinity_auto:
     "infinity_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> (?\<phi>(i,j,h)))"
   unfolding infinity_ax_def
   by ((rule sep_rules | simp)+)
 
 synthesize "ZF_infinity" from_schematic ZF_infinity_auto
 notation ZF_infinity_fm (\<open>\<cdot>Infinity\<cdot>\<close>)
 
 schematic_goal ZF_choice_auto:
     "choice_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> (?\<phi>(i,j,h)))"
   unfolding choice_ax_def
   by ((rule sep_rules | simp)+)
 
 synthesize "ZF_choice" from_schematic ZF_choice_auto
 notation ZF_choice_fm (\<open>\<cdot>AC\<cdot>\<close>)
 
 lemmas ZFC_fm_defs = ZF_extensionality_fm_def ZF_foundation_fm_def ZF_pairing_fm_def
               ZF_union_fm_def ZF_infinity_fm_def ZF_power_fm_def ZF_choice_fm_def
 
 lemmas ZFC_fm_sats = ZF_extensionality_auto ZF_foundation_auto ZF_pairing_auto
               ZF_union_auto ZF_infinity_auto ZF_power_auto ZF_choice_auto
 
 definition
   ZF_fin :: "i" where
   "ZF_fin \<equiv> {\<cdot>Extensionality\<cdot>, \<cdot>Foundation\<cdot>, \<cdot>Pairing\<cdot>,
               \<cdot>Union Ax\<cdot>, \<cdot>Infinity\<cdot>, \<cdot>Powerset Ax\<cdot>}"
 
 subsection\<open>The Axiom of Separation, internalized\<close>
 lemma iterates_Forall_type [TC]:
       "\<lbrakk> n \<in> nat; p \<in> formula \<rbrakk> \<Longrightarrow> Forall^n(p) \<in> formula"
   by (induct set:nat, auto)
 
 lemma last_init_eq :
   assumes "l \<in> list(A)" "length(l) = succ(n)"
   shows "\<exists> a\<in>A. \<exists>l'\<in>list(A). l = l'@[a]"
 proof-
   from \<open>l\<in>_\<close> \<open>length(_) = _\<close>
   have "rev(l) \<in> list(A)" "length(rev(l)) = succ(n)"
     by simp_all
   then
   obtain a l' where "a\<in>A" "l'\<in>list(A)" "rev(l) = Cons(a,l')"
     by (cases;simp)
   then
   have "l = rev(l') @ [a]" "rev(l') \<in> list(A)"
     using rev_rev_ident[OF \<open>l\<in>_\<close>] by auto
   with \<open>a\<in>_\<close>
   show ?thesis by blast
 qed
 
 lemma take_drop_eq :
   assumes "l\<in>list(M)"
   shows "\<And> n . n < succ(length(l)) \<Longrightarrow> l = take(n,l) @ drop(n,l)"
   using \<open>l\<in>list(M)\<close>
 proof induct
   case Nil
   then show ?case by auto
 next
   case (Cons a l)
   then show ?case
   proof -
     {
       fix i
       assume "i<succ(succ(length(l)))"
       with \<open>l\<in>list(M)\<close>
       consider (lt) "i = 0" | (eq) "\<exists>k\<in>nat. i = succ(k) \<and> k < succ(length(l))"
         using \<open>l\<in>list(M)\<close>  le_natI nat_imp_quasinat
         by (cases rule:nat_cases[of i];auto)
       then
       have "take(i,Cons(a,l)) @ drop(i,Cons(a,l)) = Cons(a,l)"
         using Cons
         by (cases;auto)
     }
     then show ?thesis using Cons by auto
   qed
 qed
 
 lemma list_split :
 assumes "n \<le> succ(length(rest))" "rest \<in> list(M)"
 shows  "\<exists>re\<in>list(M). \<exists>st\<in>list(M). rest = re @ st \<and> length(re) = pred(n)"
 proof -
   from assms
   have "pred(n) \<le> length(rest)"
     using pred_mono[OF _ \<open>n\<le>_\<close>] pred_succ_eq by auto
   with \<open>rest\<in>_\<close>
   have "pred(n)\<in>nat" "rest = take(pred(n),rest) @ drop(pred(n),rest)" (is "_ = ?re @ ?st")
     using take_drop_eq[OF \<open>rest\<in>_\<close>] le_natI by auto
   then
   have "length(?re) = pred(n)" "?re\<in>list(M)" "?st\<in>list(M)"
     using length_take[rule_format,OF _ \<open>pred(n)\<in>_\<close>] \<open>pred(n) \<le> _\<close> \<open>rest\<in>_\<close>
     unfolding min_def
     by auto
   then
   show ?thesis
     using rev_bexI[of _ _ "\<lambda> re. \<exists>st\<in>list(M). rest = re @ st \<and> length(re) = pred(n)"]
       \<open>length(?re) = _\<close> \<open>rest = _\<close>
     by auto
 qed
 
 lemma sats_nForall:
   assumes
     "\<phi> \<in> formula"
   shows
     "n\<in>nat \<Longrightarrow> ms \<in> list(M) \<Longrightarrow>
        (M, ms \<Turnstile> (Forall^n(\<phi>))) \<longleftrightarrow>
        (\<forall>rest \<in> list(M). length(rest) = n \<longrightarrow> M, rest @ ms \<Turnstile> \<phi>)"
 proof (induct n arbitrary:ms set:nat)
   case 0
   with assms
   show ?case by simp
 next
   case (succ n)
   have "(\<forall>rest\<in>list(M). length(rest) = succ(n) \<longrightarrow> P(rest,n)) \<longleftrightarrow>
         (\<forall>t\<in>M. \<forall>res\<in>list(M). length(res) = n \<longrightarrow> P(res @ [t],n))"
     if "n\<in>nat" for n P
     using that last_init_eq by force
   from this[of _ "\<lambda>rest _. (M, rest @ ms \<Turnstile> \<phi>)"] \<open>n\<in>nat\<close>
   have "(\<forall>rest\<in>list(M). length(rest) = succ(n) \<longrightarrow> M, rest @ ms \<Turnstile> \<phi>) \<longleftrightarrow>
         (\<forall>t\<in>M. \<forall>res\<in>list(M). length(res) = n \<longrightarrow>  M, (res @ [t]) @ ms \<Turnstile> \<phi>)"
     by simp
     with assms succ(1,3) succ(2)[of "Cons(_,ms)"]
   show ?case
     using arity_sats_iff[of \<phi> _ M "Cons(_, ms @ _)"] app_assoc
     by (simp)
 qed
 
 definition
   sep_body_fm :: "i \<Rightarrow> i" where
   "sep_body_fm(p) \<equiv> (\<cdot>\<forall>(\<cdot>\<exists>(\<cdot>\<forall>\<cdot>\<cdot>0 \<in> 1\<cdot> \<leftrightarrow> \<cdot>\<cdot>0 \<in> 2\<cdot> \<and> incr_bv1^2 (p) \<cdot>\<cdot>\<cdot>)\<cdot>)\<cdot>)"
 
 lemma sep_body_fm_type [TC]: "p \<in> formula \<Longrightarrow> sep_body_fm(p) \<in> formula"
   by (simp add: sep_body_fm_def)
 
 lemma sats_sep_body_fm:
   assumes
     "\<phi> \<in> formula" "ms\<in>list(M)" "rest\<in>list(M)"
   shows
     "(M, rest @ ms \<Turnstile> sep_body_fm(\<phi>)) \<longleftrightarrow>
      separation(##M,\<lambda>x. M, [x] @ rest @ ms \<Turnstile> \<phi>)"
   using assms formula_add_params1[of _ 2 _ _ "[_,_]" ]
   unfolding sep_body_fm_def separation_def by simp
 
 definition
   ZF_separation_fm :: "i \<Rightarrow> i" (\<open>\<cdot>Separation'(_')\<cdot>\<close>) where
   "ZF_separation_fm(p) \<equiv> Forall^(pred(arity(p)))(sep_body_fm(p))"
 
 lemma ZF_separation_fm_type [TC]: "p \<in> formula \<Longrightarrow> ZF_separation_fm(p) \<in> formula"
   by (simp add: ZF_separation_fm_def)
 
 lemma sats_ZF_separation_fm_iff:
   assumes
     "\<phi>\<in>formula"
   shows
   "(M, [] \<Turnstile> \<cdot>Separation(\<phi>)\<cdot>)
    \<longleftrightarrow>
    (\<forall>env\<in>list(M). arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<longrightarrow>
       separation(##M,\<lambda>x. M, [x] @ env \<Turnstile> \<phi>))"
 proof (intro iffI ballI impI)
   let ?n="pred(arity(\<phi>))"
   fix env
   assume "M, [] \<Turnstile> ZF_separation_fm(\<phi>)"
   assume "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" "env\<in>list(M)"
   moreover from this
   have "arity(\<phi>) \<le> succ(length(env))" by simp
   then
   obtain some rest where "some\<in>list(M)" "rest\<in>list(M)"
     "env = some @ rest" "length(some) = pred(arity(\<phi>))"
     using list_split[OF \<open>arity(\<phi>) \<le> succ(_)\<close> \<open>env\<in>_\<close>] by force
   moreover from \<open>\<phi>\<in>_\<close>
   have "arity(\<phi>) \<le> succ(pred(arity(\<phi>)))"
    using succpred_leI by simp
   moreover
   note assms
   moreover
   assume "M, [] \<Turnstile> ZF_separation_fm(\<phi>)"
   moreover from calculation
   have "M, some \<Turnstile> sep_body_fm(\<phi>)"
     using sats_nForall[of "sep_body_fm(\<phi>)" ?n]
     unfolding ZF_separation_fm_def by simp
   ultimately
   show "separation(##M, \<lambda>x. M, [x] @ env \<Turnstile> \<phi>)"
     unfolding ZF_separation_fm_def
     using sats_sep_body_fm[of \<phi> "[]" M some]
       arity_sats_iff[of \<phi> rest M "[_] @ some"]
       separation_cong[of "##M" "\<lambda>x. M, Cons(x, some @ rest) \<Turnstile> \<phi>" _ ]
     by simp
 next \<comment> \<open>almost equal to the previous implication\<close>
   let ?n="pred(arity(\<phi>))"
   assume asm:"\<forall>env\<in>list(M). arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<longrightarrow>
     separation(##M, \<lambda>x. M, [x] @ env \<Turnstile> \<phi>)"
   {
     fix some
     assume "some\<in>list(M)" "length(some) = pred(arity(\<phi>))"
     moreover
     note \<open>\<phi>\<in>_\<close>
     moreover from calculation
     have "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(some)"
       using le_trans[OF succpred_leI] succpred_leI by simp
     moreover from calculation and asm
     have "separation(##M, \<lambda>x. M, [x] @ some \<Turnstile> \<phi>)" by blast
     ultimately
     have "M, some \<Turnstile> sep_body_fm(\<phi>)"
     using sats_sep_body_fm[of \<phi> "[]" M some]
       arity_sats_iff[of \<phi> _ M "[_,_] @ some"]
       strong_replacement_cong[of "##M" "\<lambda>x y. M, Cons(x, Cons(y, some @ _)) \<Turnstile> \<phi>" _ ]
     by simp
   }
   with \<open>\<phi>\<in>_\<close>
   show "M, [] \<Turnstile> ZF_separation_fm(\<phi>)"
     using sats_nForall[of "sep_body_fm(\<phi>)" ?n]
     unfolding ZF_separation_fm_def
     by simp
 qed
 
 subsection\<open>The Axiom of Replacement, internalized\<close>
 schematic_goal sats_univalent_fm_auto:
   assumes
     (*    Q_iff_sats:"\<And>a b z env aa bb. nth(a,Cons(z,env)) = aa \<Longrightarrow> nth(b,Cons(z,env)) = bb \<Longrightarrow> z\<in>A
           \<Longrightarrow> aa \<in> A \<Longrightarrow> bb \<in> A \<Longrightarrow> env\<in> list(A) \<Longrightarrow>
                  Q(aa,bb) \<longleftrightarrow> (A, Cons(z,env) \<Turnstile> (Q_fm(a,b)))" \<comment> \<open>using only \<one> formula\<close> *)
     Q_iff_sats:"\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
                  Q(x,z) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q1_fm)"
        "\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
                  Q(x,y) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q2_fm)"
     and
     asms: "nth(i,env) = B" "i \<in> nat" "env \<in> list(A)"
   shows
     "univalent(##A,B,Q) \<longleftrightarrow> A,env \<Turnstile> ?ufm(i)"
   unfolding univalent_def
   by (insert asms; (rule sep_rules Q_iff_sats | simp)+)
 
 synthesize_notc "univalent" from_schematic sats_univalent_fm_auto
 
 lemma univalent_fm_type [TC]: "q1\<in> formula \<Longrightarrow> q2\<in>formula \<Longrightarrow> i\<in>nat \<Longrightarrow>
   univalent_fm(q2,q1,i) \<in>formula"
   by (simp add:univalent_fm_def)
 
 lemma sats_univalent_fm :
   assumes
     Q_iff_sats:"\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
                  Q(x,z) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q1_fm)"
        "\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
                  Q(x,y) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q2_fm)"
     and
     asms: "nth(i,env) = B" "i \<in> nat" "env \<in> list(A)"
   shows
     "(A,env \<Turnstile> univalent_fm(Q1_fm,Q2_fm,i)) \<longleftrightarrow> univalent(##A,B,Q)"
   unfolding univalent_fm_def using asms sats_univalent_fm_auto[OF Q_iff_sats] by simp
 
 definition
   swap_vars :: "i\<Rightarrow>i" where
   "swap_vars(\<phi>) \<equiv>
       Exists(Exists(And(Equal(0,3),And(Equal(1,2),iterates(\<lambda>p. incr_bv(p)`2 , 2, \<phi>)))))"
 
 lemma swap_vars_type[TC] :
   "\<phi>\<in>formula \<Longrightarrow> swap_vars(\<phi>) \<in>formula"
   unfolding swap_vars_def by simp
 
 lemma sats_swap_vars :
   "[x,y] @ env \<in> list(M) \<Longrightarrow> \<phi>\<in>formula \<Longrightarrow>
     (M, [x,y] @ env \<Turnstile> swap_vars(\<phi>)) \<longleftrightarrow> M,[y,x] @ env \<Turnstile> \<phi>"
   unfolding swap_vars_def
   using sats_incr_bv_iff [of _ _ M _ "[y,x]"] by simp
 
 definition
   univalent_Q1 :: "i \<Rightarrow> i" where
   "univalent_Q1(\<phi>) \<equiv> incr_bv1(swap_vars(\<phi>))"
 
 definition
   univalent_Q2 :: "i \<Rightarrow> i" where
   "univalent_Q2(\<phi>) \<equiv> incr_bv(swap_vars(\<phi>))`0"
 
 lemma univalent_Qs_type [TC]:
   assumes "\<phi>\<in>formula"
   shows "univalent_Q1(\<phi>) \<in> formula" "univalent_Q2(\<phi>) \<in> formula"
   unfolding univalent_Q1_def univalent_Q2_def using assms by simp_all
 
 lemma sats_univalent_fm_assm:
   assumes
     "x \<in> A" "y \<in> A" "z\<in>A" "env\<in> list(A)" "\<phi> \<in> formula"
   shows
     "(A, ([x,z] @ env) \<Turnstile> \<phi>) \<longleftrightarrow> (A, Cons(z,Cons(y,Cons(x,env))) \<Turnstile> (univalent_Q1(\<phi>)))"
     "(A, ([x,y] @ env) \<Turnstile> \<phi>) \<longleftrightarrow> (A, Cons(z,Cons(y,Cons(x,env))) \<Turnstile> (univalent_Q2(\<phi>)))"
   unfolding univalent_Q1_def univalent_Q2_def
   using
     sats_incr_bv_iff[of _ _ A _ "[]"] \<comment> \<open>simplifies iterates of \<^term>\<open>\<lambda>x. incr_bv(x)`0\<close>\<close>
     sats_incr_bv1_iff[of _ "Cons(x,env)" A z y]
     sats_swap_vars  assms
    by simp_all
 
 definition
   rep_body_fm :: "i \<Rightarrow> i" where
   "rep_body_fm(p) \<equiv> Forall(Implies(
         univalent_fm(univalent_Q1(incr_bv(p)`2),univalent_Q2(incr_bv(p)`2),0),
         Exists(Forall(
           Iff(Member(0,1),Exists(And(Member(0,3),incr_bv(incr_bv(p)`2)`2)))))))"
 
 lemma rep_body_fm_type [TC]: "p \<in> formula \<Longrightarrow> rep_body_fm(p) \<in> formula"
   by (simp add: rep_body_fm_def)
 
 lemmas ZF_replacement_simps = formula_add_params1[of \<phi> 2 _ M "[_,_]" ]
   sats_incr_bv_iff[of _ _ M _ "[]"] \<comment> \<open>simplifies iterates of \<^term>\<open>\<lambda>x. incr_bv(x)`0\<close>\<close>
   sats_incr_bv_iff[of _ _ M _ "[_,_]"]\<comment> \<open>simplifies \<^term>\<open>\<lambda>x. incr_bv(x)`2\<close>\<close>
   sats_incr_bv1_iff[of _ _ M] sats_swap_vars for \<phi> M
 
 lemma sats_rep_body_fm:
   assumes
     "\<phi> \<in> formula" "ms\<in>list(M)" "rest\<in>list(M)"
   shows
     "(M, rest @ ms \<Turnstile> rep_body_fm(\<phi>)) \<longleftrightarrow>
      strong_replacement(##M,\<lambda>x y. M, [x,y] @ rest @ ms \<Turnstile> \<phi>)"
   using assms ZF_replacement_simps
   unfolding rep_body_fm_def strong_replacement_def univalent_def
   unfolding univalent_fm_def univalent_Q1_def univalent_Q2_def
   by simp
 
 definition
   ZF_replacement_fm :: "i \<Rightarrow> i" (\<open>\<cdot>Replacement'(_')\<cdot>\<close>) where
   "ZF_replacement_fm(p) \<equiv> Forall^(pred(pred(arity(p))))(rep_body_fm(p))"
 
 lemma ZF_replacement_fm_type [TC]: "p \<in> formula \<Longrightarrow> ZF_replacement_fm(p) \<in> formula"
   by (simp add: ZF_replacement_fm_def)
 
 lemma sats_ZF_replacement_fm_iff:
   assumes
     "\<phi>\<in>formula"
   shows
   "(M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>)
    \<longleftrightarrow>
    (\<forall>env\<in>list(M). arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
       strong_replacement(##M,\<lambda>x y. M,[x,y] @ env \<Turnstile> \<phi>))"
 proof (intro iffI ballI impI)
   let ?n="pred(pred(arity(\<phi>)))"
   fix env
   assume "M, [] \<Turnstile> ZF_replacement_fm(\<phi>)" "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env)" "env\<in>list(M)"
   moreover from this
   have "arity(\<phi>) \<le> succ(succ(length(env)))" by (simp)
   moreover from calculation
   have "pred(arity(\<phi>)) \<le> succ(length(env))"
     using pred_mono[OF _ \<open>arity(\<phi>)\<le>succ(_)\<close>] pred_succ_eq by simp
   moreover from calculation
   obtain some rest where "some\<in>list(M)" "rest\<in>list(M)"
     "env = some @ rest" "length(some) = pred(pred(arity(\<phi>)))"
     using list_split[OF \<open>pred(_) \<le> _\<close> \<open>env\<in>_\<close>] by auto
   moreover
   note \<open>\<phi>\<in>_\<close>
   moreover from this
   have "arity(\<phi>) \<le> succ(succ(pred(pred(arity(\<phi>)))))"
     using le_trans[OF succpred_leI] succpred_leI by simp
   moreover from calculation
   have "M, some \<Turnstile> rep_body_fm(\<phi>)"
     using sats_nForall[of "rep_body_fm(\<phi>)" ?n]
     unfolding ZF_replacement_fm_def
     by simp
   ultimately
   show "strong_replacement(##M, \<lambda>x y. M, [x, y] @ env \<Turnstile> \<phi>)"
     using sats_rep_body_fm[of \<phi> "[]" M some]
       arity_sats_iff[of \<phi> rest M "[_,_] @ some"]
       strong_replacement_cong[of "##M" "\<lambda>x y. M, Cons(x, Cons(y, some @ rest)) \<Turnstile> \<phi>" _ ]
     by simp
 next \<comment> \<open>almost equal to the previous implication\<close>
   let ?n="pred(pred(arity(\<phi>)))"
   assume asm:"\<forall>env\<in>list(M). arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
     strong_replacement(##M, \<lambda>x y. M, [x, y] @ env \<Turnstile> \<phi>)"
   {
     fix some
     assume "some\<in>list(M)" "length(some) = pred(pred(arity(\<phi>)))"
     moreover
     note \<open>\<phi>\<in>_\<close>
     moreover from calculation
     have "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(some)"
       using le_trans[OF succpred_leI] succpred_leI by simp
     moreover from calculation and asm
     have "strong_replacement(##M, \<lambda>x y. M, [x, y] @ some \<Turnstile> \<phi>)" by blast
     ultimately
     have "M, some \<Turnstile> rep_body_fm(\<phi>)"
     using sats_rep_body_fm[of \<phi> "[]" M some]
       arity_sats_iff[of \<phi> _ M "[_,_] @ some"]
       strong_replacement_cong[of "##M" "\<lambda>x y. M, Cons(x, Cons(y, some @ _)) \<Turnstile> \<phi>" _ ]
     by simp
   }
   with \<open>\<phi>\<in>_\<close>
   show "M, [] \<Turnstile> ZF_replacement_fm(\<phi>)"
     using sats_nForall[of "rep_body_fm(\<phi>)" ?n]
     unfolding ZF_replacement_fm_def
     by simp
 qed
 
 definition
   ZF_schemes :: "i" where
   "ZF_schemes \<equiv> {\<cdot>Separation(p)\<cdot> . p \<in> formula } \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> formula }"
 
 lemma Un_subset_formula [TC]: "A\<subseteq>formula \<and> B\<subseteq>formula \<Longrightarrow> A\<union>B \<subseteq> formula"
   by auto
 
 lemma ZF_schemes_subset_formula [TC]: "ZF_schemes \<subseteq> formula"
   unfolding ZF_schemes_def by auto
 
 lemma ZF_fin_subset_formula [TC]: "ZF_fin \<subseteq> formula"
   unfolding ZF_fin_def by simp
 
 definition
   ZF :: "i" where
   "ZF \<equiv> ZF_schemes \<union> ZF_fin"
 
 lemma ZF_subset_formula [TC]: "ZF \<subseteq> formula"
   unfolding ZF_def by auto
 
 definition
   ZFC :: "i" where
   "ZFC \<equiv> ZF \<union> {\<cdot>AC\<cdot>}"
 
 definition
   ZF_minus_P :: "i" where
   "ZF_minus_P \<equiv> ZF - { \<cdot>Powerset Ax\<cdot> }"
 
 definition
   Zermelo_fms :: "i" (\<open>\<cdot>Z\<cdot>\<close>) where
   "Zermelo_fms \<equiv> ZF_fin \<union> {\<cdot>Separation(p)\<cdot> . p \<in> formula }"
 
 definition
   ZC :: "i" where
   "ZC \<equiv> Zermelo_fms \<union> {\<cdot>AC\<cdot>}"
 
 lemma ZFC_subset_formula: "ZFC \<subseteq> formula"
   by (simp add:ZFC_def Un_subset_formula)
 
-txt\<open>Satisfaction of a set of sentences\<close>
+text\<open>Satisfaction of a set of sentences\<close>
 definition
   satT :: "[i,i] \<Rightarrow> o"  ("_ \<Turnstile> _" [36,36] 60) where
   "A \<Turnstile> \<Phi>  \<equiv>  \<forall>\<phi>\<in>\<Phi>. (A,[] \<Turnstile> \<phi>)"
 
 lemma satTI [intro!]:
   assumes "\<And>\<phi>. \<phi>\<in>\<Phi> \<Longrightarrow> A,[] \<Turnstile> \<phi>"
   shows "A \<Turnstile> \<Phi>"
   using assms unfolding satT_def by simp
 
 lemma satTD [dest] :"A \<Turnstile> \<Phi> \<Longrightarrow> \<phi>\<in>\<Phi> \<Longrightarrow> A,[] \<Turnstile> \<phi>"
   unfolding satT_def by simp
 
 lemma satT_mono: "A \<Turnstile> \<Phi> \<Longrightarrow> \<Psi> \<subseteq> \<Phi> \<Longrightarrow> A \<Turnstile> \<Psi>"
   by blast
 
 lemma satT_Un_iff: "M \<Turnstile> \<Phi> \<union> \<Psi> \<longleftrightarrow> M \<Turnstile> \<Phi> \<and> M \<Turnstile> \<Psi>" by auto
 
 lemma sats_ZFC_iff_sats_ZF_AC:
   "(N \<Turnstile> ZFC) \<longleftrightarrow> (N \<Turnstile> ZF) \<and> (N, [] \<Turnstile> \<cdot>AC\<cdot>)"
     unfolding ZFC_def ZF_def by auto
 
 lemma satT_ZF_imp_satT_Z: "M \<Turnstile> ZF \<Longrightarrow> M \<Turnstile> \<cdot>Z\<cdot>"
   unfolding ZF_def ZF_schemes_def Zermelo_fms_def ZF_fin_def by auto
 
 lemma satT_ZFC_imp_satT_ZC: "M \<Turnstile> ZFC \<Longrightarrow> M \<Turnstile> ZC"
   unfolding ZFC_def ZF_def ZF_schemes_def ZC_def Zermelo_fms_def by auto
 
 lemma satT_Z_ZF_replacement_imp_satT_ZF: "N \<Turnstile> \<cdot>Z\<cdot> \<Longrightarrow> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<Longrightarrow> N \<Turnstile> ZF"
   unfolding ZF_def ZF_schemes_def Zermelo_fms_def ZF_fin_def by auto
 
 lemma satT_ZC_ZF_replacement_imp_satT_ZFC: "N \<Turnstile> ZC \<Longrightarrow> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<Longrightarrow> N \<Turnstile> ZFC"
   unfolding ZFC_def ZF_def ZF_schemes_def ZC_def Zermelo_fms_def  by auto
 
 lemma ground_repl_fm_sub_ZF: "{\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> formula} \<subseteq> ZF"
    unfolding ZF_def ZF_schemes_def by auto
 
 lemma ZF_replacement_fms_sub_ZFC: "{\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula} \<subseteq> ZFC"
    unfolding ZFC_def ZF_def ZF_schemes_def by auto
 
 lemma ground_repl_fm_sub_ZFC: "{\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> formula} \<subseteq> ZFC"
    unfolding ZFC_def ZF_def ZF_schemes_def by auto
 
 lemma ZF_replacement_ground_repl_fm_type: "{\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> formula} \<subseteq> formula"
   by auto
 
 end
diff --git a/thys/Independence_CH/Kappa_Closed_Notions.thy b/thys/Independence_CH/Kappa_Closed_Notions.thy
--- a/thys/Independence_CH/Kappa_Closed_Notions.thy
+++ b/thys/Independence_CH/Kappa_Closed_Notions.thy
@@ -1,723 +1,732 @@
 section\<open>Preservation results for $\kappa$-closed forcing notions\<close>
 
 theory Kappa_Closed_Notions
   imports
     Not_CH
 begin
 
 definition
   lerel :: "i\<Rightarrow>i" where
   "lerel(\<alpha>) \<equiv> Memrel(\<alpha>) \<union> id(\<alpha>)"
 
 lemma lerelI[intro!]: "x\<le>y \<Longrightarrow> y\<in>\<alpha> \<Longrightarrow> Ord(\<alpha>) \<Longrightarrow> \<langle>x,y\<rangle> \<in> lerel(\<alpha>)"
   using Ord_trans[of x y \<alpha>] ltD unfolding lerel_def by auto
 
 lemma lerelD[dest]: "\<langle>x,y\<rangle> \<in> lerel(\<alpha>) \<Longrightarrow> Ord(\<alpha>) \<Longrightarrow> x\<le>y"
   using ltI[THEN leI] Ord_in_Ord unfolding lerel_def by auto
 
 definition
   mono_seqspace :: "[i,i,i] \<Rightarrow> i" (\<open>_ \<^sub><\<rightarrow> '(_,_')\<close> [61] 60) where
   "\<alpha> \<^sub><\<rightarrow> (P,leq) \<equiv> mono_map(\<alpha>,Memrel(\<alpha>),P,leq)"
 
 relativize functional "mono_seqspace" "mono_seqspace_rel"
 relationalize "mono_seqspace_rel" "is_mono_seqspace"
 synthesize "is_mono_seqspace" from_definition assuming "nonempty"
 
 context M_ZF_library
 begin
 
 rel_closed for "mono_seqspace"
   unfolding mono_seqspace_rel_def mono_map_rel_def
   using separation_closed separation_ball separation_imp separation_in
     lam_replacement_fst lam_replacement_snd lam_replacement_hcomp lam_replacement_constant
     lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
     lam_replacement_apply2[THEN[5] lam_replacement_hcomp2]
   by simp_all
 
 end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
 
 abbreviation
   mono_seqspace_r (\<open>_ \<^sub><\<rightarrow>\<^bsup>_\<^esup> '(_,_')\<close> [61] 60) where
   "\<alpha> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) \<equiv> mono_seqspace_rel(M,\<alpha>,P,leq)"
 
 abbreviation
   mono_seqspace_r_set (\<open>_ \<^sub><\<rightarrow>\<^bsup>_\<^esup> '(_,_')\<close> [61] 60) where
   "\<alpha> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) \<equiv> mono_seqspace_rel(##M,\<alpha>,P,leq)"
 
 lemma mono_seqspaceI[intro!]:
   includes mono_map_rules
   assumes "f: A\<rightarrow>P" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x<y \<Longrightarrow> \<langle>f`x, f`y\<rangle> \<in> leq" "Ord(A)"
   shows  "f: A \<^sub><\<rightarrow> (P,leq)"
   using ltI[OF _ Ord_in_Ord[of A], THEN [3] assms(2)] assms(1,3)
   unfolding mono_seqspace_def by auto
 
 lemma (in M_ZF_library) mono_seqspace_rel_char:
   assumes "M(A)" "M(P)" "M(leq)"
   shows "A \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) = {f\<in>A \<^sub><\<rightarrow> (P,leq). M(f)}"
   using assms mono_map_rel_char
   unfolding mono_seqspace_def mono_seqspace_rel_def by simp
 
 lemma (in M_ZF_library) mono_seqspace_relI[intro!]:
   assumes "f: A\<rightarrow>\<^bsup>M\<^esup> P" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x<y \<Longrightarrow> \<langle>f`x, f`y\<rangle> \<in> leq"
     "Ord(A)" "M(A)" "M(P)" "M(leq)"
   shows  "f: A \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq)"
   using mono_seqspace_rel_char function_space_rel_char assms by auto
 
 lemma mono_seqspace_is_fun[dest]:
   includes mono_map_rules
   shows "j: A \<^sub><\<rightarrow> (P,leq) \<Longrightarrow> j: A\<rightarrow> P"
   unfolding mono_seqspace_def by auto
 
 lemma mono_map_lt_le_is_mono[dest]:
   includes mono_map_rules
   assumes "j: A \<^sub><\<rightarrow> (P,leq)" "a\<in>A" "c\<in>A" "a\<le>c" "Ord(A)" "refl(P,leq)"
   shows "\<langle>j`a,j`c\<rangle> \<in> leq"
   using assms mono_map_increasing unfolding mono_seqspace_def refl_def
   by (cases "a=c") (auto dest:ltD)
 
 lemma (in M_ZF_library) mem_mono_seqspace_abs[absolut]:
   assumes "M(f)" "M(A)" "M(P)" "M(leq)"
   shows  "f:A \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) \<longleftrightarrow>  f: A \<^sub><\<rightarrow> (P,leq)"
   using assms mono_map_rel_char unfolding mono_seqspace_def mono_seqspace_rel_def
   by (simp)
 
 definition
   mono_map_lt_le :: "[i,i] \<Rightarrow> i" (infixr \<open>\<^sub><\<rightarrow>\<^sub>\<le>\<close> 60) where
   "\<alpha> \<^sub><\<rightarrow>\<^sub>\<le> \<beta> \<equiv> \<alpha> \<^sub><\<rightarrow> (\<beta>,lerel(\<beta>))"
 
 lemma mono_map_lt_leI[intro!]:
   includes mono_map_rules
   assumes "f: A\<rightarrow>B" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x<y \<Longrightarrow> f`x \<le> f`y" "Ord(A)" "Ord(B)"
   shows  "f: A \<^sub><\<rightarrow>\<^sub>\<le> B"
   using assms
   unfolding mono_map_lt_le_def by auto
 
 \<comment> \<open>Kunen IV.7.13, with “$\kappa$” in place of “$\lambda$”\<close>
 definition
   kappa_closed :: "[i,i,i] \<Rightarrow> o" (\<open>_-closed'(_,_')\<close>) where
   "\<kappa>-closed(P,leq) \<equiv> \<forall>\<delta>. \<delta><\<kappa> \<longrightarrow> (\<forall>f\<in>\<delta> \<^sub><\<rightarrow> (P,converse(leq)). \<exists>q\<in>P. \<forall>\<alpha>\<in>\<delta>. \<langle>q,f`\<alpha>\<rangle>\<in>leq)"
 
 relativize functional "kappa_closed" "kappa_closed_rel"
 relationalize "kappa_closed_rel" "is_kappa_closed"
 synthesize "is_kappa_closed" from_definition assuming "nonempty"
 
 abbreviation
   kappa_closed_r (\<open>_-closed\<^bsup>_\<^esup>'(_,_')\<close> [61] 60) where
   "\<kappa>-closed\<^bsup>M\<^esup>(P,leq) \<equiv> kappa_closed_rel(M,\<kappa>,P,leq)"
 
 abbreviation
   kappa_closed_r_set (\<open>_-closed\<^bsup>_\<^esup>'(_,_')\<close> [61] 60) where
   "\<kappa>-closed\<^bsup>M\<^esup>(P,leq) \<equiv> kappa_closed_rel(##M,\<kappa>,P,leq)"
 
 lemma (in forcing_data4) forcing_a_value:
   assumes "p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]" "a \<in> A"
     "q \<preceq> p" "q \<in> P" "p\<in>P" "f_dot \<in> M" "A\<in>M" "B\<in>M"
   shows "\<exists>d\<in>P. \<exists>b\<in>B. d \<preceq> q \<and> d \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]"
-    \<comment> \<open>Old neater version, but harder to use
+    (* \<comment> \<open>Old neater version, but harder to use
     (without the assumptions on \<^term>\<open>q\<close>):\<close>
-    (* "dense_below({q \<in> P. \<exists>b\<in>B. q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]}, p)" *)
+    "dense_below({q \<in> P. \<exists>b\<in>B. q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]}, p)" *)
 proof -
   from assms
   have "q \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]"
     using strengthening_lemma[of p "\<cdot>0:1\<rightarrow>2\<cdot>" q "[f_dot, A\<^sup>v, B\<^sup>v]"]
       typed_function_type arity_typed_function_fm
-    by (auto simp: union_abs2 union_abs1 check_in_M P_in_M)
+    by (auto simp: union_abs2 union_abs1)
   from \<open>a\<in>A\<close> \<open>A\<in>M\<close>
-  have "a\<in>M" by (auto dest:transM)
+  have "a\<in>M" by (auto dest:transitivity)
   from \<open>q\<in>P\<close>
   text\<open>Here we're using countability (via the existence of generic filters)
     of \<^term>\<open>M\<close> as a shortcut, to avoid a further density argument.\<close>
   obtain G where "M_generic(G)" "q\<in>G"
     using generic_filter_existence by blast
   then
   interpret G_generic4_AC _ _ _ _ _ G by unfold_locales
   include G_generic1_lemmas
   note \<open>q\<in>G\<close>
   moreover
   note \<open>q \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]\<close> \<open>M_generic(G)\<close>
   moreover
   note \<open>q\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close> \<open>A\<in>M\<close>
   moreover from this
-  have "map(val(P, G), [f_dot, A\<^sup>v, B\<^sup>v]) \<in> list(M[G])" by simp
+  have "map(val( G), [f_dot, A\<^sup>v, B\<^sup>v]) \<in> list(M[G])" by simp
   moreover from calculation
-  have "val(P,G,f_dot) : A \<rightarrow>\<^bsup>M[G]\<^esup> B"
-    using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[f_dot, A\<^sup>v, B\<^sup>v]", THEN iffD1]
-      typed_function_type arity_typed_function_fm valcheck[OF one_in_G one_in_P]
+  have "val(G,f_dot) : A \<rightarrow>\<^bsup>M[G]\<^esup> B"
+    using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" "[f_dot, A\<^sup>v, B\<^sup>v]", THEN iffD1]
+      typed_function_type arity_typed_function_fm val_check[OF one_in_G one_in_P]
     by (auto simp: union_abs2 union_abs1 ext.mem_function_space_rel_abs)
   moreover
   note \<open>a \<in> M\<close>
   moreover from calculation and \<open>a\<in>A\<close>
-  have "val(P,G,f_dot) ` a \<in> B" (is "?b \<in> B")
+  have "val(G,f_dot) ` a \<in> B" (is "?b \<in> B")
     by (simp add: ext.mem_function_space_rel_abs)
   moreover from calculation
-  have "?b \<in> M" by (auto dest:transM)
+  have "?b \<in> M" by (auto dest:transitivity)
   moreover from calculation
-  have "M[G], map(val(P,G), [f_dot, a\<^sup>v, ?b\<^sup>v]) \<Turnstile> \<cdot>0`1 is 2\<cdot>"
+  have "M[G], map(val(G), [f_dot, a\<^sup>v, ?b\<^sup>v]) \<Turnstile> \<cdot>0`1 is 2\<cdot>"
     by simp
-  moreover
-  note \<open>M_generic(G)\<close>
   ultimately
   obtain r where "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, ?b\<^sup>v]" "r\<in>G" "r\<in>P"
-    using truth_lemma[of "\<cdot>0`1 is 2\<cdot>" G "[f_dot, a\<^sup>v, ?b\<^sup>v]", THEN iffD2]
-      fun_apply_type arity_fun_apply_fm valcheck[OF one_in_G one_in_P]
+    using truth_lemma[of "\<cdot>0`1 is 2\<cdot>" "[f_dot, a\<^sup>v, ?b\<^sup>v]", THEN iffD2]
+      fun_apply_type arity_fun_apply_fm val_check[OF one_in_G one_in_P]
+      G_subset_P
     by (auto simp: union_abs2 union_abs1 ext.mem_function_space_rel_abs)
   moreover from this and \<open>q\<in>G\<close>
   obtain d where "d\<preceq>q" "d\<preceq>r" "d\<in>P" by force
   moreover
   note \<open>f_dot\<in>M\<close> \<open>a\<in>M\<close> \<open>?b\<in>B\<close> \<open>B\<in>M\<close>
   moreover from calculation
   have "d \<preceq> q \<and> d \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, ?b\<^sup>v]"
     using fun_apply_type arity_fun_apply_fm
       strengthening_lemma[of r "\<cdot>0`1 is 2\<cdot>" d "[f_dot, a\<^sup>v, ?b\<^sup>v]"]
-    by (auto dest:transM simp add: union_abs2 union_abs1)
+    by (auto dest:transitivity simp add: union_abs2 union_abs1)
   ultimately
   show ?thesis by auto
 qed
 
-context G_generic4_AC begin
+locale M_master_CH = M_master + M_library_DC
+
+sublocale M_ZFC3_ground_CH_trans \<subseteq> M_master_CH "##M"
+  using replacement_dcwit_repl_body
+  by unfold_locales (simp_all add:sep_instances del:setclass_iff
+      add: transrec_replacement_def wfrec_replacement_def dcwit_repl_body_def)
+
+context G_generic4_AC_CH begin
 
 context
   includes G_generic1_lemmas
 begin
 
 lemma separation_check_snd_aux:
   assumes "f_dot\<in>M" "\<tau>\<in>M" "\<chi>\<in>formula" "arity(\<chi>) \<le> 7"
   shows "separation(##M, \<lambda>r. M, [fst(r), P, leq, \<one>, f_dot, \<tau>, snd(r)\<^sup>v] \<Turnstile> \<chi>)"
 proof -
-  note types = assms leq_in_M P_in_M one_in_M
   let ?f_fm="fst_fm(1,0)"
-  let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
+  let ?g_fm="hcomp_fm(check_fm(6),snd_fm,2,0)"
+  note assms
+  moreover
   have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
     using ord_simp_union
-    unfolding hcomp_fm_def check_fm'_def
+    unfolding hcomp_fm_def
     by (simp_all add:arity)
-  then
+  ultimately
   show ?thesis
-    using separation_sat_after_function assms types
-    using fst_abs snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M
-    unfolding hcomp_fm_def check_fm'_def
+    using separation_sat_after_function
+    using fst_abs snd_abs sats_snd_fm sats_check_fm check_abs
+    unfolding hcomp_fm_def
     by simp
 qed
 
 lemma separation_check_fst_snd_aux :
   assumes "f_dot\<in>M" "r\<in>M" "\<chi>\<in>formula" "arity(\<chi>) \<le> 7"
   shows "separation(##M, \<lambda>p. M, [r, P, leq, \<one>, f_dot, fst(p)\<^sup>v, snd(p)\<^sup>v] \<Turnstile> \<chi>)"
 proof -
   let ?\<rho>="\<lambda>z. [r, P, leq, \<one>, f_dot, fst(z)\<^sup>v, snd(z)\<^sup>v]"
   let ?\<rho>'="\<lambda>z. [fst(z)\<^sup>v, P, leq, \<one>, f_dot, r, snd(z)\<^sup>v]"
   let ?\<phi>=" (\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>0 = 11\<cdot> \<and> \<cdot>\<cdot>1 = 7\<cdot> \<and> \<cdot>\<cdot>2 = 8\<cdot> \<and> \<cdot>\<cdot>3 = 9\<cdot> \<and> \<cdot>\<cdot>4 = 10\<cdot> \<and> \<cdot>\<cdot>5 = 6\<cdot> \<and>
     (\<lambda>p. incr_bv(p)`6)^6 (\<chi>) \<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)"
-  note types = assms leq_in_M P_in_M one_in_M
-  let ?f_fm="hcomp_fm(check_fm'(5),fst_fm,1,0)"
-  let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
+  let ?f_fm="hcomp_fm(check_fm(5),fst_fm,1,0)"
+  let ?g_fm="hcomp_fm(check_fm(6),snd_fm,2,0)"
+  note assms
+  moreover
   have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
     using ord_simp_union
-    unfolding hcomp_fm_def check_fm'_def
+    unfolding hcomp_fm_def
     by (simp_all add:arity)
   moreover from assms
   have fm:"?\<phi>\<in>formula" by simp
   moreover from \<open>\<chi> \<in> formula\<close> \<open>arity(\<chi>) \<le> 7\<close>
   have "arity(\<chi>) = 0 \<or> arity(\<chi>) = 1 \<or> arity(\<chi>) = 2 \<or> arity(\<chi>) = 3
     \<or> arity(\<chi>) = 4 \<or> arity(\<chi>) = 5 \<or> arity(\<chi>) = 6 \<or> arity(\<chi>) = 7"
     unfolding lt_def by auto
   with calculation and \<open>\<chi> \<in> formula\<close>
   have ar:"arity(?\<phi>) \<le> 7"
     using arity_incr_bv_lemma by safe (simp_all add: arity ord_simp_union)
   moreover from calculation
   have sep:"separation(##M,\<lambda>z. M,?\<rho>'(z)\<Turnstile>?\<phi>)"
-    using separation_sat_after_function assms types sats_check_fm check_abs check_in_M
+    using separation_sat_after_function sats_check_fm check_abs
       fst_abs snd_abs
-    unfolding hcomp_fm_def check_fm'_def
+    unfolding hcomp_fm_def
     by simp
-  moreover
+  moreover from assms
   have "?\<rho>(z) \<in> list(M)" if "(##M)(z)" for z
-    using types that by simp
+    using that by simp
   moreover from calculation and \<open>r \<in> M\<close> \<open>\<chi> \<in> formula\<close>
   have "(M,?\<rho>(z) \<Turnstile> \<chi>) \<longleftrightarrow> (M,?\<rho>'(z)\<Turnstile>?\<phi>)" if "(##M)(z)" for z
-    using that types sats_incr_bv_iff[of _ _ M _ "[_,_,_,_,_,_]"]
+    using that sats_incr_bv_iff[of _ _ M _ "[_,_,_,_,_,_]"]
     by simp
   ultimately
-  show ?thesis using separation_cong[THEN iffD1,OF _ sep]
+  show ?thesis
+    using separation_cong[THEN iffD1,OF _ sep]
     by simp
 qed
 
 lemma separation_leq_and_forces_apply_aux:
   assumes "f_dot\<in>M" "B\<in>M"
   shows "\<forall>n\<in>M. separation(##M, \<lambda>x. snd(x) \<preceq> fst(x) \<and>
           (\<exists>b\<in>B. M, [snd(x), P, leq, \<one>, f_dot, (\<Union>(n))\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> )))"
 proof -
   have pred_nat_closed: "pred(n)\<in>M" if "n\<in>M" for n
     using nat_case_closed that
     unfolding pred_def
     by auto
   have "separation(##M, \<lambda>z. M, [snd(fst(z)), P, leq, \<one>, f_dot, \<tau>, snd(z)\<^sup>v] \<Turnstile> \<chi>)"
     if "\<chi>\<in>formula" "arity(\<chi>) \<le> 7" "\<tau>\<in>M" for \<chi> \<tau>
   proof -
-    note types = assms leq_in_M P_in_M one_in_M
     let ?f_fm="hcomp_fm(snd_fm,fst_fm,1,0)"
-    let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
+    let ?g_fm="hcomp_fm(check_fm(6),snd_fm,2,0)"
+    note assms
+    moreover
     have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
       using ord_simp_union
-      unfolding hcomp_fm_def check_fm'_def
+      unfolding hcomp_fm_def
       by (simp_all add:arity)
-    then
+    ultimately
     show ?thesis
-      using separation_sat_after_function assms types sats_check_fm check_abs fst_abs snd_abs that
-      unfolding hcomp_fm_def check_fm'_def
+      using separation_sat_after_function sats_check_fm check_abs fst_abs snd_abs that
+      unfolding hcomp_fm_def
       by simp
   qed
-  then
+  with assms
   show ?thesis
-    using P_in_M assms
-      separation_in lam_replacement_constant lam_replacement_snd lam_replacement_fst
-      lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] leq_in_M  check_in_M pred_nat_closed
+    using separation_in lam_replacement_constant lam_replacement_snd lam_replacement_fst
+      lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] pred_nat_closed
       arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
-    by(clarify, rule_tac separation_conj,simp_all,rule_tac separation_bex,simp_all)
+    by(clarify,rule_tac separation_conj,simp_all,rule_tac separation_bex,simp_all)
 qed
 
 lemma separation_ball_leq_and_forces_apply_aux:
   assumes "f_dot\<in>M" "p\<in>M" "B\<in>M"
   shows "separation
      (##M,
       \<lambda>pa. \<forall>x\<in>P. x \<preceq> p \<longrightarrow>
             (\<forall>y\<in>P. y \<preceq> p \<longrightarrow>
               \<langle>x, y\<rangle> \<in> snd(pa) \<longleftrightarrow>
                 y \<preceq> x \<and> (\<exists>b\<in>B. M, [y, P, leq, \<one>, f_dot, (\<Union>(fst(pa)))\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))))"
 proof -
   have "separation(##M, \<lambda>z. M, [snd(fst(z)), P, leq, \<one>, f_dot, (\<Union>(fst(fst(fst(fst(z))))))\<^sup>v, snd(z)\<^sup>v] \<Turnstile> \<chi>)"
     if "\<chi>\<in>formula" "arity(\<chi>) \<le> 7" for \<chi>
   proof -
-    note types = assms leq_in_M P_in_M one_in_M
     let ?f_fm="hcomp_fm(snd_fm,fst_fm,1,0)"
     let ?g="\<lambda>z . (\<Union>(fst(fst(fst(fst(z))))))\<^sup>v"
-    let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(big_union_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)))),2,0)"
-    let ?h_fm="hcomp_fm(check_fm'(7),snd_fm,3,0)"
+    let ?g_fm="hcomp_fm(check_fm(6),hcomp_fm(big_union_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)))),2,0)"
+    let ?h_fm="hcomp_fm(check_fm(7),snd_fm,3,0)"
+    note assms
+    moreover
     have f_fm_facts:"?f_fm \<in> formula" "arity(?f_fm) \<le> 6"
       using ord_simp_union
       unfolding hcomp_fm_def
       by (simp_all add:arity)
-    moreover from types
+    moreover from assms
     have "?g_fm \<in> formula" "arity(?g_fm) \<le> 7" "?h_fm \<in> formula" "arity(?h_fm) \<le> 8"
       using ord_simp_union
-      unfolding hcomp_fm_def check_fm'_def
+      unfolding hcomp_fm_def
       by (simp_all add:arity)
     ultimately
     show ?thesis
       using separation_sat_after_function3[OF _ _ _ f_fm_facts] check_abs
-        types assms sats_check_fm that fst_abs snd_abs
-      unfolding hcomp_fm_def check_fm'_def
+        sats_check_fm that fst_abs snd_abs
+      unfolding hcomp_fm_def
       by simp
   qed
-  then
+  with assms
   show ?thesis
-    using P_in_M leq_in_M assms
+    using
       separation_ball separation_imp separation_conj separation_bex separation_in separation_iff'
       lam_replacement_constant lam_replacement_identity lam_replacement_hcomp
       lam_replacement_fst lam_replacement_snd
       lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
       lam_replacement_hcomp[OF
         lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]
         lam_replacement_snd]
       arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
       separation_in[OF _ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]]
     by simp
 qed
 
 lemma separation_closed_leq_and_forces_eq_check_aux :
   assumes "A\<in>M" "r\<in>G" "\<tau> \<in> M"
   shows "(##M)({q\<in>P. \<exists>h\<in>A. q \<preceq> r \<and> q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]})"
 proof -
   have "separation(##M, \<lambda>z. M, [fst(z), P, leq, \<one>, \<tau>, snd(z)\<^sup>v] \<Turnstile> \<chi>)" if
     "\<chi>\<in>formula" "arity(\<chi>) \<le> 6" for \<chi>
   proof -
     let ?f_fm="fst_fm(1,0)"
-    let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
-    note types = assms leq_in_M P_in_M one_in_M
+    let ?g_fm="hcomp_fm(check_fm(6),snd_fm,2,0)"
+    note assms
     moreover
     have "?f_fm \<in> formula" "arity(?f_fm) \<le> 6" "?g_fm \<in> formula" "arity(?g_fm) \<le> 7"
       using ord_simp_union
-      unfolding hcomp_fm_def check_fm'_def
+      unfolding hcomp_fm_def
       by (simp_all add:arity)
     ultimately
     show ?thesis
-      using separation_sat_after_function_1 assms sats_fst_fm that
-        fst_abs snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M
-      unfolding hcomp_fm_def check_fm'_def
+      using separation_sat_after_function_1 sats_fst_fm that
+        fst_abs snd_abs sats_snd_fm sats_check_fm check_abs
+      unfolding hcomp_fm_def
       by simp
   qed
-  then
+  with assms
   show ?thesis
     using separation_conj separation_in
       lam_replacement_constant lam_replacement_fst
       lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
-      assms leq_in_M G_subset_M[THEN subsetD] generic
+      G_subset_M[THEN subsetD]
       arity_forces[of "\<cdot>0 = 1\<cdot>",simplified] ord_simp_union
     by(rule_tac separation_closed[OF separation_bex],simp_all)
 qed
 
 lemma separation_closed_forces_apply_aux:
   assumes "B\<in>M" "f_dot\<in>M" "r\<in>M"
   shows "(##M)({\<langle>n,b\<rangle> \<in> \<omega> \<times> B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]})"
-  using nat_in_M assms check_in_M transitivity[OF _ \<open>B\<in>M\<close>] nat_into_M separation_check_fst_snd_aux
+  using nat_in_M assms transitivity[OF _ \<open>B\<in>M\<close>] nat_into_M separation_check_fst_snd_aux
     arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
   unfolding split_def
   by simp_all
 
 \<comment> \<open>Kunen IV.6.9 (3)$\Rightarrow$(2), with general domain.\<close>
 lemma kunen_IV_6_9_function_space_rel_eq:
   assumes "\<And>p \<tau>. p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [\<tau>, A\<^sup>v, B\<^sup>v] \<Longrightarrow> p\<in>P \<Longrightarrow> \<tau> \<in> M \<Longrightarrow>
     \<exists>q\<in>P. \<exists>h\<in>A \<rightarrow>\<^bsup>M\<^esup> B. q \<preceq> p \<and>  q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]" "A\<in>M" "B\<in>M"
   shows
     "A \<rightarrow>\<^bsup>M\<^esup> B = A \<rightarrow>\<^bsup>M[G]\<^esup> B"
 proof (intro equalityI; clarsimp simp add:
     assms function_space_rel_char ext.function_space_rel_char)
   fix f
   assume "f \<in> A \<rightarrow> B" "f \<in> M[G]"
   moreover from this
-  obtain \<tau> where "val(P,G,\<tau>) = f" "\<tau> \<in> M"
+  obtain \<tau> where "val(G,\<tau>) = f" "\<tau> \<in> M"
     using GenExtD by force
   moreover from calculation and \<open>A\<in>M\<close> \<open>B\<in>M\<close>
   obtain r where "r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [\<tau>, A\<^sup>v, B\<^sup>v]" "r\<in>G"
-    using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[\<tau>, A\<^sup>v, B\<^sup>v]"] generic
-      typed_function_type arity_typed_function_fm valcheck[OF one_in_G one_in_P]
+    using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" "[\<tau>, A\<^sup>v, B\<^sup>v]"]
+      typed_function_type arity_typed_function_fm val_check[OF one_in_G one_in_P]
     by (auto simp: union_abs2 union_abs1)
   moreover from \<open>A\<in>M\<close> \<open>B\<in>M\<close> \<open>r\<in>G\<close> \<open>\<tau> \<in> M\<close>
   have "{q\<in>P. \<exists>h\<in>A \<rightarrow>\<^bsup>M\<^esup> B. q \<preceq> r \<and> q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]} \<in> M" (is "?D \<in> M")
     using separation_closed_leq_and_forces_eq_check_aux by auto
   moreover from calculation and assms(2-)
   have "dense_below(?D, r)"
     using strengthening_lemma[of r "\<cdot>0:1\<rightarrow>2\<cdot>" _ "[\<tau>, A\<^sup>v, B\<^sup>v]", THEN assms(1)[of _ \<tau>]]
       leq_transD generic_dests(1)[of r]
     by (auto simp: union_abs2 union_abs1 typed_function_type arity_typed_function_fm) blast
   moreover from calculation
   obtain q h where "h\<in>A \<rightarrow>\<^bsup>M\<^esup> B" "q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]" "q \<preceq> r" "q\<in>P" "q\<in>G"
-    using generic_inter_dense_below[of ?D G r, OF _ generic] by blast
+    using generic_inter_dense_below[of ?D r] by blast
   note \<open>q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]\<close> \<open>\<tau>\<in>M\<close> \<open>h\<in>A \<rightarrow>\<^bsup>M\<^esup> B\<close> \<open>A\<in>M\<close> \<open>B\<in>M\<close> \<open>q\<in>G\<close>
   moreover from this
-  have "map(val(P, G), [\<tau>, h\<^sup>v]) \<in> list(M[G])" "h\<in>M"
-    by (auto dest:transM)
+  have "map(val(G), [\<tau>, h\<^sup>v]) \<in> list(M[G])" "h\<in>M"
+    by (auto dest:transitivity)
   ultimately
   have "h = f"
-    using truth_lemma[of "\<cdot>0=1\<cdot>" G "[\<tau>, h\<^sup>v]"] generic valcheck[OF one_in_G one_in_P]
+    using truth_lemma[of "\<cdot>0=1\<cdot>" "[\<tau>, h\<^sup>v]"] val_check[OF one_in_G one_in_P]
     by (auto simp: ord_simp_union)
   with \<open>h\<in>M\<close>
   show "f \<in> M" by simp
 qed
 
 subsection\<open>$(\omega+1)$-Closed notions preserve countable sequences\<close>
 
 \<comment> \<open>Kunen IV.7.15, only for countable sequences\<close>
 lemma succ_omega_closed_imp_no_new_nat_sequences:
   assumes "succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)" "f : \<omega> \<rightarrow> B" "f\<in>M[G]" "B\<in>M"
   shows "f\<in>M"
 proof -
   (* Nice jEdit folding level to read this: 7 *)
-  txt\<open>The next long block proves that the assumptions of Lemma
+  text\<open>The next long block proves that the assumptions of Lemma
   @{thm [source] kunen_IV_6_9_function_space_rel_eq} are satisfied.\<close>
   {
     fix p f_dot
     assume "p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]" "p\<in>P" "f_dot\<in>M"
     let ?subp="{q\<in>P. q \<preceq> p}"
     from \<open>p\<in>P\<close>
     have "?subp \<in> M"
-      using first_section_closed[of P p "converse(leq)"] leq_in_M P_in_M
-      by (auto dest:transM)
+      using first_section_closed[of P p "converse(leq)"]
+      by (auto dest:transitivity)
     define S where "S \<equiv> \<lambda>n\<in>nat.
     {\<langle>q,r\<rangle> \<in> ?subp\<times>?subp. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (\<Union>(n))\<^sup>v, b\<^sup>v])}"
       (is "S \<equiv> \<lambda>n\<in>nat. ?Y(n)")
     define S' where "S' \<equiv> \<lambda>n\<in>nat.
     {\<langle>q,r\<rangle> \<in> ?subp\<times>?subp. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (pred(n))\<^sup>v, b\<^sup>v])}"
       \<comment> \<open>Towards proving \<^term>\<open>S\<in>M\<close>.\<close>
     moreover
     have "S = S'"
       unfolding S_def S'_def using pred_nat_eq lam_cong by auto
     moreover from \<open>B\<in>M\<close> \<open>?subp\<in>M\<close> \<open>f_dot\<in>M\<close>
     have "{r \<in> ?subp. \<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (\<Union>(n))\<^sup>v, b\<^sup>v]} \<in> M" (is "?X(n) \<in> M")
       if "n\<in>\<omega>" for n
       using that separation_check_snd_aux nat_into_M ord_simp_union
         arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm
       by(rule_tac separation_closed[OF separation_bex,simplified], simp_all)
     moreover
     have "?Y(n) = (?subp \<times> ?X(n)) \<inter> converse(leq)" for n
       by (intro equalityI) auto
     moreover
     note \<open>?subp \<in> M\<close> \<open>B\<in>M\<close> \<open>p\<in>P\<close> \<open>f_dot\<in>M\<close>
     moreover from calculation
     have "n \<in> \<omega> \<Longrightarrow> ?Y(n) \<in> M" for n
-      using nat_into_M leq_in_M by simp
+      using nat_into_M by simp
     moreover from calculation
     have "S \<in> M"
       using separation_ball_leq_and_forces_apply_aux separation_leq_and_forces_apply_aux
-        transitivity[OF \<open>p\<in>P\<close> P_in_M]
+        transitivity[OF \<open>p\<in>P\<close>]
       unfolding S_def split_def
       by(rule_tac lam_replacement_Collect[THEN lam_replacement_imp_lam_closed,simplified], simp_all)
     ultimately
     have "S' \<in> M"
       by simp
     from \<open>p\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close> \<open>B\<in>M\<close>
     have exr:"\<exists>r\<in>P. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, pred(n)\<^sup>v, b\<^sup>v])"
       if "q \<preceq> p" "q\<in>P" "n\<in>\<omega>" for q n
-      using that forcing_a_value by (auto dest:transM)
+      using that forcing_a_value by (auto dest:transitivity)
     have "\<forall>q\<in>?subp. \<forall>n\<in>\<omega>. \<exists>r\<in>?subp. \<langle>q,r\<rangle> \<in> S'`n"
     proof -
       {
         fix q n
         assume "q \<in> ?subp" "n\<in>\<omega>"
         moreover from this
         have "q \<preceq> p" "q \<in> P" "pred(n) = \<Union>n"
           using pred_nat_eq by simp_all
         moreover from calculation and exr
         obtain r where MM:"r \<preceq> q" "\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, pred(n)\<^sup>v, b\<^sup>v]" "r\<in>P"
           by blast
         moreover from calculation \<open>q \<preceq> p\<close> \<open>p \<in> P\<close>
         have "r \<preceq> p"
           using leq_transD[of r q p] by auto
         ultimately
         have "\<exists>r\<in>?subp. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (pred(n))\<^sup>v, b\<^sup>v])"
           by auto
       }
       then
       show ?thesis
         unfolding S'_def by simp
     qed
     with \<open>p\<in>P\<close> \<open>?subp \<in> M\<close> \<open>S' \<in> M\<close>
     obtain g where "g \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> ?subp" "g`0 = p" "\<forall>n \<in> nat. \<langle>g`n,g`succ(n)\<rangle>\<in>S'`succ(n)"
       using sequence_DC[simplified] refl_leq[of p] by blast
     moreover from this and \<open>?subp \<in> M\<close>
     have "g : \<omega> \<rightarrow> P" "g \<in> M"
       using fun_weaken_type[of g \<omega> ?subp P] function_space_rel_char by auto
     ultimately
     have "g : \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,converse(leq))"
-      using decr_succ_decr[of g] leq_preord leq_in_M P_in_M
+      using decr_succ_decr[of g] leq_preord
       unfolding S'_def by (auto simp:absolut intro:leI)
     moreover from \<open>succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)\<close> and this
     have "\<exists>q\<in>M. q \<in> P \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> q \<preceq> g ` \<alpha>)"
-      using transM[simplified, of g] leq_in_M
-        mono_seqspace_rel_closed[of \<omega> _ "converse(leq)"]
+      using transitivity[simplified, of g] mono_seqspace_rel_closed[of \<omega> _ "converse(leq)"]
       unfolding kappa_closed_rel_def
       by auto
     ultimately
     obtain r where "r\<in>P" "r\<in>M" "\<forall>n\<in>\<omega>. r \<preceq> g`n"
       using nat_into_M by auto
     with \<open>g`0 = p\<close>
     have "r \<preceq> p"
       by blast
     let ?h="{\<langle>n,b\<rangle> \<in> \<omega> \<times> B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]}"
     have "function(?h)"
     proof (rule_tac functionI, rule_tac ccontr, auto simp del: app_Cons)
       fix n b b'
       assume "n \<in> \<omega>" "b \<noteq> b'" "b \<in> B" "b' \<in> B"
       moreover
       assume "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]" "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b'\<^sup>v]"
       moreover
       note \<open>r \<in> P\<close>
       moreover from this
       have "\<not> r \<bottom> r"
         by (auto intro!:refl_leq)
       moreover
       note \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close>
       ultimately
       show False
         using forces_neq_apply_imp_incompatible[of r f_dot "n\<^sup>v" b r b']
-          transM[of _ B] by (auto dest:transM)
+          transitivity[of _ B] by (auto dest:transitivity)
     qed
     moreover
     have "range(?h) \<subseteq> B"
       by auto
     moreover
     have "domain(?h) = \<omega>"
     proof -
       {
         fix n
         assume "n \<in> \<omega>"
         moreover from this
         have 1:"(\<Union>(n)) = pred(n)"
           using pred_nat_eq by simp
         moreover from calculation and \<open>\<forall>n \<in> nat. \<langle>g`n,g`succ(n)\<rangle>\<in>S'`succ(n)\<close>
         obtain b where "g`(succ(n)) \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]" "b\<in>B"
           unfolding S'_def by auto
         moreover from \<open>B\<in>M\<close> and calculation
         have "b \<in> M" "n \<in> M"
-          by (auto dest:transM)
+          by (auto dest:transitivity)
         moreover
         note \<open>g : \<omega> \<rightarrow> P\<close> \<open>\<forall>n\<in>\<omega>. r \<preceq> g`n\<close> \<open>r\<in>P\<close> \<open>f_dot\<in>M\<close>
         moreover from calculation
         have "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]"
           using fun_apply_type arity_fun_apply_fm
             strengthening_lemma[of "g`succ(n)" "\<cdot>0`1 is 2\<cdot>" r "[f_dot, n\<^sup>v, b\<^sup>v]"]
           by (simp add: union_abs2 union_abs1)
         ultimately
         have "\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]"
           by auto
       }
       then
       show ?thesis
         by force
     qed
     moreover
     have "relation(?h)"
       unfolding relation_def by simp
     moreover from \<open>f_dot\<in>M\<close> \<open>r\<in>M\<close> \<open>B\<in>M\<close>
     have "?h \<in> M"
       using separation_closed_forces_apply_aux by simp
     moreover
     note \<open>B \<in> M\<close>
     ultimately
     have "?h: \<omega> \<rightarrow>\<^bsup>M\<^esup> B"
       using function_imp_Pi[THEN fun_weaken_type[of ?h _ "range(?h)" B]]
         function_space_rel_char by simp
     moreover
     note \<open>p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close> \<open>r \<preceq> p\<close> \<open>r\<in>P\<close> \<open>p\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close>
     moreover from this
     have "r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]"
       using strengthening_lemma[of p "\<cdot>0:1\<rightarrow>2\<cdot>" r "[f_dot, \<omega>\<^sup>v, B\<^sup>v]"]
         typed_function_type arity_typed_function_fm
       by (auto simp: union_abs2 union_abs1)
     moreover
     note \<open>?h\<in>M\<close>
     moreover from calculation
     have "r \<tturnstile> \<cdot>0 = 1\<cdot> [f_dot, ?h\<^sup>v]"
     proof (intro definition_of_forcing[THEN iffD2] allI impI,
         simp_all add:union_abs2 union_abs1 del:app_Cons)
-      fix G
-      let ?f="val(P,G,f_dot)"
-      assume "M_generic(G) \<and> r \<in> G"
+      fix H
+      let ?f="val(H,f_dot)"
+      assume "M_generic(H) \<and> r \<in> H"
       moreover from this
-      interpret g:G_generic1 _ _ _ _ _ G
+      interpret g:G_generic1 _ _ _ _ _ H
         by unfold_locales simp
       note \<open>r\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close>
-      moreover from this
-      have "map(val(P, G), [f_dot, \<omega>\<^sup>v, B\<^sup>v]) \<in> list(M[G])"
-        by simp
-      moreover from calculation and \<open>r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close>
+      moreover from calculation
+      have "map(val(H), [f_dot, \<omega>\<^sup>v, B\<^sup>v]) \<in> list(M[H])" "r\<in>H"
+        by simp_all
+      moreover from calculation and \<open>r\<in>H\<close> and \<open>r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close>
       have "?f : \<omega> \<rightarrow> B"
-        using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[f_dot, \<omega>\<^sup>v, B\<^sup>v]"] one_in_G one_in_P
-          typed_function_type arity_typed_function_fm valcheck
+        using g.truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" "[f_dot, \<omega>\<^sup>v, B\<^sup>v]",THEN iffD1] g.one_in_G one_in_P
+          typed_function_type arity_typed_function_fm val_check
         by (auto simp: union_abs2 union_abs1)
       moreover
       have "?h`n = ?f`n" if "n \<in> \<omega>" for n
       proof -
         note \<open>n \<in> \<omega>\<close> \<open>domain(?h) = \<omega>\<close>
         moreover from this
         have "n\<in>domain(?h)"
           by simp
         moreover from this
         obtain b where "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]" "b\<in>B"
           by force
         moreover
         note \<open>function(?h)\<close>
         moreover from calculation
         have "b = ?h`n"
           using function_apply_equality by simp
         moreover
         note \<open>B \<in> M\<close>
         moreover from calculation
         have "?h`n \<in> M"
-          by (auto dest:transM)
+          by (auto dest:transitivity)
         moreover
-        note \<open>f_dot \<in> M\<close> \<open>r \<in> P\<close> \<open>M_generic(G) \<and> r \<in> G\<close> \<open>map(val(P, G), [f_dot, \<omega>\<^sup>v, B\<^sup>v]) \<in> list(M[G])\<close>
+        note \<open>f_dot \<in> M\<close> \<open>r \<in> P\<close> \<open>M_generic(H) \<and> r \<in> H\<close> \<open>map(val(H), [f_dot, \<omega>\<^sup>v, B\<^sup>v]) \<in> list(M[H])\<close>
         moreover from calculation
-        have "[?f, n, ?h`n] \<in> list(M[G])"
-          using M_subset_MG nat_into_M[of n] one_in_G by (auto dest:transM)
+        have "[?f, n, ?h`n] \<in> list(M[H])"
+          using M_subset_MG nat_into_M[of n] g.one_in_G by (auto dest:transitivity)
         ultimately
         show ?thesis
           using definition_of_forcing[of r "\<cdot>0`1 is 2\<cdot>" "[f_dot, n\<^sup>v, b\<^sup>v]",
-              THEN iffD1, rule_format, of G]\<comment> \<open>without this line is slower\<close>
-            valcheck one_in_G one_in_P nat_into_M
-          by (auto dest:transM simp add:fun_apply_type
+              THEN iffD1, rule_format, of H]\<comment> \<open>without this line is slower\<close>
+            val_check g.one_in_G one_in_P nat_into_M
+          by (auto dest:transitivity simp add:fun_apply_type
               arity_fun_apply_fm union_abs2 union_abs1)
       qed
       with calculation and \<open>B\<in>M\<close> \<open>?h: \<omega> \<rightarrow>\<^bsup>M\<^esup> B\<close>
       have "?h = ?f"
         using function_space_rel_char
         by (rule_tac fun_extension[of ?h \<omega> "\<lambda>_.B" ?f]) auto
       ultimately
-      show "?f = val(P, G, ?h\<^sup>v)"
-        using valcheck one_in_G one_in_P generic by simp
+      show "?f = val(H, ?h\<^sup>v)"
+        using val_check g.one_in_G one_in_P generic by simp
     qed
     ultimately
     have "\<exists>r\<in>P. \<exists>h\<in>\<omega> \<rightarrow>\<^bsup>M\<^esup> B. r \<preceq> p \<and> r \<tturnstile> \<cdot>0 = 1\<cdot> [f_dot, h\<^sup>v]"
       by blast
   }
   moreover
   note \<open>B \<in> M\<close> assms
   moreover from calculation
   have "f : \<omega> \<rightarrow>\<^bsup>M\<^esup> B"
     using kunen_IV_6_9_function_space_rel_eq function_space_rel_char
       ext.mem_function_space_rel_abs by auto
   ultimately
   show ?thesis
-    by (auto dest:transM)
+    by (auto dest:transitivity)
 qed
 
 declare mono_seqspace_rel_closed[rule del]
   \<comment> \<open>Mysteriously breaks the end of the next proof\<close>
 
 lemma succ_omega_closed_imp_no_new_reals:
   assumes "succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)"
   shows "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2 = \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
 proof -
   from assms
   have "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2 \<subseteq> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
     using succ_omega_closed_imp_no_new_nat_sequences function_space_rel_char
       ext.function_space_rel_char Aleph_rel_succ Aleph_rel_zero
     by auto
   then
   show ?thesis
     using function_space_rel_transfer by (intro equalityI) auto
 qed
 
 lemma succ_omega_closed_imp_Aleph_1_preserved:
   assumes "succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)"
   shows "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
 proof -
   have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
   proof (rule ccontr)
     assume "\<not> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     then
     have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
       \<comment> \<open>Ridiculously complicated proof\<close>
       using Card_rel_is_Ord ext.Card_rel_is_Ord
         not_le_iff_lt[THEN iffD1] by auto
     then
     have "|\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>|\<^bsup>M[G]\<^esup> \<le> \<omega>"
       using ext.Card_rel_lt_csucc_rel_iff ext.Aleph_rel_zero
         ext.Aleph_rel_succ ext.Card_rel_nat
       by (auto intro!:ext.lt_csucc_rel_iff[THEN iffD1]
           intro:Card_rel_Aleph_rel[THEN Card_rel_is_Ord, of 1])
     then
     obtain f where "f \<in> inj(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>,\<omega>)" "f \<in> M[G]"
       using ext.countable_rel_iff_cardinal_rel_le_nat[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>", THEN iffD2]
       unfolding countable_rel_def lepoll_rel_def
       by auto
     then
     obtain g where "g \<in> surj\<^bsup>M[G]\<^esup>(\<omega>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)"
       using ext.inj_rel_imp_surj_rel[of f _ \<omega>, OF _ zero_lt_Aleph_rel1[THEN ltD]]
       by auto
     moreover from this
     have "g : \<omega> \<rightarrow> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "g \<in> M[G]"
       using ext.surj_rel_char surj_is_fun by simp_all
     moreover
     note \<open>succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)\<close>
     ultimately
     have "g \<in> surj\<^bsup>M\<^esup>(\<omega>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "g \<in> M"
       using succ_omega_closed_imp_no_new_nat_sequences
         mem_surj_abs ext.mem_surj_abs by simp_all
     then
     show False
       using surj_rel_implies_cardinal_rel_le[of g \<omega> "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"]
         Card_rel_nat[THEN Card_rel_cardinal_rel_eq] Card_rel_is_Ord
         not_le_iff_lt[THEN iffD2, OF _ _ nat_lt_Aleph_rel1]
       by simp
   qed
   then
   show ?thesis
     using Aleph_rel_le_Aleph_rel
     by (rule_tac le_anti_sym) simp
 qed
 
 end \<comment> \<open>bundle G\_generic1\_lemmas\<close>
 
 end \<comment> \<open>\<^locale>\<open>G_generic4_AC\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Names.thy b/thys/Independence_CH/Names.thy
--- a/thys/Independence_CH/Names.thy
+++ b/thys/Independence_CH/Names.thy
@@ -1,634 +1,637 @@
 section\<open>Names and generic extensions\<close>
 
 theory Names
   imports
     Forcing_Data
     FrecR_Arities
+    ZF_Trans_Interpretations
 begin
 
 definition
-  Hv :: "[i,i,i,i]\<Rightarrow>i" where
-  "Hv(P,G,x,f) \<equiv> { z . y\<in> domain(x), (\<exists>p\<in>P. \<langle>y,p\<rangle> \<in> x \<and> p \<in> G) \<and> z=f`y}"
+  Hv :: "[i,i,i]\<Rightarrow>i" where
+  "Hv(G,x,f) \<equiv> { z . y\<in> domain(x), (\<exists>p\<in>G. \<langle>y,p\<rangle> \<in> x) \<and> z=f`y}"
 
 text\<open>The funcion \<^term>\<open>val\<close> interprets a name in \<^term>\<open>M\<close>
 according to a (generic) filter \<^term>\<open>G\<close>. Note the definition
 in terms of the well-founded recursor.\<close>
 
 definition
-  val :: "[i,i,i]\<Rightarrow>i" where
-  "val(P,G,\<tau>) \<equiv> wfrec(edrel(eclose({\<tau>})), \<tau> ,Hv(P,G))"
+  val :: "[i,i]\<Rightarrow>i" where
+  "val(G,\<tau>) \<equiv> wfrec(edrel(eclose({\<tau>})), \<tau> ,Hv(G))"
 
 definition
-  GenExt :: "[i,i,i]\<Rightarrow>i"     ("_\<^bsup>_\<^esup>[_]" [71,1])
-  where "M\<^bsup>P\<^esup>[G] \<equiv> {val(P,G,\<tau>). \<tau> \<in> M}"
+  GenExt :: "[i,i]\<Rightarrow>i"     ("_[_]" [71,1])
+  where "M[G] \<equiv> {val(G,\<tau>). \<tau> \<in> M}"
 
-abbreviation (in forcing_notion)
-  GenExt_at_P :: "i\<Rightarrow>i\<Rightarrow>i"     ("_[_]" [71,1])
-  where "M[G] \<equiv> M\<^bsup>P\<^esup>[G]"
+lemma map_val_in_MG:
+  assumes
+    "env\<in>list(M)"
+  shows
+    "map(val(G),env)\<in>list(M[G])"
+  unfolding GenExt_def using assms map_type2 by simp
 
 subsection\<open>Values and check-names\<close>
 context forcing_data1
 begin
 
+lemma name_components_in_M:
+  assumes "\<langle>\<sigma>,p\<rangle>\<in>\<theta>" "\<theta> \<in> M"
+  shows   "\<sigma>\<in>M" "p\<in>M"
+  using assms transitivity pair_in_M_iff
+  by auto
+
 definition
   Hcheck :: "[i,i] \<Rightarrow> i" where
   "Hcheck(z,f)  \<equiv> { \<langle>f`y,\<one>\<rangle> . y \<in> z}"
 
 definition
   check :: "i \<Rightarrow> i" where
   "check(x) \<equiv> transrec(x , Hcheck)"
 
 lemma checkD:
   "check(x) =  wfrec(Memrel(eclose({x})), x, Hcheck)"
   unfolding check_def transrec_def ..
 
 lemma Hcheck_trancl:"Hcheck(y, restrict(f,Memrel(eclose({x}))-``{y}))
                    = Hcheck(y, restrict(f,(Memrel(eclose({x}))^+)-``{y}))"
   unfolding Hcheck_def
   using restrict_trans_eq by simp
 
 lemma check_trancl: "check(x) = wfrec(rcheck(x), x, Hcheck)"
   using checkD wf_eq_trancl Hcheck_trancl unfolding rcheck_def by simp
 
 lemma rcheck_in_M : "x \<in> M \<Longrightarrow> rcheck(x) \<in> M"
   unfolding rcheck_def by (simp flip: setclass_iff)
 
+lemma rcheck_subset_M : "x \<in> M \<Longrightarrow> field(rcheck(x)) \<subseteq> eclose({x})"
+  unfolding rcheck_def using field_Memrel field_trancl by auto
+
 lemma  aux_def_check: "x \<in> y \<Longrightarrow>
   wfrec(Memrel(eclose({y})), x, Hcheck) =
   wfrec(Memrel(eclose({x})), x, Hcheck)"
   by (rule wfrec_eclose_eq,auto simp add: arg_into_eclose eclose_sing)
 
 lemma def_check : "check(y) = { \<langle>check(w),\<one>\<rangle> . w \<in> y}"
 proof -
   let
     ?r="\<lambda>y. Memrel(eclose({y}))"
   have wfr:   "\<forall>w . wf(?r(w))"
     using wf_Memrel ..
   then
   have "check(y)= Hcheck( y, \<lambda>x\<in>?r(y) -`` {y}. wfrec(?r(y), x, Hcheck))"
     using wfrec[of "?r(y)" y "Hcheck"] checkD by simp
   also
   have " ... = Hcheck( y, \<lambda>x\<in>y. wfrec(?r(y), x, Hcheck))"
     using under_Memrel_eclose arg_into_eclose by simp
   also
   have " ... = Hcheck( y, \<lambda>x\<in>y. check(x))"
     using aux_def_check checkD by simp
   finally
   show ?thesis
     using Hcheck_def by simp
 qed
 
 lemma def_checkS :
   fixes n
   assumes "n \<in> nat"
   shows "check(succ(n)) = check(n) \<union> {\<langle>check(n),\<one>\<rangle>}"
 proof -
   have "check(succ(n)) = {\<langle>check(i),\<one>\<rangle> . i \<in> succ(n)} "
     using def_check by blast
   also
   have "... = {\<langle>check(i),\<one>\<rangle> . i \<in> n} \<union> {\<langle>check(n),\<one>\<rangle>}"
     by blast
   also
   have "... = check(n) \<union> {\<langle>check(n),\<one>\<rangle>}"
     using def_check[of n,symmetric] by simp
   finally
   show ?thesis .
 qed
 
 lemma field_Memrel2 :
   assumes "x \<in> M"
   shows "field(Memrel(eclose({x}))) \<subseteq> M"
 proof -
   have "field(Memrel(eclose({x}))) \<subseteq> eclose({x})" "eclose({x}) \<subseteq> M"
     using Ordinal.Memrel_type field_rel_subset assms eclose_least[OF trans_M] by auto
   then
   show ?thesis
     using subset_trans by simp
 qed
 
 lemma aux_def_val:
   assumes "z \<in> domain(x)"
-  shows "wfrec(edrel(eclose({x})),z,Hv(P,G)) = wfrec(edrel(eclose({z})),z,Hv(P,G))"
+  shows "wfrec(edrel(eclose({x})),z,Hv(G)) = wfrec(edrel(eclose({z})),z,Hv(G))"
 proof -
   let ?r="\<lambda>x . edrel(eclose({x}))"
   have "z\<in>eclose({z})"
     using arg_in_eclose_sing .
   moreover
   have "relation(?r(x))"
     using relation_edrel .
   moreover
   have "wf(?r(x))"
     using wf_edrel .
   moreover from assms
   have "tr_down(?r(x),z) \<subseteq> eclose({z})"
     using tr_edrel_subset by simp
   ultimately
-  have "wfrec(?r(x),z,Hv(P,G)) = wfrec[eclose({z})](?r(x),z,Hv(P,G))"
+  have "wfrec(?r(x),z,Hv(G)) = wfrec[eclose({z})](?r(x),z,Hv(G))"
     using wfrec_restr by simp
   also from \<open>z\<in>domain(x)\<close>
-  have "... = wfrec(?r(z),z,Hv(P,G))"
+  have "... = wfrec(?r(z),z,Hv(G))"
     using restrict_edrel_eq wfrec_restr_eq by simp
   finally
   show ?thesis .
 qed
 
-text\<open>The next lemma provides the usual recursive expresion for the definition of term\<open>val\<close>.\<close>
+text\<open>The next lemma provides the usual recursive expresion for the definition of \<^term>\<open>val\<close>.\<close>
 
-lemma def_val:  "val(P,G,x) = {z . t\<in>domain(x) , (\<exists>p\<in>P .  \<langle>t,p\<rangle>\<in>x \<and> p \<in> G) \<and> z=val(P,G,t)}"
+lemma def_val:  "val(G,x) = {z . t\<in>domain(x) , (\<exists>p\<in>G .  \<langle>t,p\<rangle>\<in>x) \<and> z=val(G,t)}"
 proof -
   let
     ?r="\<lambda>\<tau> . edrel(eclose({\<tau>}))"
   let
-    ?f="\<lambda>z\<in>?r(x)-``{x}. wfrec(?r(x),z,Hv(P,G))"
+    ?f="\<lambda>z\<in>?r(x)-``{x}. wfrec(?r(x),z,Hv(G))"
   have "\<forall>\<tau>. wf(?r(\<tau>))"
     using wf_edrel by simp
   with wfrec [of _ x]
-  have "val(P,G,x) = Hv(P,G,x,?f)"
+  have "val(G,x) = Hv(G,x,?f)"
     using val_def by simp
   also
-  have " ... = Hv(P,G,x,\<lambda>z\<in>domain(x). wfrec(?r(x),z,Hv(P,G)))"
+  have " ... = Hv(G,x,\<lambda>z\<in>domain(x). wfrec(?r(x),z,Hv(G)))"
     using dom_under_edrel_eclose by simp
   also
-  have " ... = Hv(P,G,x,\<lambda>z\<in>domain(x). val(P,G,z))"
+  have " ... = Hv(G,x,\<lambda>z\<in>domain(x). val(G,z))"
     using aux_def_val val_def by simp
   finally
   show ?thesis
     using Hv_def by simp
 qed
 
-lemma val_mono : "x\<subseteq>y \<Longrightarrow> val(P,G,x) \<subseteq> val(P,G,y)"
+lemma val_mono : "x\<subseteq>y \<Longrightarrow> val(G,x) \<subseteq> val(G,y)"
   by (subst (1 2) def_val, force)
 
 text\<open>Check-names are the canonical names for elements of the
 ground model. Here we show that this is the case.\<close>
 
-lemma valcheck : "\<one> \<in> G \<Longrightarrow>  \<one> \<in> P \<Longrightarrow> val(P,G,check(y))  = y"
+lemma val_check : "\<one> \<in> G \<Longrightarrow>  \<one> \<in> P \<Longrightarrow> val(G,check(y))  = y"
 proof (induct rule:eps_induct)
   case (1 y)
   then show ?case
   proof -
     have "check(y) = { \<langle>check(w), \<one>\<rangle> . w \<in> y}"  (is "_ = ?C")
       using def_check .
     then
-    have "val(P,G,check(y)) = val(P,G, {\<langle>check(w), \<one>\<rangle> . w \<in> y})"
+    have "val(G,check(y)) = val(G, {\<langle>check(w), \<one>\<rangle> . w \<in> y})"
       by simp
     also
-    have " ...  = {z . t\<in>domain(?C) , (\<exists>p\<in>P .  \<langle>t, p\<rangle>\<in>?C \<and> p \<in> G) \<and> z=val(P,G,t) }"
+    have " ...  = {z . t\<in>domain(?C) , (\<exists>p\<in>G .  \<langle>t, p\<rangle>\<in>?C ) \<and> z=val(G,t) }"
       using def_val by blast
     also
-    have " ... =  {z . t\<in>domain(?C) , (\<exists>w\<in>y. t=check(w)) \<and> z=val(P,G,t) }"
+    have " ... =  {z . t\<in>domain(?C) , (\<exists>w\<in>y. t=check(w)) \<and> z=val(G,t) }"
       using 1 by simp
     also
-    have " ... = {val(P,G,check(w)) . w\<in>y }"
+    have " ... = {val(G,check(w)) . w\<in>y }"
       by force
     finally
-    show "val(P,G,check(y)) = y"
+    show "val(G,check(y)) = y"
       using 1 by simp
   qed
 qed
 
 lemma val_of_name :
-  "val(P,G,{x\<in>A\<times>P. Q(x)}) = {z . t\<in>A , (\<exists>p\<in>P .  Q(\<langle>t,p\<rangle>) \<and> p \<in> G) \<and> z=val(P,G,t)}"
+  "val(G,{x\<in>A\<times>P. Q(x)}) = {z . t\<in>A , (\<exists>p\<in>P .  Q(\<langle>t,p\<rangle>) \<and> p \<in> G) \<and> z=val(G,t)}"
 proof -
   let
     ?n="{x\<in>A\<times>P. Q(x)}" and
     ?r="\<lambda>\<tau> . edrel(eclose({\<tau>}))"
   let
-    ?f="\<lambda>z\<in>?r(?n)-``{?n}. val(P,G,z)"
+    ?f="\<lambda>z\<in>?r(?n)-``{?n}. val(G,z)"
   have
     wfR : "wf(?r(\<tau>))" for \<tau>
     by (simp add: wf_edrel)
   have "domain(?n) \<subseteq> A" by auto
   { fix t
     assume H:"t \<in> domain({x \<in> A \<times> P . Q(x)})"
-    then have "?f ` t = (if t \<in> ?r(?n)-``{?n} then val(P,G,t) else 0)"
+    then have "?f ` t = (if t \<in> ?r(?n)-``{?n} then val(G,t) else 0)"
       by simp
-    moreover have "... = val(P,G,t)"
+    moreover have "... = val(G,t)"
       using dom_under_edrel_eclose H if_P by auto
   }
   then
-  have Eq1: "t \<in> domain({x \<in> A \<times> P . Q(x)}) \<Longrightarrow> val(P,G,t) = ?f` t"  for t
+  have Eq1: "t \<in> domain({x \<in> A \<times> P . Q(x)}) \<Longrightarrow> val(G,t) = ?f` t"  for t
     by simp
-  have "val(P,G,?n) = {z . t\<in>domain(?n), (\<exists>p \<in> P . \<langle>t,p\<rangle> \<in> ?n \<and> p \<in> G) \<and> z=val(P,G,t)}"
+  have "val(G,?n) = {z . t\<in>domain(?n), (\<exists>p \<in> G . \<langle>t,p\<rangle> \<in> ?n) \<and> z=val(G,t)}"
     by (subst def_val,simp)
   also
   have "... = {z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=?f`t}"
     unfolding Hv_def
     by (auto simp add:Eq1)
   also
-  have "... = {z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=(if t\<in>?r(?n)-``{?n} then val(P,G,t) else 0)}"
+  have "... = {z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=(if t\<in>?r(?n)-``{?n} then val(G,t) else 0)}"
     by (simp)
   also
-  have "... = { z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(P,G,t)}"
+  have "... = { z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(G,t)}"
   proof -
     have "domain(?n) \<subseteq> ?r(?n)-``{?n}"
       using dom_under_edrel_eclose by simp
     then
-    have "\<forall>t\<in>domain(?n). (if t\<in>?r(?n)-``{?n} then val(P,G,t) else 0) = val(P,G,t)"
+    have "\<forall>t\<in>domain(?n). (if t\<in>?r(?n)-``{?n} then val(G,t) else 0) = val(G,t)"
       by auto
     then
-    show "{ z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=(if t\<in>?r(?n)-``{?n} then val(P,G,t) else 0)} =
-          { z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(P,G,t)}"
+    show "{ z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=(if t\<in>?r(?n)-``{?n} then val(G,t) else 0)} =
+          { z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(G,t)}"
       by auto
   qed
   also
-  have " ... = { z . t\<in>A, (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(P,G,t)}"
+  have " ... = { z . t\<in>A, (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(G,t)}"
     by force
   finally
-  show " val(P,G,?n)  = { z . t\<in>A, (\<exists>p\<in>P . Q(\<langle>t,p\<rangle>) \<and> p\<in>G) \<and> z=val(P,G,t)}"
+  show " val(G,?n)  = { z . t\<in>A, (\<exists>p\<in>P . Q(\<langle>t,p\<rangle>) \<and> p\<in>G) \<and> z=val(G,t)}"
     by auto
 qed
 
 lemma val_of_name_alt :
-  "val(P,G,{x\<in>A\<times>P. Q(x)}) = {z . t\<in>A , (\<exists>p\<in>P\<inter>G .  Q(\<langle>t,p\<rangle>)) \<and> z=val(P,G,t) }"
+  "val(G,{x\<in>A\<times>P. Q(x)}) = {z . t\<in>A , (\<exists>p\<in>P\<inter>G .  Q(\<langle>t,p\<rangle>)) \<and> z=val(G,t) }"
   using val_of_name by force
 
-lemma val_only_names: "val(P,F,\<tau>) = val(P,F,{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>P. x=\<langle>t,p\<rangle>})"
-  (is "_ = val(P,F,?name)")
+lemma val_only_names: "val(F,\<tau>) = val(F,{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>F. x=\<langle>t,p\<rangle>})"
+  (is "_ = val(F,?name)")
 proof -
-  have "val(P,F,?name) = {z . t\<in>domain(?name), (\<exists>p\<in>P. \<langle>t, p\<rangle> \<in> ?name \<and> p \<in> F) \<and> z=val(P,F, t)}"
+  have "val(F,?name) = {z . t\<in>domain(?name), (\<exists>p\<in>F. \<langle>t, p\<rangle> \<in> ?name) \<and> z=val(F, t)}"
     using def_val by blast
   also
-  have " ... = {val(P,F, t). t\<in>{y\<in>domain(\<tau>). \<exists>p\<in>P. \<langle>y, p\<rangle> \<in> \<tau> \<and> p \<in> F}}"
+  have " ... = {val(F, t). t\<in>{y\<in>domain(\<tau>). \<exists>p\<in>F. \<langle>y, p\<rangle> \<in> \<tau> }}"
     by blast
   also
-  have " ... = {z . t\<in>domain(\<tau>), (\<exists>p\<in>P. \<langle>t, p\<rangle> \<in> \<tau> \<and> p \<in> F) \<and> z=val(P,F, t)}"
+  have " ... = {z . t\<in>domain(\<tau>), (\<exists>p\<in>F. \<langle>t, p\<rangle> \<in> \<tau>) \<and> z=val(F, t)}"
     by blast
   also
-  have " ... = val(P,F, \<tau>)"
+  have " ... = val(F, \<tau>)"
     using def_val[symmetric] by blast
   finally
   show ?thesis ..
 qed
 
-lemma val_only_pairs: "val(P,F,\<tau>) = val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})"
+lemma val_only_pairs: "val(F,\<tau>) = val(F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})"
 proof
-  have "val(P,F,\<tau>) = val(P,F,{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>P. x=\<langle>t,p\<rangle>})" (is "_ = val(P,F,?name)")
+  have "val(F,\<tau>) = val(F,{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>F. x=\<langle>t,p\<rangle>})" (is "_ = val(F,?name)")
     using val_only_names .
   also
-  have "... \<subseteq> val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})"
+  have "... \<subseteq> val(F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})"
     using val_mono[of ?name "{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}"] by auto
   finally
-  show "val(P,F,\<tau>) \<subseteq> val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})" by simp
+  show "val(F,\<tau>) \<subseteq> val(F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})" by simp
 next
-  show "val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}) \<subseteq> val(P,F,\<tau>)"
+  show "val(F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}) \<subseteq> val(F,\<tau>)"
     using val_mono[of "{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}"] by auto
 qed
 
-lemma val_subset_domain_times_range: "val(P,F,\<tau>) \<subseteq> val(P,F,domain(\<tau>)\<times>range(\<tau>))"
+lemma val_subset_domain_times_range: "val(F,\<tau>) \<subseteq> val(F,domain(\<tau>)\<times>range(\<tau>))"
   using val_only_pairs[THEN equalityD1]
     val_mono[of "{x \<in> \<tau> . \<exists>t p. x = \<langle>t, p\<rangle>}" "domain(\<tau>)\<times>range(\<tau>)"] by blast
 
-lemma val_subset_domain_times_P: "val(P,F,\<tau>) \<subseteq> val(P,F,domain(\<tau>)\<times>P)"
-  using val_only_names[of F \<tau>] val_mono[of "{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>P. x=\<langle>t,p\<rangle>}" "domain(\<tau>)\<times>P" F]
-  by auto
-
-lemma val_of_elem: "\<langle>\<theta>,p\<rangle> \<in> \<pi> \<Longrightarrow> p\<in>G \<Longrightarrow> p\<in>P \<Longrightarrow> val(P,G,\<theta>) \<in> val(P,G,\<pi>)"
+lemma val_of_elem: "\<langle>\<theta>,p\<rangle> \<in> \<pi> \<Longrightarrow> p\<in>G \<Longrightarrow> val(G,\<theta>) \<in> val(G,\<pi>)"
 proof -
   assume "\<langle>\<theta>,p\<rangle> \<in> \<pi>"
   then
   have "\<theta>\<in>domain(\<pi>)"
     by auto
-  assume "p\<in>G" "p\<in>P"
+  assume "p\<in>G"
   with \<open>\<theta>\<in>domain(\<pi>)\<close> \<open>\<langle>\<theta>,p\<rangle> \<in> \<pi>\<close>
-  have "val(P,G,\<theta>) \<in> {z . t\<in>domain(\<pi>) , (\<exists>p\<in>P .  \<langle>t, p\<rangle>\<in>\<pi> \<and> p \<in> G) \<and> z=val(P,G,t) }"
+  have "val(G,\<theta>) \<in> {z . t\<in>domain(\<pi>) , (\<exists>p\<in>G .  \<langle>t, p\<rangle>\<in>\<pi>) \<and> z=val(G,t) }"
     by auto
   then
   show ?thesis
     by (subst def_val)
 qed
 
-lemma elem_of_val: "x\<in>val(P,G,\<pi>) \<Longrightarrow> \<exists>\<theta>\<in>domain(\<pi>). val(P,G,\<theta>) = x"
+lemma elem_of_val: "x\<in>val(G,\<pi>) \<Longrightarrow> \<exists>\<theta>\<in>domain(\<pi>). val(G,\<theta>) = x"
   by (subst (asm) def_val,auto)
 
-lemma elem_of_val_pair: "x\<in>val(P,G,\<pi>) \<Longrightarrow> \<exists>\<theta>. \<exists>p\<in>G.  \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x"
+lemma elem_of_val_pair: "x\<in>val(G,\<pi>) \<Longrightarrow> \<exists>\<theta>. \<exists>p\<in>G.  \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(G,\<theta>) = x"
   by (subst (asm) def_val,auto)
 
 lemma elem_of_val_pair':
-  assumes "\<pi>\<in>M" "x\<in>val(P,G,\<pi>)"
-  shows "\<exists>\<theta>\<in>M. \<exists>p\<in>G.  \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x"
+  assumes "\<pi>\<in>M" "x\<in>val(G,\<pi>)"
+  shows "\<exists>\<theta>\<in>M. \<exists>p\<in>G.  \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(G,\<theta>) = x"
 proof -
   from assms
-  obtain \<theta> p where "p\<in>G" "\<langle>\<theta>,p\<rangle>\<in>\<pi>" "val(P,G,\<theta>) = x"
+  obtain \<theta> p where "p\<in>G" "\<langle>\<theta>,p\<rangle>\<in>\<pi>" "val(G,\<theta>) = x"
     using elem_of_val_pair by blast
   moreover from this \<open>\<pi>\<in>M\<close>
   have "\<theta>\<in>M"
     using pair_in_M_iff[THEN iffD1, THEN conjunct1, simplified]
       transitivity by blast
   ultimately
   show ?thesis
     by blast
 qed
 
-
-lemma GenExtD: "x \<in> M[G] \<Longrightarrow> \<exists>\<tau>\<in>M. x = val(P,G,\<tau>)"
+lemma GenExtD: "x \<in> M[G] \<Longrightarrow> \<exists>\<tau>\<in>M. x = val(G,\<tau>)"
   by (simp add:GenExt_def)
 
-lemma GenExtI: "x \<in> M \<Longrightarrow> val(P,G,x) \<in> M[G]"
+lemma GenExtI: "x \<in> M \<Longrightarrow> val(G,x) \<in> M[G]"
   by (auto simp add: GenExt_def)
 
 lemma Transset_MG : "Transset(M[G])"
 proof -
   { fix vc y
     assume "vc \<in> M[G]" and "y \<in> vc"
     then
-    obtain c where "c\<in>M" "val(P,G,c)\<in>M[G]" "y \<in> val(P,G,c)"
+    obtain c where "c\<in>M" "val(G,c)\<in>M[G]" "y \<in> val(G,c)"
       using GenExtD by auto
-    from \<open>y \<in> val(P,G,c)\<close>
-    obtain \<theta> where "\<theta>\<in>domain(c)" "val(P,G,\<theta>) = y"
+    from \<open>y \<in> val(G,c)\<close>
+    obtain \<theta> where "\<theta>\<in>domain(c)" "val(G,\<theta>) = y"
       using elem_of_val by blast
     with trans_M \<open>c\<in>M\<close>
     have "y \<in> M[G]"
       using domain_trans GenExtI by blast
   }
   then
   show ?thesis
     using Transset_def by auto
 qed
 
 lemmas transitivity_MG = Transset_intf[OF Transset_MG]
 
 text\<open>This lemma can be proved before having \<^term>\<open>check_in_M\<close>. At some point Miguel naïvely
 thought that the \<^term>\<open>check_in_M\<close> could be proved using this argument.\<close>
 lemma check_nat_M :
   assumes "n \<in> nat"
   shows "check(n) \<in> M"
   using assms
 proof (induct n)
   case 0
   then
   show ?case
     using zero_in_M by (subst def_check,simp)
 next
   case (succ x)
   have "\<one> \<in> M"
     using one_in_P P_sub_M subsetD by simp
   with \<open>check(x)\<in>M\<close>
   have "\<langle>check(x),\<one>\<rangle> \<in> M"
     using pair_in_M_iff by simp
   then
   have "{\<langle>check(x),\<one>\<rangle>} \<in> M"
     using singleton_closed by simp
   with \<open>check(x)\<in>M\<close>
   have "check(x) \<union> {\<langle>check(x),\<one>\<rangle>} \<in> M"
     using Un_closed by simp
   then
   show ?case
     using \<open>x\<in>nat\<close> def_checkS by simp
 qed
 
 lemma def_PHcheck:
   assumes
     "z\<in>M" "f\<in>M"
   shows
     "Hcheck(z,f) = Replace(z,PHcheck(##M,\<one>,f))"
 proof -
   from assms
   have "\<langle>f`x,\<one>\<rangle> \<in> M" "f`x\<in>M" if "x\<in>z" for x
-    using pair_in_M_iff one_in_M transitivity that apply_closed by simp_all
+    using pair_in_M_iff transitivity that apply_closed by simp_all
   then
   have "{y . x \<in> z, y = \<langle>f ` x, \<one>\<rangle>} =  {y . x \<in> z, y = \<langle>f ` x, \<one>\<rangle> \<and> y\<in>M \<and> f`x\<in>M}"
     by simp
   then
   show ?thesis
     using \<open>z\<in>M\<close> \<open>f\<in>M\<close> transitivity
     unfolding Hcheck_def PHcheck_def RepFun_def
     by auto
 qed
 
-
 (* instance of replacement for hcheck *)
 lemma wfrec_Hcheck :
   assumes "X\<in>M"
   shows "wfrec_replacement(##M,is_Hcheck(##M,\<one>),rcheck(X))"
 proof -
   let ?f="Exists(And(pair_fm(1,0,2),
                is_wfrec_fm(is_Hcheck_fm(8,2,1,0),4,1,0)))"
   have "is_Hcheck(##M,\<one>,a,b,c) \<longleftrightarrow>
         sats(M,is_Hcheck_fm(8,2,1,0),[c,b,a,d,e,y,x,z,\<one>,rcheck(x)])"
     if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
     for a b c d e y x z
-    using that one_in_M \<open>X\<in>M\<close> rcheck_in_M is_Hcheck_iff_sats zero_in_M
+    using that \<open>X\<in>M\<close> rcheck_in_M is_Hcheck_iff_sats zero_in_M
     by simp
   then
   have "sats(M,is_wfrec_fm(is_Hcheck_fm(8,2,1,0),4,1,0), [y,x,z,\<one>,rcheck(X)])
         \<longleftrightarrow> is_wfrec(##M, is_Hcheck(##M,\<one>),rcheck(X), x, y)"
     if "x\<in>M" "y\<in>M" "z\<in>M" for x y z
-    using  that sats_is_wfrec_fm \<open>X\<in>M\<close> rcheck_in_M one_in_M zero_in_M
+    using that sats_is_wfrec_fm \<open>X\<in>M\<close> rcheck_in_M zero_in_M
     by simp
   moreover from this
   have satsf:"sats(M, ?f, [x,z,\<one>,rcheck(X)]) \<longleftrightarrow>
               (\<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hcheck(##M,\<one>),rcheck(X), x, y))"
     if "x\<in>M" "z\<in>M" for x z
-    using that \<open>X\<in>M\<close> rcheck_in_M one_in_M
+    using that \<open>X\<in>M\<close> rcheck_in_M
     by (simp del:pair_abs)
   moreover
   have artyf:"arity(?f) = 4"
     using arity_wfrec_replacement_fm[where p="is_Hcheck_fm(8, 2, 1, 0)" and i=9]
       arity_is_Hcheck_fm ord_simp_union
     by simp
   ultimately
   have "strong_replacement(##M,\<lambda>x z. sats(M,?f,[x,z,\<one>,rcheck(X)]))"
-    using replacement_ax1(10) artyf \<open>X\<in>M\<close> rcheck_in_M one_in_M
-    unfolding replacement_assm_def by simp
+    using ZF_ground_replacements(2) artyf \<open>X\<in>M\<close> rcheck_in_M
+    unfolding replacement_assm_def wfrec_Hcheck_fm_def by simp
   then
   have "strong_replacement(##M,\<lambda>x z.
           \<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hcheck(##M,\<one>),rcheck(X), x, y))"
     using repl_sats[of M ?f "[\<one>,rcheck(X)]"] satsf by (simp del:pair_abs)
   then
   show ?thesis
     unfolding wfrec_replacement_def by simp
 qed
 
+lemma Hcheck_closed' : "f\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> {f ` x . x \<in> z} \<in> M"
+  using RepFun_closed[OF lam_replacement_imp_strong_replacement]
+          lam_replacement_apply apply_closed transM[of _ z]
+  by simp
+
 lemma repl_PHcheck :
   assumes "f\<in>M"
-  shows "strong_replacement(##M,PHcheck(##M,\<one>,f))"
+  shows "lam_replacement(##M,\<lambda>x. Hcheck(x,f))"
 proof -
-  from \<open>f\<in>M\<close>
-  have "strong_replacement(##M,\<lambda>x y. sats(M,PHcheck_fm(2,3,0,1),[x,y,\<one>,f]))"
-    using replacement_ax1(11) one_in_M unfolding replacement_assm_def
-    by (simp add:arity ord_simp_union)
-  with \<open>f\<in>M\<close>
+  have "Hcheck(x,f) = {f`y . y\<in>x}\<times>{\<one>}" for x
+    unfolding Hcheck_def by auto
+  moreover
+  note assms
+  moreover from this
+  have 1:"lam_replacement(##M, \<lambda>x . {f`y . y\<in>x}\<times>{\<one>})"
+    using lam_replacement_RepFun_apply
+      lam_replacement_constant lam_replacement_fst lam_replacement_snd
+      singleton_closed cartprod_closed fst_snd_closed Hcheck_closed'
+    by (rule_tac lam_replacement_CartProd[THEN [5] lam_replacement_hcomp2],simp_all)
+  ultimately
   show ?thesis
-    using one_in_M zero_in_M
-    unfolding strong_replacement_def univalent_def
-    by simp
+    using singleton_closed cartprod_closed Hcheck_closed'
+    by(rule_tac lam_replacement_cong[OF 1],auto)
 qed
 
 lemma univ_PHcheck : "\<lbrakk> z\<in>M ; f\<in>M \<rbrakk> \<Longrightarrow> univalent(##M,z,PHcheck(##M,\<one>,f))"
   unfolding univalent_def PHcheck_def
   by simp
 
 lemma PHcheck_closed : "\<lbrakk>z\<in>M ; f\<in>M ; x\<in>z; PHcheck(##M,\<one>,f,x,y) \<rbrakk> \<Longrightarrow> (##M)(y)"
   unfolding PHcheck_def by simp
 
 lemma relation2_Hcheck : "relation2(##M,is_Hcheck(##M,\<one>),Hcheck)"
 proof -
   have "is_Replace(##M,z,PHcheck(##M,\<one>,f),hc) \<longleftrightarrow> hc = Replace(z,PHcheck(##M,\<one>,f))"
     if "z\<in>M" "f\<in>M" "hc\<in>M" for z f hc
     using that Replace_abs[OF _ _ univ_PHcheck] PHcheck_closed[of z f]
     by simp
   with def_PHcheck
   show ?thesis
     unfolding relation2_def is_Hcheck_def Hcheck_def
     by simp
 qed
 
-lemma Hcheck_closed : "\<forall>y\<in>M. \<forall>g\<in>M. function(g) \<longrightarrow> Hcheck(y,g)\<in>M"
+lemma Hcheck_closed : "\<forall>y\<in>M. \<forall>g\<in>M.  Hcheck(y,g)\<in>M"
 proof -
-  have "Replace(y,PHcheck(##M,\<one>,f))\<in>M" if "f\<in>M" "y\<in>M" for f y
-    using that repl_PHcheck  PHcheck_closed[of y f] univ_PHcheck
-      strong_replacement_closed
-    by (simp flip: setclass_iff)
+  have eq:"Hcheck(x,f) = {f`y . y\<in>x}\<times>{\<one>}" for f x
+    unfolding Hcheck_def by auto
+  then
+  have "Hcheck(y,g)\<in>M" if "y\<in>M" "g\<in>M" for y g
+    using eq that Hcheck_closed' cartprod_closed singleton_closed
+    by simp
   then
   show ?thesis
-    using def_PHcheck by auto
+    by auto
 qed
 
 lemma wf_rcheck : "x\<in>M \<Longrightarrow> wf(rcheck(x))"
   unfolding rcheck_def using wf_trancl[OF wf_Memrel] .
 
 lemma trans_rcheck : "x\<in>M \<Longrightarrow> trans(rcheck(x))"
   unfolding rcheck_def using trans_trancl .
 
 lemma relation_rcheck : "x\<in>M \<Longrightarrow> relation(rcheck(x))"
   unfolding rcheck_def using relation_trancl .
 
 lemma check_in_M : "x\<in>M \<Longrightarrow> check(x) \<in> M"
-  unfolding transrec_def
   using wfrec_Hcheck[of x] check_trancl wf_rcheck trans_rcheck relation_rcheck rcheck_in_M
-    Hcheck_closed relation2_Hcheck trans_wfrec_closed[of "rcheck(x)" x "is_Hcheck(##M,\<one>)" Hcheck]
-  by (simp flip: setclass_iff)
+    Hcheck_closed relation2_Hcheck trans_wfrec_closed[of "rcheck(x)"]
+  by simp
 
 (* Internalization and absoluteness of rcheck\<close> *)
-
 lemma rcheck_abs[Rel] : "\<lbrakk> x\<in>M ; r\<in>M \<rbrakk> \<Longrightarrow> is_rcheck(##M,x,r) \<longleftrightarrow> r = rcheck(x)"
   unfolding rcheck_def is_rcheck_def
   using singleton_closed trancl_closed Memrel_closed eclose_closed zero_in_M
   by simp
 
 lemma check_abs[Rel] :
   assumes "x\<in>M" "z\<in>M"
   shows "is_check(##M,\<one>,x,z) \<longleftrightarrow> z = check(x)"
 proof -
   have "is_check(##M,\<one>,x,z) \<longleftrightarrow> is_wfrec(##M,is_Hcheck(##M,\<one>),rcheck(x),x,z)"
     unfolding is_check_def
     using assms rcheck_abs rcheck_in_M zero_in_M
     unfolding check_trancl is_check_def
     by simp
   then
   show ?thesis
     unfolding check_trancl
     using assms wfrec_Hcheck[of x] wf_rcheck trans_rcheck relation_rcheck rcheck_in_M
       Hcheck_closed relation2_Hcheck trans_wfrec_abs[of "rcheck(x)" x z "is_Hcheck(##M,\<one>)" Hcheck]
     by (simp flip: setclass_iff)
 qed
 
-lemma check_replacement: "{check(x). x\<in>P} \<in> M"
+lemma check_lam_replacement: "lam_replacement(##M,check)"
 proof -
-  have "arity(check_fm(0,2,1)) = 3"
+  have "arity(check_fm(2,0,1)) = 3"
     by (simp add:ord_simp_union arity)
   then
+  have "Lambda(A, check) \<in> M" if "A\<in>M" for A
+    using that check_in_M transitivity[of _ A]
+      sats_check_fm check_abs zero_in_M
+      check_fm_type ZF_ground_replacements(3)
+    by(rule_tac Lambda_in_M [of "check_fm(2,0,1)" "[\<one>]"],simp_all)
+  then
   show ?thesis
-    using sats_check_fm check_abs P_in_M check_in_M one_in_M transitivity zero_in_M
-      Replace_relativized_in_M[of "check_fm(0,2,1)" "[\<one>]" _ "is_check(##M,\<one>)" check]
-      check_fm_type replacement_ax1(12)
+    using check_in_M lam_replacement_iff_lam_closed[THEN iffD2]
     by simp
 qed
 
-lemma M_subset_MG :  "\<one> \<in> G \<Longrightarrow> M \<subseteq> M[G]"
-  using check_in_M one_in_P GenExtI
-  by (intro subsetI, subst valcheck [of G,symmetric], auto)
+lemma check_replacement: "{check(x). x\<in>P} \<in> M"
+  using lam_replacement_imp_strong_replacement_aux[OF check_lam_replacement]
+    transitivity check_in_M RepFun_closed
+    by simp_all
+
+lemma M_subset_MG : "\<one> \<in> G \<Longrightarrow> M \<subseteq> M[G]"
+  using check_in_M GenExtI
+  by (intro subsetI, subst val_check [of G,symmetric], auto)
 
 text\<open>The name for the generic filter\<close>
 definition
   G_dot :: "i" where
   "G_dot \<equiv> {\<langle>check(p),p\<rangle> . p\<in>P}"
 
 lemma G_dot_in_M : "G_dot \<in> M"
-proof -
-  let ?is_pcheck = "\<lambda>x y. \<exists>ch\<in>M. is_check(##M,\<one>,x,ch) \<and> pair(##M,ch,x,y)"
-  let ?pcheck_fm = "Exists(And(check_fm(1,3,0),pair_fm(0,1,2)))"
-  have "sats(M,?pcheck_fm,[x,y,\<one>]) \<longleftrightarrow> ?is_pcheck(x,y)" if "x\<in>M" "y\<in>M" for x y
-    using sats_check_fm that one_in_M zero_in_M by simp
-  moreover
-  have "?is_pcheck(x,y) \<longleftrightarrow> y = \<langle>check(x),x\<rangle>" if "x\<in>M" "y\<in>M" for x y
-    using that check_abs check_in_M by simp
-  moreover
-  have "?pcheck_fm\<in>formula"
-    by simp
-  moreover
-  have "arity(?pcheck_fm)=3"
-    by (simp add:ord_simp_union arity)
-  moreover
-  from P_in_M check_in_M pair_in_M_iff P_sub_M
-  have "\<langle>check(p),p\<rangle> \<in> M" if "p\<in>P" for p
-    using that by auto
-  ultimately
-  show ?thesis
-    unfolding G_dot_def
-    using one_in_M P_in_M transitivity Replace_relativized_in_M[of ?pcheck_fm "[\<one>]"]
-      replacement_ax1(13)
-    by simp
-qed
+  using lam_replacement_Pair[THEN [5] lam_replacement_hcomp2,OF
+    check_lam_replacement lam_replacement_identity]
+    check_in_M lam_replacement_imp_strong_replacement_aux
+    transitivity check_in_M RepFun_closed pair_in_M_iff
+  unfolding G_dot_def
+  by simp
 
-lemma val_G_dot :
-  assumes "G \<subseteq> P" "\<one> \<in> G"
-  shows "val(P,G,G_dot) = G"
-proof (intro equalityI subsetI)
-  fix x
-  assume "x\<in>val(P,G,G_dot)"
-  then obtain \<theta> p where "p\<in>G" "\<langle>\<theta>,p\<rangle> \<in> G_dot" "val(P,G,\<theta>) = x" "\<theta> = check(p)"
-    unfolding G_dot_def using elem_of_val_pair G_dot_in_M
-    by force
-  with \<open>\<one>\<in>G\<close> \<open>G\<subseteq>P\<close>
-  show "x \<in> G"
-    using valcheck P_sub_M by auto
-next
-  fix p
-  assume "p\<in>G"
-  have "\<langle>check(q),q\<rangle> \<in> G_dot" if "q\<in>P" for q
-    unfolding G_dot_def using that by simp
-  with \<open>p\<in>G\<close> \<open>G\<subseteq>P\<close>
-  have "val(P,G,check(p)) \<in> val(P,G,G_dot)"
-    using val_of_elem G_dot_in_M by blast
-  with \<open>p\<in>G\<close> \<open>G\<subseteq>P\<close> \<open>\<one>\<in>G\<close>
-  show "p \<in> val(P,G,G_dot)"
-    using P_sub_M valcheck by auto
-qed
-
-lemma G_in_Gen_Ext :
-  assumes "G \<subseteq> P" "\<one> \<in> G"
-  shows   "G \<in> M[G]"
-  using assms val_G_dot GenExtI[of _ G] G_dot_in_M
-  by force
-
-end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
-
-locale G_generic1 = forcing_data1 +
-  fixes G :: "i"
-  assumes generic : "M_generic(G)"
-begin
-
-lemma zero_in_MG :
-  "0 \<in> M[G]"
+lemma zero_in_MG : "0 \<in> M[G]"
 proof -
-  have "0 = val(P,G,0)"
+  have "0 = val(G,0)"
     using zero_in_M elem_of_val by auto
   also
   have "... \<in> M[G]"
     using GenExtI zero_in_M by simp
   finally
   show ?thesis .
 qed
 
-lemma G_nonempty: "G\<noteq>0"
-  using generic subset_refl[of P] P_in_M P_dense
-  unfolding M_generic_def
-  by auto
+declare check_in_M [simp,intro]
 
-end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
 
-locale G_generic1_AC = G_generic1 + M_ctm1_AC
+context G_generic1
+begin
+
+lemma val_G_dot : "val(G,G_dot) = G"
+proof (intro equalityI subsetI)
+  fix x
+  assume "x\<in>val(G,G_dot)"
+  then obtain \<theta> p where "p\<in>G" "\<langle>\<theta>,p\<rangle> \<in> G_dot" "val(G,\<theta>) = x" "\<theta> = check(p)"
+    unfolding G_dot_def using elem_of_val_pair G_dot_in_M
+    by force
+  then
+  show "x \<in> G"
+    using G_subset_P one_in_G val_check P_sub_M by auto
+next
+  fix p
+  assume "p\<in>G"
+  have "\<langle>check(q),q\<rangle> \<in> G_dot" if "q\<in>P" for q
+    unfolding G_dot_def using that by simp
+  with \<open>p\<in>G\<close>
+  have "val(G,check(p)) \<in> val(G,G_dot)"
+    using val_of_elem G_dot_in_M by blast
+  with \<open>p\<in>G\<close>
+  show "p \<in> val(G,G_dot)"
+    using one_in_G G_subset_P P_sub_M val_check by auto
+qed
+
+lemma G_in_Gen_Ext : "G \<in> M[G]"
+  using G_subset_P one_in_G val_G_dot GenExtI[of _ G] G_dot_in_M
+  by force
+
+lemmas generic_simps = val_check[OF one_in_G one_in_P]
+  M_subset_MG[OF one_in_G, THEN subsetD]
+  GenExtI P_in_M
+
+lemmas generic_dests = M_genericD M_generic_compatD
+
+bundle G_generic1_lemmas = generic_simps[simp] generic_dests[dest]
+
+end  \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Not_CH.thy b/thys/Independence_CH/Not_CH.thy
--- a/thys/Independence_CH/Not_CH.thy
+++ b/thys/Independence_CH/Not_CH.thy
@@ -1,684 +1,600 @@
 section\<open>Model of the negation of the Continuum Hypothesis\<close>
 
 theory Not_CH
   imports
     Cardinal_Preservation
 begin
 
-txt\<open>We are taking advantage that the poset of finite functions is absolute,
+text\<open>We are taking advantage that the poset of finite functions is absolute,
 and thus we work with the unrelativized \<^term>\<open>Fn\<close>. But it would have been more
 appropriate to do the following using the relative \<^term>\<open>Fn_rel\<close>. As it turns
 out, the present theory was developed prior to having \<^term>\<open>Fn\<close> relativized!
 
 We also note that \<^term>\<open>Fn(\<omega>,\<kappa>\<times>\<omega>,2)\<close> is separative, i.e. each \<^term>\<open>X \<in> Fn(\<omega>,\<kappa>\<times>\<omega>,2)\<close>
 has two incompatible extensions; therefore we may recover part of our previous theorem
 @{thm [source] extensions_of_ctms_ZF}. But that result also included the possibility
 of not having $\AC$ in the ground model, which would not be sensible in a context
 where the cardinality of the continuum is under discussion. It is also the case that
 @{thm [source] extensions_of_ctms_ZF} was historically our first formalized result
 (with a different proof) that showed the forcing machinery had all of its elements
 in place.\<close>
 
 abbreviation
   Add_subs :: "i \<Rightarrow> i" where
   "Add_subs(\<kappa>) \<equiv> Fn(\<omega>,\<kappa>\<times>\<omega>,2)"
 
 abbreviation
   Add_le :: "i \<Rightarrow> i" where
   "Add_le(\<kappa>) \<equiv> Fnle(\<omega>,\<kappa> \<times> \<omega>,2)"
 
 lemma (in M_aleph) Aleph_rel2_closed[intro,simp]: "M(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>)"
   using nat_into_Ord by simp
 
-locale M_master = M_cohen + M_library_DC +
+locale M_master = M_cohen + M_library +
   assumes
-  UN_lepoll_assumptions:
-  "M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> M(A') \<Longrightarrow> separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x\<in>if_range_F_else_F((`)(A), b, f, i)\<rangle>)"
+    UN_lepoll_assumptions:
+    "M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> M(A') \<Longrightarrow> separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x\<in>if_range_F_else_F((`)(A), b, f, i)\<rangle>)"
 
 subsection\<open>Non-absolute concepts between extensions\<close>
 
-locale M_master_sub = M_master + N:M_master N for N +
+sublocale M_master \<subseteq> M_Pi_replacement
+  by unfold_locales
+
+\<comment> \<open>Note that in L. 132 we interpret \<^locale>\<open>M_master\<close> from \<^locale>\<open>M_ZFC3_trans\<close>, so
+the assumption \<^locale>\<open>M_aleph\<close> for \<^term>\<open>N\<close> is misleading.\<close>
+locale M_master_sub = M_master + N:M_aleph N for N +
   assumes
     M_imp_N: "M(x) \<Longrightarrow> N(x)" and
     Ord_iff: "Ord(x) \<Longrightarrow> M(x) \<longleftrightarrow> N(x)"
+    (* TODO: update ground replacement assms in M_ZF4: those stemming from
+  M_DC, M_cardinal_library, and M_seqspace should no longer be needed
+  (5 total). At least M_cardinal_library is needed for CH and M_library for Not_CH. *)
 
 sublocale M_master_sub \<subseteq> M_N_Perm
   using M_imp_N by unfold_locales
 
 context M_master_sub
 begin
 
 lemma cardinal_rel_le_cardinal_rel: "M(X) \<Longrightarrow> |X|\<^bsup>N\<^esup> \<le> |X|\<^bsup>M\<^esup>"
   using M_imp_N N.lepoll_rel_cardinal_rel_le[OF lepoll_rel_transfer Card_rel_is_Ord]
-      cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym, THEN eqpoll_rel_imp_lepoll_rel]
+    cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym, THEN eqpoll_rel_imp_lepoll_rel]
   by simp
 
 lemma Aleph_rel_sub_closed: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> N(\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>)"
   using Ord_iff[THEN iffD1, OF Card_rel_Aleph_rel[THEN Card_rel_is_Ord]]
   by simp
 
 lemma Card_rel_imp_Card_rel: "Card\<^bsup>N\<^esup>(\<kappa>) \<Longrightarrow> M(\<kappa>) \<Longrightarrow> Card\<^bsup>M\<^esup>(\<kappa>)"
   using N.Card_rel_is_Ord[of \<kappa>] M_imp_N Ord_cardinal_rel_le[of \<kappa>]
     cardinal_rel_le_cardinal_rel[of \<kappa>] le_anti_sym
   unfolding Card_rel_def by auto
 
 lemma csucc_rel_le_csucc_rel:
   assumes "Ord(\<kappa>)" "M(\<kappa>)"
   shows "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<kappa>\<^sup>+)\<^bsup>N\<^esup>"
 proof -
   note assms
   moreover from this
   have "N(L) \<and> Card\<^bsup>N\<^esup>(L) \<and> \<kappa> < L \<Longrightarrow> M(L) \<and> Card\<^bsup>M\<^esup>(L) \<and> \<kappa> < L"
     (is "?P(L) \<Longrightarrow> ?Q(L)") for L
     using M_imp_N Ord_iff[THEN iffD2, of L] N.Card_rel_is_Ord lt_Ord
       Card_rel_imp_Card_rel by auto
   moreover from assms
   have "N((\<kappa>\<^sup>+)\<^bsup>N\<^esup>)" "Card\<^bsup>N\<^esup>((\<kappa>\<^sup>+)\<^bsup>N\<^esup>)" "\<kappa> < (\<kappa>\<^sup>+)\<^bsup>N\<^esup>"
     using N.lt_csucc_rel[of \<kappa>] N.Card_rel_csucc_rel[of \<kappa>] M_imp_N by simp_all
   ultimately
   show ?thesis
     using M_imp_N Least_antitone[of _ ?P ?Q] unfolding csucc_rel_def by blast
 qed
 
 lemma Aleph_rel_le_Aleph_rel: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>N\<^esup>"
 proof (induct rule:trans_induct3)
   case 0
   then
   show ?case
     using Aleph_rel_zero N.Aleph_rel_zero by simp
 next
   case (succ x)
   then
   have "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>" "Ord(x)" "M(x)" by simp_all
   moreover from this
   have "(\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
     using M_imp_N Ord_iff[THEN iffD2, OF N.Card_rel_is_Ord]
     by (intro csucc_rel_le_mono) simp_all
   moreover from calculation
   have "(\<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>\<^sup>+)\<^bsup>N\<^esup>"
     using M_imp_N N.Card_rel_is_Ord Ord_iff[THEN iffD2, OF N.Card_rel_is_Ord]
     by (intro csucc_rel_le_csucc_rel) auto
   ultimately
   show ?case
     using M_imp_N Aleph_rel_succ N.Aleph_rel_succ csucc_rel_le_csucc_rel
       le_trans by auto
 next
   case (limit x)
   then
   show ?case
     using M_imp_N Aleph_rel_limit N.Aleph_rel_limit
-     by simp (blast dest: transM intro!:le_implies_UN_le_UN)
+    by simp (blast dest: transM intro!:le_implies_UN_le_UN)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_master_sub\<close>\<close>
 
 lemmas (in M_ZF3_trans) sep_instances =
- separation_insnd_ballPair
- separation_ifrangeF_body separation_ifrangeF_body2 separation_ifrangeF_body3
- separation_ifrangeF_body4 separation_ifrangeF_body5 separation_ifrangeF_body6
- separation_ifrangeF_body7 separation_cardinal_rel_lesspoll_rel
- separation_is_dcwit_body
+  separation_ifrangeF_body separation_ifrangeF_body2 separation_ifrangeF_body3
+  separation_ifrangeF_body4 separation_ifrangeF_body5 separation_ifrangeF_body6
+  separation_ifrangeF_body7 separation_cardinal_rel_lesspoll_rel
+  separation_is_dcwit_body separation_cdltgamma separation_cdeqgamma
 
 lemmas (in M_ZF3_trans) repl_instances = lam_replacement_inj_rel
-  lam_replacement_cardinal replacement_trans_apply_image
 
-sublocale M_ZFC3_trans \<subseteq> M_master "##M"
-  using replacement_dcwit_repl_body\<comment> \<open>this is another replacement instance\<close>
+sublocale M_ZFC3_ground_trans \<subseteq> M_master "##M"
+  using replacement_trans_apply_image
   by unfold_locales (simp_all add:repl_instances sep_instances del:setclass_iff
-      add: transrec_replacement_def wfrec_replacement_def dcwit_repl_body_def)
+      add: transrec_replacement_def wfrec_replacement_def)
+
+sublocale M_ZFC3_trans \<subseteq> M_Pi_replacement "##M"
+  by unfold_locales
 
 subsection\<open>Cohen forcing is ccc\<close>
 
 context M_ctm3_AC
 begin
 
 lemma ccc_Add_subs_Aleph_2: "ccc\<^bsup>M\<^esup>(Add_subs(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>),Add_le(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>))"
 proof -
   interpret M_add_reals "##M" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>"
     by unfold_locales blast
   show ?thesis
     using ccc_rel_Fn_nat by fast
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_ctm3_AC\<close>\<close>
 
 sublocale G_generic4_AC \<subseteq> M_master_sub "##M" "##(M[G])"
   using M_subset_MG[OF one_in_G] generic Ord_MG_iff
   by unfold_locales auto
 
 lemma (in M_trans) mem_F_bound4:
   fixes F A
   defines "F \<equiv> (`)"
   shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> domain(A))"
   using apply_0 unfolding F_def
   by (cases "M(c)", auto simp:F_def)
 
 lemma (in M_trans) mem_F_bound5:
   fixes F A
   defines "F \<equiv> \<lambda>_ x. A`x "
   shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> domain(A))"
   using apply_0 unfolding F_def
   by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
 
 sublocale M_ctm3_AC \<subseteq> M_replacement_lepoll "##M" "(`)"
   using UN_lepoll_assumptions lam_replacement_apply lam_replacement_inj_rel
-    mem_F_bound4 apply_0
+    mem_F_bound4 apply_0 lam_replacement_minimum
   unfolding lepoll_assumptions_defs
 proof (unfold_locales,
     rule_tac [3] lam_Least_assumption_general[where U=domain, OF _ mem_F_bound4], simp_all)
   fix A i x
   assume "A \<in> M" "x \<in> M" "x \<in> A ` i"
   then
   show "i \<in> M"
     using apply_0[of i A] transM[of _ "domain(A)", simplified]
     by force
 qed
 
 context G_generic4_AC begin
 
 context
   includes G_generic1_lemmas
 begin
 
 lemma G_in_MG: "G \<in> M[G]"
-  using G_in_Gen_Ext[ OF _ one_in_G, OF _ generic]
+  using G_in_Gen_Ext
   by blast
 
 lemma ccc_preserves_Aleph_succ:
   assumes "ccc\<^bsup>M\<^esup>(P,leq)" "Ord(z)" "z \<in> M"
   shows "Card\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
 proof (rule ccontr)
   assume "\<not> Card\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
   moreover
   note \<open>z \<in> M\<close> \<open>Ord(z)\<close>
   moreover from this
   have "Ord(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
     using Card_rel_is_Ord by fastforce
   ultimately
   obtain \<alpha> f where "\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" "f \<in> surj\<^bsup>M[G]\<^esup>(\<alpha>, \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
-    using ext.lt_surj_rel_empty_imp_Card_rel M_subset_MG[OF one_in_G, OF generic]
+    using ext.lt_surj_rel_empty_imp_Card_rel M_subset_MG[OF one_in_G]
     by force
   moreover from this and \<open>z\<in>M\<close> \<open>Ord(z)\<close>
   have "\<alpha> \<in> M" "f \<in> M[G]"
     using ext.trans_surj_rel_closed
     by (auto dest:transM ext.transM dest!:ltD)
   moreover
   note \<open>ccc\<^bsup>M\<^esup>(P,leq)\<close> \<open>z\<in>M\<close>
   ultimately
   obtain F where "F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)" "\<forall>\<beta>\<in>\<alpha>. f`\<beta> \<in> F`\<beta>" "\<forall>\<beta>\<in>\<alpha>. |F`\<beta>|\<^bsup>M\<^esup> \<le> \<omega>"
     "F \<in> M"
     using ccc_fun_approximation_lemma[of \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" f]
       ext.mem_surj_abs[of f \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"] \<open>Ord(z)\<close>
       surj_is_fun[of f \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"] by auto
   then
   have "\<beta> \<in> \<alpha> \<Longrightarrow> |F`\<beta>|\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup>" for \<beta>
     using Aleph_rel_zero by simp
   have "w \<in> F ` x \<Longrightarrow> x \<in> M" for w x
-    proof -
-      fix w x
-      assume "w \<in> F`x"
-      then
-      have "x \<in> domain(F)"
-        using apply_0 by auto
-      with \<open>F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close>
-      have "x \<in> \<alpha>"
-        using domain_of_fun by simp
-      with \<open>\<alpha> \<in> M\<close>
-      show "x \<in> M" by (auto dest:transM)
-    qed
-    with \<open>\<alpha> \<in> M\<close> \<open>F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close> \<open>F\<in>M\<close>
+  proof -
+    fix w x
+    assume "w \<in> F`x"
+    then
+    have "x \<in> domain(F)"
+      using apply_0 by auto
+    with \<open>F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close> \<open>\<alpha> \<in> M\<close>
+    show "x \<in> M" using domain_of_fun
+      by (auto dest:transM)
+  qed
+  with \<open>\<alpha> \<in> M\<close> \<open>F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close> \<open>F\<in>M\<close>
   interpret M_cardinal_UN_lepoll "##M" "\<lambda>\<beta>. F`\<beta>" \<alpha>
     using UN_lepoll_assumptions lepoll_assumptions
-      lam_replacement_apply lam_replacement_inj_rel
+      lam_replacement_apply lam_replacement_inj_rel lam_replacement_minimum
   proof (unfold_locales, auto dest:transM simp del:if_range_F_else_F_def)
     fix f b
     assume "b\<in>M" "f\<in>M"
     with \<open>F\<in>M\<close>
     show "lam_replacement(##M, \<lambda>x. \<mu> i. x \<in> if_range_F_else_F((`)(F), b, f, i))"
       using UN_lepoll_assumptions mem_F_bound5
       by (rule_tac lam_Least_assumption_general[where U="domain", OF _ mem_F_bound5])
         simp_all
   qed
-  from \<open>\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>\<close> \<open>\<alpha> \<in> M\<close> assms
+  from \<open>\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>\<close> \<open>\<alpha> \<in> M\<close> \<open>Ord(z)\<close> \<open>z\<in>M\<close>
   have "\<alpha> \<lesssim>\<^bsup>M\<^esup> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
     using
-      Aleph_rel_zero
       cardinal_rel_lt_csucc_rel_iff[of "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>" \<alpha>]
       le_Card_rel_iff[of "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>" \<alpha>]
       Aleph_rel_succ[of z] Card_rel_lt_iff[of \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"]
       lt_Ord[of \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"]
       Card_rel_csucc_rel[of "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"]
-      Aleph_rel_closed[of z]
-      Card_rel_Aleph_rel[THEN Card_rel_is_Ord, OF _ _ Aleph_rel_closed]
+      Card_rel_Aleph_rel[THEN Card_rel_is_Ord]
     by simp
   with \<open>\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>\<close> \<open>\<forall>\<beta>\<in>\<alpha>. |F`\<beta>|\<^bsup>M\<^esup> \<le> \<omega>\<close> \<open>\<alpha> \<in> M\<close> assms
   have "|\<Union>\<beta>\<in>\<alpha>. F`\<beta>|\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
     using InfCard_rel_Aleph_rel[of z] Aleph_rel_zero
       subset_imp_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le,
         of "\<Union>\<beta>\<in>\<alpha>. F`\<beta>" "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"] Aleph_rel_succ
       Aleph_rel_increasing[THEN leI, THEN [2] le_trans, of _ 0 z]
       Ord_0_lt_iff[THEN iffD1, of z]
     by (cases "0<z"; rule_tac leqpoll_rel_imp_cardinal_rel_UN_le) (auto, force)
   moreover
   note \<open>z\<in>M\<close> \<open>Ord(z)\<close>
   moreover from \<open>\<forall>\<beta>\<in>\<alpha>. f`\<beta> \<in> F`\<beta>\<close> \<open>f \<in> surj\<^bsup>M[G]\<^esup>(\<alpha>, \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close>
     \<open>\<alpha> \<in> M\<close> \<open>f \<in> M[G]\<close> and this
   have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<subseteq> (\<Union>\<beta>\<in>\<alpha>. F`\<beta>)"
     using ext.mem_surj_abs by (force simp add:surj_def)
   moreover from \<open>F \<in> M\<close> \<open>\<alpha> \<in> M\<close>
   have "(\<Union>x\<in>\<alpha>. F ` x) \<in> M"
     using j.B_replacement\<comment> \<open>NOTE: it didn't require @{thm j.UN_closed} before!\<close>
     by (intro Union_closed[simplified] RepFun_closed[simplified])
       (auto dest:transM)
   ultimately
   have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
     using subset_imp_le_cardinal_rel[of "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" "\<Union>\<beta>\<in>\<alpha>. F`\<beta>"]
       le_trans by auto
   with assms
   show "False"
     using Aleph_rel_increasing not_le_iff_lt[of "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"]
       Card_rel_Aleph_rel[THEN Card_rel_is_Ord]
     by auto
 qed
 
 end \<comment> \<open>bundle G\_generic1\_lemmas\<close>
 
 end \<comment> \<open>\<^locale>\<open>G_generic4_AC\<close>\<close>
 
 context M_ctm1
 begin
 
 abbreviation
   Add :: "i" where
   "Add \<equiv> Fn(\<omega>, \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>, 2)"
 
 end \<comment> \<open>\<^locale>\<open>M_ctm1\<close>\<close>
 
 locale add_generic4 = G_generic4_AC "Fn(\<omega>, \<aleph>\<^bsub>2\<^esub>\<^bsup>##M\<^esup> \<times> \<omega>, 2)" "Fnle(\<omega>, \<aleph>\<^bsub>2\<^esub>\<^bsup>##M\<^esup> \<times> \<omega>, 2)" 0
 
 sublocale add_generic4 \<subseteq> cohen_data \<omega> "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 2 by unfold_locales auto
 
 context add_generic4
 begin
 
 notation Leq (infixl "\<preceq>" 50)
 notation Incompatible (infixl "\<bottom>" 50)
-notation GenExt_at_P ("_[_]" [71,1])
 
 lemma Add_subs_preserves_Aleph_succ: "Ord(z) \<Longrightarrow> z\<in>M \<Longrightarrow> Card\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
   using ccc_preserves_Aleph_succ ccc_Add_subs_Aleph_2
   by auto
 
 lemma Aleph_rel_nats_MG_eq_Aleph_rel_nats_M:
   includes G_generic1_lemmas
   assumes "z \<in> \<omega>"
   shows "\<aleph>\<^bsub>z\<^esub>\<^bsup>M[G]\<^esup> = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
   using assms
 proof (induct)
   case 0
-  have "\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup> = \<omega>"
-    using ext.Aleph_rel_zero .
-  also
-  have "\<omega> = \<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup>"
-    using Aleph_rel_zero by simp
-  finally
-  show ?case .
+  show ?case
+    by(rule trans[OF ext.Aleph_rel_zero Aleph_rel_zero[symmetric]])
 next
   case (succ z)
   then
   have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M[G]\<^esup>"
     using Aleph_rel_le_Aleph_rel nat_into_M by simp
   moreover from \<open>z \<in> \<omega>\<close>
   have "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<in> M[G]"
     using nat_into_M by simp_all
   moreover from this and \<open>\<aleph>\<^bsub>z\<^esub>\<^bsup>M[G]\<^esup> = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>\<close> \<open>z \<in> \<omega>\<close>
   have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M[G]\<^esup> \<le> \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"
     using ext.Aleph_rel_succ nat_into_M
       Add_subs_preserves_Aleph_succ[THEN ext.csucc_rel_le, of z]
       Aleph_rel_increasing[of z "succ(z)"]
     by simp
   ultimately
   show ?case using le_anti_sym by blast
 qed
 
 abbreviation
   f_G :: "i" (\<open>f\<^bsub>G\<^esub>\<close>) where
   "f\<^bsub>G\<^esub> \<equiv> \<Union>G"
 
 abbreviation
-  dom_dense :: "i\<Rightarrow>i" where
-  "dom_dense(x) \<equiv> { p\<in>Add . x \<in> domain(p) }"
-
-(* TODO: write general versions of this for \<^term>\<open>Fn(\<omega>,I,J)\<close> *)
-lemma dense_dom_dense: "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega> \<Longrightarrow> dense(dom_dense(x))"
-proof
-  fix p
-  assume "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" "p \<in> Add"
-  show "\<exists>d\<in>dom_dense(x). d \<preceq> p"
-  proof (cases "x \<in> domain(p)")
-    case True
-    with \<open>x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>\<close> \<open>p \<in> Add\<close>
-    show ?thesis using refl_leq by auto
-  next
-    case False
-    note \<open>p \<in> Add\<close>
-    moreover from this and False and \<open>x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>\<close>
-    have "cons(\<langle>x,0\<rangle>, p) \<in> Add"
-      using FiniteFun.consI[of x "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 0 2 p]
-        Fn_nat_eq_FiniteFun by auto
-    moreover from \<open>p \<in> Add\<close>
-    have "x\<in>domain(cons(\<langle>x,0\<rangle>, p))" by simp
-    ultimately
-    show ?thesis
-      by (fastforce del:FnD)
-  qed
-qed
+  dom_dense :: "i \<Rightarrow> i" where
+  "dom_dense(x) \<equiv> {p \<in> Add . x \<in> domain(p) }"
 
 declare (in M_ctm3_AC) Fn_nat_closed[simplified setclass_iff, simp, intro]
 declare (in M_ctm3_AC) Fnle_nat_closed[simp del, rule del,
     simplified setclass_iff, simp, intro]
 declare (in M_ctm3_AC) cexp_rel_closed[simplified setclass_iff, simp, intro]
 declare (in G_generic4_AC) ext.cexp_rel_closed[simplified setclass_iff, simp, intro]
 
 lemma dom_dense_closed[intro,simp]: "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega> \<Longrightarrow> dom_dense(x) \<in> M"
   using separation_in_domain[of x] nat_into_M
   by (rule_tac separation_closed[simplified], blast dest:transM) simp
 
 lemma domain_f_G: assumes "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "y \<in> \<omega>"
   shows "\<langle>x, y\<rangle> \<in> domain(f\<^bsub>G\<^esub>)"
 proof -
   from assms
-  have "dense(dom_dense(\<langle>x, y\<rangle>))" using dense_dom_dense by simp
+  have "Add = Fn\<^bsup>M\<^esup>(\<omega>,\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>\<times>\<omega>,2)"
+    using Fn_nat_abs by auto
+  moreover from this
+  have "Fnle(\<omega>,\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>\<times>\<omega>,2) = Fnle\<^bsup>M\<^esup>(\<omega>,\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>\<times>\<omega>,2)"
+    unfolding Fnle_rel_def Fnle_def by auto
+  moreover from calculation assms
+  have "dense(dom_dense(\<langle>x, y\<rangle>))"
+    using dense_dom_dense[of "\<langle>x,y\<rangle>" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>\<times>\<omega>" \<omega>  2] InfCard_rel_nat
+    unfolding dense_def by auto
   with assms
   obtain p where "p\<in>dom_dense(\<langle>x, y\<rangle>)" "p\<in>G"
-    using generic[THEN M_generic_denseD, of "dom_dense(\<langle>x, y\<rangle>)"]
+    using M_generic_denseD[of "dom_dense(\<langle>x, y\<rangle>)"]
     by auto
   then
   show "\<langle>x, y\<rangle> \<in> domain(f\<^bsub>G\<^esub>)" by blast
 qed
 
 lemma f_G_funtype:
   includes G_generic1_lemmas
   shows "f\<^bsub>G\<^esub> : \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega> \<rightarrow> 2"
-  using generic domain_f_G
-  unfolding Pi_def
-proof (auto)
-  show "x \<in> B \<Longrightarrow> B \<in> G \<Longrightarrow> x \<in> (\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>) \<times> 2" for B x
-    using Fn_nat_subset_Pow by blast
-  show "function(f\<^bsub>G\<^esub>)"
-    using Un_filter_is_function generic
-    unfolding M_generic_def by fast
-qed
-
-abbreviation
-  inj_dense :: "i\<Rightarrow>i\<Rightarrow>i" where
-  "inj_dense(w,x) \<equiv>
-    { p\<in>Add . (\<exists>n\<in>\<omega>. \<langle>\<langle>w,n\<rangle>,1\<rangle> \<in> p \<and> \<langle>\<langle>x,n\<rangle>,0\<rangle> \<in> p) }"
-
-(* TODO write general versions of this for \<^term>\<open>Fn(\<omega>,I,J)\<close> *)
-lemma dense_inj_dense:
-  assumes "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "w \<noteq> x"
-  shows "dense(inj_dense(w,x))"
-proof
-  fix p
-  assume "p \<in> Add"
-  then
-  obtain n where "\<langle>w,n\<rangle> \<notin> domain(p)" "\<langle>x,n\<rangle> \<notin> domain(p)" "n \<in> \<omega>"
-  proof -
-    {
-      assume "\<langle>w,n\<rangle> \<in> domain(p) \<or> \<langle>x,n\<rangle> \<in> domain(p)" if "n \<in> \<omega>" for n
-      then
-      have "\<omega> \<subseteq> range(domain(p))" by blast
-      then
-      have "\<not> Finite(p)"
-        using Finite_range Finite_domain subset_Finite nat_not_Finite
-        by auto
-      with \<open>p \<in> Add\<close>
-      have False
-        using Fn_nat_eq_FiniteFun FiniteFun.dom_subset[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 2]
-          Fin_into_Finite by auto
-    }
-    with that\<comment> \<open>the shape of the goal puts assumptions in this variable\<close>
-    show ?thesis by auto
-  qed
-  moreover
-  note \<open>p \<in> Add\<close> assms
-  moreover from calculation
-  have "cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p) \<in> Add"
-    using FiniteFun.consI[of "\<langle>x,n\<rangle>" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 0 2 p]
-      Fn_nat_eq_FiniteFun by auto
-  ultimately
-  have "cons(\<langle>\<langle>w,n\<rangle>,1\<rangle>, cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p) ) \<in> Add"
-    using FiniteFun.consI[of "\<langle>w,n\<rangle>" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 1 2 "cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p)"]
-      Fn_nat_eq_FiniteFun by auto
-  with \<open>n \<in> \<omega>\<close>
-  show "\<exists>d\<in>inj_dense(w,x). d \<preceq> p"
-    using \<open>p \<in> Add\<close> by (intro bexI) auto
-qed
+  using generic domain_f_G Pi_iff Un_filter_is_function generic
+    subset_trans[OF filter_subset_notion Fn_nat_subset_Pow]
+  unfolding M_generic_def
+  by force
 
 lemma inj_dense_closed[intro,simp]:
-  "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> inj_dense(w,x) \<in> M"
+  "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> inj_dense(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>,2,w,x) \<in> M"
   using transM[OF _ Aleph_rel2_closed] separation_conj separation_bex
-    lam_replacement_hcomp2[OF _ _  _ _ lam_replacement_Pair]
+    lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
     separation_in lam_replacement_fst lam_replacement_snd lam_replacement_constant
     lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict']
     separation_bex separation_conj
   by simp
 
 lemma Aleph_rel2_new_reals:
   assumes "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "w \<noteq> x"
   shows "(\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>w, n\<rangle>) \<noteq> (\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>x, n\<rangle>)"
 proof -
-  from assms
-  have "dense(inj_dense(w,x))" using dense_inj_dense by simp
+  have "0\<in>2" by auto
   with assms
-  obtain p where "p\<in>inj_dense(w,x)" "p\<in>G"
-    using generic[THEN M_generic_denseD, of "inj_dense(w,x)"]
+  have "dense(inj_dense(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>,2,w,x))"
+    unfolding dense_def using dense_inj_dense by auto
+  with assms
+  obtain p where "p\<in>inj_dense(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>,2,w,x)" "p\<in>G"
+    using M_generic_denseD[of "inj_dense(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>,2,w,x)"]
     by blast
   then
   obtain n where "n \<in> \<omega>" "\<langle>\<langle>w, n\<rangle>, 1\<rangle> \<in> p" "\<langle>\<langle>x, n\<rangle>, 0\<rangle> \<in> p"
     by blast
   moreover from this and \<open>p\<in>G\<close>
   have "\<langle>\<langle>w, n\<rangle>, 1\<rangle> \<in> f\<^bsub>G\<^esub>" "\<langle>\<langle>x, n\<rangle>, 0\<rangle> \<in> f\<^bsub>G\<^esub>" by auto
   moreover from calculation
   have "f\<^bsub>G\<^esub> ` \<langle>w, n\<rangle> = 1" "f\<^bsub>G\<^esub> ` \<langle>x, n\<rangle> = 0"
     using f_G_funtype apply_equality
     by auto
   ultimately
   have "(\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>w, n\<rangle>) ` n \<noteq> (\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>x, n\<rangle>) ` n"
     by simp
   then
   show ?thesis by fastforce
 qed
 
 definition
   h_G :: "i" (\<open>h\<^bsub>G\<^esub>\<close>) where
   "h\<^bsub>G\<^esub> \<equiv> \<lambda>\<alpha>\<in>\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>. \<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub>`\<langle>\<alpha>,n\<rangle>"
 
 lemma h_G_in_MG[simp]:
   includes G_generic1_lemmas
   shows "h\<^bsub>G\<^esub> \<in> M[G]"
-  using ext.lam_apply_replacement ext.apply_replacement2
-    ext.lam_apply_replacement[unfolded lam_replacement_def]
-    ext.Union_closed[simplified, OF G_in_MG]
-    \<comment> \<open>The "simplified" here is because of
-        the \<^term>\<open>setclass\<close> ocurrences\<close>
-    ext.nat_into_M
+  using ext.curry_closed[unfolded curry_def] G_in_MG
   unfolding h_G_def
-  by (rule_tac ext.lam_closed[simplified] |
-      auto dest:transM del:ext.cexp_rel_closed[simplified])+
+  by simp
 
 lemma h_G_inj_Aleph_rel2_reals: "h\<^bsub>G\<^esub> \<in> inj\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
-  using Aleph_rel_sub_closed
-proof (intro ext.mem_inj_abs[THEN iffD2])
-  show "h\<^bsub>G\<^esub> \<in> inj(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
-    unfolding inj_def
-  proof (intro ballI CollectI impI)
-    show "h\<^bsub>G\<^esub> \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
-      using f_G_funtype G_in_MG ext.nat_into_M
-      unfolding h_G_def
-      apply (intro lam_type ext.mem_function_space_rel_abs[THEN iffD2], simp_all)
-      apply (rule_tac ext.lam_closed[simplified], simp_all)
-       apply (rule ext.apply_replacement2)
-        apply (auto dest:ext.transM[OF _ Aleph_rel_sub_closed])
-      done
-    fix w x
-    assume "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "h\<^bsub>G\<^esub> ` w = h\<^bsub>G\<^esub> ` x"
-    then
-    show "w = x"
-      unfolding h_G_def using Aleph_rel2_new_reals by auto
-  qed
-qed simp_all
+  using Aleph_rel_sub_closed f_G_funtype G_in_MG Aleph_rel_sub_closed
+    ext.curry_rel_exp[unfolded curry_def] ext.curry_closed[unfolded curry_def]
+    ext.mem_function_space_rel_abs
+  by (intro ext.mem_inj_abs[THEN iffD2],simp_all)
+      (auto simp: inj_def h_G_def dest:Aleph_rel2_new_reals)
 
 lemma Aleph2_extension_le_continuum_rel:
   includes G_generic1_lemmas
   shows "\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
 proof -
-  have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "Ord(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>)"
-    using Card_rel_is_Ord by auto
-  moreover from this
-  have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<lesssim>\<^bsup>M[G]\<^esup> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
+  have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup> \<lesssim>\<^bsup>M[G]\<^esup> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
     using ext.def_lepoll_rel[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"]
-      h_G_inj_Aleph_rel2_reals by auto
+      h_G_inj_Aleph_rel2_reals Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
+    by auto
   moreover from calculation
-  have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<lesssim>\<^bsup>M[G]\<^esup> |\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2|\<^bsup>M[G]\<^esup>"
+  have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup> \<lesssim>\<^bsup>M[G]\<^esup> |\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2|\<^bsup>M[G]\<^esup>"
     using ext.lepoll_rel_imp_lepoll_rel_cardinal_rel by simp
   ultimately
-  have "|\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>|\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
-    using ext.lepoll_rel_imp_cardinal_rel_le[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2",
+  have "|\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup>|\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
+    using ext.lepoll_rel_imp_cardinal_rel_le[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2",
         OF _ _ ext.function_space_rel_closed]
-      ext.Aleph_rel_zero Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
+      ext.Aleph_rel_zero
     unfolding cexp_rel_def by simp
   then
   show "\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
-    using Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
-      ext.Card_rel_Aleph_rel[of 2, THEN ext.Card_rel_cardinal_rel_eq]
+    using ext.Card_rel_Aleph_rel[of 2, THEN ext.Card_rel_cardinal_rel_eq]
     by simp
 qed
 
 lemma Aleph_rel_lt_continuum_rel: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> < 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
   using Aleph2_extension_le_continuum_rel
     ext.Aleph_rel_increasing[of 1 2] le_trans by auto
 
 corollary not_CH: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> \<noteq> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
   using Aleph_rel_lt_continuum_rel by auto
 
 end \<comment> \<open>\<^locale>\<open>add_generic4\<close>\<close>
 
 subsection\<open>Models of fragments of $\ZFC + \neg \CH$\<close>
 
 definition
   ContHyp :: "o" where
   "ContHyp \<equiv> \<aleph>\<^bsub>1\<^esub> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^esup>"
 
 relativize functional "ContHyp" "ContHyp_rel"
 notation ContHyp_rel (\<open>CH\<^bsup>_\<^esup>\<close>)
 relationalize "ContHyp_rel" "is_ContHyp"
 
-context M_master
+context M_ZF_library
 begin
 
 is_iff_rel for "ContHyp"
   using is_cexp_iff is_Aleph_iff[of 0] is_Aleph_iff[of 1]
   unfolding is_ContHyp_def ContHyp_rel_def
   by (auto simp del:setclass_iff) (rule rexI[of _ _ M, OF _ nonempty], auto)
 
-end \<comment> \<open>\<^locale>\<open>M_master\<close>\<close>
+end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
 
 synthesize "is_ContHyp" from_definition assuming "nonempty"
 arity_theorem for "is_ContHyp_fm"
 
 notation is_ContHyp_fm (\<open>\<cdot>CH\<cdot>\<close>)
 
 theorem ctm_of_not_CH:
   assumes
     "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
     "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
   shows
     "\<exists>N.
       M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
       (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
 proof -
   from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
   interpret M_ZFC4 M
     using M_satT_overhead_imp_M_ZF4 by simp
-  from \<open>Transset(M)\<close>
-  interpret M_ZFC4_trans M
-    using M_satT_imp_M_ZF4
-    by unfold_locales
+  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
+  have "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms \<union> instances_ground_fms }"
+    unfolding overhead_def ZC_def
+    by auto
+  with \<open>Transset(M)\<close>
+  interpret M_ZF_ground_trans M
+    using M_satT_imp_M_ZF_ground_trans
+    by simp
   from \<open>M \<approx> \<omega>\<close>
   obtain enum where "enum \<in> bij(\<omega>,M)"
     using eqpoll_sym unfolding eqpoll_def by blast
   then
   interpret M_ctm4_AC M enum by unfold_locales
   interpret cohen_data \<omega> "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 2 by unfold_locales auto
   have "Add \<in> M" "Add_le(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>) \<in> M"
     using nat_into_M Aleph_rel_closed M_nat cartprod_closed Fn_nat_closed Fnle_nat_closed
     by simp_all
   then
   interpret forcing_data1 "Add" "Add_le(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>)" 0 M enum
     by unfold_locales simp_all
   obtain G where "M_generic(G)"
     using generic_filter_existence[OF one_in_P]
     by auto
   moreover from this
   interpret add_generic4 M enum G by unfold_locales
   have "\<not> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>)"
     using not_CH .
   then
   have "M[G], [] \<Turnstile> \<cdot>\<not>\<cdot>CH\<cdot>\<cdot>"
     using ext.is_ContHyp_iff
     by (simp add:ContHyp_rel_def)
   then
   have "M[G] \<Turnstile> ZC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}"
     using ext.M_satT_ZC by auto
   moreover
   have "Transset(M[G])" using Transset_MG .
   moreover
   have "M \<subseteq> M[G]" using M_subset_MG[OF one_in_G] generic by simp
   moreover
   note \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
   ultimately
   show ?thesis
     using Ord_MG_iff MG_eqpoll_nat satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
     by (rule_tac x="M[G]" in exI, blast)
 qed
 
 lemma ZF_replacement_overhead_sub_ZFC: "{\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<subseteq> ZFC"
   using overhead_type unfolding ZFC_def ZF_def ZF_schemes_def by auto
 
+lemma ZF_replacement_overhead_CH_sub_ZFC: "{\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH} \<subseteq> ZFC"
+  using overhead_CH_type unfolding ZFC_def ZF_def ZF_schemes_def by auto
+
 corollary ctm_ZFC_imp_ctm_not_CH:
   assumes
     "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZFC"
   shows
     "\<exists>N.
       M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<and>
       (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
 proof-
   from assms
   have "\<exists>N.
       M \<subseteq> N \<and>
         N \<approx> \<omega> \<and>
         Transset(N) \<and>
         N \<Turnstile> ZC \<and> N \<Turnstile> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<and> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
     using ctm_of_not_CH[of M formula] satT_ZFC_imp_satT_ZC[of M]
       satT_mono[OF _ ground_repl_fm_sub_ZFC, of M]
       satT_mono[OF _ ZF_replacement_overhead_sub_ZFC, of M]
       satT_mono[OF _ ZF_replacement_fms_sub_ZFC, of M]
     by (simp add: satT_Un_iff)
   then
   obtain N where "N \<Turnstile> ZC" "N \<Turnstile> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}" "N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula}"
     "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
     by auto
   moreover from this
   have "N \<Turnstile> ZFC"
     using satT_ZC_ZF_replacement_imp_satT_ZFC
     by auto
   moreover from this and \<open>N \<Turnstile> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}\<close>
   have "N \<Turnstile> ZFC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}"
     by auto
   ultimately
   show ?thesis by auto
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Ordinals_In_MG.thy b/thys/Independence_CH/Ordinals_In_MG.thy
--- a/thys/Independence_CH/Ordinals_In_MG.thy
+++ b/thys/Independence_CH/Ordinals_In_MG.thy
@@ -1,57 +1,57 @@
 section\<open>Ordinals in generic extensions\<close>
 theory Ordinals_In_MG
   imports
     Forcing_Theorems
 begin
 
 context G_generic1
 begin
 
-lemma rank_val: "rank(val(P,G,x)) \<le> rank(x)" (is "?Q(x)")
+lemma rank_val: "rank(val(G,x)) \<le> rank(x)" (is "?Q(x)")
 proof (induct rule:ed_induction[of ?Q])
   case (1 x)
-  have "val(P,G,x) = {val(P,G,u). u\<in>{t\<in>domain(x). \<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G }}"
+  have "val(G,x) = {val(G,u). u\<in>{t\<in>domain(x). \<exists>p\<in>G . \<langle>t,p\<rangle>\<in>x }}"
     using def_val[of G x] by auto
   then
-  have "rank(val(P,G,x)) = (\<Union>u\<in>{t\<in>domain(x). \<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G }. succ(rank(val(P,G,u))))"
-    using rank[of "val(P,G,x)"] by simp
+  have "rank(val(G,x)) = (\<Union>u\<in>{t\<in>domain(x). \<exists>p\<in>G . \<langle>t,p\<rangle>\<in>x }. succ(rank(val(G,u))))"
+    using rank[of "val(G,x)"] by simp
   moreover
-  have "succ(rank(val(P,G, y))) \<le> rank(x)" if "ed(y, x)" for y
+  have "succ(rank(val(G, y))) \<le> rank(x)" if "ed(y, x)" for y
     using 1[OF that] rank_ed[OF that] by (auto intro:lt_trans1)
   moreover from this
-  have "(\<Union>u\<in>{t\<in>domain(x). \<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G }. succ(rank(val(P,G,u)))) \<le> rank(x)"
+  have "(\<Union>u\<in>{t\<in>domain(x). \<exists>p\<in>G . \<langle>t,p\<rangle>\<in>x }. succ(rank(val(G,u)))) \<le> rank(x)"
     by (rule_tac UN_least_le) (auto)
   ultimately
   show ?case
     by simp
 qed
 
 lemma Ord_MG_iff:
   assumes "Ord(\<alpha>)"
   shows "\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> M[G]"
 proof
   show "\<alpha> \<in> M[G]" if "\<alpha> \<in> M"
-    using generic[THEN one_in_G, THEN M_subset_MG] that ..
+    using M_subset_MG[OF one_in_G] that ..
 next
   assume "\<alpha> \<in> M[G]"
   then
-  obtain x where "x\<in>M" "val(P,G,x) = \<alpha>"
+  obtain x where "x\<in>M" "val(G,x) = \<alpha>"
     using GenExtD by auto
   then
   have "rank(\<alpha>) \<le> rank(x)"
     using rank_val by blast
   with assms
   have "\<alpha> \<le> rank(x)"
     using rank_of_Ord by simp
   then
   have "\<alpha> \<in> succ(rank(x))"
     using ltD by simp
   with \<open>x\<in>M\<close>
   show "\<alpha> \<in> M"
     using cons_closed transitivity[of \<alpha> "succ(rank(x))"] rank_closed
     unfolding succ_def by simp
 qed
 
 end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Pairing_Axiom.thy b/thys/Independence_CH/Pairing_Axiom.thy
--- a/thys/Independence_CH/Pairing_Axiom.thy
+++ b/thys/Independence_CH/Pairing_Axiom.thy
@@ -1,54 +1,46 @@
 section\<open>The Axiom of Pairing in $M[G]$\<close>
 
 theory Pairing_Axiom
   imports
     Names
 begin
 
-context forcing_data1
+context G_generic1
 begin
 
 lemma val_Upair :
-  "\<one> \<in> G \<Longrightarrow> val(P,G,{\<langle>\<tau>,\<one>\<rangle>,\<langle>\<rho>,\<one>\<rangle>}) = {val(P,G,\<tau>),val(P,G,\<rho>)}"
-  by (insert one_in_P, rule trans, subst def_val,auto)
+  "\<one> \<in> G \<Longrightarrow> val(G,{\<langle>\<tau>,\<one>\<rangle>,\<langle>\<rho>,\<one>\<rangle>}) = {val(G,\<tau>),val(G,\<rho>)}"
+  by (rule trans, subst def_val,auto)
 
-lemma pairing_in_MG :
-  assumes "M_generic(G)"
-  shows "upair_ax(##M[G])"
+lemma pairing_in_MG : "upair_ax(##M[G])"
 proof -
-  from assms
-  have types: "\<one>\<in>G" "\<one>\<in>P" "\<one>\<in>M"
-    using one_in_G one_in_M one_in_P
-    by simp_all
   {
     fix x y
-    note assms types
-    moreover
     assume "x \<in> M[G]" "y \<in> M[G]"
     moreover from this
-    obtain \<tau> \<rho> where "val(P,G,\<tau>) = x" "val(P,G,\<rho>) = y" "\<rho> \<in> M"  "\<tau> \<in> M"
+    obtain \<tau> \<rho> where "val(G,\<tau>) = x" "val(G,\<rho>) = y" "\<rho> \<in> M"  "\<tau> \<in> M"
       using GenExtD by blast
-    moreover from types this
+    moreover from this
     have "\<langle>\<tau>,\<one>\<rangle> \<in> M" "\<langle>\<rho>,\<one>\<rangle>\<in>M"
       using pair_in_M_iff by auto
     moreover from this
     have "{\<langle>\<tau>,\<one>\<rangle>,\<langle>\<rho>,\<one>\<rangle>} \<in> M" (is "?\<sigma> \<in> _")
       using upair_in_M_iff by simp
     moreover from this
-    have "val(P,G,?\<sigma>) \<in> M[G]"
+    have "val(G,?\<sigma>) \<in> M[G]"
       using GenExtI by simp
     moreover from calculation
-    have "{val(P,G,\<tau>),val(P,G,\<rho>)} \<in> M[G]"
-      using val_Upair assms one_in_G by simp
+    have "{val(G,\<tau>),val(G,\<rho>)} \<in> M[G]"
+      using val_Upair one_in_G by simp
     ultimately
     have "{x,y} \<in> M[G]"
       by simp
   }
   then
   show ?thesis
     unfolding upair_ax_def upair_def by auto
 qed
 
-end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Powerset_Axiom.thy b/thys/Independence_CH/Powerset_Axiom.thy
--- a/thys/Independence_CH/Powerset_Axiom.thy
+++ b/thys/Independence_CH/Powerset_Axiom.thy
@@ -1,298 +1,266 @@
 section\<open>The Powerset Axiom in $M[G]$\<close>
 theory Powerset_Axiom
   imports Separation_Axiom Pairing_Axiom Union_Axiom
 begin
 
 simple_rename "perm_pow" src "[ss,p,l,o,fs,\<chi>]" tgt "[fs,ss,sp,p,l,o,\<chi>]"
 
 lemma Collect_inter_Transset:
   assumes
     "Transset(M)" "b \<in> M"
   shows
     "{x\<in>b . P(x)} = {x\<in>b . P(x)} \<inter> M"
   using assms unfolding Transset_def
   by (auto)
 
 context G_generic1
 begin
 
-lemma name_components_in_M:
-  assumes "\<langle>\<sigma>,p\<rangle>\<in>\<theta>" "\<theta> \<in> M"
-  shows   "\<sigma>\<in>M" "p\<in>M"
-proof -
-  from assms
-  obtain a where "\<sigma> \<in> a" "p \<in> a" "a\<in>\<langle>\<sigma>,p\<rangle>"
-    unfolding Pair_def by auto
-  moreover from assms
-  have "\<langle>\<sigma>,p\<rangle>\<in>M"
-    using transitivity by simp
-  moreover from calculation
-  have "a\<in>M"
-    using transitivity by simp
-  ultimately
-  show "\<sigma>\<in>M" "p\<in>M"
-    using transitivity by simp_all
-qed
-
 lemma sats_fst_snd_in_M:
   assumes
     "A\<in>M" "B\<in>M" "\<phi> \<in> formula" "p\<in>M" "l\<in>M" "o\<in>M" "\<chi>\<in>M" "arity(\<phi>) \<le> 6"
   shows "{\<langle>s,q\<rangle>\<in>A\<times>B . M, [q,p,l,o,s,\<chi>] \<Turnstile> \<phi>} \<in> M" (is "?\<theta> \<in> M")
 proof -
   let ?\<phi>' = "ren(\<phi>)`6`7`perm_pow_fn"
   from \<open>A\<in>M\<close> \<open>B\<in>M\<close>
   have "A\<times>B \<in> M"
     using cartprod_closed by simp
   from \<open>arity(\<phi>) \<le> 6\<close> \<open>\<phi>\<in> formula\<close>
   have "?\<phi>' \<in> formula" "arity(?\<phi>')\<le>7"
     unfolding perm_pow_fn_def
     using perm_pow_thm  arity_ren ren_tc Nil_type
     by auto
   with \<open>?\<phi>' \<in> formula\<close>
   have arty: "arity(Exists(Exists(And(pair_fm(0,1,2),?\<phi>'))))\<le>5" (is "arity(?\<psi>)\<le>5")
     using ord_simp_union pred_le
     by (auto simp:arity)
   {
     fix sp
     note \<open>A\<times>B \<in> M\<close> \<open>A\<in>M\<close> \<open>B\<in>M\<close>
     moreover
     assume "sp \<in> A\<times>B"
     moreover from calculation
     have "fst(sp) \<in> A" "snd(sp) \<in> B"
       using fst_type snd_type by simp_all
     ultimately
     have "sp \<in> M" "fst(sp) \<in> M" "snd(sp) \<in> M"
       using transitivity
       by simp_all
     note inM = \<open>A\<in>M\<close> \<open>B\<in>M\<close> \<open>p\<in>M\<close> \<open>l\<in>M\<close> \<open>o\<in>M\<close> \<open>\<chi>\<in>M\<close>
       \<open>sp\<in>M\<close> \<open>fst(sp)\<in>M\<close> \<open>snd(sp)\<in>M\<close>
     with arty \<open>sp \<in> M\<close> \<open>?\<phi>' \<in> formula\<close>
     have "(M, [sp,p,l,o,\<chi>]@[p] \<Turnstile> ?\<psi>) \<longleftrightarrow> M,[sp,p,l,o,\<chi>] \<Turnstile> ?\<psi>" (is "(M,?env0@ _\<Turnstile>_) \<longleftrightarrow> _")
       using arity_sats_iff[of ?\<psi> "[p]" M ?env0] by auto
     also from inM \<open>sp \<in> A\<times>B\<close>
     have "... \<longleftrightarrow> sats(M,?\<phi>',[fst(sp),snd(sp),sp,p,l,o,\<chi>])"
       by auto
     also from inM \<open>\<phi> \<in> formula\<close> \<open>arity(\<phi>) \<le> 6\<close>
     have "... \<longleftrightarrow> M, [snd(sp),p,l,o,fst(sp),\<chi>] \<Turnstile> \<phi>"
       (is "sats(_,_,?env1) \<longleftrightarrow> sats(_,_,?env2)")
       using sats_iff_sats_ren[of \<phi> 6 7 ?env2 M ?env1 perm_pow_fn] perm_pow_thm
       unfolding perm_pow_fn_def by simp
     finally
     have "(M,[sp,p,l,o,\<chi>,p] \<Turnstile> ?\<psi>) \<longleftrightarrow> M, [snd(sp),p,l,o,fst(sp),\<chi>] \<Turnstile> \<phi>"
       by simp
   }
   then
   have "?\<theta> = {sp\<in>A\<times>B . sats(M,?\<psi>,[sp,p,l,o,\<chi>,p])}"
     by auto
-  also from assms \<open>A\<times>B\<in>M\<close>
-  have " ... \<in> M"
-  proof -
-    from arty
-    have "arity(?\<psi>) \<le> 6"
-      using leI by simp
-    moreover from \<open>?\<phi>' \<in> formula\<close>
-    have "?\<psi> \<in> formula"
-      by simp
-    moreover
-    note assms \<open>A\<times>B\<in>M\<close>
-    ultimately
-    show "{x \<in> A\<times>B . M, [x, p, l, o, \<chi>, p] \<Turnstile> ?\<psi>} \<in> M"
-      using separation_ax separation_iff
-      by simp
-  qed
-  finally show ?thesis .
+  with assms \<open>A\<times>B\<in>M\<close>
+  show ?thesis
+    using separation_ax separation_iff arty leI \<open>?\<phi>' \<in> formula\<close>
+    by simp
 qed
 
+declare nat_into_M[rule del, simplified setclass_iff, intro]
+lemmas ssimps = domain_closed cartprod_closed cons_closed
+declare ssimps [simp del, simplified setclass_iff, simp, intro]
+
 lemma Pow_inter_MG:
   assumes "a\<in>M[G]"
   shows "Pow(a) \<inter> M[G] \<in> M[G]"
 proof -
   from assms
-  obtain \<tau> where "\<tau> \<in> M" "val(P,G, \<tau>) = a"
+  obtain \<tau> where "\<tau> \<in> M" "val(G, \<tau>) = a"
     using GenExtD by auto
   let ?Q="Pow(domain(\<tau>)\<times>P) \<inter> M"
   from \<open>\<tau>\<in>M\<close>
   have "domain(\<tau>)\<times>P \<in> M" "domain(\<tau>) \<in> M"
-    using domain_closed cartprod_closed P_in_M
     by simp_all
   then
   have "?Q \<in> M"
   proof -
     from power_ax \<open>domain(\<tau>)\<times>P \<in> M\<close>
     obtain Q where "powerset(##M,domain(\<tau>)\<times>P,Q)" "Q \<in> M"
       unfolding power_ax_def by auto
     moreover from calculation
     have "z\<in>Q \<Longrightarrow> z\<in>M" for z
       using transitivity by blast
     ultimately
     have "Q = {a\<in>Pow(domain(\<tau>)\<times>P) . a\<in>M}"
       using \<open>domain(\<tau>)\<times>P \<in> M\<close> powerset_abs[of "domain(\<tau>)\<times>P" Q]
       by (simp flip: setclass_iff)
     also
     have " ... = ?Q"
       by auto
     finally
     show ?thesis
       using \<open>Q\<in>M\<close> by simp
   qed
   let ?\<pi>="?Q\<times>{\<one>}"
-  let ?b="val(P,G,?\<pi>)"
+  let ?b="val(G,?\<pi>)"
   from \<open>?Q\<in>M\<close>
   have "?\<pi>\<in>M"
-    using one_in_P P_in_M transitivity
-    by (simp flip: setclass_iff)
+    by auto
   then
   have "?b \<in> M[G]"
     using GenExtI by simp
   have "Pow(a) \<inter> M[G] \<subseteq> ?b"
   proof
     fix c
     assume "c \<in> Pow(a) \<inter> M[G]"
     then
-    obtain \<chi> where "c\<in>M[G]" "\<chi> \<in> M" "val(P,G,\<chi>) = c"
+    obtain \<chi> where "c\<in>M[G]" "\<chi> \<in> M" "val(G,\<chi>) = c"
       using GenExt_iff by auto
     let ?\<theta>="{\<langle>\<sigma>,p\<rangle> \<in>domain(\<tau>)\<times>P . p \<tturnstile> \<cdot>0 \<in> 1\<cdot> [\<sigma>,\<chi>] }"
     have "arity(forces(Member(0,1))) = 6"
       using arity_forces_at by auto
     with \<open>domain(\<tau>) \<in> M\<close> \<open>\<chi> \<in> M\<close>
     have "?\<theta> \<in> M"
-      using P_in_M one_in_M leq_in_M sats_fst_snd_in_M
+      using sats_fst_snd_in_M
       by simp
     then
     have "?\<theta> \<in> ?Q" by auto
     then
-    have "val(P,G,?\<theta>) \<in> ?b"
-      using one_in_G one_in_P generic val_of_elem [of ?\<theta> \<one> ?\<pi> G]
+    have "val(G,?\<theta>) \<in> ?b"
+      using one_in_G generic val_of_elem [of ?\<theta> \<one> ?\<pi> G]
       by auto
-    have "val(P,G,?\<theta>) = c"
+    have "val(G,?\<theta>) = c"
     proof(intro equalityI subsetI)
       fix x
-      assume "x \<in> val(P,G,?\<theta>)"
+      assume "x \<in> val(G,?\<theta>)"
       then
-      obtain \<sigma> p where 1: "\<langle>\<sigma>,p\<rangle>\<in>?\<theta>" "p\<in>G" "val(P,G,\<sigma>) =  x"
+      obtain \<sigma> p where 1: "\<langle>\<sigma>,p\<rangle>\<in>?\<theta>" "p\<in>G" "val(G,\<sigma>) =  x"
         using elem_of_val_pair
         by blast
       moreover from \<open>\<langle>\<sigma>,p\<rangle>\<in>?\<theta>\<close> \<open>?\<theta> \<in> M\<close>
       have "\<sigma>\<in>M"
         using name_components_in_M[of _ _ ?\<theta>] by auto
       moreover from 1
       have "p \<tturnstile> \<cdot>0 \<in> 1\<cdot> [\<sigma>,\<chi>]" "p\<in>P"
         by simp_all
       moreover
-      note \<open>val(P,G,\<chi>) = c\<close> \<open>\<chi> \<in> M\<close>
+      note \<open>val(G,\<chi>) = c\<close> \<open>\<chi> \<in> M\<close>
       ultimately
       have "M[G], [x, c] \<Turnstile> \<cdot>0 \<in> 1\<cdot>"
         using generic definition_of_forcing[where \<phi>="\<cdot>0 \<in> 1\<cdot>"] ord_simp_union
         by auto
       moreover from \<open>\<sigma>\<in>M\<close> \<open>\<chi>\<in>M\<close>
       have "x\<in>M[G]"
-        using \<open>val(P,G,\<sigma>) = x\<close> GenExtI by blast
+        using \<open>val(G,\<sigma>) = x\<close> GenExtI by blast
       ultimately
       show "x\<in>c"
         using \<open>c\<in>M[G]\<close> by simp
     next
       fix x
       assume "x \<in> c"
       with \<open>c \<in> Pow(a) \<inter> M[G]\<close>
       have "x \<in> a" "c\<in>M[G]" "x\<in>M[G]"
         using transitivity_MG by auto
-      with \<open>val(P,G, \<tau>) = a\<close>
-      obtain \<sigma> where "\<sigma>\<in>domain(\<tau>)" "val(P,G,\<sigma>) = x"
+      with \<open>val(G, \<tau>) = a\<close>
+      obtain \<sigma> where "\<sigma>\<in>domain(\<tau>)" "val(G,\<sigma>) = x"
         using elem_of_val by blast
       moreover
-      note \<open>x\<in>c\<close> \<open>val(P,G,\<chi>) = c\<close> \<open>c\<in>M[G]\<close> \<open>x\<in>M[G]\<close>
+      note \<open>x\<in>c\<close> \<open>val(G,\<chi>) = c\<close> \<open>c\<in>M[G]\<close> \<open>x\<in>M[G]\<close>
       moreover from calculation
-      have "val(P,G,\<sigma>) \<in> val(P,G,\<chi>)"
+      have "val(G,\<sigma>) \<in> val(G,\<chi>)"
         by simp
       moreover from calculation
       have "M[G], [x, c] \<Turnstile> \<cdot>0 \<in> 1\<cdot>"
         by simp
       moreover
       have "\<sigma>\<in>M"
       proof -
         from \<open>\<sigma>\<in>domain(\<tau>)\<close>
         obtain p where "\<langle>\<sigma>,p\<rangle> \<in> \<tau>"
           by auto
         with \<open>\<tau>\<in>M\<close>
         show ?thesis
           using name_components_in_M by blast
       qed
       moreover
       note \<open>\<chi> \<in> M\<close>
       ultimately
       obtain p where "p\<in>G" "p \<tturnstile> \<cdot>0 \<in> 1\<cdot> [\<sigma>,\<chi>]"
-        using generic truth_lemma[of "\<cdot>0 \<in> 1\<cdot>" "G" "[\<sigma>,\<chi>]" ] ord_simp_union
+        using generic truth_lemma[of "\<cdot>0 \<in> 1\<cdot>" "[\<sigma>,\<chi>]" ] ord_simp_union
         by auto
       moreover from \<open>p\<in>G\<close>
       have "p\<in>P"
         using generic by blast
       ultimately
       have "\<langle>\<sigma>,p\<rangle>\<in>?\<theta>"
         using \<open>\<sigma>\<in>domain(\<tau>)\<close> by simp
-      with \<open>val(P,G,\<sigma>) =  x\<close> \<open>p\<in>G\<close>
-      show "x\<in>val(P,G,?\<theta>)"
-        using val_of_elem [of _ _ "?\<theta>"] by auto
+      with \<open>val(G,\<sigma>) =  x\<close> \<open>p\<in>G\<close>
+      show "x\<in>val(G,?\<theta>)"
+        using val_of_elem [of _ _ "?\<theta>" G] by auto
     qed
-    with \<open>val(P,G,?\<theta>) \<in> ?b\<close>
+    with \<open>val(G,?\<theta>) \<in> ?b\<close>
     show "c\<in>?b"
       by simp
   qed
   then
   have "Pow(a) \<inter> M[G] = {x\<in>?b . x\<subseteq>a \<and> x\<in>M[G]}"
     by auto
   also from \<open>a\<in>M[G]\<close>
   have " ... = {x\<in>?b . ( M[G], [x,a] \<Turnstile> \<cdot>0 \<subseteq> 1\<cdot> ) \<and> x\<in>M[G]}"
     using Transset_MG by force
   also
   have " ... = {x\<in>?b . ( M[G], [x,a] \<Turnstile> \<cdot>0 \<subseteq> 1\<cdot> )} \<inter> M[G]"
     by auto
   also from \<open>?b\<in>M[G]\<close>
   have " ... = {x\<in>?b . ( M[G], [x,a] \<Turnstile> \<cdot>0 \<subseteq> 1\<cdot> )}"
     using Collect_inter_Transset Transset_MG
     by simp
   also from \<open>?b\<in>M[G]\<close> \<open>a\<in>M[G]\<close>
   have " ... \<in> M[G]"
     using Collect_sats_in_MG GenExtI ord_simp_union by (simp add:arity)
   finally
   show ?thesis .
 qed
 
 end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 sublocale G_generic1 \<subseteq> ext: M_trivial "##M[G]"
   using generic Union_MG pairing_in_MG zero_in_MG transitivity_MG
   unfolding M_trivial_def M_trans_def M_trivial_axioms_def
   by (simp; blast)
 
 context G_generic1 begin
 
 theorem power_in_MG : "power_ax(##(M[G]))"
   unfolding power_ax_def
 proof (intro rallI, simp only:setclass_iff rex_setclass_is_bex)
-  (* After simplification, we have to show that for every
-     a\<in>M[G] there exists some x\<in>M[G] with powerset(##M[G],a,x)
-  *)
   fix a
+  text\<open>After simplification, we have to show that for every
+  \<^term>\<open>a\<in>M[G]\<close> there exists some \<^term>\<open>x\<in>M[G]\<close> satisfying
+  \<^term>\<open>powerset(##M[G],a,x)\<close>\<close>
   assume "a \<in> M[G]"
-  then
-  have "(##M[G])(a)"
-    by simp
   have "{x\<in>Pow(a) . x \<in> M[G]} = Pow(a) \<inter> M[G]"
     by auto
   also from \<open>a\<in>M[G]\<close>
   have " ... \<in> M[G]"
     using Pow_inter_MG by simp
   finally
   have "{x\<in>Pow(a) . x \<in> M[G]} \<in> M[G]" .
-  moreover from \<open>a\<in>M[G]\<close> \<open>{x\<in>Pow(a) . x \<in> M[G]} \<in> _\<close>
+  moreover from \<open>a\<in>M[G]\<close> this
   have "powerset(##M[G], a, {x\<in>Pow(a) . x \<in> M[G]})"
-    using ext.powerset_abs[OF \<open>(##M[G])(a)\<close>]
+    using ext.powerset_abs
     by simp
   ultimately
   show "\<exists>x\<in>M[G] . powerset(##M[G], a, x)"
     by auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Proper_Extension.thy b/thys/Independence_CH/Proper_Extension.thy
--- a/thys/Independence_CH/Proper_Extension.thy
+++ b/thys/Independence_CH/Proper_Extension.thy
@@ -1,79 +1,83 @@
 section\<open>Separative notions and proper extensions\<close>
 theory Proper_Extension
   imports
     Names
 
 begin
 
 text\<open>The key ingredient to obtain a proper extension is to have
 a \<^emph>\<open>separative preorder\<close>:\<close>
 
 locale separative_notion = forcing_notion +
   assumes separative: "p\<in>P \<Longrightarrow> \<exists>q\<in>P. \<exists>r\<in>P. q \<preceq> p \<and> r \<preceq> p \<and> q \<bottom> r"
 begin
 
 text\<open>For separative preorders, the complement of every filter is
 dense. Hence an $M$-generic filter cannot belong to the ground model.\<close>
 
 lemma filter_complement_dense:
   assumes "filter(G)"
   shows "dense(P - G)"
 proof
   fix p
   assume "p\<in>P"
   show "\<exists>d\<in>P - G. d \<preceq> p"
   proof (cases "p\<in>G")
     case True
     note \<open>p\<in>P\<close> assms
     moreover
     obtain q r where "q \<preceq> p" "r \<preceq> p" "q \<bottom> r" "q\<in>P" "r\<in>P"
       using separative[OF \<open>p\<in>P\<close>]
       by force
     with \<open>filter(G)\<close>
     obtain s where "s \<preceq> p" "s \<notin> G" "s \<in> P"
       using filter_imp_compat[of G q r]
       by auto
     then
     show ?thesis
       by blast
   next
     case False
     with \<open>p\<in>P\<close>
     show ?thesis
       using refl_leq unfolding Diff_def by auto
   qed
 qed
 
 end \<comment> \<open>\<^locale>\<open>separative_notion\<close>\<close>
-
-locale ctm_separative = forcing_data1 + separative_notion
+locale ctm_separative = forcing_data2 + separative_notion
 begin
 
+context
+  fixes G
+  assumes generic: "M_generic(G)"
+begin
+
+interpretation G_generic1 P leq \<one> M enum G
+  by unfold_locales (simp add:generic)
+
 lemma generic_not_in_M:
-  assumes "M_generic(G)"
   shows "G \<notin> M"
 proof
   assume "G\<in>M"
   then
   have "P - G \<in> M"
-    using P_in_M Diff_closed by simp
+    using Diff_closed by simp
   moreover
   have "\<not>(\<exists>q\<in>G. q \<in> P - G)" "(P - G) \<subseteq> P"
     unfolding Diff_def by auto
   moreover
-  note assms
+  note generic
   ultimately
   show "False"
-    using filter_complement_dense[of G] M_generic_denseD[of G "P-G"]
-      M_generic_def by simp \<comment> \<open>need to put generic ==> filter in claset\<close>
+    using filter_complement_dense[of G] M_generic_denseD[of "P-G"]
+      M_generic_def[of G] by simp (*TODO: put generic ==> filter in claset ?*)
 qed
 
-theorem proper_extension:
-  assumes "M_generic(G)"
-  shows "M \<noteq> M[G]"
-  using assms G_in_Gen_Ext[of G] one_in_G[of G] generic_not_in_M
+theorem proper_extension: "M \<noteq> M[G]"
+  using generic G_in_Gen_Ext one_in_G generic_not_in_M
   by force
-
+end
 end \<comment> \<open>\<^locale>\<open>ctm_separative\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Replacement_Axiom.thy b/thys/Independence_CH/Replacement_Axiom.thy
--- a/thys/Independence_CH/Replacement_Axiom.thy
+++ b/thys/Independence_CH/Replacement_Axiom.thy
@@ -1,393 +1,306 @@
 section\<open>The Axiom of Replacement in $M[G]$\<close>
 theory Replacement_Axiom
   imports
     Separation_Axiom
 begin
 
 context forcing_data1
 begin
 
 bundle sharp_simps1 = snd_abs[simp] fst_abs[simp] fst_closed[simp del, simplified, simp]
-    snd_closed[simp del, simplified, simp] M_inhabited[simplified, simp]
-    pair_in_M_iff[simp del, simplified, simp]
-
-lemma sats_forces_iff_sats_rename_split_fm:
-  includes sharp_simps1
-  assumes
-    "[\<alpha>,m,p,P,leq,\<one>,t,\<tau>] @ nenv \<in>list(M)" "V \<in> M"
-    "\<phi>\<in>formula"
-  shows
-    "(M, [p, P, leq, \<one>, t, \<tau>] @ nenv \<Turnstile> forces(\<phi>)) \<longleftrightarrow>
-      M, [V, \<tau>, \<alpha>, \<langle>t,p\<rangle>, m, P, leq, \<one>] @ nenv \<Turnstile> rename_split_fm(\<phi>)"
-  using assms unfolding rename_split_fm_def
-  by (simp add:sats_incr_bv_iff[where bvs="[_,_,_,_,_,_]", simplified])
+  snd_closed[simp del, simplified, simp] M_inhabited[simplified, simp]
+  pair_in_M_iff[simp del, simplified, simp]
 
 lemma sats_body_ground_repl_fm:
   includes sharp_simps1
   assumes
     "\<exists>t p. x=\<langle>t,p\<rangle>" "[x,\<alpha>,m,P,leq,\<one>] @ nenv \<in>list(M)"
     "\<phi>\<in>formula"
   shows
     "(\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(\<lambda>a. (##M)(a),\<alpha>,V) \<and> \<tau> \<in> V \<and> (snd(x) \<tturnstile> \<phi> ([fst(x),\<tau>]@nenv)))
     \<longleftrightarrow> M, [\<alpha>, x, m, P, leq, \<one>] @ nenv \<Turnstile> body_ground_repl_fm(\<phi>)"
-proof -
-  {
-    fix \<tau> V t p
-    assume "\<tau> \<in> M" "V \<in> M" "x = \<langle>t, p\<rangle>" "t \<in> M" "p \<in> M"
-    with assms
-    have "\<tau> \<in> V \<and> (M, [p,P,leq,\<one>,t,\<tau>] @ nenv \<Turnstile> forces(\<phi>)) \<longleftrightarrow>
-      \<tau> \<in> V \<and> (M, [V,\<tau>,\<alpha>,\<langle>t, p\<rangle>,m,P, leq, \<one>] @ nenv \<Turnstile> rename_split_fm(\<phi>))"
-      using sats_forces_iff_sats_rename_split_fm[of \<alpha> m p t \<tau>, where nenv=nenv and \<phi>=\<phi>]
-      by auto
-  }
-  note eq = this
-  show ?thesis
-    unfolding body_ground_repl_fm_def
-    apply (insert assms)
-    apply (rule iff_sats | simp add:nonempty[simplified])+
-    using eq
-    by (auto del: iffI)
-qed
+  unfolding body_ground_repl_fm_def rename_split_fm_def
+  by ((insert assms,rule iff_sats | simp add:nonempty[simplified])+,
+      insert sats_incr_bv_iff[where bvs="[_,_,_,_,_,_]", simplified],auto del: iffI)
 
 end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
 
 context G_generic1
 begin
 
 lemma Replace_sats_in_MG:
   assumes
     "c\<in>M[G]" "env \<in> list(M[G])"
     "\<phi> \<in> formula" "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env)"
     "univalent(##M[G], c, \<lambda>x v. (M[G] , [x,v]@env \<Turnstile> \<phi>) )"
     and
     ground_replacement:
     "\<And>nenv. ground_replacement_assm(M,[P,leq,\<one>] @ nenv, \<phi>)"
   shows
     "{v. x\<in>c, v\<in>M[G] \<and> (M[G] , [x,v]@env \<Turnstile> \<phi>)} \<in> M[G]"
 proof -
   let ?R = "\<lambda> x v . v\<in>M[G] \<and> (M[G] , [x,v]@env \<Turnstile> \<phi>)"
   from \<open>c\<in>M[G]\<close>
-  obtain \<pi>' where "val(P,G, \<pi>') = c" "\<pi>' \<in> M"
+  obtain \<pi>' where "val(G, \<pi>') = c" "\<pi>' \<in> M"
     using GenExt_def by auto
   then
   have "domain(\<pi>')\<times>P\<in>M" (is "?\<pi>\<in>M")
-    using cartprod_closed P_in_M domain_closed by simp
-  from \<open>val(P,G, \<pi>') = c\<close>
-  have "c \<subseteq> val(P,G,?\<pi>)"
-    using def_val[of G ?\<pi>] one_in_P one_in_G[OF generic] elem_of_val
-      domain_of_prod[OF one_in_P, of "domain(\<pi>')"] by force
+    using cartprod_closed domain_closed by simp
+  from \<open>val(G, \<pi>') = c\<close>
+  have "c \<subseteq> val(G,?\<pi>)"
+    using def_val[of G ?\<pi>] elem_of_val[of _ G \<pi>'] one_in_G
+       domain_of_prod[OF one_in_P, of "domain(\<pi>')"]
+    by (force del:M_genericD)
   from \<open>env \<in> _\<close>
-  obtain nenv where "nenv\<in>list(M)" "env = map(val(P,G),nenv)"
+  obtain nenv where "nenv\<in>list(M)" "env = map(val(G),nenv)"
     using map_val by auto
   then
   have "length(nenv) = length(env)" by simp
+  with \<open>arity(\<phi>) \<le> _\<close>
+  have "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(nenv)" by simp
   define f where "f(\<rho>p) \<equiv> \<mu> \<alpha>. \<alpha>\<in>M \<and> (\<exists>\<tau>\<in>M. \<tau> \<in> Vset(\<alpha>) \<and>
         (snd(\<rho>p) \<tturnstile> \<phi> ([fst(\<rho>p),\<tau>] @ nenv)))" (is "_ \<equiv> \<mu> \<alpha>. ?P(\<rho>p,\<alpha>)") for \<rho>p
   have "f(\<rho>p) = (\<mu> \<alpha>. \<alpha>\<in>M \<and> (\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(##M,\<alpha>,V) \<and> \<tau>\<in>V \<and>
         (snd(\<rho>p) \<tturnstile> \<phi> ([fst(\<rho>p),\<tau>] @ nenv))))" (is "_ = (\<mu> \<alpha>. \<alpha>\<in>M \<and> ?Q(\<rho>p,\<alpha>))") for \<rho>p
     unfolding f_def using Vset_abs Vset_closed Ord_Least_cong[of "?P(\<rho>p)" "\<lambda> \<alpha>. \<alpha>\<in>M \<and> ?Q(\<rho>p,\<alpha>)"]
     by (simp, simp del:setclass_iff)
   moreover
-  have "f(\<rho>p) \<in> M" for \<rho>p
-    unfolding f_def using Least_closed'[of "?P(\<rho>p)"] by simp
+  note inM = \<open>nenv\<in>list(M)\<close> \<open>?\<pi>\<in>M\<close>
+  moreover
+  have "f(\<rho>p) \<in> M" "Ord(f(\<rho>p))" for \<rho>p
+    unfolding f_def using Least_closed'[of "?P(\<rho>p)"] by simp_all
   ultimately
   have 1:"least(##M,\<lambda>\<alpha>. ?Q(\<rho>p,\<alpha>),f(\<rho>p))" for \<rho>p
     using least_abs'[of "\<lambda>\<alpha>. \<alpha>\<in>M \<and> ?Q(\<rho>p,\<alpha>)" "f(\<rho>p)"] least_conj
     by (simp flip: setclass_iff)
-  have "Ord(f(\<rho>p))" for \<rho>p unfolding f_def by simp
   define QQ where "QQ\<equiv>?Q"
   from 1
   have "least(##M,\<lambda>\<alpha>. QQ(\<rho>p,\<alpha>),f(\<rho>p))" for \<rho>p
     unfolding QQ_def .
-  from \<open>arity(\<phi>) \<le> _\<close> \<open>length(nenv) = _\<close>
-  have "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(nenv)"
-    by simp
-  moreover
-  note assms \<open>nenv\<in>list(M)\<close> \<open>?\<pi>\<in>M\<close>
-  moreover
-  have "\<rho>p\<in>?\<pi> \<Longrightarrow> \<exists>t p. \<rho>p=\<langle>t,p\<rangle>" for \<rho>p
-    by auto
-  ultimately
-  have body:"(M , [\<alpha>,\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> body_ground_repl_fm(\<phi>)) \<longleftrightarrow> ?Q(\<rho>p,\<alpha>)"
-    if "\<rho>p\<in>?\<pi>" "\<rho>p\<in>M" "m\<in>M" "\<alpha>\<in>M" for \<alpha> \<rho>p m
-    using that P_in_M leq_in_M one_in_M sats_body_ground_repl_fm[of \<rho>p \<alpha> m nenv \<phi>] by simp
-  {
-    fix \<rho>p m
-    assume asm: "\<rho>p\<in>M" "\<rho>p\<in>?\<pi>" "m\<in>M"
-    note inM = this P_in_M leq_in_M one_in_M \<open>nenv\<in>list(M)\<close>
-    with body
-    have body':"\<And>\<alpha>. \<alpha> \<in> M \<Longrightarrow> (\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(\<lambda>a. (##M)(a), \<alpha>, V) \<and> \<tau> \<in> V \<and>
+  have body:"(M, [\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(##M, QQ(\<rho>p), m)"
+    if "\<rho>p\<in>M" "\<rho>p\<in>?\<pi>" "m\<in>M" for \<rho>p m
+  proof -
+    note inM that
+    moreover from this assms 1
+    have "(M , [\<alpha>,\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> body_ground_repl_fm(\<phi>)) \<longleftrightarrow> ?Q(\<rho>p,\<alpha>)" if "\<alpha>\<in>M" for \<alpha>
+      using that sats_body_ground_repl_fm[of \<rho>p \<alpha> m nenv \<phi>]
+      by auto
+    moreover from calculation
+    have body:"\<And>\<alpha>. \<alpha> \<in> M \<Longrightarrow> (\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(\<lambda>a. a\<in>M, \<alpha>, V) \<and> \<tau> \<in> V \<and>
           (snd(\<rho>p) \<tturnstile> \<phi> ([fst(\<rho>p),\<tau>] @ nenv))) \<longleftrightarrow>
-          M, Cons(\<alpha>, [\<rho>p, m, P, leq, \<one>] @ nenv) \<Turnstile> body_ground_repl_fm(\<phi>)" by simp
-    from inM
-    have "(M , [\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(##M, QQ(\<rho>p), m)"
-      using sats_least_fm[OF body', of 1] unfolding QQ_def ground_repl_fm_def
+          M, Cons(\<alpha>, [\<rho>p, m, P, leq, \<one>] @ nenv) \<Turnstile> body_ground_repl_fm(\<phi>)"
+      by simp
+    ultimately
+    show "(M , [\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(##M, QQ(\<rho>p), m)"
+      using sats_least_fm[OF body,of 1] unfolding QQ_def ground_repl_fm_def
       by (simp, simp flip: setclass_iff)
-  }
-  then
-  have "(M, [\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(##M, QQ(\<rho>p), m)"
-    if "\<rho>p\<in>M" "\<rho>p\<in>?\<pi>" "m\<in>M" for \<rho>p m using that by simp
+  qed
   then
   have "univalent(##M, ?\<pi>, \<lambda>\<rho>p m. M , [\<rho>p,m] @ ([P,leq,\<one>] @ nenv) \<Turnstile> ground_repl_fm(\<phi>))"
     unfolding univalent_def by (auto intro:unique_least)
   moreover from \<open>length(_) = _\<close> \<open>env \<in> _\<close>
   have "length([P,leq,\<one>] @ nenv) = 3 +\<^sub>\<omega> length(env)" by simp
   moreover from \<open>arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(nenv)\<close>
     \<open>length(_) = length(_)\<close>[symmetric] \<open>nenv\<in>_\<close> \<open>\<phi>\<in>_\<close>
   have "arity(ground_repl_fm(\<phi>)) \<le> 5 +\<^sub>\<omega> length(env)"
     using arity_ground_repl_fm[of \<phi>] le_trans Un_le by auto
   moreover from \<open>\<phi>\<in>formula\<close>
   have "ground_repl_fm(\<phi>)\<in>formula" by simp
   moreover
-  note inM = P_in_M leq_in_M one_in_M \<open>nenv\<in>list(M)\<close> \<open>?\<pi>\<in>M\<close>
-  moreover
-  note \<open>length(nenv) = length(env)\<close>
+  note \<open>length(nenv) = length(env)\<close> inM
   ultimately
   obtain Y where "Y\<in>M"
     "\<forall>m\<in>M. m \<in> Y \<longleftrightarrow> (\<exists>\<rho>p\<in>M. \<rho>p \<in> ?\<pi> \<and> (M, [\<rho>p,m] @ ([P,leq,\<one>] @ nenv) \<Turnstile> ground_repl_fm(\<phi>)))"
     using ground_replacement[of nenv]
     unfolding strong_replacement_def ground_replacement_assm_def replacement_assm_def by auto
-  with \<open>least(_,QQ(_),f(_))\<close> \<open>f(_) \<in> M\<close> \<open>?\<pi>\<in>M\<close>
-    \<open>_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> (M,_ \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(_,_,_)\<close>
+  with \<open>least(_,QQ(_),f(_))\<close> \<open>f(_) \<in> M\<close> \<open>?\<pi>\<in>M\<close> body
   have "f(\<rho>p)\<in>Y" if "\<rho>p\<in>?\<pi>" for \<rho>p
     using that transitivity[OF _ \<open>?\<pi>\<in>M\<close>]
-    by (clarsimp, rule_tac x="\<langle>x,y\<rangle>" in bexI, auto)
-  moreover
-  have "{y\<in>Y. Ord(y)} \<in> M"
-    using \<open>Y\<in>M\<close> separation_ax sats_ordinal_fm trans_M
-      separation_cong[of "##M" "\<lambda>y. sats(M,ordinal_fm(0),[y])" "Ord"]
-      separation_closed by (simp add:arity)
-  then
+    by (clarsimp,rename_tac \<rho> p \<rho>p, rule_tac x="\<langle>\<rho>,p\<rangle>" in bexI, auto)
+  from \<open>Y\<in>M\<close>
   have "\<Union> {y\<in>Y. Ord(y)} \<in> M" (is "?sup \<in> M")
-    using Union_closed by simp
+    using separation_Ord separation_closed Union_closed by simp
   then
-  have "{x\<in>Vset(?sup). x \<in> M} \<in> M"
-    using Vset_closed by simp
-  moreover
-  have "{\<one>} \<in> M"
-    using one_in_M singleton_closed by simp
-  ultimately
   have "{x\<in>Vset(?sup). x \<in> M} \<times> {\<one>} \<in> M" (is "?big_name \<in> M")
-    using cartprod_closed by simp
+    using Vset_closed cartprod_closed singleton_closed by simp
   then
-  have "val(P,G,?big_name) \<in> M[G]"
+  have "val(G,?big_name) \<in> M[G]"
     by (blast intro:GenExtI)
-  {
-    fix v x
-    assume "x\<in>c"
+  have "{v. x\<in>c, ?R(x,v)} \<subseteq> val(G,?big_name)" (is "?repl\<subseteq>?big")
+  proof(intro subsetI)
+    fix v
+    assume "v\<in>?repl"
+    moreover from this
+    obtain x where "x\<in>c" "M[G], [x, v] @ env \<Turnstile> \<phi>" "v\<in>M[G]"
+      by auto
     moreover
-    note \<open>val(P,G,\<pi>')=c\<close> \<open>\<pi>'\<in>M\<close>
+    note \<open>val(G,\<pi>')=c\<close> \<open>\<pi>'\<in>M\<close>
     moreover
     from calculation
-    obtain \<rho> p where "\<langle>\<rho>,p\<rangle>\<in>\<pi>'"  "val(P,G,\<rho>) = x" "p\<in>G" "\<rho>\<in>M"
-      using elem_of_val_pair'[of \<pi>' x G] by blast
-    moreover
-    assume "v\<in>M[G]"
-    then
-    obtain \<sigma> where "val(P,G,\<sigma>) = v" "\<sigma>\<in>M"
-      using GenExtD by auto
-    moreover
-    assume "sats(M[G], \<phi>, [x,v] @ env)"
+    obtain \<rho> p where "\<langle>\<rho>,p\<rangle>\<in>\<pi>'" "val(G,\<rho>) = x" "p\<in>G" "\<rho>\<in>M"
+      using elem_of_val_pair' by blast
+    moreover from this \<open>v\<in>M[G]\<close>
+    obtain \<sigma> where "val(G,\<sigma>) = v" "\<sigma>\<in>M"
+      using GenExtD by (force del:M_genericD)
     moreover
     note \<open>\<phi>\<in>_\<close> \<open>nenv\<in>_\<close> \<open>env = _\<close> \<open>arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)\<close>
     ultimately
-    obtain q where "q\<in>G" "q \<tturnstile> \<phi> ([\<rho>,\<sigma>]@nenv)"
-      using truth_lemma[OF \<open>\<phi>\<in>_\<close> generic, symmetric, of "[\<rho>,\<sigma>] @ nenv"]
+    obtain q where "q\<in>G" "q \<tturnstile> \<phi> ([\<rho>,\<sigma>]@nenv)" "q\<in>P"
+      using truth_lemma[OF \<open>\<phi>\<in>_\<close>,of "[\<rho>,\<sigma>] @ nenv"]
       by auto
     with \<open>\<langle>\<rho>,p\<rangle>\<in>\<pi>'\<close> \<open>\<langle>\<rho>,q\<rangle>\<in>?\<pi> \<Longrightarrow> f(\<langle>\<rho>,q\<rangle>)\<in>Y\<close>
     have "f(\<langle>\<rho>,q\<rangle>)\<in>Y"
       using generic unfolding M_generic_def filter_def by blast
     let ?\<alpha>="succ(rank(\<sigma>))"
     note \<open>\<sigma>\<in>M\<close>
     moreover from this
-    have "?\<alpha> \<in> M"
-      using rank_closed cons_closed by (simp flip: setclass_iff)
-    moreover
-    have "\<sigma> \<in> Vset(?\<alpha>)"
-      using Vset_Ord_rank_iff by auto
+    have "?\<alpha> \<in> M" "\<sigma> \<in> Vset(?\<alpha>)"
+      using rank_closed cons_closed Vset_Ord_rank_iff
+      by (simp_all flip: setclass_iff)
     moreover
     note \<open>q \<tturnstile> \<phi> ([\<rho>,\<sigma>] @ nenv)\<close>
     ultimately
     have "?P(\<langle>\<rho>,q\<rangle>,?\<alpha>)" by (auto simp del: Vset_rank_iff)
     moreover
     have "(\<mu> \<alpha>. ?P(\<langle>\<rho>,q\<rangle>,\<alpha>)) = f(\<langle>\<rho>,q\<rangle>)"
       unfolding f_def by simp
     ultimately
     obtain \<tau> where "\<tau>\<in>M" "\<tau> \<in> Vset(f(\<langle>\<rho>,q\<rangle>))" "q \<tturnstile> \<phi> ([\<rho>,\<tau>] @ nenv)"
       using LeastI[of "\<lambda> \<alpha>. ?P(\<langle>\<rho>,q\<rangle>,\<alpha>)" ?\<alpha>] by auto
     with \<open>q\<in>G\<close> \<open>\<rho>\<in>M\<close> \<open>nenv\<in>_\<close> \<open>arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(nenv)\<close>
-    have "M[G], map(val(P,G),[\<rho>,\<tau>] @ nenv) \<Turnstile> \<phi>"
-      using truth_lemma[OF \<open>\<phi>\<in>_\<close> generic, of "[\<rho>,\<tau>] @ nenv"] by auto
+    have "M[G], map(val(G),[\<rho>,\<tau>] @ nenv) \<Turnstile> \<phi>"
+      using truth_lemma[OF \<open>\<phi>\<in>_\<close>, of "[\<rho>,\<tau>] @ nenv"] by auto
     moreover from \<open>x\<in>c\<close> \<open>c\<in>M[G]\<close>
     have "x\<in>M[G]" using transitivity_MG by simp
     moreover
-    note \<open>M[G],[x,v] @ env\<Turnstile> \<phi>\<close> \<open>env = map(val(P,G),nenv)\<close> \<open>\<tau>\<in>M\<close> \<open>val(P,G,\<rho>)=x\<close>
+    note \<open>M[G],[x,v] @ env\<Turnstile> \<phi>\<close> \<open>env = map(val(G),nenv)\<close> \<open>\<tau>\<in>M\<close> \<open>val(G,\<rho>)=x\<close>
       \<open>univalent(##M[G],_,_)\<close> \<open>x\<in>c\<close> \<open>v\<in>M[G]\<close>
     ultimately
-    have "v=val(P,G,\<tau>)"
+    have "v=val(G,\<tau>)"
       using GenExtI[of \<tau> G] unfolding univalent_def by (auto)
     from \<open>\<tau> \<in> Vset(f(\<langle>\<rho>,q\<rangle>))\<close> \<open>Ord(f(_))\<close>  \<open>f(\<langle>\<rho>,q\<rangle>)\<in>Y\<close>
     have "\<tau> \<in> Vset(?sup)"
       using Vset_Ord_rank_iff lt_Union_iff[of _ "rank(\<tau>)"] by auto
     with \<open>\<tau>\<in>M\<close>
-    have "val(P,G,\<tau>) \<in> val(P,G,?big_name)"
+    have "val(G,\<tau>) \<in> val(G,?big_name)"
       using domain_of_prod[of \<one> "{\<one>}" "{x\<in>Vset(?sup). x \<in> M}" ] def_val[of G ?big_name]
-        one_in_G[OF generic] one_in_P  by (auto simp del: Vset_rank_iff)
-    with \<open>v=val(P,G,\<tau>)\<close>
-    have "v \<in> val(P,G,{x\<in>Vset(?sup). x \<in> M} \<times> {\<one>})"
+        one_in_G one_in_P  by (auto simp del: Vset_rank_iff)
+    with \<open>v=val(G,\<tau>)\<close>
+    show "v \<in> val(G,?big_name)"
       by simp
-  }
-  then
-  have "{v. x\<in>c, ?R(x,v)} \<subseteq> val(P,G,?big_name)" (is "?repl\<subseteq>?big")
-    by blast
-  with \<open>?big_name\<in>M\<close>
-  have "?repl = {v\<in>?big. \<exists>x\<in>c. sats(M[G], \<phi>, [x,v] @ env )}" (is "_ = ?rhs")
+  qed
+  from \<open>?big_name\<in>M\<close>
+  have "?repl = {v\<in>?big. \<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile>  \<phi>}" (is "_ = ?rhs")
   proof(intro equalityI subsetI)
     fix v
     assume "v\<in>?repl"
     with \<open>?repl\<subseteq>?big\<close>
     obtain x where "x\<in>c" "M[G], [x, v] @ env \<Turnstile> \<phi>" "v\<in>?big"
       using subsetD by auto
     with \<open>univalent(##M[G],_,_)\<close> \<open>c\<in>M[G]\<close>
     show "v \<in> ?rhs"
       unfolding univalent_def
       using transitivity_MG ReplaceI[of "\<lambda> x v. \<exists>x\<in>c. M[G], [x, v] @ env \<Turnstile> \<phi>"] by blast
   next
     fix v
     assume "v\<in>?rhs"
     then
     obtain x where
-      "v\<in>val(P,G, ?big_name)" "M[G], [x, v] @ env \<Turnstile> \<phi>" "x\<in>c"
+      "v\<in>val(G, ?big_name)" "M[G], [x, v] @ env \<Turnstile> \<phi>" "x\<in>c"
       by blast
     moreover from this \<open>c\<in>M[G]\<close>
     have "v\<in>M[G]" "x\<in>M[G]"
       using transitivity_MG GenExtI[OF \<open>?big_name\<in>_\<close>,of G] by auto
     moreover from calculation \<open>univalent(##M[G],_,_)\<close>
     have "?R(x,y) \<Longrightarrow> y = v" for y
       unfolding univalent_def by auto
     ultimately
     show "v\<in>?repl"
       using ReplaceI[of ?R x v c]
       by blast
   qed
   moreover
-  let ?\<psi> = "Exists(And(Member(0,2+\<^sub>\<omega>length(env)),\<phi>))"
-  have "v\<in>M[G] \<Longrightarrow> (\<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>) \<longleftrightarrow> M[G], [v] @ env @ [c] \<Turnstile> ?\<psi>"
-    "arity(?\<psi>) \<le> 2 +\<^sub>\<omega> length(env)" "?\<psi>\<in>formula"
-    for v
-  proof -
-    fix v
-    assume "v\<in>M[G]"
-    with \<open>c\<in>M[G]\<close>
-    have "nth(length(env)+\<^sub>\<omega>1,[v]@env@[c]) = c"
-      using  \<open>env\<in>_\<close>nth_concat[of v c "M[G]" env]
-      by auto
-    note inMG= \<open>nth(length(env)+\<^sub>\<omega>1,[v]@env@[c]) = c\<close> \<open>c\<in>M[G]\<close> \<open>v\<in>M[G]\<close> \<open>env\<in>_\<close>
-    show "(\<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>) \<longleftrightarrow> M[G], [v] @ env @ [c] \<Turnstile> ?\<psi>"
-    proof
-      assume "\<exists>x\<in>c. M[G], [x, v] @ env \<Turnstile> \<phi>"
-      then obtain x where
-        "x\<in>c" "M[G], [x, v] @ env \<Turnstile> \<phi>" "x\<in>M[G]"
-        using transitivity_MG[OF _ \<open>c\<in>M[G]\<close>]
-        by auto
-      with \<open>\<phi>\<in>_\<close> \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close> inMG
-      show "M[G], [v] @ env @ [c] \<Turnstile> Exists(And(Member(0, 2 +\<^sub>\<omega> length(env)), \<phi>))"
-        using arity_sats_iff[of \<phi> "[c]" _ "[x,v]@env"]
-        by auto
-    next
-      assume "M[G], [v] @ env @ [c] \<Turnstile> Exists(And(Member(0, 2 +\<^sub>\<omega> length(env)), \<phi>))"
-      with inMG
-      obtain x where
-        "x\<in>M[G]" "x\<in>c" "M[G], [x,v]@env@[c] \<Turnstile> \<phi>"
-        by auto
-      with \<open>\<phi>\<in>_\<close> \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close> inMG
-      show "\<exists>x\<in>c. M[G], [x, v] @ env\<Turnstile> \<phi>"
-        using arity_sats_iff[of \<phi> "[c]" _ "[x,v]@env"]
-        by auto
-    qed
-  next
-    from \<open>env\<in>_\<close> \<open>\<phi>\<in>_\<close>
-    show "arity(?\<psi>)\<le>2+\<^sub>\<omega>length(env)"
-      using pred_mono[OF _ \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close>] lt_trans[OF _ le_refl]
-      by (auto simp add:ord_simp_union arity)
-  next
-    from \<open>\<phi>\<in>_\<close>
-    show "?\<psi>\<in>formula" by simp
-  qed
+  let ?\<psi> = "(\<cdot>\<exists>\<cdot>\<cdot>0 \<in> 2 +\<^sub>\<omega> length(env) \<cdot> \<and> \<phi>\<cdot>\<cdot>)"
+  from \<open>\<phi>\<in>_\<close>
+  have "?\<psi>\<in>formula" "arity(?\<psi>) \<le> 2 +\<^sub>\<omega> length(env)"
+    using pred_mono[OF _ \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close>] lt_trans[OF _ le_refl]
+    by (auto simp add:ord_simp_union arity)
+  moreover
+  from \<open>\<phi>\<in>_\<close> \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close> \<open>c\<in>M[G]\<close> \<open>env\<in>_\<close>
+  have "(\<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>) \<longleftrightarrow> M[G], [v] @ env @ [c] \<Turnstile> ?\<psi>" if "v\<in>M[G]" for v
+    using that nth_concat transitivity_MG[OF _ \<open>c\<in>M[G]\<close>] arity_sats_iff[of \<phi> "[c]" _ "[_,v]@env"]
+    by auto
   moreover from this
   have "{v\<in>?big. \<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>} = {v\<in>?big. M[G], [v] @ env @ [c] \<Turnstile>  ?\<psi>}"
     using transitivity_MG[OF _ GenExtI, OF _ \<open>?big_name\<in>M\<close>]
     by simp
   moreover from calculation and \<open>env\<in>_\<close> \<open>c\<in>_\<close> \<open>?big\<in>M[G]\<close>
   have "{v\<in>?big. M[G] , [v] @ env @ [c] \<Turnstile> ?\<psi>} \<in> M[G]"
     using Collect_sats_in_MG by auto
   ultimately
   show ?thesis by simp
 qed
 
 theorem strong_replacement_in_MG:
   assumes
     "\<phi>\<in>formula" and "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env)" "env \<in> list(M[G])"
     and
     ground_replacement:
     "\<And>nenv. ground_replacement_assm(M,[P,leq,\<one>] @ nenv, \<phi>)"
   shows
-    "strong_replacement(##M[G],\<lambda>x v. sats(M[G],\<phi>,[x,v] @ env))"
+    "strong_replacement(##M[G],\<lambda>x v. M[G],[x,v] @ env \<Turnstile> \<phi>)"
 proof -
   let ?R="\<lambda>x y . M[G], [x, y] @ env \<Turnstile> \<phi>"
   {
     fix A
     let ?Y="{v . x \<in> A, v\<in>M[G] \<and> ?R(x,v)}"
-    assume 1: "(##M[G])(A)"
-      "\<forall>x[##M[G]]. x \<in> A \<longrightarrow> (\<forall>y[##M[G]]. \<forall>z[##M[G]]. ?R(x,y) \<and> ?R(x,z) \<longrightarrow> y = z)"
-    then
-    have "univalent(##M[G], A, ?R)" "A\<in>M[G]"
-      unfolding univalent_def by simp_all
-    with assms \<open>A\<in>_\<close>
+    assume 1: "(##M[G])(A)" "univalent(##M[G], A, ?R)"
+    with assms
     have "(##M[G])(?Y)"
-      using Replace_sats_in_MG ground_replacement
-      unfolding ground_replacement_assm_def by (auto)
+      using Replace_sats_in_MG ground_replacement 1
+      unfolding ground_replacement_assm_def by auto
     have "b \<in> ?Y \<longleftrightarrow> (\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b))" if "(##M[G])(b)" for b
     proof(rule)
-      from \<open>A\<in>_\<close>
+      from \<open>(##M[G])(A)\<close>
       show "\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b)" if "b \<in> ?Y"
         using that transitivity_MG by auto
     next
       show "b \<in> ?Y" if "\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b)"
       proof -
         from \<open>(##M[G])(b)\<close>
         have "b\<in>M[G]" by simp
         with that
         obtain x where "(##M[G])(x)" "x\<in>A" "b\<in>M[G] \<and> ?R(x,b)"
           by blast
         moreover from this 1 \<open>(##M[G])(b)\<close>
         have "x\<in>M[G]" "z\<in>M[G] \<and> ?R(x,z) \<Longrightarrow> b = z" for z
+          unfolding univalent_def
           by auto
         ultimately
         show ?thesis
           using ReplaceI[of "\<lambda> x y. y\<in>M[G] \<and> ?R(x,y)"] by blast
       qed
     qed
     then
     have "\<forall>b[##M[G]]. b \<in> ?Y \<longleftrightarrow> (\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b))"
       by simp
     with \<open>(##M[G])(?Y)\<close>
     have " (\<exists>Y[##M[G]]. \<forall>b[##M[G]]. b \<in> Y \<longleftrightarrow> (\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b)))"
       by auto
   }
-  then show ?thesis unfolding strong_replacement_def univalent_def
-    by auto
+  then show ?thesis unfolding strong_replacement_def
+    by simp
 qed
 
 lemma replacement_assm_MG:
   assumes
     ground_replacement:
     "\<And>nenv. ground_replacement_assm(M,[P,leq,\<one>] @ nenv, \<phi>)"
   shows
     "replacement_assm(M[G],env,\<phi>)"
   using assms strong_replacement_in_MG
   unfolding replacement_assm_def by simp
 
 end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Replacement_Instances.thy b/thys/Independence_CH/Replacement_Instances.thy
--- a/thys/Independence_CH/Replacement_Instances.thy
+++ b/thys/Independence_CH/Replacement_Instances.thy
@@ -1,1432 +1,1352 @@
 section\<open>More Instances of Replacement\<close>
 
 theory Replacement_Instances
   imports
     Separation_Instances
     Transitive_Models.Pointed_DC_Relative
 begin
 
-synthesize "setdiff" from_definition "setdiff" assuming "nonempty"
-arity_theorem for "setdiff_fm"
-
-relationalize  "first_rel" "is_first" external
-synthesize "first_fm" from_definition "is_first" assuming "nonempty"
-
-relationalize  "minimum_rel" "is_minimum" external
-definition is_minimum' where
-  "is_minimum'(M,R,X,u) \<equiv> (M(u) \<and> u \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> u \<longrightarrow> a \<in> R) \<and> pair(M, u, v, a))) \<and>
-    (\<exists>x[M].
-        (M(x) \<and> x \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> x \<longrightarrow> a \<in> R) \<and> pair(M, x, v, a))) \<and>
-        (\<forall>y[M]. M(y) \<and> y \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> y \<longrightarrow> a \<in> R) \<and> pair(M, y, v, a)) \<longrightarrow> y = x)) \<or>
-    \<not> (\<exists>x[M]. (M(x) \<and> x \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> x \<longrightarrow> a \<in> R) \<and> pair(M, x, v, a))) \<and>
-               (\<forall>y[M]. M(y) \<and> y \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> y \<longrightarrow> a \<in> R) \<and> pair(M, y, v, a)) \<longrightarrow> y = x)) \<and>
-    empty(M, u)"
-
-synthesize "minimum" from_definition "is_minimum'" assuming "nonempty"
-arity_theorem for "minimum_fm"
-
 lemma composition_fm_type[TC]: "a0 \<in> \<omega> \<Longrightarrow> a1 \<in> \<omega> \<Longrightarrow> a2 \<in> \<omega> \<Longrightarrow>
    composition_fm(a0,a1,a2) \<in> formula"
   unfolding composition_fm_def by simp
 
 arity_theorem for "composition_fm"
 
 definition is_omega_funspace :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
   "is_omega_funspace(N,B,n,z) \<equiv>  \<exists>o[N]. omega(N,o) \<and> n\<in>o \<and> is_funspace(N, n, B, z)"
 
 synthesize "omega_funspace" from_definition "is_omega_funspace" assuming "nonempty"
 arity_theorem for "omega_funspace_fm"
 
 definition HAleph_wfrec_repl_body where
   "HAleph_wfrec_repl_body(N,mesa,x,z) \<equiv> \<exists>y[N].
                    pair(N, x, y, z) \<and>
-                   (\<exists>f[N].
-                       (\<forall>z[N].
-                           z \<in> f \<longleftrightarrow>
-                           (\<exists>xa[N].
+                   (\<exists>g[N].
+                       (\<forall>u[N].
+                           u \<in> g \<longleftrightarrow>
+                           (\<exists>a[N].
                                \<exists>y[N].
-                                  \<exists>xaa[N].
+                                  \<exists>ax[N].
                                      \<exists>sx[N].
                                         \<exists>r_sx[N].
                                            \<exists>f_r_sx[N].
-                                              pair(N, xa, y, z) \<and>
-                                              pair(N, xa, x, xaa) \<and>
-                                              upair(N, xa, xa, sx) \<and>
-                                              pre_image(N, mesa, sx, r_sx) \<and> restriction(N, f, r_sx, f_r_sx) \<and> xaa \<in> mesa \<and> is_HAleph(N, xa, f_r_sx, y))) \<and>
-                       is_HAleph(N, x, f, y))"
+                                              pair(N, a, y, u) \<and>
+                                              pair(N, a, x, ax) \<and>
+                                              upair(N, a, a, sx) \<and>
+                                              pre_image(N, mesa, sx, r_sx) \<and>
+      restriction(N, g, r_sx, f_r_sx) \<and> ax \<in> mesa \<and> is_HAleph(N, a, f_r_sx, y))) \<and>
+                       is_HAleph(N, x, g, y))"
 
 (* MOVE THIS to an appropriate place *)
 arity_theorem for "ordinal_fm"
 arity_theorem for "is_Limit_fm"
 arity_theorem for "empty_fm"
 arity_theorem for "fun_apply_fm"
 
 synthesize "HAleph_wfrec_repl_body" from_definition assuming "nonempty"
 arity_theorem for "HAleph_wfrec_repl_body_fm"
 
 definition dcwit_repl_body where
   "dcwit_repl_body(N,mesa,A,a,s,R) \<equiv> \<lambda>x z. \<exists>y[N]. pair(N, x, y, z) \<and>
                                 is_wfrec
                                  (N, \<lambda>n f. is_nat_case
                                              (N, a,
                                               \<lambda>m bmfm.
                                                  \<exists>fm[N].
                                                     \<exists>cp[N].
                                                        is_apply(N, f, m, fm) \<and>
                                                        is_Collect(N, A, \<lambda>x. \<exists>fmx[N]. (N(x) \<and> fmx \<in> R) \<and> pair(N, fm, x, fmx), cp) \<and>
                                                        is_apply(N, s, cp, bmfm),
                                               n),
                                   mesa, x, y)"
 
 manual_schematic for "dcwit_repl_body" assuming "nonempty"
   unfolding dcwit_repl_body_def
   by (rule iff_sats is_nat_case_iff_sats is_eclose_iff_sats sep_rules | simp)+
 
 synthesize "dcwit_repl_body" from_schematic
 
 definition dcwit_aux_fm where
   "dcwit_aux_fm(A,s,R) \<equiv> (\<cdot>\<exists>\<cdot>\<cdot>4`2 is 0\<cdot> \<and>
                (\<cdot>\<exists>\<cdot>Collect_fm
                    (succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(A)))))))))),
                     (\<cdot>\<exists>\<cdot>\<cdot>0 \<in>
                        succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(R)))))))))))) \<cdot> \<and>
                        pair_fm(3, 1, 0) \<cdot>\<cdot>),
                     0) \<and>
                   \<cdot> succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(s))))))))))`0 is 2\<cdot>\<cdot>\<cdot>)\<cdot>\<cdot>)"
 
 arity_theorem for "dcwit_aux_fm"
 
 lemma dcwit_aux_fm_type[TC]: "A \<in> \<omega> \<Longrightarrow> s \<in> \<omega> \<Longrightarrow> R \<in> \<omega> \<Longrightarrow> dcwit_aux_fm(A,s,R) \<in> formula"
   by (simp_all add: dcwit_aux_fm_def)
 
 definition is_nat_case_dcwit_aux_fm where
   "is_nat_case_dcwit_aux_fm(A,a,s,R) \<equiv> is_nat_case_fm
            (succ(succ(succ(succ(succ(succ(a)))))),dcwit_aux_fm(A,s,R),
             2, 0)"
 
 lemma is_nat_case_dcwit_aux_fm_type[TC]: "A \<in> \<omega> \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> s \<in> \<omega> \<Longrightarrow> R \<in> \<omega> \<Longrightarrow> is_nat_case_dcwit_aux_fm(A,a,s,R) \<in> formula"
   by (simp_all add: is_nat_case_dcwit_aux_fm_def)
 
 manual_arity for "is_nat_case_dcwit_aux_fm"
   unfolding is_nat_case_dcwit_aux_fm_def
   by (rule arity_dcwit_aux_fm[THEN [6] arity_is_nat_case_fm]) simp_all
 
 manual_arity for "dcwit_repl_body_fm"
   using arity_is_nat_case_dcwit_aux_fm[THEN [6] arity_is_wfrec_fm]
   unfolding dcwit_repl_body_fm_def  is_nat_case_dcwit_aux_fm_def dcwit_aux_fm_def
   by (auto simp add: arity(1-33))
 
 lemma arity_dcwit_repl_body: "arity(dcwit_repl_body_fm(6,5,4,3,2,0,1)) = 7"
   by (simp_all add: FOL_arities arity_dcwit_repl_body_fm ord_simp_union)
 
 definition fst2_snd2
   where "fst2_snd2(x) \<equiv> \<langle>fst(fst(x)), snd(snd(x))\<rangle>"
 
 relativize functional "fst2_snd2" "fst2_snd2_rel"
 relationalize "fst2_snd2_rel" "is_fst2_snd2"
 
 lemma (in M_trivial) fst2_snd2_abs:
   assumes "M(x)" "M(res)"
   shows "is_fst2_snd2(M, x, res) \<longleftrightarrow> res = fst2_snd2(x)"
   unfolding is_fst2_snd2_def fst2_snd2_def
-  using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
+  using fst_rel_abs snd_rel_abs fst_abs snd_abs assms
   by simp
 
 synthesize "is_fst2_snd2" from_definition assuming "nonempty"
 arity_theorem for "is_fst2_snd2_fm"
 
 definition sndfst_fst2_snd2
   where "sndfst_fst2_snd2(x) \<equiv> \<langle>snd(fst(x)), fst(fst(x)), snd(snd(x))\<rangle>"
 
 relativize functional "sndfst_fst2_snd2" "sndfst_fst2_snd2_rel"
 relationalize "sndfst_fst2_snd2_rel" "is_sndfst_fst2_snd2"
 synthesize "is_sndfst_fst2_snd2" from_definition assuming "nonempty"
 arity_theorem for "is_sndfst_fst2_snd2_fm"
 
-definition RepFun_body :: "i \<Rightarrow> i \<Rightarrow> i"where
-  "RepFun_body(u,v) \<equiv> {{\<langle>v, x\<rangle>} . x \<in> u}"
-
-relativize functional "RepFun_body" "RepFun_body_rel"
-relationalize "RepFun_body_rel" "is_RepFun_body"
-synthesize "is_RepFun_body" from_definition assuming "nonempty"
-arity_theorem for "is_RepFun_body_fm"
-
-lemma arity_body_repfun:
-  "arity((\<cdot>\<exists>\<cdot>cons_fm(0, 3, 2) \<and> pair_fm(5, 1, 0) \<cdot>\<cdot>)) = 5"
-  using arity_cons_fm arity_pair_fm pred_Un_distrib union_abs1 FOL_arities
-  by auto
-
-lemma arity_RepFun: "arity(is_RepFun_body_fm(0, 1, 2)) = 3"
-  unfolding is_RepFun_body_fm_def
-  using arity_Replace_fm[OF _ _ _ _ arity_body_repfun] arity_fst_fm arity_snd_fm arity_empty_fm
-    pred_Un_distrib union_abs2 union_abs1 FOL_arities
-  by simp
-
 definition order_eq_map where
   "order_eq_map(M,A,r,a,z) \<equiv> \<exists>x[M]. \<exists>g[M]. \<exists>mx[M]. \<exists>par[M].
              ordinal(M,x) & pair(M,a,x,z) & membership(M,x,mx) &
              pred_set(M,A,a,r,par) & order_isomorphism(M,par,r,x,mx,g)"
 
 synthesize "order_eq_map" from_definition assuming "nonempty"
 arity_theorem for "is_ord_iso_fm"
 arity_theorem for "order_eq_map_fm"
 
 (* Banach *)
 synthesize "is_banach_functor" from_definition assuming "nonempty"
 arity_theorem for "is_banach_functor_fm"
 
 definition banach_body_iterates where
   "banach_body_iterates(M,X,Y,f,g,W,n,x,z) \<equiv>
 \<exists>y[M].
                    pair(M, x, y, z) \<and>
                    (\<exists>fa[M].
                        (\<forall>z[M].
                            z \<in> fa \<longleftrightarrow>
                            (\<exists>xa[M].
                                \<exists>y[M].
                                   \<exists>xaa[M].
                                      \<exists>sx[M].
                                         \<exists>r_sx[M].
                                            \<exists>f_r_sx[M]. \<exists>sn[M]. \<exists>msn[M]. successor(M,n,sn) \<and>
                                               membership(M,sn,msn) \<and>
                                               pair(M, xa, y, z) \<and>
                                               pair(M, xa, x, xaa) \<and>
                                               upair(M, xa, xa, sx) \<and>
                                               pre_image(M, msn, sx, r_sx) \<and>
                                               restriction(M, fa, r_sx, f_r_sx) \<and>
                                               xaa \<in> msn \<and>
                                               (empty(M, xa) \<longrightarrow> y = W) \<and>
                                               (\<forall>m[M].
                                                   successor(M, m, xa) \<longrightarrow>
                                                   (\<exists>gm[M].
                                                       is_apply(M, f_r_sx, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
                                               (is_quasinat(M, xa) \<or> empty(M, y)))) \<and>
                        (empty(M, x) \<longrightarrow> y = W) \<and>
                        (\<forall>m[M].
                            successor(M, m, x) \<longrightarrow>
                            (\<exists>gm[M]. is_apply(M, fa, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
                        (is_quasinat(M, x) \<or> empty(M, y)))"
 
 synthesize "is_quasinat" from_definition assuming "nonempty"
 arity_theorem for "is_quasinat_fm"
 
 synthesize "banach_body_iterates" from_definition assuming "nonempty"
 arity_theorem for "banach_body_iterates_fm"
 
 definition banach_is_iterates_body where
   "banach_is_iterates_body(M,X,Y,f,g,W,n,y) \<equiv> \<exists>om[M]. omega(M,om) \<and> n \<in> om \<and>
              (\<exists>sn[M].
                  \<exists>msn[M].
                     successor(M, n, sn) \<and>
                     membership(M, sn, msn) \<and>
                     (\<exists>fa[M].
                         (\<forall>z[M].
                             z \<in> fa \<longleftrightarrow>
                             (\<exists>x[M].
                                 \<exists>y[M].
                                    \<exists>xa[M].
                                       \<exists>sx[M].
                                          \<exists>r_sx[M].
                                             \<exists>f_r_sx[M].
                                                pair(M, x, y, z) \<and>
                                                pair(M, x, n, xa) \<and>
                                                upair(M, x, x, sx) \<and>
                                                pre_image(M, msn, sx, r_sx) \<and>
                                                restriction(M, fa, r_sx, f_r_sx) \<and>
                                                xa \<in> msn \<and>
                                                (empty(M, x) \<longrightarrow> y = W) \<and>
                                                (\<forall>m[M].
                                                    successor(M, m, x) \<longrightarrow>
                                                    (\<exists>gm[M].
                                                        fun_apply(M, f_r_sx, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
                                                (is_quasinat(M, x) \<or> empty(M, y)))) \<and>
                         (empty(M, n) \<longrightarrow> y = W) \<and>
                         (\<forall>m[M].
                             successor(M, m, n) \<longrightarrow>
                             (\<exists>gm[M]. fun_apply(M, fa, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
                         (is_quasinat(M, n) \<or> empty(M, y))))"
 
 synthesize "banach_is_iterates_body" from_definition assuming "nonempty"
 arity_theorem for "banach_is_iterates_body_fm"
 
 (* (##M)(f) \<Longrightarrow> strong_replacement(##M, \<lambda>x y. y = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a))\<rangle>) *)
 
 definition trans_apply_image where
   "trans_apply_image(f) \<equiv> \<lambda>a g. f ` (g `` a)"
 
 relativize functional "trans_apply_image" "trans_apply_image_rel"
 relationalize "trans_apply_image" "is_trans_apply_image"
 
 (* MOVE THIS to an appropriate place *)
 schematic_goal arity_is_recfun_fm[arity]:
   "p \<in> formula \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> r \<in> \<omega> \<Longrightarrow> arity(is_recfun_fm(p, a, z ,r)) = ?ar"
   unfolding is_recfun_fm_def
   by (simp add:arity) (* clean simpset from arities, use correct attrib *)
     (* Don't know why it doesn't use the theorem at \<^file>\<open>Arities\<close> *)
 schematic_goal arity_is_wfrec_fm[arity]:
   "p \<in> formula \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> r \<in> \<omega> \<Longrightarrow> arity(is_wfrec_fm(p, a, z ,r)) = ?ar"
   unfolding is_wfrec_fm_def
   by (simp add:arity)
 schematic_goal arity_is_transrec_fm[arity]:
   "p \<in> formula \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> arity(is_transrec_fm(p, a, z)) = ?ar"
   unfolding is_transrec_fm_def
   by (simp add:arity)
 
 synthesize "is_trans_apply_image" from_definition assuming "nonempty"
 arity_theorem for "is_trans_apply_image_fm"
 
 
 definition transrec_apply_image_body where
   "transrec_apply_image_body(M,f,mesa,x,z) \<equiv>  \<exists>y[M]. pair(M, x, y, z) \<and>
                                 (\<exists>fa[M].
                                     (\<forall>z[M].
                                         z \<in> fa \<longleftrightarrow>
                                         (\<exists>xa[M].
                                             \<exists>y[M].
                                                \<exists>xaa[M].
                                                   \<exists>sx[M].
                                                      \<exists>r_sx[M].
                                                         \<exists>f_r_sx[M].
                                                            pair(M, xa, y, z) \<and>
                                                            pair(M, xa, x, xaa) \<and>
                                                            upair(M, xa, xa, sx) \<and>
                                                            pre_image(M, mesa, sx, r_sx) \<and>
                                                            restriction(M, fa, r_sx, f_r_sx) \<and>
                                                            xaa \<in> mesa \<and> is_trans_apply_image(M, f, xa, f_r_sx, y))) \<and>
                                     is_trans_apply_image(M, f, x, fa, y))"
 
 synthesize "transrec_apply_image_body" from_definition assuming "nonempty"
 arity_theorem for "transrec_apply_image_body_fm"
 
-definition is_trans_apply_image_body where
+ definition is_trans_apply_image_body where
   "is_trans_apply_image_body(M,f,\<beta>,a,w) \<equiv> \<exists>z[M]. pair(M,a,z,w) \<and> a\<in>\<beta> \<and> (\<exists>sa[M].
-                \<exists>esa[M].
-                   \<exists>mesa[M].
+                 \<exists>esa[M].
+                    \<exists>mesa[M].
                       upair(M, a, a, sa) \<and>
-                      is_eclose(M, sa, esa) \<and>
+                       is_eclose(M, sa, esa) \<and>
                       membership(M, esa, mesa) \<and>
                       (\<exists>fa[M].
                           (\<forall>z[M].
                               z \<in> fa \<longleftrightarrow>
                               (\<exists>x[M].
                                   \<exists>y[M].
                                      \<exists>xa[M].
                                         \<exists>sx[M].
                                            \<exists>r_sx[M].
                                               \<exists>f_r_sx[M].
                                                  pair(M, x, y, z) \<and>
                                                  pair(M, x, a, xa) \<and>
                                                  upair(M, x, x, sx) \<and>
                                                  pre_image(M, mesa, sx, r_sx) \<and>
                                                  restriction(M, fa, r_sx, f_r_sx) \<and>
                                                  xa \<in> mesa \<and> is_trans_apply_image(M, f, x, f_r_sx, y))) \<and>
                           is_trans_apply_image(M, f, a, fa, z)))"
 
-manual_schematic "is_trans_apply_image_body_schematic" for "is_trans_apply_image_body"assuming "nonempty"
-  unfolding is_trans_apply_image_body_def
-  by (rule sep_rules is_eclose_iff_sats is_trans_apply_image_iff_sats | simp)+
 
-synthesize "is_trans_apply_image_body" from_schematic "is_trans_apply_image_body_schematic"
+synthesize "is_trans_apply_image_body" from_definition assuming "nonempty"
 arity_theorem for "is_trans_apply_image_body_fm"
 
-synthesize "is_converse" from_definition assuming "nonempty"
-arity_theorem for "is_converse_fm"
-
 definition replacement_is_omega_funspace_fm where "replacement_is_omega_funspace_fm \<equiv>  omega_funspace_fm(2,0,1)"
 definition replacement_HAleph_wfrec_repl_body_fm where "replacement_HAleph_wfrec_repl_body_fm \<equiv>  HAleph_wfrec_repl_body_fm(2,0,1)"
 definition replacement_is_fst2_snd2_fm where "replacement_is_fst2_snd2_fm \<equiv>  is_fst2_snd2_fm(0,1)"
 definition replacement_is_sndfst_fst2_snd2_fm where "replacement_is_sndfst_fst2_snd2_fm \<equiv>  is_sndfst_fst2_snd2_fm(0,1)"
 definition replacement_is_order_eq_map_fm where "replacement_is_order_eq_map_fm \<equiv>  order_eq_map_fm(2,3,0,1)"
 definition replacement_transrec_apply_image_body_fm where "replacement_transrec_apply_image_body_fm \<equiv>  transrec_apply_image_body_fm(3,2,0,1)"
 definition banach_replacement_iterates_fm where "banach_replacement_iterates_fm \<equiv> banach_is_iterates_body_fm(6,5,4,3,2,0,1)"
 definition replacement_is_trans_apply_image_fm where "replacement_is_trans_apply_image_fm \<equiv> is_trans_apply_image_body_fm(3,2,0,1)"
 definition banach_iterates_fm where "banach_iterates_fm \<equiv> banach_body_iterates_fm(7,6,5,4,3,2,0,1)"
 definition replacement_dcwit_repl_body_fm where "replacement_dcwit_repl_body_fm \<equiv> dcwit_repl_body_fm(6,5,4,3,2,0,1)"
 
 locale M_ZF2 = M_ZF1 +
   assumes
     replacement_ax2:
-    "replacement_assm(M,env,replacement_is_omega_funspace_fm)"
     "replacement_assm(M,env,replacement_HAleph_wfrec_repl_body_fm)"
-    "replacement_assm(M,env,replacement_is_fst2_snd2_fm)"
-    "replacement_assm(M,env,replacement_is_sndfst_fst2_snd2_fm)"
     "replacement_assm(M,env,replacement_is_order_eq_map_fm)"
-    "replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
-    "replacement_assm(M,env,banach_replacement_iterates_fm)"
-    "replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
     "replacement_assm(M,env,banach_iterates_fm)"
-    "replacement_assm(M,env,replacement_dcwit_repl_body_fm)"
-    and
-    Lambda_in_M_replacement2:
-    "replacement_assm(M,env,Lambda_in_M_fm(fst_fm(0,1),0))"
-    "replacement_assm(M,env,Lambda_in_M_fm(domain_fm(0,1),0))"
-    "replacement_assm(M,env,Lambda_in_M_fm(snd_fm(0,1),0))"
-    "replacement_assm(M,env,Lambda_in_M_fm(big_union_fm(0,1),0))"
-    "replacement_assm(M,env,Lambda_in_M_fm(is_cardinal_fm(0,1),0))"
-    "replacement_assm(M,env,Lambda_in_M_fm(is_converse_fm(0,1),0))"
-    and
-    LambdaPair_in_M_replacement2:
-    "replacement_assm(M,env,LambdaPair_in_M_fm(image_fm(0,1,2),0))"
-    "replacement_assm(M,env,LambdaPair_in_M_fm(setdiff_fm(0,1,2),0))"
-    "replacement_assm(M,env,LambdaPair_in_M_fm(minimum_fm(0,1,2),0))"
-    "replacement_assm(M,env,LambdaPair_in_M_fm(upair_fm(0,1,2),0))"
-    "replacement_assm(M,env,LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0))"
-    "replacement_assm(M,env,LambdaPair_in_M_fm(composition_fm(0,1,2),0))"
 
 definition instances2_fms where "instances2_fms \<equiv>
-  { replacement_is_omega_funspace_fm,
-    replacement_HAleph_wfrec_repl_body_fm,
-    replacement_is_fst2_snd2_fm,
-    replacement_is_sndfst_fst2_snd2_fm,
+  { replacement_HAleph_wfrec_repl_body_fm,
     replacement_is_order_eq_map_fm,
-    replacement_transrec_apply_image_body_fm,
-    banach_replacement_iterates_fm,
-    replacement_is_trans_apply_image_fm,
-    banach_iterates_fm,
-    replacement_dcwit_repl_body_fm,
-    Lambda_in_M_fm(fst_fm(0,1),0),
-    Lambda_in_M_fm(domain_fm(0,1),0),
-    Lambda_in_M_fm(snd_fm(0,1),0),
-    Lambda_in_M_fm(big_union_fm(0,1),0),
-    Lambda_in_M_fm(is_cardinal_fm(0,1),0),
-    Lambda_in_M_fm(is_converse_fm(0,1),0),
-    LambdaPair_in_M_fm(image_fm(0,1,2),0),
-    LambdaPair_in_M_fm(setdiff_fm(0,1,2),0),
-    LambdaPair_in_M_fm(minimum_fm(0,1,2),0),
-    LambdaPair_in_M_fm(upair_fm(0,1,2),0),
-    LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0),
-    LambdaPair_in_M_fm(composition_fm(0,1,2),0) }"
+    banach_iterates_fm }"
 
-txt\<open>This set has 22 internalized formulas.\<close>
+text\<open>This set has 12 internalized formulas.\<close>
 
 lemmas replacement_instances2_defs =
-  replacement_is_omega_funspace_fm_def
   replacement_HAleph_wfrec_repl_body_fm_def
-  replacement_is_fst2_snd2_fm_def
-  replacement_is_sndfst_fst2_snd2_fm_def
   replacement_is_order_eq_map_fm_def
-  replacement_transrec_apply_image_body_fm_def
-  banach_replacement_iterates_fm_def
-  replacement_is_trans_apply_image_fm_def
   banach_iterates_fm_def
-  replacement_dcwit_repl_body_fm_def
 
 declare (in M_ZF2) replacement_instances2_defs [simp]
 
 lemma instances2_fms_type[TC]: "instances2_fms \<subseteq> formula"
   unfolding replacement_instances2_defs instances2_fms_def
   by (simp del:Lambda_in_M_fm_def)
 
 locale M_ZF2_trans = M_ZF1_trans + M_ZF2
 
+text\<open>The following instances are needed only on the ground model. The
+first one corresponds to the recursive definition of forces for atomic
+formulas; the next two corresponds to \<^term>\<open>PHcheck\<close>; the following
+is used to get a generic filter using some form of choice.\<close>
+
+locale M_ZF_ground = M_ZF2 +
+  assumes
+    ZF_ground_replacements:
+    "replacement_assm(M,env,wfrec_Hfrc_at_fm)"
+    "replacement_assm(M,env,wfrec_Hcheck_fm)"
+    "replacement_assm(M,env,Lambda_in_M_fm(check_fm(2,0,1),1))"
+    "replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
+    "replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
+
+locale M_ZF_ground_trans = M_ZF2_trans + M_ZF_ground
+
+definition instances_ground_fms where "instances_ground_fms \<equiv>
+  { wfrec_Hfrc_at_fm,
+    wfrec_Hcheck_fm,
+    Lambda_in_M_fm(check_fm(2,0,1),1),
+    replacement_transrec_apply_image_body_fm,
+    replacement_is_trans_apply_image_fm }"
+
+lemmas replacement_instances_ground_defs =
+  wfrec_Hfrc_at_fm_def wfrec_Hcheck_fm_def
+  replacement_transrec_apply_image_body_fm_def
+  replacement_is_trans_apply_image_fm_def
+
+declare (in M_ZF_ground) replacement_instances_ground_defs [simp]
+
+lemma instances_ground_fms_type[TC]: "instances_ground_fms \<subseteq> formula"
+  using Lambda_in_M_fm_type
+  unfolding instances_ground_fms_def replacement_instances_ground_defs
+  by simp
+
+locale M_ZF_ground_CH = M_ZF_ground +
+  assumes
+    dcwit_replacement: "replacement_assm(M,env,replacement_dcwit_repl_body_fm)"
+
+declare (in M_ZF_ground_CH) replacement_dcwit_repl_body_fm_def [simp]
+
+locale M_ZF_ground_CH_trans = M_ZF_ground_trans + M_ZF_ground_CH
+
 locale M_ZFC2 = M_ZFC1 + M_ZF2
 
 locale M_ZFC2_trans = M_ZFC1_trans + M_ZF2_trans + M_ZFC2
 
-lemma (in M_ZF2_trans) lam_replacement_domain : "lam_replacement(##M, domain)"
-  using lam_replacement_iff_lam_closed[THEN iffD2,of domain]
-    Lambda_in_M[where \<phi>="domain_fm(0,1)" and env="[]"] domain_type domain_abs
-    Lambda_in_M_replacement2(2)
-    arity_domain_fm[of 0 1] ord_simp_union transitivity domain_closed
-  by simp
-
-lemma (in M_ZF2_trans) lam_replacement_converse : "lam_replacement(##M, converse)"
-  using lam_replacement_iff_lam_closed[THEN iffD2,of converse] nonempty
-    Lambda_in_M[where \<phi>="is_converse_fm(0,1)" and env="[]"]
-    is_converse_fm_type converse_abs
-    arity_is_converse_fm[of 0 1] ord_simp_union transitivity converse_closed
-    Lambda_in_M_replacement2(6)
-  by simp
-
-lemma (in M_ZF2_trans) lam_replacement_fst : "lam_replacement(##M, fst)"
-  using lam_replacement_iff_lam_closed[THEN iffD2,of fst]
-    Lambda_in_M[where \<phi>="fst_fm(0,1)" and env="[]"]
-    fst_iff_sats[symmetric] fst_abs fst_type
-    arity_fst_fm[of 0 1] ord_simp_union transitivity fst_closed
-    Lambda_in_M_replacement2(1)
-  by simp
+locale M_ctm1 = M_ZF1_trans +
+  fixes enum
+  assumes M_countable:      "enum\<in>bij(nat,M)"
 
-lemma (in M_ZF2_trans) lam_replacement_snd : "lam_replacement(##M, snd)"
-  using lam_replacement_iff_lam_closed[THEN iffD2,of snd]
-    Lambda_in_M[where \<phi>="snd_fm(0,1)" and env="[]"]
-    snd_iff_sats[symmetric] snd_abs snd_type
-    arity_snd_fm[of 0 1] ord_simp_union transitivity snd_closed
-    Lambda_in_M_replacement2(3)
-  by simp
+locale M_ctm1_AC = M_ctm1 + M_ZFC1_trans
 
-lemma (in M_ZF2_trans) lam_replacement_Union : "lam_replacement(##M, Union)"
-  using lam_replacement_iff_lam_closed[THEN iffD2,of Union]
-    Lambda_in_M[where \<phi>="big_union_fm(0,1)" and env="[]"] Union_abs
-    union_fm_def big_union_iff_sats[symmetric]
-    arity_big_union_fm[of 0 1] ord_simp_union transitivity Union_closed
-    Lambda_in_M_replacement2(4)
-  by simp
+locale M_ctm2 = M_ctm1 + M_ZF_ground_trans
 
-lemma (in M_ZF2_trans) lam_replacement_image:
-  "lam_replacement(##M, \<lambda>p. fst(p) `` snd(p))"
-  using lam_replacement2_in_ctm[where \<phi>="image_fm(0,1,2)" and env="[]"]
-    image_type image_iff_sats image_abs
-    arity_image_fm[of 0 1 2] ord_simp_union transitivity image_closed fst_snd_closed
-    LambdaPair_in_M_replacement2(1)
-  by simp
+locale M_ctm2_AC = M_ctm2 + M_ZFC2_trans
 
-lemma (in M_ZF2_trans) lam_replacement_Diff:
-  "lam_replacement(##M, \<lambda>p. fst(p) - snd(p))"
-  using lam_replacement2_in_ctm[where \<phi>="setdiff_fm(0,1,2)" and env="[]"]
-    setdiff_fm_type setdiff_iff_sats setdiff_abs
-    arity_setdiff_fm[of 0 1 2] ord_simp_union transitivity Diff_closed fst_snd_closed
-    nonempty LambdaPair_in_M_replacement2(2)
+context M_ZF2_trans
+begin
+
+lemma replacement_HAleph_wfrec_repl_body:
+  "B\<in>M \<Longrightarrow> strong_replacement(##M, HAleph_wfrec_repl_body(##M,B))"
+  using strong_replacement_rel_in_ctm[where \<phi>="HAleph_wfrec_repl_body_fm(2,0,1)" and env="[B]"]
+    zero_in_M arity_HAleph_wfrec_repl_body_fm replacement_ax2(1) ord_simp_union
   by simp
 
-lemma is_minimum_eq :
-  "M(R) \<Longrightarrow> M(X) \<Longrightarrow> M(u) \<Longrightarrow> is_minimum(M,R,X,u) \<longleftrightarrow> is_minimum'(M,R,X,u)"
-  unfolding is_minimum_def is_minimum'_def is_The_def is_first_def by simp
-
-context M_trivial
-begin
-
-lemma first_closed:
-  "M(B) \<Longrightarrow> M(r) \<Longrightarrow> first(u,r,B) \<Longrightarrow> M(u)"
-  using transM[OF first_is_elem] by simp
-
-is_iff_rel for "first"
-  unfolding is_first_def first_rel_def by auto
-
-is_iff_rel for "minimum"
-  unfolding is_minimum_def minimum_rel_def
-  using is_first_iff The_abs nonempty
-  by force
-
-end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
-
-lemma (in M_ZF2_trans) lam_replacement_minimum:
-  "lam_replacement(##M, \<lambda>p. minimum(fst(p), snd(p)))"
-  using lam_replacement2_in_ctm[where \<phi>="minimum_fm(0,1,2)" and env="[]"]
-    minimum_iff_sats[symmetric] is_minimum_iff minimum_abs is_minimum_eq
-    arity_minimum_fm[of 0 1 2] ord_simp_union minimum_fm_type
-    minimum_closed zero_in_M LambdaPair_in_M_replacement2(3)
-  by simp
-
-lemma (in M_ZF2_trans) lam_replacement_Upair: "lam_replacement(##M, \<lambda>p. Upair(fst(p), snd(p)))"
-  using lam_replacement2_in_ctm[where \<phi>="upair_fm(0,1,2)" and env="[]" and f="Upair"]
-    Upair_closed upair_type upair_iff_sats Upair_eq_cons
-    arity_upair_fm[of 0 1 2,simplified] ord_simp_union LambdaPair_in_M_replacement2(4)
-  by simp
-
-lemma (in M_ZF2_trans) lam_replacement_comp:
-  "lam_replacement(##M, \<lambda>p. comp(fst(p), snd(p)))"
-  using lam_replacement2_in_ctm[where \<phi>="composition_fm(0,1,2)" and env="[]" and f="comp"]
-    comp_closed composition_fm_type composition_iff_sats
-    arity_composition_fm[of 0 1 2] ord_simp_union LambdaPair_in_M_replacement2(6)
-  by simp
-
-lemma (in M_ZF2_trans) omega_funspace_abs:
-  "B\<in>M \<Longrightarrow> n\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> is_omega_funspace(##M,B,n,z) \<longleftrightarrow> n\<in>\<omega> \<and> is_funspace(##M,n,B,z)"
-  unfolding is_omega_funspace_def using nat_in_M by simp
-
-lemma (in M_ZF2_trans) replacement_is_omega_funspace:
-  "B\<in>M \<Longrightarrow> strong_replacement(##M, is_omega_funspace(##M,B))"
-  using strong_replacement_rel_in_ctm[where \<phi>="omega_funspace_fm(2,0,1)" and env="[B]"]
-    zero_in_M arity_omega_funspace_fm ord_simp_union replacement_ax2(1)
-  by simp
-
-lemma (in M_ZF2_trans) replacement_omega_funspace:
-  "b\<in>M\<Longrightarrow>strong_replacement(##M, \<lambda>n z. n\<in>\<omega> \<and> is_funspace(##M,n,b,z))"
-  using strong_replacement_cong[THEN iffD2,OF _ replacement_is_omega_funspace[of b]]
-    omega_funspace_abs[of b] setclass_iff[THEN iffD1]
-  by (simp del:setclass_iff)
-
-lemma (in M_ZF2_trans) replacement_HAleph_wfrec_repl_body:
-  "B\<in>M \<Longrightarrow> strong_replacement(##M, HAleph_wfrec_repl_body(##M,B))"
-  using strong_replacement_rel_in_ctm[where \<phi>="HAleph_wfrec_repl_body_fm(2,0,1)" and env="[B]"]
-    zero_in_M arity_HAleph_wfrec_repl_body_fm replacement_ax2(2) ord_simp_union
-  by simp
-
-lemma (in M_ZF2_trans) HAleph_wfrec_repl:
+lemma HAleph_wfrec_repl:
   "(##M)(sa) \<Longrightarrow>
         (##M)(esa) \<Longrightarrow>
         (##M)(mesa) \<Longrightarrow>
         strong_replacement
          (##M,
           \<lambda>x z. \<exists>y[##M].
                    pair(##M, x, y, z) \<and>
                    (\<exists>f[##M].
                        (\<forall>z[##M].
                            z \<in> f \<longleftrightarrow>
                            (\<exists>xa[##M].
                                \<exists>y[##M].
                                   \<exists>xaa[##M].
                                      \<exists>sx[##M].
                                         \<exists>r_sx[##M].
                                            \<exists>f_r_sx[##M].
                                               pair(##M, xa, y, z) \<and>
                                               pair(##M, xa, x, xaa) \<and>
                                               upair(##M, xa, xa, sx) \<and>
                                               pre_image(##M, mesa, sx, r_sx) \<and> restriction(##M, f, r_sx, f_r_sx) \<and> xaa \<in> mesa \<and> is_HAleph(##M, xa, f_r_sx, y))) \<and>
                        is_HAleph(##M, x, f, y)))"
   using replacement_HAleph_wfrec_repl_body unfolding HAleph_wfrec_repl_body_def by simp
 
-lemma dcwit_replacement:"Ord(na) \<Longrightarrow>
-    N(na) \<Longrightarrow>
-    N(A) \<Longrightarrow>
-    N(a) \<Longrightarrow>
-    N(s) \<Longrightarrow>
-    N(R) \<Longrightarrow>
-    transrec_replacement
-     (N, \<lambda>n f ntc.
-            is_nat_case
-             (N, a,
-              \<lambda>m bmfm.
-                 \<exists>fm[N]. \<exists>cp[N].
-                    is_apply(N, f, m, fm) \<and>
-                    is_Collect(N, A, \<lambda>x. \<exists>fmx[N]. (N(x) \<and> fmx \<in> R) \<and> pair(N, fm, x, fmx), cp) \<and>
-                    is_apply(N, s, cp, bmfm),
-              n, ntc),na)"
-  unfolding transrec_replacement_def wfrec_replacement_def oops
 
-lemma (in M_ZF2_trans) replacement_dcwit_repl_body:
+lemma (in M_ZF_ground_CH_trans) replacement_dcwit_repl_body:
   "(##M)(mesa) \<Longrightarrow> (##M)(A) \<Longrightarrow> (##M)(a) \<Longrightarrow> (##M)(s) \<Longrightarrow> (##M)(R) \<Longrightarrow>
    strong_replacement(##M, dcwit_repl_body(##M,mesa,A,a,s,R))"
   using strong_replacement_rel_in_ctm[where \<phi>="dcwit_repl_body_fm(6,5,4,3,2,0,1)"
       and env="[R,s,a,A,mesa]" and f="dcwit_repl_body(##M,mesa,A,a,s,R)"]
-    zero_in_M arity_dcwit_repl_body replacement_ax2(10)
+    zero_in_M arity_dcwit_repl_body dcwit_replacement
+  unfolding replacement_dcwit_repl_body_fm_def
   by simp
 
-lemma (in M_ZF2_trans) dcwit_repl:
+lemma (in M_ZF_ground_CH_trans) dcwit_repl:
   "(##M)(sa) \<Longrightarrow>
         (##M)(esa) \<Longrightarrow>
         (##M)(mesa) \<Longrightarrow> (##M)(A) \<Longrightarrow> (##M)(a) \<Longrightarrow> (##M)(s) \<Longrightarrow> (##M)(R) \<Longrightarrow>
         strong_replacement
               ((##M), \<lambda>x z. \<exists>y[(##M)]. pair((##M), x, y, z) \<and>
                                 is_wfrec
                                  ((##M), \<lambda>n f. is_nat_case
                                              ((##M), a,
                                               \<lambda>m bmfm.
                                                  \<exists>fm[(##M)].
                                                     \<exists>cp[(##M)].
                                                        is_apply((##M), f, m, fm) \<and>
                                                        is_Collect((##M), A, \<lambda>x. \<exists>fmx[(##M)]. ((##M)(x) \<and> fmx \<in> R) \<and> pair((##M), fm, x, fmx), cp) \<and>
                                                        is_apply((##M), s, cp, bmfm),
                                               n),
                                   mesa, x, y))"
   using replacement_dcwit_repl_body unfolding dcwit_repl_body_def by simp
 
-lemma (in M_ZF2_trans) replacement_fst2_snd2: "strong_replacement(##M, \<lambda>x y. y = \<langle>fst(fst(x)), snd(snd(x))\<rangle>)"
-  using strong_replacement_in_ctm[where \<phi>="is_fst2_snd2_fm(0,1)" and env="[]"]
-    zero_in_M fst_snd_closed pair_in_M_iff
-    arity_is_fst2_snd2_fm ord_simp_union fst2_snd2_abs replacement_ax2(3)
-  unfolding fst2_snd2_def
-  by simp
-
-lemma (in M_trivial) sndfst_fst2_snd2_abs:
-  assumes "M(x)" "M(res)"
-  shows "is_sndfst_fst2_snd2(M, x, res) \<longleftrightarrow> res = sndfst_fst2_snd2(x)"
-  unfolding is_sndfst_fst2_snd2_def sndfst_fst2_snd2_def
-  using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
-  by simp
-
-lemma (in M_ZF2_trans) replacement_sndfst_fst2_snd2:
-  "strong_replacement(##M, \<lambda>x y. y = \<langle>snd(fst(x)), fst(fst(x)), snd(snd(x))\<rangle>)"
-  using strong_replacement_in_ctm[where \<phi>="is_sndfst_fst2_snd2_fm(0,1)" and env="[]"]
-    zero_in_M fst_snd_closed pair_in_M_iff
-    arity_is_sndfst_fst2_snd2_fm ord_simp_union sndfst_fst2_snd2_abs replacement_ax2(4)
-  unfolding sndfst_fst2_snd2_def
-  by simp
-
-lemmas (in M_ZF2_trans) M_replacement_ZF_instances = lam_replacement_domain
+lemmas M_replacement_ZF_instances = lam_replacement_domain
   lam_replacement_fst lam_replacement_snd lam_replacement_Union
-  lam_replacement_Upair lam_replacement_image
+  lam_replacement_Upair lam_replacement_Image
   lam_replacement_Diff lam_replacement_converse
-  replacement_fst2_snd2 replacement_sndfst_fst2_snd2
+  lam_replacement_middle_del lam_replacement_prodRepl
   lam_replacement_comp
 
-lemmas (in M_ZF2_trans) M_separation_ZF_instances =  separation_fstsnd_in_sndsnd
-  separation_sndfst_eq_fstsnd
-
-sublocale M_ZF2_trans \<subseteq> M_replacement "##M"
-  using M_replacement_ZF_instances M_separation_ZF_instances
-  by unfold_locales simp
+lemmas M_separation_ZF_instances = separation_fstsnd_in_sndsnd separation_sndfst_eq_fstsnd
 
 lemma (in M_ZF1_trans) separation_is_dcwit_body:
   assumes "(##M)(A)" "(##M)(a)" "(##M)(g)" "(##M)(R)"
   shows "separation(##M,is_dcwit_body(##M, A, a, g, R))"
   using assms separation_in_ctm[where env="[A,a,g,R]" and \<phi>="is_dcwit_body_fm(1,2,3,4,0)",
       OF _ _ _ is_dcwit_body_iff_sats[symmetric],
       of "\<lambda>_.A" "\<lambda>_.a" "\<lambda>_.g" "\<lambda>_.R" "\<lambda>x. x"]
     nonempty arity_is_dcwit_body_fm is_dcwit_body_fm_type
   by (simp add:ord_simp_union)
 
-lemma (in M_trivial) RepFun_body_abs:
-  assumes "M(u)" "M(v)" "M(res)"
-  shows "is_RepFun_body(M, u, v, res) \<longleftrightarrow> res = RepFun_body(u,v)"
-  unfolding is_RepFun_body_def RepFun_body_def
-  using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
-    Replace_abs[where P="\<lambda>xa a. a = {\<langle>v, xa\<rangle>}" and A="u"]
-    univalent_triv transM[of _ u]
-  by auto
+end
 
-lemma (in M_ZF2_trans) RepFun_SigFun_closed: "x \<in> M \<Longrightarrow> z \<in> M \<Longrightarrow> {{\<langle>z, x\<rangle>} . x \<in> x} \<in> M"
-  using lam_replacement_sing_const_id lam_replacement_imp_strong_replacement RepFun_closed
-    transitivity singleton_in_M_iff pair_in_M_iff
+sublocale M_ZF2_trans \<subseteq> M_replacement "##M"
+  using M_replacement_ZF_instances M_separation_ZF_instances
+  by unfold_locales simp
+
+context M_ZF2_trans
+begin
+
+lemma separation_Pow_rel: "A\<in>M \<Longrightarrow>
+    separation(##M, \<lambda>y. \<exists>x \<in> M . x\<in>A \<and> y = \<langle>x, Pow\<^bsup>##M\<^esup>(x)\<rangle>)"
+  using separation_assm_sats[of "is_Pow_fm(0,1)"] arity_is_Pow_fm ord_simp_union
+    Pow_rel_closed nonempty Pow_rel_iff
   by simp
 
-lemma (in M_ZF2_trans) replacement_RepFun_body:
-  "lam_replacement(##M, \<lambda>p . {{\<langle>snd(p), x\<rangle>} . x \<in> fst(p)})"
-  using lam_replacement2_in_ctm[where \<phi>="is_RepFun_body_fm(0,1,2)" and env="[]" and f="\<lambda>p q . {{\<langle>q, x\<rangle>} . x \<in> p}"]
-    RepFun_SigFun_closed[OF fst_snd_closed[THEN conjunct1,simplified] fst_snd_closed[THEN conjunct2,simplified]]
-    arity_RepFun ord_simp_union transitivity zero_in_M RepFun_body_def RepFun_body_abs RepFun_SigFun_closed
-    LambdaPair_in_M_replacement2(5)
+lemma strong_replacement_Powapply_rel:
+  "f\<in>M \<Longrightarrow> strong_replacement(##M, \<lambda>x y. y = Powapply\<^bsup>##M\<^esup>(f,x))"
+  using Powapply_rel_replacement separation_Pow_rel transM
   by simp
 
-sublocale M_ZF2_trans \<subseteq> M_replacement_extra "##M"
-  by unfold_locales (simp_all add: replacement_RepFun_body
-      lam_replacement_minimum del:setclass_iff)
+end
+
+sublocale M_ZF2_trans \<subseteq> M_Vfrom "##M"
+  using power_ax strong_replacement_Powapply_rel phrank_repl trans_repl_HVFrom wfrec_rank
+  by unfold_locales auto
 
 sublocale M_ZF2_trans \<subseteq> M_Perm "##M"
   using separation_PiP_rel separation_injP_rel separation_surjP_rel
     lam_replacement_imp_strong_replacement[OF
       lam_replacement_Sigfun[OF lam_replacement_constant]]
     Pi_replacement1 unfolding Sigfun_def
   by unfold_locales simp_all
 
-lemma (in M_ZF2_trans) replacement_is_order_eq_map:
+sublocale M_ZF2_trans \<subseteq> M_pre_seqspace "##M"
+  by unfold_locales
+
+context M_ZF2_trans
+begin
+
+lemma separation_inj_rel: "A\<in>M \<Longrightarrow>
+     separation(##M, \<lambda>y. \<exists>x\<in>M. x \<in> A \<and> y = \<langle>x, inj_rel(##M,fst(x), snd(x))\<rangle>)"
+  using arity_is_inj_fm ord_simp_union
+    nonempty inj_rel_closed[simplified] inj_rel_iff[simplified]
+  by (rule_tac separation_assm_bin_sats[of "is_inj_fm(0,1,2)"])
+    (simp_all add:setclass_def)
+
+lemma lam_replacement_inj_rel: "lam_replacement(##M, \<lambda>x . inj_rel(##M,fst(x),snd(x)))"
+  using lam_replacement_inj_rel' separation_inj_rel
+  by simp
+
+lemma replacement_is_order_eq_map:
   "A\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> strong_replacement(##M, order_eq_map(##M,A,r))"
   using strong_replacement_rel_in_ctm[where \<phi>="order_eq_map_fm(2,3,0,1)" and env="[A,r]"  and f="order_eq_map(##M,A,r)"]
     order_eq_map_iff_sats[where env="[_,_,A,r]"] zero_in_M fst_snd_closed pair_in_M_iff
-    arity_order_eq_map_fm ord_simp_union replacement_ax2(5)
+    arity_order_eq_map_fm ord_simp_union replacement_ax2(2)
   by simp
 
-lemma (in M_ZF2_trans) banach_iterates:
+lemma banach_iterates:
   assumes "X\<in>M" "Y\<in>M" "f\<in>M" "g\<in>M" "W\<in>M"
   shows "iterates_replacement(##M, is_banach_functor(##M,X,Y,f,g), W)"
 proof -
   have "strong_replacement(##M, \<lambda> x z . banach_body_iterates(##M,X,Y,f,g,W,n,x,z))" if "n\<in>\<omega>" for n
     using assms that arity_banach_body_iterates_fm ord_simp_union nat_into_M
       strong_replacement_rel_in_ctm[where \<phi>="banach_body_iterates_fm(7,6,5,4,3,2,0,1)"
-        and env="[n,W,g,f,Y,X]"] replacement_ax2(9)
+        and env="[n,W,g,f,Y,X]"] replacement_ax2(3)
     by simp
   then
   show ?thesis
     using assms nat_into_M Memrel_closed
     unfolding iterates_replacement_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
       is_nat_case_def iterates_MH_def banach_body_iterates_def
     by simp
 qed
 
-lemma (in M_ZF2_trans) banach_replacement_iterates:
-  assumes "X\<in>M" "Y\<in>M" "f\<in>M" "g\<in>M" "W\<in>M"
-  shows "strong_replacement(##M, \<lambda>n y. n\<in>\<omega> \<and> is_iterates(##M,is_banach_functor(##M,X, Y, f, g),W,n,y))"
+lemma separation_banach_functor_iterates:
+  assumes "X\<in>M" "Y\<in>M" "f\<in>M" "g\<in>M" "A\<in>M"
+  shows "separation(##M, \<lambda>b. \<exists>x\<in>A. x \<in> \<omega> \<and> b = banach_functor(X, Y, f, g)^x (0))"
 proof -
-  have "strong_replacement(##M, \<lambda> n z . banach_is_iterates_body(##M,X,Y,f,g,W,n,z))"
-    using assms arity_banach_is_iterates_body_fm ord_simp_union nat_into_M
-      strong_replacement_rel_in_ctm[where \<phi>="banach_is_iterates_body_fm(6,5,4,3,2,0,1)"
-        and env="[W,g,f,Y,X]"] replacement_ax2(7)
+  have " (\<exists>xa\<in>M. xa \<in> A \<and> xa \<in> \<omega> \<and> banach_is_iterates_body(##M, X, Y, f, g, 0, xa, x)) \<longleftrightarrow>
+         (\<exists>n\<in>A. n \<in> \<omega> \<and> banach_is_iterates_body(##M, X, Y, f, g, 0, n, x))" if "x\<in>M" for x
+    using assms nat_into_M nat_in_M transM[of _ A] transM[of _ \<omega>] that
+    by auto
+  then
+  have "separation(##M, \<lambda> z . \<exists>n\<in>A . n\<in>\<omega> \<and> banach_is_iterates_body(##M,X,Y,f,g,0,n,z))"
+    using assms nat_into_M nat_in_M
+      arity_banach_is_iterates_body_fm[of 6 5 4 3 2 0 1] ord_simp_union
+      separation_in_ctm[where \<phi>="(\<cdot>\<exists> \<cdot>\<cdot>0\<in>7\<cdot> \<and> \<cdot>\<cdot>0\<in>8\<cdot> \<and> banach_is_iterates_body_fm(6,5,4,3,2,0,1) \<cdot>\<cdot>\<cdot>)"
+        and env="[0,g,f,Y,X,A,\<omega>]"]
+    by (simp add:arity_Exists arity_And)
+  moreover from assms
+  have "(\<exists>x\<in>A. x \<in> \<omega> \<and> is_iterates(##M,is_banach_functor(##M,X, Y, f, g),0,x,z)) \<longleftrightarrow>
+          (\<exists>n\<in>A . n\<in>\<omega> \<and> banach_is_iterates_body(##M,X,Y,f,g,0,n,z))" if "z\<in>M" for z
+    using nat_in_M nat_into_M transM[of _ A] transM[of _ \<omega>]
+    unfolding is_iterates_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
+      is_nat_case_def iterates_MH_def banach_body_iterates_def banach_is_iterates_body_def
     by simp
-  then
+  moreover from assms
+  have "(\<exists>x\<in>A. x \<in> \<omega> \<and> is_iterates(##M,is_banach_functor(##M,X, Y, f, g),0,x,z)) \<longleftrightarrow>
+          (\<exists>x\<in>A. x \<in> \<omega> \<and> z = banach_functor(X, Y, f, g)^x (0))" if "z\<in>M" for z
+    using transM[of _ A] nat_in_M nat_into_M that
+      iterates_abs[OF banach_iterates banach_functor_abs] banach_functor_closed
+    by auto
+  ultimately
   show ?thesis
-    using assms nat_in_M
-    unfolding is_iterates_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
-      is_nat_case_def iterates_MH_def banach_is_iterates_body_def
-    by simp
+    by(rule_tac separation_cong[THEN iffD2],auto)
 qed
 
-lemma (in M_ZF2_trans) banach_replacement:
-  assumes "(##M)(X)" "(##M)(Y)" "(##M)(f)" "(##M)(g)"
+lemma banach_replacement:
+  assumes "X\<in>M" "Y\<in>M" "f\<in>M" "g\<in>M"
   shows "strong_replacement(##M, \<lambda>n y. n\<in>nat \<and> y = banach_functor(X, Y, f, g)^n (0))"
-  using iterates_abs[OF banach_iterates banach_functor_abs,of X Y f g]
-    assms banach_functor_closed zero_in_M
-    strong_replacement_cong[THEN iffD1,OF _ banach_replacement_iterates[of X Y f g 0]]
+  using assms banach_repl_iter' separation_banach_functor_iterates
   by simp
 
-lemma (in M_ZF2_trans) lam_replacement_cardinal : "lam_replacement(##M, cardinal_rel(##M))"
-  using lam_replacement_iff_lam_closed[THEN iffD2,of "cardinal_rel(##M)"]
-    cardinal_rel_closed is_cardinal_iff
-    Lambda_in_M[where \<phi>="is_cardinal_fm(0,1)" and env="[]",OF is_cardinal_fm_type[of 0 1]]
-    arity_is_cardinal_fm[of 0 1] ord_simp_union cardinal_rel_closed transitivity zero_in_M
-    Lambda_in_M_replacement2(5)
-  by simp_all
-
 lemma (in M_basic) rel2_trans_apply:
   "M(f) \<Longrightarrow> relation2(M,is_trans_apply_image(M,f),trans_apply_image(f))"
   unfolding is_trans_apply_image_def trans_apply_image_def relation2_def
   by auto
 
 lemma (in M_basic) apply_image_closed:
-  shows "M(f) \<Longrightarrow> \<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(trans_apply_image(f, x, g))"
-  unfolding trans_apply_image_def by simp
-
-lemma (in M_basic) apply_image_closed':
   shows "M(f) \<Longrightarrow> \<forall>x[M]. \<forall>g[M]. M(trans_apply_image(f, x, g))"
   unfolding trans_apply_image_def by simp
 
-lemma (in M_ZF2_trans) replacement_transrec_apply_image_body :
+end \<comment> \<open>\<^locale>\<open>M_ZF2_trans\<close>\<close>
+
+context M_ZF_ground_trans
+begin
+
+lemma replacement_transrec_apply_image_body :
   "(##M)(f) \<Longrightarrow> (##M)(mesa) \<Longrightarrow> strong_replacement(##M,transrec_apply_image_body(##M,f,mesa))"
   using strong_replacement_rel_in_ctm[where \<phi>="transrec_apply_image_body_fm(3,2,0,1)" and env="[mesa,f]"]
     zero_in_M arity_transrec_apply_image_body_fm ord_simp_union
-    replacement_ax2(6)
+    ZF_ground_replacements(4)
   by simp
 
-lemma (in M_ZF2_trans) transrec_replacement_apply_image:
+lemma transrec_replacement_apply_image:
   assumes "(##M)(f)" "(##M)(\<alpha>)"
   shows "transrec_replacement(##M, is_trans_apply_image(##M, f), \<alpha>)"
-  unfolding transrec_replacement_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
   using replacement_transrec_apply_image_body[unfolded transrec_apply_image_body_def] assms
     Memrel_closed singleton_closed eclose_closed
+  unfolding transrec_replacement_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
   by simp
 
-lemma (in M_ZF2_trans) rec_trans_apply_image_abs:
+lemma rec_trans_apply_image_abs:
   assumes "(##M)(f)" "(##M)(x)" "(##M)(y)" "Ord(x)"
   shows "is_transrec(##M,is_trans_apply_image(##M, f),x,y) \<longleftrightarrow> y = transrec(x,trans_apply_image(f))"
   using transrec_abs[OF transrec_replacement_apply_image rel2_trans_apply] assms apply_image_closed
   by simp
 
-lemma (in M_ZF2_trans) replacement_is_trans_apply_image:
+lemma replacement_is_trans_apply_image:
   "(##M)(f) \<Longrightarrow> (##M)(\<beta>) \<Longrightarrow> strong_replacement(##M, \<lambda> x z .
     \<exists>y[##M]. pair(##M,x,y,z) \<and> x\<in>\<beta> \<and> (is_transrec(##M,is_trans_apply_image(##M, f),x,y)))"
   unfolding is_transrec_def is_wfrec_def M_is_recfun_def
   apply(rule_tac strong_replacement_cong[
         where P="\<lambda> x z. M,[x,z,\<beta>,f] \<Turnstile> is_trans_apply_image_body_fm(3,2,0,1)",THEN iffD1])
    apply(rule_tac is_trans_apply_image_body_iff_sats[symmetric,unfolded is_trans_apply_image_body_def,where env="[_,_,\<beta>,f]"])
             apply(simp_all add:zero_in_M)
-  apply(rule_tac replacement_ax2(8)[unfolded replacement_assm_def, rule_format, where env="[\<beta>,f]",simplified])
+  apply(rule_tac ZF_ground_replacements(5)[unfolded replacement_assm_def, rule_format, where env="[\<beta>,f]",simplified])
     apply(simp_all add: arity_is_trans_apply_image_body_fm is_trans_apply_image_body_fm_type ord_simp_union)
   done
 
-lemma (in M_ZF2_trans) trans_apply_abs:
+lemma trans_apply_abs:
   "(##M)(f) \<Longrightarrow> (##M)(\<beta>) \<Longrightarrow> Ord(\<beta>) \<Longrightarrow> (##M)(x) \<Longrightarrow> (##M)(z) \<Longrightarrow>
     (x\<in>\<beta> \<and> z = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a)) \<rangle>) \<longleftrightarrow>
     (\<exists>y[##M]. pair(##M,x,y,z) \<and> x\<in>\<beta> \<and> (is_transrec(##M,is_trans_apply_image(##M, f),x,y)))"
   using rec_trans_apply_image_abs Ord_in_Ord
     transrec_closed[OF transrec_replacement_apply_image rel2_trans_apply,of f,simplified]
-    apply_image_closed'[of f]
+    apply_image_closed
   unfolding trans_apply_image_def
   by auto
 
-lemma (in M_ZF2_trans) replacement_trans_apply_image:
+lemma replacement_trans_apply_image:
   "(##M)(f) \<Longrightarrow> (##M)(\<beta>) \<Longrightarrow> Ord(\<beta>) \<Longrightarrow>
   strong_replacement(##M, \<lambda>x y. x\<in>\<beta> \<and> y = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a))\<rangle>)"
   using strong_replacement_cong[THEN iffD1,OF _ replacement_is_trans_apply_image,simplified]
     trans_apply_abs Ord_in_Ord
   by simp
 
+end \<comment> \<open>\<^locale>\<open>M_ZF_ground_trans\<close>\<close>
+
 definition ifrFb_body where
   "ifrFb_body(M,b,f,x,i) \<equiv> x \<in>
   (if b = 0 then if i \<in> range(f) then
   if M(converse(f) ` i) then converse(f) ` i else 0 else 0 else if M(i) then i else 0)"
 
 relativize functional "ifrFb_body" "ifrFb_body_rel"
 relationalize "ifrFb_body_rel" "is_ifrFb_body"
 
 synthesize "is_ifrFb_body" from_definition assuming "nonempty"
 arity_theorem for "is_ifrFb_body_fm"
 
 definition ifrangeF_body :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
   "ifrangeF_body(M,A,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body(M,b,f,x,i)\<rangle>"
 
 relativize functional "ifrangeF_body" "ifrangeF_body_rel"
 relationalize "ifrangeF_body_rel" "is_ifrangeF_body"
 
 synthesize "is_ifrangeF_body" from_definition assuming "nonempty"
 arity_theorem for "is_ifrangeF_body_fm"
 
 lemma (in M_Z_trans) separation_is_ifrangeF_body:
   "(##M)(A) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body(##M,A,r,s))"
   using separation_in_ctm[where \<phi>="is_ifrangeF_body_fm(1,2,3,0)" and env="[A,r,s]"]
     zero_in_M arity_is_ifrangeF_body_fm ord_simp_union is_ifrangeF_body_fm_type
   by simp
 
 lemma (in M_basic) is_ifrFb_body_closed: "M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body(M, r, s, x, i) \<Longrightarrow> M(i)"
   unfolding ifrangeF_body_def is_ifrangeF_body_def is_ifrFb_body_def If_abs
   by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
 
 lemma (in M_ZF1_trans) ifrangeF_body_abs:
   assumes "(##M)(A)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
   shows "is_ifrangeF_body(##M,A,r,s,x) \<longleftrightarrow> ifrangeF_body(##M,A,r,s,x)"
 proof -
   {
     fix a
     assume "a\<in>M"
     with assms
     have "(\<mu> i. i\<in> M \<and> is_ifrFb_body(##M, r, s, z, i))= (\<mu> i. is_ifrFb_body(##M, r, s, z, i))" for z
       using is_ifrFb_body_closed[of r s z]
       by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body(##M,r,s,z,i)"]) auto
     moreover
     have "(\<mu> i. is_ifrFb_body(##M, r, s, z, i))= (\<mu> i. ifrFb_body(##M, r, s, z, i))" for z
     proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body(##M,r,s,z,i)" "\<lambda>i. ifrFb_body(##M,r,s,z,i)"])
       fix y
       from assms \<open>a\<in>M\<close>
       show "is_ifrFb_body(##M, r, s, z, y) \<longleftrightarrow> ifrFb_body(##M, r, s, z, y)"
         using If_abs apply_0
         unfolding ifrFb_body_def is_ifrFb_body_def
         by (cases "y\<in>M"; cases "y\<in>range(s)"; cases "converse(s)`y \<in> M";
             auto dest:transM split del: split_if del:iffI)
           (auto simp flip:setclass_iff; (force simp only:setclass_iff))+
     qed
     moreover from \<open>a\<in>M\<close>
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body(##M, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body(##M, r, s, z,i))" for z
       using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body(##M,r,s,z,i)" a]
       by simp
     ultimately
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body(##M, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i. ifrFb_body(##M, r, s, z,i))" for z
       by simp
   }
   with assms
   show ?thesis
     using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
     unfolding ifrangeF_body_def is_ifrangeF_body_def
     by (auto dest:transM)
 qed
 
 lemma (in M_ZF1_trans) separation_ifrangeF_body:
   "(##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow> separation
         (##M, \<lambda>y.  \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. if (##M)(x) then x else 0, b, f, i)\<rangle>)"
   using separation_is_ifrangeF_body ifrangeF_body_abs
     separation_cong[where P="is_ifrangeF_body(##M,A,b,f)" and M="##M",THEN iffD1]
   unfolding ifrangeF_body_def if_range_F_def if_range_F_else_F_def ifrFb_body_def
   by simp
 
 (* (##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
     separation(##M,
       \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if (##M)(a) then G`a else 0, b, f, i)\<rangle>) *)
 
 definition ifrFb_body2 where
   "ifrFb_body2(M,G,b,f,x,i) \<equiv> x \<in>
   (if b = 0 then if i \<in> range(f) then
   if M(converse(f) ` i) then G`(converse(f) ` i) else 0 else 0 else if M(i) then G`i else 0)"
 
 relativize functional "ifrFb_body2" "ifrFb_body2_rel"
 relationalize "ifrFb_body2_rel" "is_ifrFb_body2"
 
 synthesize "is_ifrFb_body2" from_definition assuming "nonempty"
 arity_theorem for "is_ifrFb_body2_fm"
 
 definition ifrangeF_body2 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "ifrangeF_body2(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body2(M,G,b,f,x,i)\<rangle>"
 
 relativize functional "ifrangeF_body2" "ifrangeF_body2_rel"
 relationalize "ifrangeF_body2_rel" "is_ifrangeF_body2"
 
 synthesize "is_ifrangeF_body2" from_definition assuming "nonempty"
 arity_theorem for "is_ifrangeF_body2_fm"
 
 lemma (in M_Z_trans) separation_is_ifrangeF_body2:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body2(##M,A,G,r,s))"
   using separation_in_ctm[where \<phi>="is_ifrangeF_body2_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
     zero_in_M arity_is_ifrangeF_body2_fm ord_simp_union is_ifrangeF_body2_fm_type
   by simp
 
 lemma (in M_basic) is_ifrFb_body2_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body2(M, G, r, s, x, i) \<Longrightarrow> M(i)"
   unfolding ifrangeF_body2_def is_ifrangeF_body2_def is_ifrFb_body2_def If_abs
   by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
 
 lemma (in M_ZF1_trans) ifrangeF_body2_abs:
   assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
   shows "is_ifrangeF_body2(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body2(##M,A,G,r,s,x)"
 proof -
   {
     fix a
     assume "a\<in>M"
     with assms
     have "(\<mu> i. i\<in> M \<and> is_ifrFb_body2(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body2(##M, G, r, s, z, i))" for z
       using is_ifrFb_body2_closed[of G r s z]
       by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body2(##M,G,r,s,z,i)"]) auto
     moreover
     have "(\<mu> i. is_ifrFb_body2(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body2(##M, G, r, s, z, i))" for z
     proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body2(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body2(##M,G,r,s,z,i)"])
       fix y
       from assms \<open>a\<in>M\<close>
       show "is_ifrFb_body2(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body2(##M, G, r, s, z, y)"
         using If_abs apply_0
         unfolding ifrFb_body2_def is_ifrFb_body2_def
         by (cases "y\<in>M"; cases "y\<in>range(s)"; cases "converse(s)`y \<in> M";
             auto dest:transM split del: split_if del:iffI)
           (auto simp flip:setclass_iff; (force simp only:setclass_iff))+
     qed
     moreover from \<open>a\<in>M\<close>
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body2(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body2(##M, G, r, s, z,i))" for z
       using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body2(##M,G,r,s,z,i)" a]
       by simp
     ultimately
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body2(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i. ifrFb_body2(##M, G, r, s, z,i))" for z
       by simp
   }
   with assms
   show ?thesis
     using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
     unfolding ifrangeF_body2_def is_ifrangeF_body2_def
     by (auto dest:transM)
 qed
 
 lemma (in M_ZF1_trans) separation_ifrangeF_body2:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
        separation
         (##M,
          \<lambda>y. \<exists>x\<in>A.
                 y =
                 \<langle>x, \<mu> i. x \<in>
                          if_range_F_else_F(\<lambda>a. if (##M)(a) then G ` a else 0, b, f, i)\<rangle>)"
   using separation_is_ifrangeF_body2 ifrangeF_body2_abs
     separation_cong[where P="is_ifrangeF_body2(##M,A,G,b,f)" and M="##M",THEN iffD1]
   unfolding ifrangeF_body2_def if_range_F_def if_range_F_else_F_def ifrFb_body2_def
   by simp
 
 (* (##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow> (##M)(F) \<Longrightarrow>
   separation(##M,
     \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if (##M)(a) then F -`` {a} else 0, b, f, i)\<rangle>) *)
 
 definition ifrFb_body3 where
   "ifrFb_body3(M,G,b,f,x,i) \<equiv> x \<in>
   (if b = 0 then if i \<in> range(f) then
   if M(converse(f) ` i) then G-``{converse(f) ` i} else 0 else 0 else if M(i) then G-``{i} else 0)"
 
 relativize functional "ifrFb_body3" "ifrFb_body3_rel"
 relationalize "ifrFb_body3_rel" "is_ifrFb_body3"
 
 synthesize "is_ifrFb_body3" from_definition assuming "nonempty"
 arity_theorem for "is_ifrFb_body3_fm"
 
 definition ifrangeF_body3 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "ifrangeF_body3(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body3(M,G,b,f,x,i)\<rangle>"
 
 relativize functional "ifrangeF_body3" "ifrangeF_body3_rel"
 relationalize "ifrangeF_body3_rel" "is_ifrangeF_body3"
 
 synthesize "is_ifrangeF_body3" from_definition assuming "nonempty"
 arity_theorem for "is_ifrangeF_body3_fm"
 
 lemma (in M_Z_trans) separation_is_ifrangeF_body3:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body3(##M,A,G,r,s))"
   using separation_in_ctm[where \<phi>="is_ifrangeF_body3_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
     zero_in_M arity_is_ifrangeF_body3_fm ord_simp_union is_ifrangeF_body3_fm_type
   by simp
 
 lemma (in M_basic) is_ifrFb_body3_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body3(M, G, r, s, x, i) \<Longrightarrow> M(i)"
   unfolding ifrangeF_body3_def is_ifrangeF_body3_def is_ifrFb_body3_def If_abs
   by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
 
 lemma (in M_ZF1_trans) ifrangeF_body3_abs:
   assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
   shows "is_ifrangeF_body3(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body3(##M,A,G,r,s,x)"
 proof -
   {
     fix a
     assume "a\<in>M"
     with assms
     have "(\<mu> i. i\<in> M \<and> is_ifrFb_body3(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body3(##M, G, r, s, z, i))" for z
       using is_ifrFb_body3_closed[of G r s z]
       by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body3(##M,G,r,s,z,i)"]) auto
     moreover
     have "(\<mu> i. is_ifrFb_body3(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body3(##M, G, r, s, z, i))" for z
     proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body3(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body3(##M,G,r,s,z,i)"])
       fix y
       from assms \<open>a\<in>M\<close>
       show "is_ifrFb_body3(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body3(##M, G, r, s, z, y)"
         using If_abs apply_0
         unfolding ifrFb_body3_def is_ifrFb_body3_def
         by (cases "y\<in>M"; cases "y\<in>range(s)"; cases "converse(s)`y \<in> M";
             auto dest:transM split del: split_if del:iffI)
           (auto simp flip:setclass_iff; (force simp only:setclass_iff))+
     qed
     moreover from \<open>a\<in>M\<close>
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body3(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body3(##M, G, r, s, z,i))" for z
       using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body3(##M,G,r,s,z,i)" a]
       by simp
     ultimately
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body3(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i. ifrFb_body3(##M, G, r, s, z,i))" for z
       by simp
   }
   with assms
   show ?thesis
     using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
     unfolding ifrangeF_body3_def is_ifrangeF_body3_def
     by (auto dest:transM)
 qed
 
 lemma (in M_ZF1_trans) separation_ifrangeF_body3:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
        separation
         (##M,
          \<lambda>y. \<exists>x\<in>A.
                 y =
                 \<langle>x, \<mu> i. x \<in>
                          if_range_F_else_F(\<lambda>a. if (##M)(a) then G-``{a} else 0, b, f, i)\<rangle>)"
   using separation_is_ifrangeF_body3 ifrangeF_body3_abs
     separation_cong[where P="is_ifrangeF_body3(##M,A,G,b,f)" and M="##M",THEN iffD1]
   unfolding ifrangeF_body3_def if_range_F_def if_range_F_else_F_def ifrFb_body3_def
   by simp
 
 (* (##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow> (##M)(A') \<Longrightarrow>
     separation(##M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F((`)(A), b, f, i)\<rangle>) *)
 
 definition ifrFb_body4 where
   "ifrFb_body4(G,b,f,x,i) \<equiv> x \<in>
   (if b = 0 then if i \<in> range(f) then G`(converse(f) ` i) else 0 else G`i)"
 
 relativize functional "ifrFb_body4" "ifrFb_body4_rel"
 relationalize "ifrFb_body4_rel" "is_ifrFb_body4"
 
 synthesize "is_ifrFb_body4" from_definition assuming "nonempty"
 arity_theorem for "is_ifrFb_body4_fm"
 
 definition ifrangeF_body4 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "ifrangeF_body4(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body4(G,b,f,x,i)\<rangle>"
 
 relativize functional "ifrangeF_body4" "ifrangeF_body4_rel"
 relationalize "ifrangeF_body4_rel" "is_ifrangeF_body4"
 
 synthesize "is_ifrangeF_body4" from_definition assuming "nonempty"
 arity_theorem for "is_ifrangeF_body4_fm"
 
 lemma (in M_Z_trans) separation_is_ifrangeF_body4:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body4(##M,A,G,r,s))"
   using separation_in_ctm[where \<phi>="is_ifrangeF_body4_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
     zero_in_M arity_is_ifrangeF_body4_fm ord_simp_union is_ifrangeF_body4_fm_type
   by simp
 
 lemma (in M_basic) is_ifrFb_body4_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body4(M, G, r, s, x, i) \<Longrightarrow> M(i)"
   using If_abs
   unfolding ifrangeF_body4_def is_ifrangeF_body4_def is_ifrFb_body4_def fun_apply_def
   by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
 
 lemma (in M_ZF1_trans) ifrangeF_body4_abs:
   assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
   shows "is_ifrangeF_body4(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body4(##M,A,G,r,s,x)"
 proof -
   {
     fix a
     assume "a\<in>M"
     with assms
     have "(\<mu> i. i\<in> M \<and> is_ifrFb_body4(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body4(##M, G, r, s, z, i))" for z
       using is_ifrFb_body4_closed[of G r s z]
       by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body4(##M,G,r,s,z,i)"]) auto
     moreover
     have "(\<mu> i. is_ifrFb_body4(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body4(G, r, s, z, i))" if "z\<in>M" for z
     proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body4(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body4(G,r,s,z,i)"])
       fix y
       from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
       show "is_ifrFb_body4(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body4(G, r, s, z, y)"
         using If_abs apply_0
         unfolding ifrFb_body4_def is_ifrFb_body4_def
         apply (cases "y\<in>M"; cases "y\<in>range(s)"; cases "r=0"; cases "y\<in>domain(G)";
             auto dest:transM split del: split_if del:iffI)
         by (auto simp flip:setclass_iff; (force simp only: fun_apply_def setclass_iff))
           (auto simp flip:setclass_iff simp: fun_apply_def )
     qed
     moreover from \<open>a\<in>M\<close>
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body4(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body4(##M, G, r, s, z,i))" for z
       using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body4(##M,G,r,s,z,i)" a]
       by simp
     ultimately
     have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body4(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i. ifrFb_body4(G, r, s, z,i))" for z
       by simp
   }
   with assms
   show ?thesis
     using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
     unfolding ifrangeF_body4_def is_ifrangeF_body4_def
     by (auto dest:transM)
 qed
 
 lemma (in M_ZF1_trans) separation_ifrangeF_body4:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
        separation(##M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F((`)(G), b, f, i)\<rangle>)"
   using separation_is_ifrangeF_body4 ifrangeF_body4_abs
     separation_cong[where P="is_ifrangeF_body4(##M,A,G,b,f)" and M="##M",THEN iffD1]
   unfolding ifrangeF_body4_def if_range_F_def if_range_F_else_F_def ifrFb_body4_def
   by simp
 
 (* (##M)(G) \<Longrightarrow> (##M)(A) \<Longrightarrow>
     separation(##M,
       \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. {xa \<in> G . x \<in> xa}, b, f, i)\<rangle>) *)
 
 definition ifrFb_body5 where
   "ifrFb_body5(G,b,f,x,i) \<equiv> x \<in>
   (if b = 0 then if i \<in> range(f) then {xa \<in> G . converse(f) ` i \<in> xa} else 0 else {xa \<in> G . i \<in> xa})"
 
 relativize functional "ifrFb_body5" "ifrFb_body5_rel"
 relationalize "ifrFb_body5_rel" "is_ifrFb_body5"
 
 synthesize "is_ifrFb_body5" from_definition assuming "nonempty"
 arity_theorem for "is_ifrFb_body5_fm"
 
 definition ifrangeF_body5 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "ifrangeF_body5(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body5(G,b,f,x,i)\<rangle>"
 
 relativize functional "ifrangeF_body5" "ifrangeF_body5_rel"
 relationalize "ifrangeF_body5_rel" "is_ifrangeF_body5"
 
 synthesize "is_ifrangeF_body5" from_definition assuming "nonempty"
 arity_theorem for "is_ifrangeF_body5_fm"
 
 lemma (in M_Z_trans) separation_is_ifrangeF_body5:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body5(##M,A,G,r,s))"
   using separation_in_ctm[where \<phi>="is_ifrangeF_body5_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
     zero_in_M arity_is_ifrangeF_body5_fm ord_simp_union is_ifrangeF_body5_fm_type
   by simp
 
 lemma (in M_basic) is_ifrFb_body5_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body5(M, G, r, s, x, i) \<Longrightarrow> M(i)"
   using If_abs
   unfolding ifrangeF_body5_def is_ifrangeF_body5_def is_ifrFb_body5_def fun_apply_def
   by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
 
 lemma (in M_ZF1_trans) ifrangeF_body5_abs:
   assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
   shows "is_ifrangeF_body5(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body5(##M,A,G,r,s,x)"
 proof -
   {
     fix a
     assume "a\<in>M"
     with assms
     have "(\<mu> i. i\<in> M \<and> is_ifrFb_body5(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body5(##M, G, r, s, z, i))" for z
       using is_ifrFb_body5_closed[of G r s z]
       by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body5(##M,G,r,s,z,i)"]) auto
     moreover
     have "(\<mu> i. is_ifrFb_body5(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body5(G, r, s, z, i))" if "z\<in>M" for z
     proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body5(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body5(G,r,s,z,i)"])
       fix y
       from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
       show "is_ifrFb_body5(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body5(G, r, s, z, y)"
         using If_abs apply_0 separation_in_constant separation_in_rev
         unfolding ifrFb_body5_def is_ifrFb_body5_def
         apply (cases "y\<in>M"; cases "y\<in>range(s)"; cases "r=0"; cases "y\<in>domain(G)";
             auto dest:transM split del: split_if del:iffI)
               apply (auto simp flip:setclass_iff; (force simp only: fun_apply_def setclass_iff))
              apply (auto simp flip:setclass_iff simp: fun_apply_def)
         apply (auto dest:transM)
         done
     qed
     moreover from \<open>a\<in>M\<close>
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body5(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body5(##M, G, r, s, z,i))" for z
       using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body5(##M,G,r,s,z,i)" a]
       by simp
     ultimately
     have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body5(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i. ifrFb_body5(G, r, s, z,i))" for z
       by simp
   }
   with assms
   show ?thesis
     using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
     unfolding ifrangeF_body5_def is_ifrangeF_body5_def
     by (auto dest:transM)
 qed
 
 lemma (in M_ZF1_trans) separation_ifrangeF_body5:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
        separation(##M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. {xa \<in> G . x \<in> xa}, b, f, i)\<rangle>)"
   using separation_is_ifrangeF_body5 ifrangeF_body5_abs
     separation_cong[where P="is_ifrangeF_body5(##M,A,G,b,f)" and M="##M",THEN iffD1]
   unfolding ifrangeF_body5_def if_range_F_def if_range_F_else_F_def ifrFb_body5_def
   by simp
 
 (* (##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
     separation(##M,
       \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. {p \<in> A . domain(p) = a}, b, f, i)\<rangle>) *)
 
 definition ifrFb_body6 where
   "ifrFb_body6(G,b,f,x,i) \<equiv> x \<in>
   (if b = 0 then if i \<in> range(f) then {p\<in>G . domain(p) = converse(f) ` i} else 0 else {p\<in>G . domain(p) = i})"
 
 relativize functional "ifrFb_body6" "ifrFb_body6_rel"
 relationalize "ifrFb_body6_rel" "is_ifrFb_body6"
 
 synthesize "is_ifrFb_body6" from_definition assuming "nonempty"
 arity_theorem for "is_ifrFb_body6_fm"
 
 definition ifrangeF_body6 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
   "ifrangeF_body6(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body6(G,b,f,x,i)\<rangle>"
 
 relativize functional "ifrangeF_body6" "ifrangeF_body6_rel"
 relationalize "ifrangeF_body6_rel" "is_ifrangeF_body6"
 
 synthesize "is_ifrangeF_body6" from_definition assuming "nonempty"
 arity_theorem for "is_ifrangeF_body6_fm"
 
 lemma (in M_Z_trans) separation_is_ifrangeF_body6:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body6(##M,A,G,r,s))"
   using separation_in_ctm[where \<phi>="is_ifrangeF_body6_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
     zero_in_M arity_is_ifrangeF_body6_fm ord_simp_union is_ifrangeF_body6_fm_type
   by simp
 
 lemma (in M_basic) ifrFb_body6_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> ifrFb_body6(G, r, s, x, i) \<longleftrightarrow>  M(i) \<and> ifrFb_body6(G, r, s, x, i)"
   using If_abs
   unfolding ifrangeF_body6_def is_ifrangeF_body6_def ifrFb_body6_def fun_apply_def
   by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
 
 lemma (in M_basic) is_ifrFb_body6_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body6(M, G, r, s, x, i) \<Longrightarrow> M(i)"
   using If_abs
   unfolding ifrangeF_body6_def is_ifrangeF_body6_def is_ifrFb_body6_def fun_apply_def
   by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
 
 lemma (in M_ZF2_trans) ifrangeF_body6_abs:
   assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
   shows "is_ifrangeF_body6(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body6(##M,A,G,r,s,x)"
 proof -
   {
     fix a
     assume "a\<in>M"
     with assms
     have "(\<mu> i. i\<in> M \<and> is_ifrFb_body6(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body6(##M, G, r, s, z, i))" for z
       using is_ifrFb_body6_closed[of G r s z]
       by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body6(##M,G,r,s,z,i)"]) auto
     moreover
     have "(\<mu> i. i\<in>M \<and> is_ifrFb_body6(##M, G, r, s, z, i))= (\<mu> i. i\<in>M \<and>  ifrFb_body6(G, r, s, z, i))" if "z\<in>M" for z
     proof (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body6(##M,G,r,s,z,i)" "\<lambda>i. i\<in>M \<and> ifrFb_body6(G,r,s,z,i)"])
       fix y
       from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
       show "y\<in>M \<and> is_ifrFb_body6(##M, G, r, s, z, y) \<longleftrightarrow> y\<in>M \<and> ifrFb_body6(G, r, s, z, y)"
         using If_abs apply_0 separation_in_constant transitivity[of _ G]
           separation_closed converse_closed apply_closed range_closed zero_in_M
           separation_cong[OF eq_commute,THEN iffD1,OF domain_eq_separation]
         unfolding ifrFb_body6_def is_ifrFb_body6_def
         by auto
     qed
     moreover from \<open>a\<in>M\<close>
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body6(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body6(##M, G, r, s, z,i))" for z
       using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body6(##M,G,r,s,z,i)" a]
       by simp
     ultimately
     have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body6(##M, G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i. ifrFb_body6(G, r, s, z,i))" for z
       using Least_cong[OF ifrFb_body6_closed[of G r s]] assms
       by simp
   }
   with assms
   show ?thesis
     using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
     unfolding ifrangeF_body6_def is_ifrangeF_body6_def
     by (auto dest:transM)
 qed
 
 lemma (in M_ZF2_trans) separation_ifrangeF_body6:
   "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
        separation(##M,
       \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. {p \<in> G . domain(p) = a}, b, f, i)\<rangle>)"
   using separation_is_ifrangeF_body6 ifrangeF_body6_abs
     separation_cong[where P="is_ifrangeF_body6(##M,A,G,b,f)" and M="##M",THEN iffD1]
   unfolding ifrangeF_body6_def if_range_F_def if_range_F_else_F_def ifrFb_body6_def
   by simp
 
 
 
 (* (##M)(A) \<Longrightarrow> (##M)(f) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(D) \<Longrightarrow> (##M)(r') \<Longrightarrow> (##M)(A') \<Longrightarrow>
     separation(##M,
       \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(drSR_Y(r', D, A), b, f, i)\<rangle>) *)
 
 definition ifrFb_body7 where
   "ifrFb_body7(B,D,A,b,f,x,i) \<equiv> x \<in>
     (if b = 0 then if i \<in> range(f) then
         {d \<in> D . \<exists>r\<in>A. restrict(r, B) = converse(f) ` i \<and> d = domain(r)} else 0
        else {d \<in> D . \<exists>r\<in>A. restrict(r, B) = i \<and> d = domain(r)})"
 
 relativize functional "ifrFb_body7" "ifrFb_body7_rel"
 relationalize "ifrFb_body7_rel" "is_ifrFb_body7"
 
 synthesize "is_ifrFb_body7" from_definition assuming "nonempty"
 arity_theorem for "is_ifrFb_body7_fm"
 
 definition ifrangeF_body7 :: "[i\<Rightarrow>o,i,i,i,i,i,i,i] \<Rightarrow> o" where
   "ifrangeF_body7(M,A,B,D,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body7(B,D,G,b,f,x,i)\<rangle>"
 
 relativize functional "ifrangeF_body7" "ifrangeF_body7_rel"
 relationalize "ifrangeF_body7_rel" "is_ifrangeF_body7"
 
 synthesize "is_ifrangeF_body7" from_definition assuming "nonempty"
 arity_theorem for "is_ifrangeF_body7_fm"
 
 lemma (in M_Z_trans) separation_is_ifrangeF_body7:
   "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> (##M)(D) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body7(##M,A,B,D,G,r,s))"
   using separation_in_ctm[where \<phi>="is_ifrangeF_body7_fm(1,2,3,4,5,6,0)" and env="[A,B,D,G,r,s]"]
     zero_in_M arity_is_ifrangeF_body7_fm ord_simp_union is_ifrangeF_body7_fm_type
   by simp
 
 lemma (in M_basic) ifrFb_body7_closed: "M(B) \<Longrightarrow> M(D) \<Longrightarrow> M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow>
   ifrFb_body7(B,D,G, r, s, x, i) \<longleftrightarrow>  M(i) \<and> ifrFb_body7(B,D,G, r, s, x, i)"
   using If_abs
   unfolding ifrangeF_body7_def is_ifrangeF_body7_def ifrFb_body7_def fun_apply_def
   by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
 
 lemma (in M_basic) is_ifrFb_body7_closed: "M(B) \<Longrightarrow> M(D) \<Longrightarrow> M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow>
   is_ifrFb_body7(M, B,D,G, r, s, x, i) \<Longrightarrow> M(i)"
   using If_abs
   unfolding ifrangeF_body7_def is_ifrangeF_body7_def is_ifrFb_body7_def fun_apply_def
   by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
 
 lemma (in M_ZF2_trans) ifrangeF_body7_abs:
   assumes "(##M)(A)"  "(##M)(B)" "(##M)(D)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
   shows "is_ifrangeF_body7(##M,A,B,D,G,r,s,x) \<longleftrightarrow> ifrangeF_body7(##M,A,B,D,G,r,s,x)"
 proof -
   from assms
-  have sep_dr: "y\<in>M \<Longrightarrow> separation(##M, \<lambda>d . \<exists>r\<in>M . r\<in>G\<and> y = restrict(r, B) \<and> d = domain(r))" for y
+  have sep_dr: "y\<in>M \<Longrightarrow> separation(##M, \<lambda>d . \<exists>r\<in>M . r\<in>G \<and> y = restrict(r, B) \<and> d = domain(r))" for y
     by(rule_tac separation_cong[where P'="\<lambda>d . \<exists>r\<in> M . r\<in>G \<and> y = restrict(r, B) \<and> d = domain(r)",THEN iffD1,OF _
           separation_restrict_eq_dom_eq[rule_format,of G B y]],auto simp:transitivity[of _ G])
-
   from assms
   have sep_dr'': "y\<in>M \<Longrightarrow> separation(##M, \<lambda>d . \<exists>r\<in>M. r \<in> G \<and> d = domain(r) \<and> converse(s) ` y = restrict(r, B))" for y
-    apply(rule_tac separation_cong[where P'="\<lambda>d . \<exists>r\<in> M . r\<in>G \<and> d = domain(r) \<and> converse(s) ` y = restrict(r, B)",THEN iffD1,OF _ separation_restrict_eq_dom_eq[rule_format,of G B "converse(s) ` y "]])
-    by(auto simp:transitivity[of _ G] apply_closed[simplified] converse_closed[simplified])
-  from assms
-  have sep_dr':"separation(##M, \<lambda>x. \<exists>r\<in>M. r \<in> G \<and> x = domain(r) \<and> 0 = restrict(r, B))"
-    apply(rule_tac separation_cong[where P'="\<lambda>d . \<exists>r\<in> M . r\<in>G \<and> d = domain(r) \<and> 0 = restrict(r, B)",THEN iffD1,OF _ separation_restrict_eq_dom_eq[rule_format,of G B 0]])
-    by(auto simp:transitivity[of _ G] zero_in_M)
+    by(rule_tac separation_cong[THEN iffD1,OF _ separation_restrict_eq_dom_eq[rule_format,of G B "converse(s) ` y "]],
+        auto simp:transitivity[of _ G] apply_closed[simplified] converse_closed[simplified])
   {
     fix a
     assume "a\<in>M"
     with assms
     have "(\<mu> i. i\<in> M \<and> is_ifrFb_body7(##M, B,D,G, r, s, z, i))= (\<mu> i. is_ifrFb_body7(##M,B,D, G, r, s, z, i))" for z
       using is_ifrFb_body7_closed[of B D G r s z]
       by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body7(##M,B,D,G,r,s,z,i)"]) auto
     moreover from this
     have "(\<mu> i. i\<in>M \<and> is_ifrFb_body7(##M, B,D,G, r, s, z, i))= (\<mu> i. i\<in>M \<and>  ifrFb_body7(B,D,G, r, s, z, i))" if "z\<in>M" for z
     proof (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body7(##M,B,D,G,r,s,z,i)" "\<lambda>i. i\<in>M \<and> ifrFb_body7(B,D,G,r,s,z,i)"])
       from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
       have "is_ifrFb_body7(##M, B,D,G, r, s, z, y) \<longleftrightarrow> ifrFb_body7(B,D,G, r, s, z, y)" if "y\<in>M" for y
         using If_abs apply_0
           separation_closed converse_closed apply_closed range_closed zero_in_M
-          separation_restrict_eq_dom_eq
-          transitivity[of _ D] transitivity[of _ G]  that sep_dr sep_dr' sep_dr''
+          transitivity[of _ D] transitivity[of _ G] that sep_dr sep_dr''
         unfolding ifrFb_body7_def is_ifrFb_body7_def
         by auto
       then
       show " y \<in> M \<and> is_ifrFb_body7(##M, B, D, G, r, s, z, y) \<longleftrightarrow> y \<in> M \<and> ifrFb_body7(B, D, G, r, s, z, y)" for y
         using conj_cong
         by simp
     qed
     moreover from \<open>a\<in>M\<close>
     have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body7(##M, B,D,G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body7(##M,B,D,G, r, s, z,i))" for z
       using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body7(##M,B,D,G,r,s,z,i)" a]
       by simp
     ultimately
     have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body7(##M,B,D,G, r, s, z, i), a)
       \<longleftrightarrow> a = (\<mu> i. ifrFb_body7(B,D,G, r, s, z,i))" for z
       using Least_cong[OF ifrFb_body7_closed[of B D G r s]] assms
       by simp
   }
   with assms
   show ?thesis
     using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
     unfolding ifrangeF_body7_def is_ifrangeF_body7_def
     by (auto dest:transM)
 qed
 
 lemma (in M_ZF2_trans) separation_ifrangeF_body7:
   "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> (##M)(D) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
     separation(##M,
       \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(drSR_Y(B, D, G), b, f, i)\<rangle>)"
   using separation_is_ifrangeF_body7 ifrangeF_body7_abs drSR_Y_equality
     separation_cong[where P="is_ifrangeF_body7(##M,A,B,D,G,b,f)" and M="##M",THEN iffD1]
   unfolding ifrangeF_body7_def if_range_F_def if_range_F_else_F_def ifrFb_body7_def
   by simp
 
+definition omfunspace :: "[i,i] \<Rightarrow> o" where
+  "omfunspace(B) \<equiv> \<lambda>z. \<exists>x. \<exists>n\<in>\<omega>. z\<in>x \<and> x = n\<rightarrow>B"
+relativize functional "omfunspace" "omfunspace_rel"
+relationalize "omfunspace_rel" "is_omfunspace"
+synthesize "is_omfunspace" from_definition assuming "nonempty"
+arity_theorem for "is_omfunspace_fm"
+
+context M_pre_seqspace
+begin
+
+is_iff_rel for "omfunspace"
+  using is_function_space_iff
+  unfolding omfunspace_rel_def is_omfunspace_def
+  by (simp add:absolut)
+
+end \<comment> \<open>\<^locale>\<open>M_pre_seqspace\<close>\<close>
+
+context M_ZF2_trans
+begin
+
+lemma separation_omfunspace:
+  assumes "(##M)(B)"
+  shows "separation(##M, \<lambda>z. \<exists>x[##M]. \<exists>n[##M]. n \<in> \<omega> \<and> z \<in> x \<and> x = n \<rightarrow>\<^bsup>M\<^esup> B)"
+  using assms separation_in_ctm[where env="[B]" and \<phi>="is_omfunspace_fm(1,0)"
+      and Q="is_omfunspace(##M,B)"]
+    nonempty is_omfunspace_iff[of B, THEN separation_cong, of "##M"]
+    arity_is_omfunspace_fm is_omfunspace_fm_type
+  unfolding omfunspace_rel_def
+  by (auto simp add:ord_simp_union)
+
+end \<comment> \<open>\<^locale>\<open>M_ZF2_trans\<close>\<close>
+
+sublocale M_ZF2_trans \<subseteq> M_seqspace "##M"
+  using separation_omfunspace by unfold_locales
+
+definition cdltgamma :: "[i,i] \<Rightarrow> o" where
+  "cdltgamma(\<gamma>) \<equiv> \<lambda>Z . |Z| < \<gamma>"
+relativize functional "cdltgamma" "cdltgamma_rel"
+relationalize "cdltgamma_rel" "is_cdltgamma"
+synthesize "is_cdltgamma" from_definition assuming "nonempty"
+arity_theorem for "is_cdltgamma_fm"
+
+definition cdeqgamma :: "[i] \<Rightarrow> o" where
+  "cdeqgamma \<equiv> \<lambda>Z . |fst(Z)| = snd(Z)"
+relativize functional "cdeqgamma" "cdeqgamma_rel"
+relationalize "cdeqgamma_rel" "is_cdeqgamma"
+synthesize "is_cdeqgamma" from_definition assuming "nonempty"
+arity_theorem for "is_cdeqgamma_fm"
+
+context M_Perm
+begin
+
+is_iff_rel for "cdltgamma"
+  using is_cardinal_iff
+  unfolding cdltgamma_rel_def is_cdltgamma_def
+  by (simp add:absolut)
+
+is_iff_rel for "cdeqgamma"
+  using is_cardinal_iff fst_rel_abs snd_rel_abs
+  unfolding cdeqgamma_rel_def is_cdeqgamma_def
+  by (auto simp add:absolut)
+
+lemma is_cdeqgamma_iff_split: "M(Z) \<Longrightarrow> cdeqgamma_rel(M, Z) \<longleftrightarrow> (\<lambda>\<langle>x,y\<rangle>. |x|\<^bsup>M\<^esup> = y)(Z)"
+  using  fst_rel_abs snd_rel_abs
+  unfolding cdeqgamma_rel_def split_def
+  by simp
+
+end
+
+context M_ZF2_trans
+begin
+
+lemma separation_cdltgamma:
+  assumes "(##M)(\<gamma>)"
+  shows "separation(##M, \<lambda>Z . cardinal_rel(##M,Z) < \<gamma>)"
+  using assms separation_in_ctm[where env="[\<gamma>]" and \<phi>="is_cdltgamma_fm(1,0)"
+      and Q="cdltgamma_rel(##M,\<gamma>)"]
+    nonempty is_cdltgamma_iff[of \<gamma>] arity_is_cdltgamma_fm is_cdltgamma_fm_type
+  unfolding cdltgamma_rel_def
+  by (auto simp add:ord_simp_union)
+
+lemma separation_cdeqgamma:
+  shows "separation(##M, \<lambda>Z. (\<lambda>\<langle>x,y\<rangle> . cardinal_rel(##M,x) = y)(Z))"
+  using separation_in_ctm[where env="[]" and \<phi>="is_cdeqgamma_fm(0)"
+      and Q="cdeqgamma_rel(##M)"] is_cdeqgamma_iff_split
+    nonempty is_cdeqgamma_iff arity_is_cdeqgamma_fm is_cdeqgamma_fm_type
+    separation_cong[OF is_cdeqgamma_iff_split, of "##M"]
+  unfolding cdeqgamma_rel_def
+  by (simp add:ord_simp_union)
+
+end \<comment> \<open>\<^locale>\<open>M_ZF2_trans\<close>\<close>
+
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Separation_Axiom.thy b/thys/Independence_CH/Separation_Axiom.thy
--- a/thys/Independence_CH/Separation_Axiom.thy
+++ b/thys/Independence_CH/Separation_Axiom.thy
@@ -1,399 +1,291 @@
 section\<open>The Axiom of Separation in $M[G]$\<close>
 theory Separation_Axiom
   imports Forcing_Theorems Separation_Rename
 begin
 
 context G_generic1
 begin
 
 lemma map_val :
   assumes "env\<in>list(M[G])"
-  shows "\<exists>nenv\<in>list(M). env = map(val(P,G),nenv)"
+  shows "\<exists>nenv\<in>list(M). env = map(val(G),nenv)"
   using assms
-  proof(induct env)
-    case Nil
-    have "map(val(P,G),Nil) = Nil" by simp
-    then show ?case by force
-  next
-    case (Cons a l)
-    then obtain a' l' where
-      "l' \<in> list(M)" "l=map(val(P,G),l')" "a = val(P,G,a')"
-      "Cons(a,l) = map(val(P,G),Cons(a',l'))" "Cons(a',l') \<in> list(M)"
-      using \<open>a\<in>M[G]\<close> GenExtD
-      by force
-    then show ?case by force
+proof(induct env)
+  case Nil
+  have "map(val(G),Nil) = Nil" by simp
+  then show ?case by force
+next
+  case (Cons a l)
+  then obtain a' l' where
+    "l' \<in> list(M)" "l=map(val(G),l')" "a = val(G,a')"
+    "Cons(a,l) = map(val(G),Cons(a',l'))" "Cons(a',l') \<in> list(M)"
+    using GenExtD
+    by force
+  then show ?case by force
 qed
 
 lemma Collect_sats_in_MG :
   assumes
-    "c\<in>M[G]"
+    "A\<in>M[G]"
     "\<phi> \<in> formula" "env\<in>list(M[G])" "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)"
   shows
-    "{x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)}\<in> M[G]"
+    "{x \<in> A . (M[G], [x] @ env \<Turnstile> \<phi>)} \<in> M[G]"
 proof -
-  from \<open>c\<in>M[G]\<close>
-  obtain \<pi> where "\<pi> \<in> M" "val(P,G, \<pi>) = c"
+  from \<open>A\<in>M[G]\<close>
+  obtain \<pi> where "\<pi> \<in> M" "val(G, \<pi>) = A"
     using GenExt_def by auto
-  let ?\<chi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>" and ?Pl1="[P,leq,\<one>]"
+  then
+  have "domain(\<pi>)\<in>M" "domain(\<pi>) \<times> P \<in> M"
+    using cartprod_closed[of _ P,simplified]
+    by (simp_all flip:setclass_iff)
+  let ?\<chi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"
   let ?new_form="sep_ren(length(env),forces(?\<chi>))"
-  let ?\<psi>="Exists(Exists(And(pair_fm(0,1,2),?new_form)))"
+  let ?\<psi>="(\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>\<langle>0,1\<rangle> is 2 \<cdot> \<and> ?new_form \<cdot> \<cdot>)\<cdot>)"
   note phi = \<open>\<phi>\<in>formula\<close> \<open>arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)\<close>
   then
-  have "?\<chi>\<in>formula" by simp
+  have "?\<chi>\<in>formula" "forces(?\<chi>) \<in> formula" "arity(\<phi>) \<le> 2+\<^sub>\<omega> length(env)"
+    using definability le_trans[OF \<open>arity(\<phi>)\<le>_\<close>] add_le_mono[of 1 2,OF _ le_refl]
+    by simp_all
   with \<open>env\<in>_\<close> phi
-  have "arity(?\<chi>) \<le> 2+\<^sub>\<omega>length(env) "
+  have "arity(?\<chi>) \<le> 2+\<^sub>\<omega>length(env)"
     using ord_simp_union leI FOL_arities by simp
   with \<open>env\<in>list(_)\<close> phi
   have "arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)"
     using  arity_forces_le by simp
   then
   have "arity(forces(?\<chi>)) \<le> 7 +\<^sub>\<omega> length(env)"
     using ord_simp_union arity_forces leI by simp
   with \<open>arity(forces(?\<chi>)) \<le>7 +\<^sub>\<omega> _\<close> \<open>env \<in> _\<close> \<open>\<phi> \<in> formula\<close>
-  have "arity(?new_form) \<le> 7 +\<^sub>\<omega> length(env)" "?new_form \<in> formula"
-    using arity_rensep[OF definability[of "?\<chi>"]]  definability[of "?\<chi>"] type_rensep
+  have "arity(?new_form) \<le> 7 +\<^sub>\<omega> length(env)" "?new_form \<in> formula" "?\<psi>\<in>formula"
+    using arity_rensep[OF definability[of "?\<chi>"]]
     by auto
   then
-  have "pred(pred(arity(?new_form))) \<le> 5 +\<^sub>\<omega> length(env)" "?\<psi>\<in>formula"
-    unfolding pair_fm_def upair_fm_def
-    using ord_simp_union length_type[OF \<open>env\<in>list(M[G])\<close>]
-        pred_mono[OF _ pred_mono[OF _ \<open>arity(?new_form) \<le> _\<close>]]
-    by auto
-  with \<open>arity(?new_form) \<le> _\<close> \<open>?new_form \<in> formula\<close>
   have "arity(?\<psi>) \<le> 5 +\<^sub>\<omega> length(env)"
-    unfolding pair_fm_def upair_fm_def
-    using ord_simp_union arity_forces
+    using ord_simp_union arity_forces pred_mono[OF _ pred_mono[OF _ \<open>arity(?new_form) \<le> _\<close>]]
     by (auto simp:arity)
-  from \<open>\<phi>\<in>formula\<close>
-  have "forces(?\<chi>) \<in> formula"
-    using definability by simp
-  from \<open>\<pi>\<in>M\<close> P_in_M
-  have "domain(\<pi>)\<in>M" "domain(\<pi>) \<times> P \<in> M"
-    by (simp_all flip:setclass_iff)
   from \<open>env \<in> _\<close>
-  obtain nenv where "nenv\<in>list(M)" "env = map(val(P,G),nenv)" "length(nenv) = length(env)"
+  obtain nenv where "nenv\<in>list(M)" "env = map(val(G),nenv)" "length(nenv) = length(env)"
     using map_val by auto
-  from \<open>arity(\<phi>) \<le> _\<close> \<open>env\<in>_\<close> \<open>\<phi>\<in>_\<close>
-  have "arity(\<phi>) \<le> 2+\<^sub>\<omega> length(env)"
-    using le_trans[OF \<open>arity(\<phi>)\<le>_\<close>] add_le_mono[of 1 2,OF _ le_refl]
-    by auto
-  with \<open>nenv\<in>_\<close> \<open>env\<in>_\<close> \<open>\<pi>\<in>M\<close> \<open>\<phi>\<in>_\<close> \<open>length(nenv) = length(env)\<close>
+  from phi \<open>nenv\<in>_\<close> \<open>env\<in>_\<close> \<open>\<pi>\<in>M\<close> \<open>\<phi>\<in>_\<close> \<open>length(nenv) = length(env)\<close>
   have "arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])" for \<theta>
     using union_abs2[OF \<open>arity(\<phi>) \<le> 2+\<^sub>\<omega> _\<close>] ord_simp_union FOL_arities
     by simp
-  note in_M = \<open>\<pi>\<in>M\<close> \<open>domain(\<pi>) \<times> P \<in> M\<close>  P_in_M one_in_M leq_in_M
-  {
-    fix u
-    assume "u \<in> domain(\<pi>) \<times> P" "u \<in> M"
-    with in_M \<open>?new_form \<in> formula\<close> \<open>?\<psi>\<in>formula\<close> \<open>nenv \<in> _\<close>
-    have Eq1: "(M, [u] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
-                        (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
-                          (M, [\<theta>,p,u]@?Pl1@[\<pi>] @ nenv \<Turnstile> ?new_form))"
-      by (auto simp add: transitivity)
-    have Eq3: "\<theta>\<in>M \<Longrightarrow> p\<in>P \<Longrightarrow>
-       (M, [\<theta>,p,u]@?Pl1@[\<pi>]@nenv \<Turnstile> ?new_form) \<longleftrightarrow>
-          (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> (M[F],  map(val(P,F), [\<theta>] @ nenv@[\<pi>]) \<Turnstile>  ?\<chi>))"
+  note in_M = \<open>\<pi>\<in>M\<close> \<open>domain(\<pi>) \<times> P \<in> M\<close>
+  have Equivalence: "
+       (M, [u,P,leq,\<one>,\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
+         (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
+          (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> M[F],  map(val(F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile>  ?\<chi>))"
+    if "u \<in> domain(\<pi>) \<times> P"
+    for u
+  proof -
+    from \<open>u \<in> domain(\<pi>) \<times> P\<close> \<open>domain(\<pi>) \<times> P \<in> M\<close>
+    have "u\<in>M" by (simp add:transitivity)
+    have "(M, [\<theta>,p,u,P,leq,\<one>,\<pi>]@nenv \<Turnstile> ?new_form) \<longleftrightarrow>
+          (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> (M[F],  map(val(F), [\<theta>] @ nenv@[\<pi>]) \<Turnstile>  ?\<chi>))"
+      if "\<theta>\<in>M" "p\<in>P"
       for \<theta> p
     proof -
-      fix p \<theta>
-      assume "\<theta> \<in> M" "p\<in>P"
-      then
-      have "p\<in>M" using P_in_M by (simp add: transitivity)
-      note in_M' = in_M \<open>\<theta> \<in> M\<close> \<open>p\<in>M\<close> \<open>u \<in> domain(\<pi>) \<times> P\<close> \<open>u \<in> M\<close> \<open>nenv\<in>_\<close>
-      then
-      have "[\<theta>,u] \<in> list(M)" by simp
-      let ?env="[p]@?Pl1@[\<theta>] @ nenv @ [\<pi>,u]"
+      from \<open>p\<in>P\<close>
+      have "p\<in>M" by (simp add: transitivity)
+      let ?env="[p,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>,u]"
       let ?new_env=" [\<theta>,p,u,P,leq,\<one>,\<pi>] @ nenv"
-      let ?\<psi>="Exists(Exists(And(pair_fm(0,1,2),?new_form)))"
-      have "[\<theta>, p, u, \<pi>, leq, \<one>, \<pi>] \<in> list(M)"
-        using in_M' by simp
-      have "?\<chi> \<in> formula" "forces(?\<chi>)\<in> formula"
-        using phi by simp_all
-      from in_M'
-      have "?Pl1 \<in> list(M)" by simp
-      from in_M' have "?env \<in> list(M)" by simp
-      have Eq1': "?new_env \<in> list(M)" using in_M'  by simp
+      note types = in_M \<open>\<theta> \<in> M\<close> \<open>p\<in>M\<close> \<open>u \<in> domain(\<pi>) \<times> P\<close> \<open>u \<in> M\<close> \<open>nenv\<in>_\<close>
       then
-      have "(M, [\<theta>,p,u]@?Pl1@[\<pi>] @ nenv \<Turnstile> ?new_form) \<longleftrightarrow> (M, ?new_env \<Turnstile> ?new_form)"
+      have tyenv:"?env \<in> list(M)" "?new_env \<in> list(M)"
+        by simp_all
+      from types
+      have eq_env:"[p, P, leq, \<one>] @ ([\<theta>] @ nenv @ [\<pi>,u]) = 
+                  ([p, P, leq, \<one>] @ ([\<theta>] @ nenv @ [\<pi>])) @ [u]"
+        using app_assoc by simp
+      then
+      have "(M, [\<theta>,p,u,P,leq,\<one>,\<pi>] @ nenv \<Turnstile> ?new_form) \<longleftrightarrow> (M, ?new_env \<Turnstile> ?new_form)"
         by simp
-      from in_M' \<open>env \<in> _\<close> Eq1' \<open>length(nenv) = length(env)\<close>
-        \<open>arity(forces(?\<chi>)) \<le> 7 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>)\<in> formula\<close>
-        \<open>[\<theta>, p, u, \<pi>, leq, \<one>, \<pi>] \<in> list(M)\<close>
-      have "... \<longleftrightarrow> M, ?env \<Turnstile> forces(?\<chi>)"
+      from tyenv \<open>length(nenv) = length(env)\<close> \<open>arity(forces(?\<chi>)) \<le> 7 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>) \<in> formula\<close>
+      have "... \<longleftrightarrow> p \<tturnstile> ?\<chi> ([\<theta>] @ nenv @ [\<pi>,u])"
         using sepren_action[of "forces(?\<chi>)"  "nenv",OF _ _ \<open>nenv\<in>list(M)\<close>]
         by simp
-      also from in_M'
-      have "... \<longleftrightarrow> M,  ([p,P, leq, \<one>,\<theta>]@nenv@ [\<pi>])@[u] \<Turnstile> forces(?\<chi>)"
-        using app_assoc by simp
-      also
-      from in_M' \<open>env\<in>_\<close> phi \<open>length(nenv) = length(env)\<close>
-        \<open>arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>)\<in>formula\<close>
-      have "... \<longleftrightarrow> M,  [p,P, leq, \<one>,\<theta>]@ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)"
-        by (rule_tac arity_sats_iff,auto)
-      also
-      from \<open>arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>)\<in>formula\<close> in_M' phi
-      have " ... \<longleftrightarrow> (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
-                           M[F],  map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>)"
-      proof (intro iffI)
-        assume a1: "M,  [p,P, leq, \<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile>  forces(?\<chi>)"
-        note \<open>arity(\<phi>)\<le> 1+\<^sub>\<omega>_\<close>
-        with \<open>nenv\<in>_\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close> \<open>env\<in>_\<close>
-        have "p \<in> P \<Longrightarrow> ?\<chi>\<in>formula \<Longrightarrow> [\<theta>,\<pi>] \<in> list(M) \<Longrightarrow>
-                  M, [p,P, leq, \<one>] @ [\<theta>]@ nenv@[\<pi>] \<Turnstile> forces(?\<chi>) \<Longrightarrow>
-              \<forall>G. M_generic(G) \<and> p \<in> G \<longrightarrow> M[G],  map(val(P,G), [\<theta>] @ nenv @[\<pi>]) \<Turnstile> ?\<chi>"
-          using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
-          by auto
-        then
-        show "\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
-                  M[F],  map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>"
-          using  \<open>?\<chi>\<in>formula\<close> \<open>p\<in>P\<close> a1 \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> by simp
-      next
-        assume "\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
-                   M[F],  map(val(P,F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile>  ?\<chi>"
-        with \<open>?\<chi>\<in>formula\<close> \<open>p\<in>P\<close> in_M'
-          \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
-        show "M,  [p, P, leq, \<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile>  forces(?\<chi>)"
-          using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>",
-              THEN iffD2] by auto
-      qed
+      also from types phi \<open>env\<in>_\<close> \<open>length(nenv) = length(env)\<close> \<open>arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)\<close>
+      have "... \<longleftrightarrow> p \<tturnstile> ?\<chi>  ([\<theta>] @ nenv @ [\<pi>])"
+        by (subst eq_env,rule_tac arity_sats_iff,auto)
+      also from types phi \<open>p\<in>P\<close> \<open>arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
+      have " ... \<longleftrightarrow> (\<forall>F . M_generic(F) \<and> p \<in> F \<longrightarrow>
+                           M[F],  map(val(F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>)"
+        using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
+        by auto
       finally
-      show "(M, [\<theta>,p,u]@?Pl1@[\<pi>]@nenv \<Turnstile> ?new_form) \<longleftrightarrow> (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
-                           M[F],  map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>)"
+      show ?thesis
         by simp
     qed
-    with Eq1
-    have "(M, [u] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
-         (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
-          (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> M[F],  map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>))"
-      by auto
-  }
-  then
-  have Equivalence: "u\<in> domain(\<pi>) \<times> P \<Longrightarrow> u \<in> M \<Longrightarrow>
-       (M, [u] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
-         (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
-          (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> M[F],   map(val(P,F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile>  ?\<chi>))"
-    for u
-    by simp
+    with in_M \<open>?new_form \<in> formula\<close> \<open>?\<psi>\<in>formula\<close> \<open>nenv \<in> _\<close> \<open>u \<in> domain(\<pi>)\<times>P\<close>
+    show ?thesis
+      by (auto simp add: transitivity)
+  qed
   moreover from \<open>env = _\<close> \<open>\<pi>\<in>M\<close> \<open>nenv\<in>list(M)\<close>
-  have map_nenv:"map(val(P,G), nenv@[\<pi>]) = env @ [val(P,G,\<pi>)]"
+  have map_nenv:"map(val(G), nenv @ [\<pi>]) = env @ [val(G,\<pi>)]"
     using map_app_distrib append1_eq_iff by auto
   ultimately
-  have aux:"(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> M[G], [val(P,G,\<theta>)] @ env @ [val(P,G,\<pi>)] \<Turnstile> ?\<chi>))"
-   (is "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. _ ( _ \<longrightarrow> _, ?vals(\<theta>) \<Turnstile> _))")
-   if "u \<in> domain(\<pi>) \<times> P" "u \<in> M"  "M, [u]@ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
+  have aux:"(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> M[G], [val(G,\<theta>)] @ env @ [val(G,\<pi>)] \<Turnstile> ?\<chi>))"
+    (is "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. _ ( _ \<longrightarrow> M[G] , ?vals(\<theta>) \<Turnstile> _))")
+    if "u \<in> domain(\<pi>) \<times> P" "M, [u,P,leq,\<one>,\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
     using Equivalence[THEN iffD1, OF that] generic by force
   moreover
-  have "\<theta>\<in>M \<Longrightarrow> val(P,G,\<theta>)\<in>M[G]" for \<theta>
-    using GenExt_def by auto
-  moreover
-  have "\<theta>\<in> M \<Longrightarrow> [val(P,G, \<theta>)] @ env @ [val(P,G, \<pi>)] \<in> list(M[G])" for \<theta>
-  proof -
-    from \<open>\<pi>\<in>M\<close>
-    have "val(P,G,\<pi>)\<in> M[G]" using GenExtI by simp
-    moreover
-    assume "\<theta> \<in> M"
-    moreover
-    note \<open>env \<in> list(M[G])\<close>
-    ultimately
-    show ?thesis
-      using GenExtI by simp
-  qed
+  have "[val(G, \<theta>)] @ env @ [val(G, \<pi>)] \<in> list(M[G])" if "\<theta>\<in>M" for \<theta>
+    using \<open>\<pi>\<in>M\<close> \<open>env \<in> list(M[G])\<close> GenExtI that by force
   ultimately
-  have "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u=\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> val(P,G,\<theta>)\<in>nth(1 +\<^sub>\<omega> length(env),[val(P,G, \<theta>)] @ env @ [val(P,G, \<pi>)])
-        \<and> (M[G], ?vals(\<theta>) \<Turnstile>  \<phi>)))"
-    if "u \<in> domain(\<pi>) \<times> P" "u \<in> M"  "M, [u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
+  have "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u=\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> val(G,\<theta>)\<in>nth(1 +\<^sub>\<omega> length(env),[val(G, \<theta>)] @ env @ [val(G, \<pi>)])
+        \<and> (M[G], ?vals(\<theta>) \<Turnstile> \<phi>)))"
+    if "u \<in> domain(\<pi>) \<times> P" "M, [u,P,leq,\<one>,\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
     using aux[OF that] by simp
   moreover from \<open>env \<in> _\<close> \<open>\<pi>\<in>M\<close>
-  have nth:"nth(1 +\<^sub>\<omega> length(env),[val(P,G, \<theta>)] @ env @ [val(P,G, \<pi>)]) = val(P,G,\<pi>)"
+  have nth:"nth(1 +\<^sub>\<omega> length(env),[val(G, \<theta>)] @ env @ [val(G, \<pi>)]) = val(G,\<pi>)"
     if "\<theta>\<in>M" for \<theta>
-    using nth_concat[of "val(P,G,\<theta>)" "val(P,G,\<pi>)" "M[G]"] using that GenExtI by simp
+    using nth_concat[of "val(G,\<theta>)" "val(G,\<pi>)" "M[G]"] that GenExtI by simp
   ultimately
-  have "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u=\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> val(P,G,\<theta>)\<in>val(P,G,\<pi>) \<and> (M[G],?vals(\<theta>) \<Turnstile>  \<phi>)))"
-    if "u \<in> domain(\<pi>) \<times> P" "u \<in> M"  "M, [u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
+  have "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u=\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> val(G,\<theta>)\<in>val(G,\<pi>) \<and> (M[G],?vals(\<theta>) \<Turnstile>  \<phi>)))"
+    if "u \<in> domain(\<pi>) \<times> P" "M, [u,P,leq,\<one>,\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
     using that \<open>\<pi>\<in>M\<close> \<open>env \<in> _\<close> by simp
   with \<open>domain(\<pi>)\<times>P\<in>M\<close>
-  have "\<forall>u\<in>domain(\<pi>)\<times>P . (M, [u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longrightarrow> (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
-        (p \<in> G \<longrightarrow> val(P,G, \<theta>)\<in>val(P,G, \<pi>) \<and> (M[G],?vals(\<theta>) \<Turnstile>  \<phi>)))"
+  have "\<forall>u\<in>domain(\<pi>)\<times>P . (M, [u,P,leq,\<one>,\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longrightarrow> (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
+        (p \<in> G \<longrightarrow> val(G, \<theta>)\<in>val(G, \<pi>) \<and> (M[G],?vals(\<theta>) \<Turnstile>  \<phi>)))"
     by (simp add:transitivity)
   then
-  have "{u\<in>domain(\<pi>)\<times>P . (M,[u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>) } \<subseteq>
+  have "{u\<in>domain(\<pi>)\<times>P . (M,[u,P,leq,\<one>,\<pi>] @ nenv \<Turnstile> ?\<psi>) } \<subseteq>
      {u\<in>domain(\<pi>)\<times>P . \<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
-       (p \<in> G \<longrightarrow> val(P,G, \<theta>)\<in>val(P,G, \<pi>) \<and> (M[G], ?vals(\<theta>) \<Turnstile> \<phi>))}"
+       (p \<in> G \<longrightarrow> val(G, \<theta>)\<in>val(G, \<pi>) \<and> (M[G], ?vals(\<theta>) \<Turnstile> \<phi>))}"
     (is "?n\<subseteq>?m")
     by auto
-  with val_mono
-  have first_incl: "val(P,G,?n) \<subseteq> val(P,G,?m)"
-    by simp
-  note  \<open>val(P,G,\<pi>) = c\<close> (* from the assumptions *)
+  then
+  have first_incl: "val(G,?n) \<subseteq> val(G,?m)"
+    using val_mono by simp
+  note  \<open>val(G,\<pi>) = A\<close> (* from the assumptions *)
   with \<open>?\<psi>\<in>formula\<close>  \<open>arity(?\<psi>) \<le> _\<close> in_M \<open>nenv \<in> _\<close> \<open>env \<in> _\<close> \<open>length(nenv) = _\<close>
   have "?n\<in>M"
     using separation_ax leI separation_iff by auto
   from generic
   have "filter(G)" "G\<subseteq>P"
     unfolding M_generic_def filter_def by simp_all
-  from \<open>val(P,G,\<pi>) = c\<close>
-  have "val(P,G,?m) =
+  from \<open>val(G,\<pi>) = A\<close>
+  have "val(G,?m) =
                {z . t\<in>domain(\<pi>) , (\<exists>q\<in>P .
                     (\<exists>\<theta>\<in>M. \<exists>p\<in>P. \<langle>t,q\<rangle> = \<langle>\<theta>, p\<rangle> \<and>
-            (p \<in> G \<longrightarrow> val(P,G, \<theta>) \<in> c \<and> (M[G],  [val(P,G, \<theta>)] @ env @ [c] \<Turnstile>  \<phi>)) \<and> q \<in> G)) \<and>
-           z=val(P,G,t)}"
+            (p \<in> G \<longrightarrow> val(G, \<theta>) \<in> A \<and> (M[G],  [val(G, \<theta>)] @ env @ [A] \<Turnstile>  \<phi>)) \<and> q \<in> G)) \<and>
+           z=val(G,t)}"
     using val_of_name by auto
   also
   have "... =  {z . t\<in>domain(\<pi>) , (\<exists>q\<in>P.
-                   val(P,G, t) \<in> c \<and> (M[G],  [val(P,G, t)] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G) \<and> z=val(P,G,t)}"
-  proof -
-    have "t\<in>M \<Longrightarrow>
-      (\<exists>q\<in>P. (\<exists>\<theta>\<in>M. \<exists>p\<in>P. \<langle>t,q\<rangle> = \<langle>\<theta>, p\<rangle> \<and>
-              (p \<in> G \<longrightarrow> val(P,G, \<theta>) \<in> c \<and> (M[G],  [val(P,G, \<theta>)] @ env @ [c] \<Turnstile>  \<phi>)) \<and> q \<in> G))
-      \<longleftrightarrow>
-      (\<exists>q\<in>P. val(P,G, t) \<in> c \<and> ( M[G], [val(P,G, t)]@env@[c]\<Turnstile> \<phi> ) \<and> q \<in> G)" for t
-      by auto
-    then show ?thesis using \<open>domain(\<pi>)\<in>M\<close> by (auto simp add:transitivity)
+                   val(G, t) \<in> A \<and> (M[G],  [val(G, t)] @ env @ [A] \<Turnstile>  \<phi>) \<and> q \<in> G) \<and> z=val(G,t)}"
+    using \<open>domain(\<pi>)\<in>M\<close> by (auto simp add:transitivity)
+  also
+  have "... =  {x\<in>A . \<exists>q\<in>P. x \<in> A \<and> (M[G],  [x] @ env @ [A] \<Turnstile>  \<phi>) \<and> q \<in> G}"
+  proof(intro equalityI, auto)
+    (* Now we show the other inclusion:
+      {x .. x \<in> A , \<exists>q\<in>P. x \<in> A \<and> (M[G],  [x, w, c] \<Turnstile>  \<phi>) \<and> q \<in> G}
+      \<subseteq>
+      {val(G,t)..t\<in>domain(\<pi>),\<exists>q\<in>P.val(G,t)\<in> A\<and>(M[G], [val(G,t),w] \<Turnstile> \<phi>)\<and>q\<in>G}
+    *)
+    {
+      fix x q
+      assume "M[G], Cons(x, env @ [A]) \<Turnstile> \<phi>" "x\<in>A" "q \<in> P" "q \<in> G"
+      from this \<open>val(G,\<pi>) = A\<close>
+      show "x \<in> {y . x \<in> domain(\<pi>), val(G, x) \<in> A \<and> (M[G], Cons(val(G, x), env @ [A]) \<Turnstile> \<phi>) \<and> (\<exists>q\<in>P. q \<in> G) \<and> y = val(G, x)}"
+        using elem_of_val by force
+    }
   qed
   also
-  have "... =  {x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G}"
-  proof
-    show "... \<subseteq> {x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G}"
-      by auto
-  next
-    (* Now we show the other inclusion:
-      {x .. x\<in>c , \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x, w, c] \<Turnstile>  \<phi>) \<and> q \<in> G}
-      \<subseteq>
-      {val(P,G,t)..t\<in>domain(\<pi>),\<exists>q\<in>P.val(P,G,t)\<in>c\<and>(M[G], [val(P,G,t),w] \<Turnstile> \<phi>)\<and>q\<in>G}
-    *)
-    {
-      fix x
-      assume "x\<in>{x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G}"
-      then
-      have "\<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G"
-        by simp
-      with \<open>val(P,G,\<pi>) = c\<close>
-      have "\<exists>q\<in>P. \<exists>t\<in>domain(\<pi>). val(P,G,t) =x \<and> (M[G],  [val(P,G,t)] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G"
-        using elem_of_val by auto
-    }
-    then
-    show " {x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G} \<subseteq> ..."
-      by force
-  qed
-  also
-  have " ... = {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}"
+  have " ... = {x \<in> A. (M[G], [x] @ env @ [A] \<Turnstile> \<phi>)}"
     using \<open>G\<subseteq>P\<close> G_nonempty by force
   finally
-  have val_m: "val(P,G,?m) = {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}" by simp
-  have "val(P,G,?m) \<subseteq> val(P,G,?n)"
+  have val_m: "val(G,?m) = {x \<in> A. (M[G], [x] @ env @ [A] \<Turnstile> \<phi>)}" by simp
+  have "val(G,?m) \<subseteq> val(G,?n)"
   proof
     fix x
-    assume "x \<in> val(P,G,?m)"
+    assume "x \<in> val(G,?m)"
     with val_m
-    have Eq4: "x \<in> {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}" by simp
-    with \<open>val(P,G,\<pi>) = c\<close>
-    have "x \<in> val(P,G,\<pi>)" by simp
+    have "x \<in> {x \<in> A. (M[G], [x] @ env @ [A] \<Turnstile> \<phi>)}" by simp
+    with \<open>val(G,\<pi>) = A\<close>
+    have "x \<in> val(G,\<pi>)" by simp
     then
-    have "\<exists>\<theta>. \<exists>q\<in>G. \<langle>\<theta>,q\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) =x"
-      using elem_of_val_pair by auto
-    then obtain \<theta> q where
-      "\<langle>\<theta>,q\<rangle>\<in>\<pi>" "q\<in>G" "val(P,G,\<theta>)=x" by auto
-    from \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close>
-    have "\<theta>\<in>M"
-      using domain_trans[OF trans_M \<open>\<pi>\<in>_\<close>] by auto
+    obtain \<theta> q where "\<langle>\<theta>,q\<rangle>\<in>\<pi>" "q\<in>G" "val(G,\<theta>)=x" "\<theta>\<in>M"
+      using elem_of_val_pair domain_trans[OF trans_M \<open>\<pi>\<in>_\<close>]
+      by force
     with \<open>\<pi>\<in>M\<close> \<open>nenv \<in> _\<close> \<open>env = _\<close>
-    have "[val(P,G,\<theta>), val(P,G,\<pi>)] @ env \<in>list(M[G])"
+    have "[val(G,\<theta>), val(G,\<pi>)] @ env \<in> list(M[G])" "[\<theta>] @ nenv @ [\<pi>]\<in>list(M)"
       using GenExt_def by auto
-    with  Eq4 \<open>val(P,G,\<theta>)=x\<close> \<open>val(P,G,\<pi>) = c\<close> \<open>x \<in> val(P,G,\<pi>)\<close> nth \<open>\<theta>\<in>M\<close>
-    have Eq5: "M[G],  [val(P,G,\<theta>)] @ env @[val(P,G,\<pi>)] \<Turnstile> And(Member(0,1 +\<^sub>\<omega> length(env)),\<phi>)"
-      by auto
-        (* Recall ?\<chi> = And(Member(0,1 +\<^sub>\<omega> length(env)),\<phi>) *)
-    with \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close>  Eq5 \<open>M_generic(G)\<close> \<open>\<phi>\<in>formula\<close> \<open>nenv \<in> _ \<close> \<open>env = _ \<close> map_nenv
-      \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
-    have "(\<exists>r\<in>G. M,  [r,P,leq,\<one>,\<theta>] @ nenv @[\<pi>] \<Turnstile> forces(?\<chi>))"
-      using truth_lemma[of "\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
+    with \<open>val(G,\<theta>)=x\<close> \<open>val(G,\<pi>) = A\<close> \<open>x \<in> val(G,\<pi>)\<close> nth \<open>\<theta>\<in>M\<close> \<open>x\<in> {x \<in> A . _}\<close>
+    have "M[G],  [val(G,\<theta>)] @ env @ [val(G,\<pi>)] \<Turnstile> \<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"
       by auto
-    then obtain r where      (* I can't "obtain" this directly *)
-      "r\<in>G" "M,  [r,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)" by auto
-    with \<open>filter(G)\<close> and \<open>q\<in>G\<close> obtain p where
-      "p\<in>G" "p\<preceq>q" "p\<preceq>r"
+        \<comment> \<open>Recall \<^term>\<open>?\<chi> = And(Member(0,1 +\<^sub>\<omega> length(env)),\<phi>)\<close>\<close>
+    with \<open>[_] @ nenv @ [_] \<in> _ \<close> map_nenv \<open>arity(?\<chi>) \<le> length(_)\<close> \<open>length(nenv) = _\<close>
+    obtain r where "r\<in>G" "r \<tturnstile> ?\<chi> ([\<theta>] @ nenv @ [\<pi>])"
+      using truth_lemma[OF \<open>?\<chi>\<in>_\<close>,of "[\<theta>] @ nenv @ [\<pi>]"]
+      by auto
+    with \<open>filter(G)\<close> and \<open>q\<in>G\<close>
+    obtain p where "p\<in>G" "p\<preceq>q" "p\<preceq>r"
       unfolding filter_def compat_in_def by force
-    with \<open>r\<in>G\<close>  \<open>q\<in>G\<close> \<open>G\<subseteq>P\<close>
+    with \<open>r\<in>G\<close> \<open>q\<in>G\<close> \<open>G\<subseteq>P\<close>
     have "p\<in>P" "r\<in>P" "q\<in>P" "p\<in>M"
-      using  P_in_M  by (auto simp add:transitivity)
-    with \<open>\<phi>\<in>formula\<close> \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close>  \<open>p\<preceq>r\<close> \<open>nenv \<in> _\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
-      \<open>M, [r,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)\<close> \<open>env\<in>_\<close>
-    have "M,  [p,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)"
+      using transitivity[OF _ P_in_M] subsetD
+      by simp_all
+    with \<open>\<phi>\<in>formula\<close> \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> \<open>p\<preceq>r\<close> \<open>nenv \<in> _\<close> \<open>arity(?\<chi>) \<le> length(_)\<close> \<open>r \<tturnstile> ?\<chi> _\<close> \<open>env\<in>_\<close>
+    have "p \<tturnstile> ?\<chi> ([\<theta>] @ nenv @ [\<pi>])"
       using strengthening_lemma
       by simp
-    with \<open>p\<in>P\<close> \<open>\<phi>\<in>formula\<close> \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> \<open>nenv \<in> _\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
+    with \<open>p\<in>P\<close> \<open>\<phi>\<in>formula\<close> \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> \<open>nenv \<in> _\<close> \<open>arity(?\<chi>) \<le> length(_)\<close>
     have "\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
-                 M[F],   map(val(P,F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile>  ?\<chi>"
+                 M[F],   map(val(F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>"
       using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
       by simp
     with \<open>p\<in>P\<close> \<open>\<theta>\<in>M\<close>
-    have Eq6: "\<exists>\<theta>'\<in>M. \<exists>p'\<in>P.  \<langle>\<theta>,p\<rangle> = <\<theta>',p'> \<and> (\<forall>F. M_generic(F) \<and> p' \<in> F \<longrightarrow>
-                 M[F],   map(val(P,F), [\<theta>'] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>)" by auto
-    from \<open>\<pi>\<in>M\<close> \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close>
-    have "\<langle>\<theta>,q\<rangle> \<in> M" by (simp add:transitivity)
-    from \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close> \<open>\<theta>\<in>M\<close> \<open>p\<in>P\<close>  \<open>p\<in>M\<close>
-    have "\<langle>\<theta>,p\<rangle>\<in>M" "\<langle>\<theta>,p\<rangle>\<in>domain(\<pi>)\<times>P"
-      using pair_in_M_iff by auto
+    have Eq6: "\<exists>\<theta>'\<in>M. \<exists>p'\<in>P.  \<langle>\<theta>,p\<rangle> = \<langle>\<theta>',p'\<rangle> \<and> (\<forall>F. M_generic(F) \<and> p' \<in> F \<longrightarrow>
+                 M[F],   map(val(F), [\<theta>'] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>)" by auto
+    from \<open>\<pi>\<in>M\<close> \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close> \<open>\<theta>\<in>M\<close> \<open>p\<in>P\<close> \<open>p\<in>M\<close>
+    have "\<langle>\<theta>,q\<rangle> \<in> M" "\<langle>\<theta>,p\<rangle>\<in>M" "\<langle>\<theta>,p\<rangle>\<in>domain(\<pi>)\<times>P"
+      using pair_in_M_iff transitivity
+      by auto
     with \<open>\<theta>\<in>M\<close> Eq6 \<open>p\<in>P\<close>
-    have "M, [\<langle>\<theta>,p\<rangle>] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>"
-      using Equivalence  by auto
+    have "M, [\<langle>\<theta>,p\<rangle>,P,leq,\<one>,\<pi>] @ nenv \<Turnstile> ?\<psi>"
+      using Equivalence by auto
     with \<open>\<langle>\<theta>,p\<rangle>\<in>domain(\<pi>)\<times>P\<close>
     have "\<langle>\<theta>,p\<rangle>\<in>?n" by simp
     with \<open>p\<in>G\<close> \<open>p\<in>P\<close>
-    have "val(P,G,\<theta>)\<in>val(P,G,?n)"
-      using  val_of_elem[of \<theta> p] by simp
-    with \<open>val(P,G,\<theta>)=x\<close>
-    show "x\<in>val(P,G,?n)" by simp
-  qed (* proof of "val(P,G,?m) \<subseteq> val(P,G,?n)" *)
+    have "val(G,\<theta>)\<in>val(G,?n)"
+      using val_of_elem[of \<theta> p] by simp
+    with \<open>val(G,\<theta>)=x\<close>
+    show "x\<in>val(G,?n)" by simp
+  qed (* proof of "val(G,?m) \<subseteq> val(G,?n)" *)
   with val_m first_incl
-  have "val(P,G,?n) = {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}" by auto
-  also
-  have " ... = {x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)}"
-  proof -
-    {
-      fix x
-      assume "x\<in>c"
-      moreover from assms
-      have "c\<in>M[G]"
-        unfolding GenExt_def by auto
-      moreover from this and \<open>x\<in>c\<close>
-      have "x\<in>M[G]"
-        using transitivity_MG
-        by simp
-      ultimately
-      have "(M[G],  ([x] @ env) @[c] \<Turnstile>  \<phi>) \<longleftrightarrow> (M[G],  [x] @ env \<Turnstile>  \<phi>)"
-        using phi \<open>env \<in> _\<close> by (rule_tac arity_sats_iff, simp_all)   (* Enhance this *)
-    }
-    then show ?thesis by auto
-  qed
+  have "val(G,?n) = {x \<in> A. (M[G], [x] @ env @ [A] \<Turnstile> \<phi>)}" by auto
+  also from \<open>A\<in>_\<close> phi \<open>env \<in> _\<close>
+  have " ... = {x \<in> A. (M[G], [x] @ env \<Turnstile> \<phi>)}"
+    using arity_sats_iff[where env="[_]@env"] transitivity_MG
+    by auto
   finally
-  show "{x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)}\<in> M[G]"
+  show "{x \<in> A. (M[G], [x] @ env \<Turnstile> \<phi>)}\<in> M[G]"
     using \<open>?n\<in>M\<close> GenExt_def by force
 qed
 
 theorem separation_in_MG:
   assumes
     "\<phi>\<in>formula" and "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" and "env\<in>list(M[G])"
   shows
     "separation(##M[G],\<lambda>x. (M[G], [x] @ env \<Turnstile> \<phi>))"
 proof -
   {
-    fix c
-    assume "c\<in>M[G]"
+    fix A
+    assume "A\<in>M[G]"
     moreover from \<open>env \<in> _\<close>
-    obtain nenv where  "nenv\<in>list(M)"
-      "env = map(val(P,G),nenv)" "length(env) = length(nenv)"
+    obtain nenv where "nenv\<in>list(M)""env = map(val(G),nenv)" "length(env) = length(nenv)"
       using GenExt_def map_val[of env] by auto
     moreover note \<open>\<phi> \<in> _\<close> \<open>arity(\<phi>) \<le> _\<close> \<open>env \<in> _\<close>
     ultimately
-    have Eq1: "{x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)} \<in> M[G]"
-      using Collect_sats_in_MG  by auto
+    have "{x \<in> A . (M[G], [x] @ env \<Turnstile> \<phi>)} \<in> M[G]"
+      using Collect_sats_in_MG by auto
   }
   then
   show ?thesis
     using separation_iff rev_bexI unfolding is_Collect_def by force
 qed
 
 end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Separation_Instances.thy b/thys/Independence_CH/Separation_Instances.thy
--- a/thys/Independence_CH/Separation_Instances.thy
+++ b/thys/Independence_CH/Separation_Instances.thy
@@ -1,234 +1,212 @@
 subsection\<open>More Instances of Separation\<close>
 
 theory Separation_Instances
   imports
-    Names
+    Interface
 begin
 
 text\<open>The following instances are mostly the same repetitive task; and we just
 copied and pasted, tweaking some lemmas if needed (for example, we might have
-needed to use some closedness results).
-\<close>
+needed to use some closure results).\<close>
 
 definition radd_body :: "[i,i,i] \<Rightarrow> o" where
   "radd_body(R,S) \<equiv> \<lambda>z. (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>) \<or>
                   (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x', x\<rangle> \<in> R) \<or>
                   (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y', y\<rangle> \<in> S)"
 
 relativize functional "radd_body" "radd_body_rel"
 relationalize "radd_body_rel" "is_radd_body"
 
 synthesize "is_radd_body" from_definition
 arity_theorem for "is_radd_body_fm"
 
-lemma (in M_ZF1_trans) radd_body_abs:
-  assumes "(##M)(R)" "(##M)(S)" "(##M)(x)"
-  shows "is_radd_body(##M,R,S,x) \<longleftrightarrow> radd_body(R,S,x)"
-  using assms pair_in_M_iff Inl_in_M_iff Inr_in_M_iff
-  unfolding radd_body_def is_radd_body_def
-  by (auto)
-
-lemma (in M_ZF1_trans) separation_radd_body:
- "(##M)(R) \<Longrightarrow> (##M)(S) \<Longrightarrow> separation
-        (##M, \<lambda>z. (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>) \<or>
-                  (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x', x\<rangle> \<in> R) \<or>
-                  (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y', y\<rangle> \<in> S))"
-  using separation_in_ctm[where \<phi>="is_radd_body_fm(1,2,0)" and env="[R,S]"]
-    is_radd_body_def arity_is_radd_body_fm ord_simp_union is_radd_body_fm_type radd_body_abs
-  unfolding radd_body_def
-  by simp
 
 definition rmult_body :: "[i,i,i] \<Rightarrow> o" where
   "rmult_body(b,d) \<equiv> \<lambda>z. \<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in>
 b \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> d)"
 
 relativize functional "rmult_body" "rmult_body_rel"
 relationalize "rmult_body_rel" "is_rmult_body"
 
 synthesize "is_rmult_body" from_definition
 arity_theorem for "is_rmult_body_fm"
 
-lemma (in M_ZF1_trans) rmult_body_abs:
-  assumes "(##M)(b)" "(##M)(d)" "(##M)(x)"
-  shows "is_rmult_body(##M,b,d,x) \<longleftrightarrow> rmult_body(b,d,x)"
-  using assms pair_in_M_iff apply_closed
-  unfolding rmult_body_def is_rmult_body_def
-  by (auto)
-
-lemma (in M_ZF1_trans) separation_rmult_body:
- "(##M)(b) \<Longrightarrow> (##M)(d) \<Longrightarrow> separation
-        (##M, \<lambda>z. \<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> b \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> d))"
-  using separation_in_ctm[where \<phi>="is_rmult_body_fm(1,2,0)" and env="[b,d]"]
-    is_rmult_body_def arity_is_rmult_body_fm ord_simp_union is_rmult_body_fm_type rmult_body_abs
-  unfolding rmult_body_def
-  by simp
-
 lemma (in M_replacement) separation_well_ord:
   "(M)(f) \<Longrightarrow> (M)(r) \<Longrightarrow> (M)(A) \<Longrightarrow> separation
         (M, \<lambda>x. x \<in> A \<longrightarrow> (\<exists>y[M]. \<exists>p[M]. is_apply(M, f, x, y) \<and> pair(M, y, x, p) \<and> p \<in> r))"
-  using separation_imp  separation_in lam_replacement_identity lam_replacement_constant
+  using separation_imp separation_in lam_replacement_identity lam_replacement_constant
     lam_replacement_apply[of f] lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
   by simp
 
 definition is_obase_body :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
   "is_obase_body(N,A,r,x) \<equiv> x \<in> A \<longrightarrow>
                   \<not> (\<exists>y[N].
                          \<exists>g[N].
                             ordinal(N, y) \<and>
                             (\<exists>my[N].
                                 \<exists>pxr[N].
                                    membership(N, y, my) \<and>
                                    pred_set(N, A, x, r, pxr) \<and>
                                    order_isomorphism(N, pxr, r, y, my, g)))"
 
 synthesize "is_obase_body" from_definition
 arity_theorem for "is_obase_body_fm"
 
-lemma (in M_ZF1_trans) separation_is_obase:
+definition is_obase_equals :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
+  "is_obase_equals(N,A,r,a) \<equiv> \<exists>x[N].
+                     \<exists>g[N].
+                        \<exists>mx[N].
+                           \<exists>par[N].
+                              ordinal(N, x) \<and>
+                              membership(N, x, mx) \<and>
+                              pred_set(N, A, a, r, par) \<and> order_isomorphism(N, par, r, x, mx, g)"
+
+
+synthesize "is_obase_equals" from_definition
+arity_theorem for "is_obase_equals_fm"
+
+synthesize "PiP_rel" from_definition assuming "nonempty"
+arity_theorem for "PiP_rel_fm"
+
+synthesize "injP_rel" from_definition assuming "nonempty"
+arity_theorem for "injP_rel_fm"
+
+synthesize "surjP_rel" from_definition assuming "nonempty"
+arity_theorem for "surjP_rel_fm"
+
+context M_ZF1_trans
+begin
+
+lemma radd_body_abs:
+  assumes "(##M)(R)" "(##M)(S)" "(##M)(x)"
+  shows "is_radd_body(##M,R,S,x) \<longleftrightarrow> radd_body(R,S,x)"
+  using assms pair_in_M_iff Inl_in_M_iff Inr_in_M_iff
+  unfolding radd_body_def is_radd_body_def
+  by (auto)
+
+lemma separation_radd_body:
+ "(##M)(R) \<Longrightarrow> (##M)(S) \<Longrightarrow> separation
+        (##M, \<lambda>z. (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>) \<or>
+                  (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x', x\<rangle> \<in> R) \<or>
+                  (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y', y\<rangle> \<in> S))"
+  using separation_in_ctm[where \<phi>="is_radd_body_fm(1,2,0)" and env="[R,S]"]
+    is_radd_body_def arity_is_radd_body_fm ord_simp_union is_radd_body_fm_type radd_body_abs
+  unfolding radd_body_def
+  by simp
+
+lemma rmult_body_abs:
+  assumes "(##M)(b)" "(##M)(d)" "(##M)(x)"
+  shows "is_rmult_body(##M,b,d,x) \<longleftrightarrow> rmult_body(b,d,x)"
+  using assms pair_in_M_iff apply_closed
+  unfolding rmult_body_def is_rmult_body_def
+  by (auto)
+
+lemma separation_rmult_body:
+ "(##M)(b) \<Longrightarrow> (##M)(d) \<Longrightarrow> separation
+        (##M, \<lambda>z. \<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> b \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> d))"
+  using separation_in_ctm[where \<phi>="is_rmult_body_fm(1,2,0)" and env="[b,d]"]
+    is_rmult_body_def arity_is_rmult_body_fm ord_simp_union is_rmult_body_fm_type rmult_body_abs
+  unfolding rmult_body_def
+  by simp
+
+lemma separation_is_obase:
  "(##M)(f) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(A) \<Longrightarrow> separation
         (##M, \<lambda>x. x \<in> A \<longrightarrow>
                   \<not> (\<exists>y[##M].
                          \<exists>g[##M].
                             ordinal(##M, y) \<and>
                             (\<exists>my[##M].
                                 \<exists>pxr[##M].
                                    membership(##M, y, my) \<and>
                                    pred_set(##M, A, x, r, pxr) \<and>
                                    order_isomorphism(##M, pxr, r, y, my, g))))"
   using separation_in_ctm[where \<phi>="is_obase_body_fm(1,2,0)" and env="[A,r]"]
     is_obase_body_def arity_is_obase_body_fm ord_simp_union is_obase_body_fm_type
   by simp
 
-definition is_obase_equals :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
-  "is_obase_equals(N,A,r,a) \<equiv> \<exists>x[N].
-                     \<exists>g[N].
-                        \<exists>mx[N].
-                           \<exists>par[N].
-                              ordinal(N, x) \<and>
-                              membership(N, x, mx) \<and>
-                              pred_set(N, A, a, r, par) \<and> order_isomorphism(N, par, r, x, mx, g)"
-
-synthesize "is_obase_equals" from_definition
-arity_theorem for "is_obase_equals_fm"
-
-lemma (in M_ZF1_trans) separation_obase_equals:
+lemma separation_obase_equals:
  "(##M)(f) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(A) \<Longrightarrow> separation
         (##M, \<lambda>a. \<exists>x[##M].
                      \<exists>g[##M].
                         \<exists>mx[##M].
                            \<exists>par[##M].
                               ordinal(##M, x) \<and>
                               membership(##M, x, mx) \<and>
                               pred_set(##M, A, a, r, par) \<and> order_isomorphism(##M, par, r, x, mx, g))"
   using separation_in_ctm[where \<phi>="is_obase_equals_fm(1,2,0)" and env="[A,r]"]
     is_obase_equals_def arity_is_obase_equals_fm ord_simp_union is_obase_equals_fm_type
   by simp
 
-synthesize "PiP_rel" from_definition assuming "nonempty"
-arity_theorem for "PiP_rel_fm"
-
-lemma (in M_ZF1_trans) separation_PiP_rel:
+lemma separation_PiP_rel:
  "(##M)(A) \<Longrightarrow> separation(##M, PiP_rel(##M,A))"
   using separation_in_ctm[where env="[A]" and \<phi>="PiP_rel_fm(1,0)"]
     nonempty PiP_rel_iff_sats[symmetric] arity_PiP_rel_fm PiP_rel_fm_type
   by(simp_all add: ord_simp_union)
 
-synthesize "injP_rel" from_definition assuming "nonempty"
-arity_theorem for "injP_rel_fm"
-
-lemma (in M_ZF1_trans) separation_injP_rel:
+lemma separation_injP_rel:
  "(##M)(A) \<Longrightarrow> separation(##M, injP_rel(##M,A))"
   using separation_in_ctm[where env="[A]" and \<phi>="injP_rel_fm(1,0)"]
     nonempty injP_rel_iff_sats[symmetric] arity_injP_rel_fm injP_rel_fm_type
   by(simp_all add: ord_simp_union)
 
-synthesize "surjP_rel" from_definition assuming "nonempty"
-arity_theorem for "surjP_rel_fm"
-
-lemma (in M_ZF1_trans) separation_surjP_rel:
+lemma separation_surjP_rel:
  "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> separation(##M, surjP_rel(##M,A,B))"
   using separation_in_ctm[where env="[A,B]" and \<phi>="surjP_rel_fm(1,2,0)"]
     nonempty surjP_rel_iff_sats[symmetric] arity_surjP_rel_fm surjP_rel_fm_type
   by(simp_all add: ord_simp_union)
 
-synthesize "cons_like_rel" from_definition assuming "nonempty"
-arity_theorem for "cons_like_rel_fm"
-
-lemma (in M_ZF1_trans) separation_cons_like_rel:
- "separation(##M, cons_like_rel(##M))"
-  using separation_in_ctm[where env="[]" and \<phi>="cons_like_rel_fm(0)"]
-    nonempty cons_like_rel_iff_sats[symmetric] arity_cons_like_rel_fm cons_like_rel_fm_type
-  by simp
-
-lemma (in M_ZF1_trans) separation_is_function:
+lemma separation_is_function:
  "separation(##M, is_function(##M))"
   using separation_in_ctm[where env="[]" and \<phi>="function_fm(0)"] arity_function_fm
   by simp
 
+end \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
+
 (* Instances in M_replacement*)
 
 definition fstsnd_in_sndsnd :: "[i] \<Rightarrow> o" where
   "fstsnd_in_sndsnd \<equiv> \<lambda>x. fst(snd(x)) \<in> snd(snd(x))"
 relativize "fstsnd_in_sndsnd" "is_fstsnd_in_sndsnd"
 synthesize "is_fstsnd_in_sndsnd" from_definition assuming "nonempty"
 arity_theorem for "is_fstsnd_in_sndsnd_fm"
 
-lemma (in M_ZF1_trans) fstsnd_in_sndsnd_abs:
+definition sndfst_eq_fstsnd :: "[i] \<Rightarrow> o" where
+  "sndfst_eq_fstsnd \<equiv> \<lambda>x. snd(fst(x)) = fst(snd(x))"
+relativize "sndfst_eq_fstsnd" "is_sndfst_eq_fstsnd"
+synthesize "is_sndfst_eq_fstsnd" from_definition assuming "nonempty"
+arity_theorem for "is_sndfst_eq_fstsnd_fm"
+
+context M_ZF1_trans
+begin
+
+lemma fstsnd_in_sndsnd_abs:
   assumes "(##M)(x)"
   shows "is_fstsnd_in_sndsnd(##M,x) \<longleftrightarrow> fstsnd_in_sndsnd(x)"
   using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
   unfolding fstsnd_in_sndsnd_def is_fstsnd_in_sndsnd_def
   by auto
 
-lemma (in M_ZF1_trans) separation_fstsnd_in_sndsnd:
+lemma separation_fstsnd_in_sndsnd:
  "separation(##M, \<lambda>x. fst(snd(x)) \<in> snd(snd(x)))"
   using separation_in_ctm[where env="[]" and \<phi>="is_fstsnd_in_sndsnd_fm(0)" and Q=fstsnd_in_sndsnd]
     nonempty fstsnd_in_sndsnd_abs arity_is_fstsnd_in_sndsnd_fm
   unfolding fstsnd_in_sndsnd_def
   by simp
 
-definition sndfst_eq_fstsnd :: "[i] \<Rightarrow> o" where
-  "sndfst_eq_fstsnd \<equiv> \<lambda>x. snd(fst(x)) = fst(snd(x))"
-relativize "sndfst_eq_fstsnd" "is_sndfst_eq_fstsnd"
-synthesize "is_sndfst_eq_fstsnd" from_definition assuming "nonempty"
-arity_theorem for "is_sndfst_eq_fstsnd_fm"
-
-lemma (in M_ZF1_trans) sndfst_eq_fstsnd_abs:
+lemma sndfst_eq_fstsnd_abs:
   assumes "(##M)(x)"
   shows "is_sndfst_eq_fstsnd(##M,x) \<longleftrightarrow> sndfst_eq_fstsnd(x)"
   using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
   unfolding sndfst_eq_fstsnd_def is_sndfst_eq_fstsnd_def
   by auto
 
-lemma (in M_ZF1_trans) separation_sndfst_eq_fstsnd:
+lemma separation_sndfst_eq_fstsnd:
  "separation(##M, \<lambda>x. snd(fst(x)) = fst(snd(x)))"
   using separation_in_ctm[where env="[]" and \<phi>="is_sndfst_eq_fstsnd_fm(0)" and Q=sndfst_eq_fstsnd]
     nonempty sndfst_eq_fstsnd_abs arity_is_sndfst_eq_fstsnd_fm
   unfolding sndfst_eq_fstsnd_def
   by simp
 
-(*  "M(G) \<Longrightarrow> M(Q) \<Longrightarrow> separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> Q))" *)
-definition insnd_ballPair :: "[i,i,i] \<Rightarrow> o" where
-  "insnd_ballPair(B,A) \<equiv> \<lambda>p. \<forall>x\<in>B. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> A)"
-
-relativize "insnd_ballPair" "is_insnd_ballPair"
-synthesize "is_insnd_ballPair" from_definition assuming "nonempty"
-arity_theorem for "is_insnd_ballPair_fm"
-
-lemma (in M_ZF1_trans) insnd_ballPair_abs:
-  assumes "(##M)(B)" "(##M)(A)" "(##M)(x)"
-  shows "is_insnd_ballPair(##M,B,A,x) \<longleftrightarrow> insnd_ballPair(B,A,x)"
-  using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
-    transM[of _ B] transM[of _ "snd(x)"] transM[of _ "fst(x)"]
-  unfolding insnd_ballPair_def is_insnd_ballPair_def
-  by (auto)
-
-lemma (in M_ZF1_trans) separation_insnd_ballPair:
- "(##M)(B) \<Longrightarrow> (##M)(A) \<Longrightarrow> separation(##M, \<lambda>p. \<forall>x\<in>B. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> A))"
-  using insnd_ballPair_abs nonempty
-    separation_in_ctm[where \<phi>="is_insnd_ballPair_fm(2,1,0)" and env="[A,B]"]
-    arity_is_insnd_ballPair_fm ord_simp_union is_insnd_ballPair_fm_type
-  unfolding insnd_ballPair_def
-  by simp
+end  \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Separation_Rename.thy b/thys/Independence_CH/Separation_Rename.thy
--- a/thys/Independence_CH/Separation_Rename.thy
+++ b/thys/Independence_CH/Separation_Rename.thy
@@ -1,519 +1,521 @@
 section\<open>Auxiliary renamings for Separation\<close>
 theory Separation_Rename
   imports
     Interface
 begin
 
+no_notation Aleph (\<open>\<aleph>_\<close> [90] 90)
+
 lemmas apply_fun = apply_iff[THEN iffD1]
 
 lemma nth_concat : "[p,t] \<in> list(A) \<Longrightarrow> env\<in> list(A) \<Longrightarrow> nth(1 +\<^sub>\<omega> length(env),[p]@ env @ [t]) = t"
   by(auto simp add:nth_append)
 
 lemma nth_concat2 : "env\<in> list(A) \<Longrightarrow> nth(length(env),env @ [p,t]) = p"
   by(auto simp add:nth_append)
 
 lemma nth_concat3 : "env\<in> list(A) \<Longrightarrow> u = nth(succ(length(env)), env @ [pi, u])"
   by(auto simp add:nth_append)
 
 definition
   sep_var :: "i \<Rightarrow> i" where
   "sep_var(n) \<equiv> {\<langle>0,1\<rangle>,\<langle>1,3\<rangle>,\<langle>2,4\<rangle>,\<langle>3,5\<rangle>,\<langle>4,0\<rangle>,\<langle>5+\<^sub>\<omega>n,6\<rangle>,\<langle>6+\<^sub>\<omega>n,2\<rangle>}"
 
 definition
   sep_env :: "i \<Rightarrow> i" where
   "sep_env(n) \<equiv> \<lambda> i \<in> (5+\<^sub>\<omega>n)-5 . i+\<^sub>\<omega>2"
 
 definition weak :: "[i, i] \<Rightarrow> i" where
   "weak(n,m) \<equiv> {i+\<^sub>\<omega>m . i \<in> n}"
 
 lemma weakD :
   assumes "n \<in> nat" "k\<in>nat" "x \<in> weak(n,k)"
   shows "\<exists> i \<in> n . x = i+\<^sub>\<omega>k"
   using assms unfolding weak_def by blast
 
 lemma weak_equal :
   assumes "n\<in>nat" "m\<in>nat"
   shows "weak(n,m) = (m+\<^sub>\<omega>n) - m"
 proof -
   have "weak(n,m)\<subseteq>(m+\<^sub>\<omega>n)-m"
   proof(intro subsetI)
     fix x
     assume "x\<in>weak(n,m)"
     with assms
     obtain i where
       "i\<in>n" "x=i+\<^sub>\<omega>m"
       using weakD by blast
     then
     have "m\<le>i+\<^sub>\<omega>m" "i<n"
       using add_le_self2[of m i] \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> ltI[OF \<open>i\<in>n\<close>] by simp_all
     then
     have "\<not>i+\<^sub>\<omega>m<m"
       using not_lt_iff_le in_n_in_nat[OF \<open>n\<in>nat\<close> \<open>i\<in>n\<close>] \<open>m\<in>nat\<close> by simp
     with \<open>x=i+\<^sub>\<omega>m\<close>
     have "x\<notin>m"
       using ltI \<open>m\<in>nat\<close> by auto
     moreover
     from assms \<open>x=i+\<^sub>\<omega>m\<close> \<open>i<n\<close>
     have "x<m+\<^sub>\<omega>n"
       using add_lt_mono1[OF \<open>i<n\<close> \<open>n\<in>nat\<close>] by simp
     ultimately
     show "x\<in>(m+\<^sub>\<omega>n)-m"
       using ltD DiffI by simp
   qed
   moreover
   have "(m+\<^sub>\<omega>n)-m\<subseteq>weak(n,m)"
   proof (intro subsetI)
     fix x
     assume "x\<in>(m+\<^sub>\<omega>n)-m"
     then
     have "x\<in>m+\<^sub>\<omega>n" "x\<notin>m"
       using DiffD1[of x "n+\<^sub>\<omega>m" m] DiffD2[of x "n+\<^sub>\<omega>m" m] by simp_all
     then
     have "x<m+\<^sub>\<omega>n" "x\<in>nat"
       using ltI in_n_in_nat[OF add_type[of m n]] by simp_all
     then
     obtain i where
       "m+\<^sub>\<omega>n = succ(x+\<^sub>\<omega>i)"
       using less_iff_succ_add[OF \<open>x\<in>nat\<close>,of "m+\<^sub>\<omega>n"] add_type by auto
     then
     have "x+\<^sub>\<omega>i<m+\<^sub>\<omega>n" using succ_le_iff by simp
     with \<open>x\<notin>m\<close>
     have "\<not>x<m" using ltD by blast
     with \<open>m\<in>nat\<close> \<open>x\<in>nat\<close>
     have "m\<le>x" using not_lt_iff_le by simp
     with \<open>x<m+\<^sub>\<omega>n\<close>  \<open>n\<in>nat\<close>
     have "x-\<^sub>\<omega>m<m+\<^sub>\<omega>n-\<^sub>\<omega>m"
       using diff_mono[OF \<open>x\<in>nat\<close> _ \<open>m\<in>nat\<close>] by simp
     have "m+\<^sub>\<omega>n-\<^sub>\<omega>m =  n" using diff_cancel2 \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> by simp
     with \<open>x-\<^sub>\<omega>m<m+\<^sub>\<omega>n-\<^sub>\<omega>m\<close> \<open>x\<in>nat\<close>
     have "x-\<^sub>\<omega>m \<in> n" "x=x-\<^sub>\<omega>m+\<^sub>\<omega>m"
       using ltD add_diff_inverse2[OF \<open>m\<le>x\<close>] by simp_all
     then
     show "x\<in>weak(n,m)"
       unfolding weak_def by auto
   qed
   ultimately
   show ?thesis by auto
 qed
 
 lemma weak_zero:
   shows "weak(0,n) = 0"
   unfolding weak_def by simp
 
 lemma weakening_diff :
   assumes "n \<in> nat"
   shows "weak(n,7) - weak(n,5) \<subseteq> {5+\<^sub>\<omega>n, 6+\<^sub>\<omega>n}"
   unfolding weak_def using assms
 proof(auto)
   {
     fix i
     assume "i\<in>n" "succ(succ(natify(i)))\<noteq>n" "\<forall>w\<in>n. succ(succ(natify(i))) \<noteq> natify(w)"
     then
     have "i<n"
       using ltI \<open>n\<in>nat\<close> by simp
     from \<open>n\<in>nat\<close> \<open>i\<in>n\<close> \<open>succ(succ(natify(i)))\<noteq>n\<close>
     have "i\<in>nat" "succ(succ(i))\<noteq>n" using in_n_in_nat by simp_all
     from \<open>i<n\<close>
     have "succ(i)\<le>n" using succ_leI by simp
     with \<open>n\<in>nat\<close>
     consider (a) "succ(i) = n" | (b) "succ(i) < n"
       using leD by auto
     then have "succ(i) = n"
     proof cases
       case a
       then show ?thesis .
     next
       case b
       then
       have "succ(succ(i))\<le>n" using succ_leI by simp
       with \<open>n\<in>nat\<close>
       consider (a) "succ(succ(i)) = n" | (b) "succ(succ(i)) < n"
         using leD by auto
       then have "succ(i) = n"
       proof cases
         case a
         with \<open>succ(succ(i))\<noteq>n\<close> show ?thesis by blast
       next
         case b
         then
         have "succ(succ(i))\<in>n" using ltD by simp
         with \<open>i\<in>nat\<close>
         have "succ(succ(natify(i))) \<noteq> natify(succ(succ(i)))"
           using  \<open>\<forall>w\<in>n. succ(succ(natify(i))) \<noteq> natify(w)\<close> by auto
         then
         have "False" using \<open>i\<in>nat\<close> by auto
         then show ?thesis by blast
       qed
       then show ?thesis .
     qed
     with \<open>i\<in>nat\<close> have "succ(natify(i)) = n" by simp
   }
   then
   show "n \<in> nat \<Longrightarrow>
     succ(succ(natify(y))) \<noteq> n \<Longrightarrow>
     \<forall>x\<in>n. succ(succ(natify(y))) \<noteq> natify(x) \<Longrightarrow>
     y \<in> n \<Longrightarrow> succ(natify(y)) = n" for y
     by blast
 qed
 
 lemma in_add_del :
   assumes "x\<in>j+\<^sub>\<omega>n" "n\<in>nat" "j\<in>nat"
   shows "x < j \<or> x \<in> weak(n,j)"
 proof (cases "x<j")
   case True
   then show ?thesis ..
 next
   case False
   have "x\<in>nat" "j+\<^sub>\<omega>n\<in>nat"
     using in_n_in_nat[OF _ \<open>x\<in>j+\<^sub>\<omega>n\<close>] assms by simp_all
   then
   have "j \<le> x" "x < j+\<^sub>\<omega>n"
     using not_lt_iff_le False \<open>j\<in>nat\<close> \<open>n\<in>nat\<close> ltI[OF \<open>x\<in>j+\<^sub>\<omega>n\<close>] by auto
   then
   have "x-\<^sub>\<omega>j < (j +\<^sub>\<omega> n) -\<^sub>\<omega> j" "x = j +\<^sub>\<omega> (x -\<^sub>\<omega>j)"
     using diff_mono \<open>x\<in>nat\<close> \<open>j+\<^sub>\<omega>n\<in>nat\<close> \<open>j\<in>nat\<close> \<open>n\<in>nat\<close>
       add_diff_inverse[OF \<open>j\<le>x\<close>] by simp_all
   then
   have "x-\<^sub>\<omega>j < n" "x = (x -\<^sub>\<omega>j ) +\<^sub>\<omega> j"
     using diff_add_inverse \<open>n\<in>nat\<close> add_commute by simp_all
   then
   have "x-\<^sub>\<omega>j \<in>n" using ltD by simp
   then
   have "x \<in> weak(n,j)"
     unfolding weak_def
     using \<open>x= (x-\<^sub>\<omega>j) +\<^sub>\<omega>j\<close> RepFunI[OF \<open>x-\<^sub>\<omega>j\<in>n\<close>] add_commute by force
   then show ?thesis  ..
 qed
 
 
 lemma sep_env_action:
   assumes
     "[t,p,u,P,leq,o,pi] \<in> list(M)"
     "env \<in> list(M)"
   shows "\<forall> i . i \<in> weak(length(env),5) \<longrightarrow>
       nth(sep_env(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
 proof -
   from assms
   have A: "5+\<^sub>\<omega>length(env)\<in>nat" "[p, P, leq, o, t] \<in>list(M)"
     by simp_all
   let ?f="sep_env(length(env))"
   have EQ: "weak(length(env),5) = 5+\<^sub>\<omega>length(env) - 5"
     using weak_equal length_type[OF \<open>env\<in>list(M)\<close>] by simp
   let ?tgt="[t,p,u,P,leq,o,pi]@env"
   let ?src="[p,P,leq,o,t] @ env @ [pi,u]"
   have "nth(?f`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
     if "i \<in> (5+\<^sub>\<omega>length(env)-5)" for i
   proof -
     from that
     have 2: "i \<in> 5+\<^sub>\<omega>length(env)"  "i \<notin> 5" "i \<in> nat" "i-\<^sub>\<omega>5\<in>nat" "i+\<^sub>\<omega>2\<in>nat"
       using in_n_in_nat[OF \<open>5+\<^sub>\<omega>length(env)\<in>nat\<close>] by simp_all
     then
     have 3: "\<not> i < 5" using ltD by force
     then
     have "5 \<le> i" "2 \<le> 5"
       using  not_lt_iff_le \<open>i\<in>nat\<close> by simp_all
     then have "2 \<le> i" using le_trans[OF \<open>2\<le>5\<close>] by simp
     from A \<open>i \<in> 5+\<^sub>\<omega>length(env)\<close>
     have "i < 5+\<^sub>\<omega>length(env)" using ltI by simp
     with \<open>i\<in>nat\<close> \<open>2\<le>i\<close> A
     have C:"i+\<^sub>\<omega>2 < 7+\<^sub>\<omega>length(env)"  by simp
     with that
     have B: "?f`i = i+\<^sub>\<omega>2" unfolding sep_env_def by simp
     from 3 assms(1) \<open>i\<in>nat\<close>
     have "\<not> i+\<^sub>\<omega>2 < 7" using not_lt_iff_le add_le_mono by simp
     from \<open>i < 5+\<^sub>\<omega>length(env)\<close> 3 \<open>i\<in>nat\<close>
     have "i-\<^sub>\<omega>5 < 5+\<^sub>\<omega>length(env) -\<^sub>\<omega> 5"
       using diff_mono[of i "5+\<^sub>\<omega>length(env)" 5,OF _ _ _ \<open>i < 5+\<^sub>\<omega>length(env)\<close>]
         not_lt_iff_le[THEN iffD1] by force
     with assms(2)
     have "i-\<^sub>\<omega>5 < length(env)" using diff_add_inverse length_type by simp
     have "nth(i,?src) =nth(i-\<^sub>\<omega>5,env@[pi,u])"
       using nth_append[OF A(2) \<open>i\<in>nat\<close>] 3 by simp
     also
     have "... = nth(i-\<^sub>\<omega>5, env)"
       using nth_append[OF \<open>env \<in>list(M)\<close> \<open>i-\<^sub>\<omega>5\<in>nat\<close>] \<open>i-\<^sub>\<omega>5 < length(env)\<close> by simp
     also
     have "... = nth(i+\<^sub>\<omega>2, ?tgt)"
       using nth_append[OF assms(1) \<open>i+\<^sub>\<omega>2\<in>nat\<close>] \<open>\<not> i+\<^sub>\<omega>2 <7\<close> by simp
     ultimately
     have "nth(i,?src) = nth(?f`i,?tgt)"
       using B by simp
     then show ?thesis using that by simp
   qed
   then show ?thesis using EQ by force
 qed
 
 lemma sep_env_type :
   assumes "n \<in> nat"
   shows "sep_env(n) : (5+\<^sub>\<omega>n)-5 \<rightarrow> (7+\<^sub>\<omega>n)-7"
 proof -
   let ?h="sep_env(n)"
   from \<open>n\<in>nat\<close>
   have "(5+\<^sub>\<omega>n)+\<^sub>\<omega>2 = 7+\<^sub>\<omega>n" "7+\<^sub>\<omega>n\<in>nat" "5+\<^sub>\<omega>n\<in>nat" by simp_all
   have
     D: "sep_env(n)`x \<in> (7+\<^sub>\<omega>n)-7" if "x \<in> (5+\<^sub>\<omega>n)-5" for x
   proof -
     from \<open>x\<in>5+\<^sub>\<omega>n-5\<close>
     have "?h`x = x+\<^sub>\<omega>2" "x<5+\<^sub>\<omega>n" "x\<in>nat"
       unfolding sep_env_def using ltI in_n_in_nat[OF \<open>5+\<^sub>\<omega>n\<in>nat\<close>] by simp_all
     then
     have "x+\<^sub>\<omega>2 < 7+\<^sub>\<omega>n" by simp
     then
     have "x+\<^sub>\<omega>2 \<in> 7+\<^sub>\<omega>n" using ltD by simp
     from \<open>x\<in>5+\<^sub>\<omega>n-5\<close>
     have "x\<notin>5" by simp
     then have "\<not>x<5" using ltD by blast
     then have "5\<le>x" using not_lt_iff_le \<open>x\<in>nat\<close> by simp
     then have "7\<le>x+\<^sub>\<omega>2" using add_le_mono \<open>x\<in>nat\<close> by simp
     then have "\<not>x+\<^sub>\<omega>2<7" using not_lt_iff_le \<open>x\<in>nat\<close> by simp
     then have "x+\<^sub>\<omega>2 \<notin> 7" using ltI \<open>x\<in>nat\<close> by force
     with \<open>x+\<^sub>\<omega>2 \<in> 7+\<^sub>\<omega>n\<close> show ?thesis using  \<open>?h`x = x+\<^sub>\<omega>2\<close> DiffI by simp
   qed
   then show ?thesis unfolding sep_env_def using lam_type by simp
 qed
 
 lemma sep_var_fin_type :
   assumes "n \<in> nat"
   shows "sep_var(n) : 7+\<^sub>\<omega>n  -||> 7+\<^sub>\<omega>n"
   unfolding sep_var_def
   using consI ltD emptyI by force
 
 lemma sep_var_domain :
   assumes "n \<in> nat"
   shows "domain(sep_var(n)) =  7+\<^sub>\<omega>n - weak(n,5)"
 proof -
   let ?A="weak(n,5)"
   have A:"domain(sep_var(n)) \<subseteq> (7+\<^sub>\<omega>n)"
     unfolding sep_var_def
     by(auto simp add: le_natE)
   have C: "x=5+\<^sub>\<omega>n \<or> x=6+\<^sub>\<omega>n \<or> x \<le> 4" if "x\<in>domain(sep_var(n))" for x
     using that unfolding sep_var_def by auto
   have D : "x<n+\<^sub>\<omega>7" if "x\<in>7+\<^sub>\<omega>n" for x
     using that \<open>n\<in>nat\<close> ltI by simp
   have "\<not> 5+\<^sub>\<omega>n < 5+\<^sub>\<omega>n" using \<open>n\<in>nat\<close>  lt_irrefl[of _ False] by force
   have "\<not> 6+\<^sub>\<omega>n < 5+\<^sub>\<omega>n" using \<open>n\<in>nat\<close> by force
   have R: "x < 5+\<^sub>\<omega>n" if "x\<in>?A" for x
   proof -
     from that
     obtain i where
       "i<n" "x=5+\<^sub>\<omega>i"
       unfolding weak_def
       using ltI \<open>n\<in>nat\<close> RepFun_iff by force
     with \<open>n\<in>nat\<close>
     have "5+\<^sub>\<omega>i < 5+\<^sub>\<omega>n" using add_lt_mono2 by simp
     with \<open>x=5+\<^sub>\<omega>i\<close>
     show "x < 5+\<^sub>\<omega>n" by simp
   qed
   then
   have 1:"x\<notin>?A" if "\<not>x <5+\<^sub>\<omega>n" for x using that by blast
   have "5+\<^sub>\<omega>n \<notin> ?A" "6+\<^sub>\<omega>n\<notin>?A"
   proof -
     show "5+\<^sub>\<omega>n \<notin> ?A" using 1 \<open>\<not>5+\<^sub>\<omega>n<5+\<^sub>\<omega>n\<close> by blast
     with 1 show "6+\<^sub>\<omega>n \<notin> ?A" using  \<open>\<not>6+\<^sub>\<omega>n<5+\<^sub>\<omega>n\<close> by blast
   qed
   then
   have E:"x\<notin>?A" if "x\<in>domain(sep_var(n))" for x
     unfolding weak_def
     using C that by force
   then
   have F: "domain(sep_var(n)) \<subseteq> 7+\<^sub>\<omega>n - ?A" using A by auto
   from assms
   have "x<7 \<or> x\<in>weak(n,7)" if "x\<in>7+\<^sub>\<omega>n" for x
     using in_add_del[OF \<open>x\<in>7+\<^sub>\<omega>n\<close>] by simp
   moreover
   {
     fix x
     assume asm:"x\<in>7+\<^sub>\<omega>n"  "x\<notin>?A"  "x\<in>weak(n,7)"
     then
     have "x\<in>domain(sep_var(n))"
     proof -
       from \<open>n\<in>nat\<close>
       have "weak(n,7)-weak(n,5)\<subseteq>{n+\<^sub>\<omega>5,n+\<^sub>\<omega>6}"
         using weakening_diff by simp
       with  \<open>x\<notin>?A\<close> asm
       have "x\<in>{n+\<^sub>\<omega>5,n+\<^sub>\<omega>6}" using  subsetD DiffI by blast
       then
       show ?thesis unfolding sep_var_def by simp
     qed
   }
   moreover
   {
     fix x
     assume asm:"x\<in>7+\<^sub>\<omega>n"  "x\<notin>?A" "x<7"
     then have "x\<in>domain(sep_var(n))"
     proof (cases "2 \<le> n")
       case True
       moreover
       have "0<n" using  leD[OF \<open>n\<in>nat\<close> \<open>2\<le>n\<close>] lt_imp_0_lt by auto
       ultimately
       have "x<5"
         using \<open>x<7\<close> \<open>x\<notin>?A\<close> \<open>n\<in>nat\<close> in_n_in_nat
         unfolding weak_def
         by (clarsimp simp add:not_lt_iff_le, auto simp add:lt_def)
       then
       show ?thesis unfolding sep_var_def
         by (clarsimp simp add:not_lt_iff_le, auto simp add:lt_def)
     next
       case False
       then
       show ?thesis
       proof (cases "n=0")
         case True
         then show ?thesis
           unfolding sep_var_def using ltD asm \<open>n\<in>nat\<close> by auto
       next
         case False
         then
         have "n < 2" using  \<open>n\<in>nat\<close> not_lt_iff_le \<open>\<not> 2 \<le> n\<close>  by force
         then
         have "\<not> n <1" using \<open>n\<noteq>0\<close> by simp
         then
         have "n=1" using not_lt_iff_le \<open>n<2\<close> le_iff by auto
         then show ?thesis
           using \<open>x\<notin>?A\<close>
           unfolding weak_def sep_var_def
           using ltD asm \<open>n\<in>nat\<close> by force
       qed
     qed
   }
   ultimately
   have "w\<in>domain(sep_var(n))" if "w\<in> 7+\<^sub>\<omega>n - ?A" for w
     using that by blast
   then
   have "7+\<^sub>\<omega>n - ?A \<subseteq> domain(sep_var(n))" by blast
   with F
   show ?thesis by auto
 qed
 
 lemma sep_var_type :
   assumes "n \<in> nat"
   shows "sep_var(n) : (7+\<^sub>\<omega>n)-weak(n,5) \<rightarrow> 7+\<^sub>\<omega>n"
   using FiniteFun_is_fun[OF sep_var_fin_type[OF \<open>n\<in>nat\<close>]]
     sep_var_domain[OF \<open>n\<in>nat\<close>] by simp
 
 lemma sep_var_action :
   assumes
     "[t,p,u,P,leq,o,pi] \<in> list(M)"
     "env \<in> list(M)"
   shows "\<forall> i . i \<in> (7+\<^sub>\<omega>length(env)) - weak(length(env),5) \<longrightarrow>
     nth(sep_var(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
   using assms
 proof (subst sep_var_domain[OF length_type[OF \<open>env\<in>list(M)\<close>],symmetric],auto)
   fix i y
   assume "\<langle>i, y\<rangle> \<in> sep_var(length(env))"
   with assms
   show "nth(sep_var(length(env)) ` i,
                Cons(t, Cons(p, Cons(u, Cons(P, Cons(leq, Cons(o, Cons(pi, env)))))))) =
            nth(i, Cons(p, Cons(P, Cons(leq, Cons(o, Cons(t, env @ [pi, u]))))))"
     using apply_fun[OF sep_var_type] assms
     unfolding sep_var_def
     using nth_concat2[OF \<open>env\<in>list(M)\<close>]  nth_concat3[OF \<open>env\<in>list(M)\<close>,symmetric]
     by force
 qed
 
 definition
   rensep :: "i \<Rightarrow> i" where
   "rensep(n) \<equiv> union_fun(sep_var(n),sep_env(n),7+\<^sub>\<omega>n-weak(n,5),weak(n,5))"
 
 lemma rensep_aux :
   assumes "n\<in>nat"
   shows "(7+\<^sub>\<omega>n-weak(n,5)) \<union> weak(n,5) = 7+\<^sub>\<omega>n" "7+\<^sub>\<omega>n \<union> ( 7 +\<^sub>\<omega> n - 7) = 7+\<^sub>\<omega>n"
 proof -
   from \<open>n\<in>nat\<close>
   have "weak(n,5) = n+\<^sub>\<omega>5-5"
     using weak_equal by simp
   with  \<open>n\<in>nat\<close>
   show "(7+\<^sub>\<omega>n-weak(n,5)) \<union> weak(n,5) = 7+\<^sub>\<omega>n" "7+\<^sub>\<omega>n \<union> ( 7 +\<^sub>\<omega> n - 7) = 7+\<^sub>\<omega>n"
     using Diff_partition le_imp_subset by auto
 qed
 
 lemma rensep_type :
   assumes "n\<in>nat"
   shows "rensep(n) \<in> 7+\<^sub>\<omega>n \<rightarrow> 7+\<^sub>\<omega>n"
 proof -
   from \<open>n\<in>nat\<close>
   have "rensep(n) \<in> (7+\<^sub>\<omega>n-weak(n,5)) \<union> weak(n,5) \<rightarrow> 7+\<^sub>\<omega>n \<union> (7+\<^sub>\<omega>n - 7)"
     unfolding rensep_def
     using union_fun_type  sep_var_type \<open>n\<in>nat\<close> sep_env_type weak_equal
     by force
   then
   show ?thesis using rensep_aux \<open>n\<in>nat\<close> by auto
 qed
 
 lemma rensep_action :
   assumes "[t,p,u,P,leq,o,pi] @ env \<in> list(M)"
   shows "\<forall> i . i < 7+\<^sub>\<omega>length(env) \<longrightarrow> nth(rensep(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
 proof -
   let ?tgt="[t,p,u,P,leq,o,pi]@env"
   let ?src="[p,P,leq,o,t] @ env @ [pi,u]"
   let ?m="7 +\<^sub>\<omega> length(env) - weak(length(env),5)"
   let ?p="weak(length(env),5)"
   let ?f="sep_var(length(env))"
   let ?g="sep_env(length(env))"
   let ?n="length(env)"
   from assms
   have 1 : "[t,p,u,P,leq,o,pi] \<in> list(M)" " env \<in> list(M)"
     "?src \<in> list(M)" "?tgt \<in> list(M)"
     "7+\<^sub>\<omega>?n = (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)"
     " length(?src) = (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)"
     using Diff_partition le_imp_subset rensep_aux by auto
   then
   have "nth(i, ?src) = nth(union_fun(?f, ?g, ?m, ?p) ` i, ?tgt)" if "i < 7+\<^sub>\<omega>length(env)" for i
   proof -
     from \<open>i<7+\<^sub>\<omega>?n\<close>
     have "i \<in> (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)"
       using ltD by simp
     then show ?thesis
       unfolding rensep_def using
         union_fun_action[OF \<open>?src\<in>list(M)\<close> \<open>?tgt\<in>list(M)\<close> \<open>length(?src) = (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)\<close>
           sep_var_action[OF \<open>[t,p,u,P,leq,o,pi] \<in> list(M)\<close> \<open>env\<in>list(M)\<close>]
           sep_env_action[OF \<open>[t,p,u,P,leq,o,pi] \<in> list(M)\<close> \<open>env\<in>list(M)\<close>]
           ] that
       by simp
   qed
   then show ?thesis unfolding rensep_def by simp
 qed
 
 definition sep_ren :: "[i,i] \<Rightarrow> i" where
   "sep_ren(n,\<phi>) \<equiv> ren(\<phi>)`(7+\<^sub>\<omega>n)`(7+\<^sub>\<omega>n)`rensep(n)"
 
 lemma arity_rensep: assumes "\<phi>\<in>formula" "env \<in> list(M)"
   "arity(\<phi>) \<le> 7+\<^sub>\<omega>length(env)"
 shows "arity(sep_ren(length(env),\<phi>)) \<le> 7+\<^sub>\<omega>length(env)"
   unfolding sep_ren_def
   using arity_ren rensep_type assms
   by simp
 
 lemma type_rensep [TC]:
   assumes "\<phi>\<in>formula" "env\<in>list(M)"
   shows "sep_ren(length(env),\<phi>) \<in> formula"
   unfolding sep_ren_def
   using ren_tc rensep_type assms
   by simp
 
 lemma sepren_action:
   assumes "arity(\<phi>) \<le> 7 +\<^sub>\<omega> length(env)"
     "[t,p,u,P,leq,o,pi] \<in> list(M)"
     "env\<in>list(M)"
     "\<phi>\<in>formula"
   shows "sats(M, sep_ren(length(env),\<phi>),[t,p,u,P,leq,o,pi] @ env) \<longleftrightarrow> sats(M, \<phi>,[p,P,leq,o,t] @ env @ [pi,u])"
 proof -
   from assms
   have 1: "[t, p, u, P, leq, o, pi] @ env \<in> list(M)"
     by simp_all
   then
   have 2: "[p,P,leq,o,t] @ env @ [pi,u] \<in> list(M)"
     using app_type by simp
   show ?thesis
     unfolding sep_ren_def
     using sats_iff_sats_ren[OF \<open>\<phi>\<in>formula\<close>
         add_type[of 7 "length(env)"]
         add_type[of 7 "length(env)"]
         2 1
         rensep_type[OF length_type[OF \<open>env\<in>list(M)\<close>]]
         \<open>arity(\<phi>) \<le> 7 +\<^sub>\<omega> length(env)\<close>]
       rensep_action[OF 1,rule_format,symmetric]
     by simp
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Succession_Poset.thy b/thys/Independence_CH/Succession_Poset.thy
--- a/thys/Independence_CH/Succession_Poset.thy
+++ b/thys/Independence_CH/Succession_Poset.thy
@@ -1,240 +1,230 @@
 section\<open>A poset of successions\<close>
 
 theory Succession_Poset
   imports
-    Replacement_Instances
+    ZF_Trans_Interpretations
     Proper_Extension
 begin
 
 text\<open>In this theory we define a separative poset. Its underlying set is the
 set of finite binary sequences (that is, with codomain $2={0,1}$);
 of course, one can see that set as
 the set \<^term>\<open>\<omega>-||>2\<close> or equivalently as the set of partial functions
 \<^term>\<open>Fn(\<omega>,\<omega>,2)\<close>, i.e. the set of partial functions bounded by \<^term>\<open>\<omega>\<close>.
 
 The order relation of the poset is that of being less defined as functions
 (cf. \<^term>\<open>Fnlerel(A\<^bsup><\<omega>\<^esup>)\<close>), so it could be surprising that we have not used
 \<^term>\<open>Fn(\<omega>,\<omega>,2)\<close> for the set. The only reason why we keep this alternative
 definition is because we can prove \<^term>\<open>A\<^bsup><\<omega>\<^esup> \<in> M\<close> (and therefore
-\<^term>\<open>Fnlerel(A\<^bsup><\<omega>\<^esup>) \<in> M\<close>) using only one instance of replacement.\<close>
-
-sublocale M_ZF2_trans \<subseteq> M_seqspace "##M"
-  by (unfold_locales, simp add:replacement_omega_funspace)
+\<^term>\<open>Fnlerel(A\<^bsup><\<omega>\<^esup>) \<in> M\<close>) using only one instance of separation.\<close>
 
 definition seq_upd :: "i \<Rightarrow> i \<Rightarrow> i" where
   "seq_upd(f,a) \<equiv> \<lambda> j \<in> succ(domain(f)) . if j < domain(f) then f`j else a"
 
 lemma seq_upd_succ_type :
   assumes "n\<in>nat" "f\<in>n\<rightarrow>A" "a\<in>A"
   shows "seq_upd(f,a)\<in> succ(n) \<rightarrow> A"
 proof -
   from assms
   have equ: "domain(f) = n"
     using domain_of_fun by simp
   {
     fix j
     assume "j\<in>succ(domain(f))"
     with equ \<open>n\<in>_\<close>
     have "j\<le>n"
       using ltI by auto
     with \<open>n\<in>_\<close>
     consider (lt) "j<n" | (eq) "j=n"
       using leD by auto
     then
     have "(if j < n then f`j else a) \<in> A"
     proof cases
       case lt
       with \<open>f\<in>_\<close>
       show ?thesis
         using apply_type ltD[OF lt] by simp
     next
       case eq
       with \<open>a\<in>_\<close>
       show ?thesis
         by auto
     qed
   }
   with equ
   show ?thesis
     unfolding seq_upd_def
     using lam_type[of "succ(domain(f))"]
     by auto
 qed
 
 lemma seq_upd_type :
   assumes "f\<in>A\<^bsup><\<omega>\<^esup>" "a\<in>A"
   shows "seq_upd(f,a) \<in> A\<^bsup><\<omega>\<^esup>"
 proof -
   from \<open>f\<in>_\<close>
   obtain y where "y\<in>nat" "f\<in>y\<rightarrow>A"
     unfolding seqspace_def by blast
   with \<open>a\<in>A\<close>
   have "seq_upd(f,a)\<in>succ(y)\<rightarrow>A"
     using seq_upd_succ_type by simp
   with \<open>y\<in>_\<close>
   show ?thesis
     unfolding seqspace_def by auto
 qed
 
 lemma seq_upd_apply_domain [simp]:
   assumes "f:n\<rightarrow>A" "n\<in>nat"
   shows "seq_upd(f,a)`n = a"
   unfolding seq_upd_def using assms domain_of_fun by auto
 
 lemma zero_in_seqspace :
   shows "0 \<in> A\<^bsup><\<omega>\<^esup>"
   unfolding seqspace_def
   by force
 
 definition
   seqlerel :: "i \<Rightarrow> i" where
   "seqlerel(A) \<equiv> Fnlerel(A\<^bsup><\<omega>\<^esup>)"
 
 definition
   seqle :: "i" where
   "seqle \<equiv> seqlerel(2)"
 
 lemma seqleI[intro!]:
   "\<langle>f,g\<rangle> \<in> 2\<^bsup><\<omega>\<^esup>\<times>2\<^bsup><\<omega>\<^esup> \<Longrightarrow> g \<subseteq> f  \<Longrightarrow> \<langle>f,g\<rangle> \<in> seqle"
   unfolding seqle_def seqlerel_def seqspace_def Rrel_def Fnlerel_def
   by blast
 
 lemma seqleD[dest!]:
   "z \<in> seqle \<Longrightarrow> \<exists>x y. \<langle>x,y\<rangle> \<in> 2\<^bsup><\<omega>\<^esup>\<times>2\<^bsup><\<omega>\<^esup> \<and> y \<subseteq> x \<and> z = \<langle>x,y\<rangle>"
   unfolding Rrel_def seqle_def seqlerel_def Fnlerel_def
   by blast
 
 lemma upd_leI :
   assumes "f\<in>2\<^bsup><\<omega>\<^esup>" "a\<in>2"
   shows "\<langle>seq_upd(f,a),f\<rangle>\<in>seqle"  (is "\<langle>?f,_\<rangle>\<in>_")
 proof
   show " \<langle>?f, f\<rangle> \<in> 2\<^bsup><\<omega>\<^esup> \<times> 2\<^bsup><\<omega>\<^esup>"
     using assms seq_upd_type by auto
 next
   show  "f \<subseteq> seq_upd(f,a)"
   proof
     fix x
     assume "x \<in> f"
     moreover from \<open>f \<in> 2\<^bsup><\<omega>\<^esup>\<close>
     obtain n where "n\<in>nat" "f : n \<rightarrow> 2"
       by blast
     moreover from calculation
     obtain y where "y\<in>n" "x=\<langle>y,f`y\<rangle>"
       using Pi_memberD[of f n "\<lambda>_ . 2"]
       by blast
     moreover from \<open>f:n\<rightarrow>2\<close>
     have "domain(f) = n"
       using domain_of_fun by simp
     ultimately
     show "x \<in> seq_upd(f,a)"
       unfolding seq_upd_def lam_def
       by (auto intro:ltI)
   qed
 qed
 
 lemma preorder_on_seqle: "preorder_on(2\<^bsup><\<omega>\<^esup>,seqle)"
   unfolding preorder_on_def refl_def trans_on_def by blast
 
 lemma zero_seqle_max: "x\<in>2\<^bsup><\<omega>\<^esup> \<Longrightarrow> \<langle>x,0\<rangle> \<in> seqle"
   using zero_in_seqspace
   by auto
 
 interpretation sp:forcing_notion "2\<^bsup><\<omega>\<^esup>" "seqle" "0"
   using preorder_on_seqle zero_seqle_max zero_in_seqspace
   by unfold_locales simp_all
 
 notation sp.Leq (infixl "\<preceq>s" 50)
 notation sp.Incompatible (infixl "\<bottom>s" 50)
-notation sp.GenExt_at_P ("_\<^bsup>s\<^esup>[_]" [71,1])
 
 lemma seqspace_separative:
   assumes "f\<in>2\<^bsup><\<omega>\<^esup>"
   shows "seq_upd(f,0) \<bottom>s seq_upd(f,1)" (is "?f \<bottom>s ?g")
 proof
   assume "sp.compat(?f, ?g)"
   then
   obtain h where "h \<in> 2\<^bsup><\<omega>\<^esup>" "?f \<subseteq> h" "?g \<subseteq> h"
     by blast
   moreover from \<open>f\<in>_\<close>
   obtain y where "y\<in>nat" "f:y\<rightarrow>2"
     by blast
   moreover from this
   have "?f: succ(y) \<rightarrow> 2" "?g: succ(y) \<rightarrow> 2"
     using seq_upd_succ_type by blast+
   moreover from this
   have "\<langle>y,?f`y\<rangle> \<in> ?f" "\<langle>y,?g`y\<rangle> \<in> ?g"
     using apply_Pair by auto
   ultimately
   have "\<langle>y,0\<rangle> \<in> h" "\<langle>y,1\<rangle> \<in> h"
     by auto
   moreover from \<open>h \<in> 2\<^bsup><\<omega>\<^esup>\<close>
   obtain n where "n\<in>nat" "h:n\<rightarrow>2"
     by blast
   ultimately
   show "False"
     using fun_is_function[of h n "\<lambda>_. 2"]
     unfolding seqspace_def function_def by auto
 qed
 
 definition seqleR_fm :: "i \<Rightarrow> i" where
   "seqleR_fm(fg) \<equiv> Exists(Exists(And(pair_fm(0,1,fg+\<^sub>\<omega>2),subset_fm(1,0))))"
 
 lemma type_seqleR_fm : "fg \<in> nat \<Longrightarrow> seqleR_fm(fg) \<in> formula"
   unfolding seqleR_fm_def
   by simp
 
 arity_theorem for "seqleR_fm"
 
 lemma (in M_ctm1) seqleR_fm_sats :
   assumes "fg\<in>nat" "env\<in>list(M)"
   shows "(M, env \<Turnstile> seqleR_fm(fg)) \<longleftrightarrow> (\<exists>f[##M]. \<exists>g[##M]. pair(##M,f,g,nth(fg,env)) \<and> f \<supseteq> g)"
   unfolding seqleR_fm_def
   using assms trans_M sats_subset_fm pair_iff_sats
   by auto
 
-locale M_ctm2 = M_ctm1 + M_ZF2_trans
-
-locale M_ctm2_AC = M_ctm2 + M_ZFC2_trans
-
-locale forcing_data2 = forcing_data1 + M_ctm2
-
 context M_ctm2
 begin
 
 lemma seqle_in_M: "seqle \<in> M"
   using arity_seqleR_fm seqleR_fm_sats type_seqleR_fm
     cartprod_closed seqspace_closed nat_into_M nat_in_M pair_in_M_iff
   unfolding seqle_def seqlerel_def Rrel_def Fnlerel_def
   by (rule_tac Collect_in_M[of "seqleR_fm(0)" "[]"],auto)
 
 subsection\<open>Cohen extension is proper\<close>
 
 interpretation ctm_separative "2\<^bsup><\<omega>\<^esup>" seqle 0
 proof (unfold_locales)
   fix f
   let ?q="seq_upd(f,0)" and ?r="seq_upd(f,1)"
   assume "f \<in> 2\<^bsup><\<omega>\<^esup>"
   then
   have "?q \<preceq>s f \<and> ?r \<preceq>s f \<and> ?q \<bottom>s ?r"
     using upd_leI seqspace_separative by auto
   moreover from calculation
   have "?q \<in> 2\<^bsup><\<omega>\<^esup>"  "?r \<in> 2\<^bsup><\<omega>\<^esup>"
     using seq_upd_type[of f 2] by auto
   ultimately
   show "\<exists>q\<in>2\<^bsup><\<omega>\<^esup>. \<exists>r\<in>2\<^bsup><\<omega>\<^esup>. q \<preceq>s f \<and> r \<preceq>s f \<and> q \<bottom>s r"
     by (rule_tac bexI)+ \<comment> \<open>why the heck auto-tools don't solve this?\<close>
 next
   show "2\<^bsup><\<omega>\<^esup> \<in> M"
     using nat_into_M seqspace_closed by simp
 next
   show "seqle \<in> M"
     using seqle_in_M .
 qed
 
-lemma cohen_extension_is_proper: "\<exists>G. M_generic(G) \<and> M \<noteq> M\<^bsup>2\<^bsup><\<omega>\<^esup>\<^esup>[G]"
+lemma cohen_extension_is_proper: "\<exists>G. M_generic(G) \<and> M \<noteq> M[G]"
   using proper_extension generic_filter_existence zero_in_seqspace
   by force
 
 end \<comment> \<open>\<^locale>\<open>M_ctm2\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/Union_Axiom.thy b/thys/Independence_CH/Union_Axiom.thy
--- a/thys/Independence_CH/Union_Axiom.thy
+++ b/thys/Independence_CH/Union_Axiom.thy
@@ -1,201 +1,134 @@
 section\<open>The Axiom of Unions in $M[G]$\<close>
 theory Union_Axiom
   imports Names
 begin
 
 definition Union_name_body :: "[i,i,i,i] \<Rightarrow> o" where
-  "Union_name_body(P,leq,\<tau>,x) \<equiv> \<exists> \<sigma> . \<exists>q\<in>P . \<exists>r\<in>P .
+  "Union_name_body(P,leq,\<tau>,x) \<equiv> \<exists> \<sigma>\<in>domain(\<tau>) . \<exists>q\<in>P . \<exists>r\<in>P .
       \<langle>\<sigma>,q\<rangle> \<in> \<tau> \<and> \<langle>fst(x),r\<rangle> \<in> \<sigma> \<and> \<langle>snd(x),r\<rangle> \<in> leq \<and> \<langle>snd(x),q\<rangle> \<in> leq"
 
-relativize relational "Union_name_body" "is_Union_name_body"
-reldb_add functional "Union_name_body" "is_Union_name_body"
-synthesize "is_Union_name_body" from_definition assuming "nonempty"
-arity_theorem for "is_Union_name_body_fm"
-
 definition Union_name :: "[i,i,i] \<Rightarrow> i" where
   "Union_name(P,leq,\<tau>) \<equiv> {u \<in> domain(\<Union>(domain(\<tau>))) \<times> P . Union_name_body(P,leq,\<tau>,u)}"
 
-relativize functional "Union_name" "Union_name_rel"
-relativize relational "Union_name" "is_Union_name"
-synthesize "is_Union_name" from_definition assuming "nonempty"
-arity_theorem for "is_Union_name_fm"
-
-context M_basic
-begin
-
-is_iff_rel for "Union_name"
-  using transM[OF _ cartprod_closed] domain_closed Union_closed
-  unfolding is_Union_name_def Union_name_rel_def
-  by simp
-
-lemma Union_name_body_iff:
-  assumes "M(x)" "M(leq)" "M(P)" "M(\<tau>)"
-  shows "is_Union_name_body(M, P, leq, \<tau>, x) \<longleftrightarrow> Union_name_body(P, leq, \<tau>, x)"
-proof -
-  from \<open>M(\<tau>)\<close>
-  have "M(\<sigma>)" if "\<langle>\<sigma>,q\<rangle>\<in>\<tau>" for \<sigma> q
-    using transM[of _ \<tau>] transM[of _ "\<langle>\<sigma>,q\<rangle>"] that
-    unfolding Pair_def
-    by auto
-  then
-  show ?thesis
-    using assms transM[OF _ cartprod_closed] pair_abs fst_abs snd_abs
-    unfolding is_Union_name_body_def Union_name_body_def
-    by auto
-qed
-
-lemma Union_name_abs :
-  assumes "M(P)" "M(leq)" "M(\<tau>)"
-  shows "Union_name_rel(M,P,leq,\<tau>) = Union_name(P,leq,\<tau>)"
-  using assms transM[OF _ cartprod_closed] Union_name_body_iff
-  unfolding Union_name_rel_def Union_name_def
-  by auto
-
-end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
-
 context forcing_data1
 begin
 
 lemma Union_name_closed :
   assumes "\<tau> \<in> M"
   shows "Union_name(P,leq,\<tau>) \<in> M"
 proof -
-  let ?\<phi>="is_Union_name_body_fm(3,2,1,0)"
-  let ?P="\<lambda> x . M,[x,\<tau>,leq,P] \<Turnstile> ?\<phi>"
   let ?Q="Union_name_body(P,leq,\<tau>)"
-  from \<open>\<tau>\<in>M\<close>
+  note lr_fst2 = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]
+    and lr_fst3 = lam_replacement_hcomp[OF lr_fst2] lam_replacement_hcomp[OF lr_fst2 lr_fst2]
+  note \<open>\<tau>\<in>M\<close>
+  moreover from this
   have "domain(\<Union>(domain(\<tau>)))\<in>M" (is "?d \<in> _")
     using domain_closed Union_closed by simp
-  then
+  moreover from this
   have "?d \<times> P \<in> M"
-    using cartprod_closed P_in_M by simp
-  note types = leq_in_M P_in_M assms \<open>?d\<times>P \<in> M\<close> \<open>?d\<in>M\<close>
-  moreover
-  have "arity(?\<phi>)\<le>4"
-    using arity_is_Union_name_body_fm ord_simp_union by simp
-  moreover from calculation
-  have "separation(##M,?P)"
-    using separation_ax by simp
-  moreover from calculation
-  have closed:"{ u \<in> ?d \<times> P . ?P(u) } \<in> M"
-    using separation_iff by force
-  moreover from calculation
-  have "?P(x)\<longleftrightarrow> x\<in>M \<and> ?Q(x)" if "x\<in>?d\<times>P" for x
-  proof -
-    note calculation that
-    moreover from this
-    have "x = \<langle>fst(x),snd(x)\<rangle>" "x\<in>M"  "fst(x) \<in> M" "snd(x) \<in> M"
-      using Pair_fst_snd_eq transitivity[of x "?d\<times>P"] fst_snd_closed
-      by simp_all
-    ultimately
-    show "?P(x) \<longleftrightarrow> x\<in>M \<and> ?Q(x)"
-      using types zero_in_M is_Union_name_body_iff_sats Union_name_body_iff
-      by simp
-  qed
-  with \<open>?d \<times> P \<in> M\<close> types
-  have "Union_name_rel(##M,P,leq,\<tau>) \<in> M"
-    unfolding Union_name_rel_def
-    using transitivity[OF _ \<open>?d\<times>P\<in>_\<close>] Collect_cong closed Union_name_body_iff
-    by simp
+    using cartprod_closed by simp
+  note types = assms \<open>?d\<times>P \<in> M\<close> \<open>?d\<in>M\<close>
   ultimately
   show ?thesis
-    using Union_name_abs
+    using domain_closed pair_in_M_iff fst_closed snd_closed separation_closed
+      lam_replacement_constant lam_replacement_hcomp
+      lam_replacement_fst lam_replacement_snd
+      lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+      separation_bex separation_conj separation_in lr_fst2 lr_fst3
+      lam_replacement_hcomp[OF lr_fst3(1) lam_replacement_snd]
+    unfolding Union_name_body_def Union_name_def
     by simp
 qed
 
 lemma Union_MG_Eq :
-  assumes "a \<in> M[G]" and "a = val(P,G,\<tau>)" and "filter(G)" and "\<tau> \<in> M"
-  shows "\<Union> a = val(P,G,Union_name(P,leq,\<tau>))"
+  assumes "a \<in> M[G]" and "a = val(G,\<tau>)" and "filter(G)" and "\<tau> \<in> M"
+  shows "\<Union> a = val(G,Union_name(P,leq,\<tau>))"
 proof (intro equalityI subsetI)
   fix x
   assume "x \<in> \<Union> a"
   with \<open>a=_\<close>
-  have "x\<in> \<Union> (val(P,G,\<tau>))"
+  have "x \<in> \<Union> (val(G,\<tau>))"
     by simp
   then
-  obtain i where "i \<in> val(P,G,\<tau>)" "x \<in> i"
+  obtain i where "i \<in> val(G,\<tau>)" "x \<in> i"
     by blast
   with \<open>\<tau> \<in> M\<close>
-  obtain \<sigma> q where "q \<in> G" "\<langle>\<sigma>,q\<rangle> \<in> \<tau>" "val(P,G,\<sigma>) = i" "\<sigma> \<in> M"
-    using elem_of_val_pair domain_trans[OF trans_M]
-    by blast
+  obtain \<sigma> q where "q \<in> G" "\<langle>\<sigma>,q\<rangle> \<in> \<tau>" "val(G,\<sigma>) = i" "\<sigma> \<in> M"
+    using elem_of_val_pair domain_trans[OF trans_M] by blast
   moreover from this \<open>x \<in> i\<close>
-  obtain \<theta> r where "r \<in> G" "\<langle>\<theta>,r\<rangle> \<in> \<sigma>" "val(P,G,\<theta>) = x" "\<theta> \<in> M"
+  obtain \<theta> r where "r \<in> G" "\<langle>\<theta>,r\<rangle> \<in> \<sigma>" "val(G,\<theta>) = x" "\<theta> \<in> M"
     using elem_of_val_pair domain_trans[OF trans_M] by blast
   moreover from calculation
   have "\<theta> \<in> domain(\<Union>(domain(\<tau>)))"
     by auto
   moreover from calculation \<open>filter(G)\<close>
   obtain p where "p \<in> G" "\<langle>p,r\<rangle> \<in> leq" "\<langle>p,q\<rangle> \<in> leq" "p \<in> P" "r \<in> P" "q \<in> P"
     using low_bound_filter filterD by blast
   moreover from this
   have "p \<in> M" "q\<in>M" "r\<in>M"
-    using P_in_M by (auto dest:transM)
+    by (auto dest:transitivity)
   moreover from calculation
   have "\<langle>\<theta>,p\<rangle> \<in> Union_name(P,leq,\<tau>)"
     unfolding Union_name_def Union_name_body_def
     by auto
   moreover from this \<open>p\<in>P\<close> \<open>p\<in>G\<close>
-  have "val(P,G,\<theta>) \<in> val(P,G,Union_name(P,leq,\<tau>))"
+  have "val(G,\<theta>) \<in> val(G,Union_name(P,leq,\<tau>))"
     using val_of_elem by simp
   ultimately
-  show "x \<in> val(P,G,Union_name(P,leq,\<tau>))"
+  show "x \<in> val(G,Union_name(P,leq,\<tau>))"
     by simp
 next
   fix x
-  assume "x \<in> (val(P,G,Union_name(P,leq,\<tau>)))"
+  assume "x \<in> (val(G,Union_name(P,leq,\<tau>)))"
   moreover
-  note \<open>filter(G)\<close> \<open>a=val(P,G,\<tau>)\<close>
+  note \<open>filter(G)\<close> \<open>a=val(G,\<tau>)\<close>
   moreover from calculation
-  obtain \<theta> p where "p \<in> G" "\<langle>\<theta>,p\<rangle> \<in> Union_name(P,leq,\<tau>)" "val(P,G,\<theta>) = x"
+  obtain \<theta> p where "p \<in> G" "\<langle>\<theta>,p\<rangle> \<in> Union_name(P,leq,\<tau>)" "val(G,\<theta>) = x"
     using elem_of_val_pair by blast
   moreover from calculation
   have "p\<in>P"
     using filterD by simp
   moreover from calculation
   obtain \<sigma> q r where "\<langle>\<sigma>,q\<rangle> \<in> \<tau>" "\<langle>\<theta>,r\<rangle> \<in> \<sigma>" "\<langle>p,r\<rangle> \<in> leq" "\<langle>p,q\<rangle> \<in> leq" "r\<in>P" "q\<in>P"
     unfolding Union_name_def Union_name_body_def
-    by force
+    by auto
   moreover from calculation
   have "r \<in> G" "q \<in> G"
     using filter_leqD by auto
   moreover from this \<open>\<langle>\<theta>,r\<rangle> \<in> \<sigma>\<close> \<open>\<langle>\<sigma>,q\<rangle>\<in>\<tau>\<close> \<open>q\<in>P\<close> \<open>r\<in>P\<close>
-  have "val(P,G,\<sigma>) \<in> val(P,G,\<tau>)" "val(P,G,\<theta>) \<in> val(P,G,\<sigma>)"
+  have "val(G,\<sigma>) \<in> val(G,\<tau>)" "val(G,\<theta>) \<in> val(G,\<sigma>)"
     using val_of_elem by simp+
-  moreover from this
-  have "val(P,G,\<theta>) \<in> \<Union> val(P,G,\<tau>)"
-    by blast
   ultimately
   show "x \<in> \<Union> a"
-    by simp
+    by blast
 qed
 
 lemma union_in_MG :
   assumes "filter(G)"
   shows "Union_ax(##M[G])"
   unfolding Union_ax_def
 proof(clarsimp)
   fix a
   assume "a \<in> M[G]"
   moreover
   note \<open>filter(G)\<close>
   moreover from calculation
   interpret mgtrans : M_trans "##M[G]"
     using transitivity_MG by (unfold_locales; auto)
   from calculation
-  obtain \<tau> where "\<tau> \<in> M" "a=val(P,G,\<tau>)"
+  obtain \<tau> where "\<tau> \<in> M" "a=val(G,\<tau>)"
     using GenExtD by blast
   moreover from this
-  have "val(P,G,Union_name(P,leq,\<tau>)) \<in> M[G]"
-    using GenExtI Union_name_closed P_in_M leq_in_M by simp
+  have "val(G,Union_name(P,leq,\<tau>)) \<in> M[G]"
+    using GenExtI Union_name_closed by simp
   ultimately
   show "\<exists>z\<in>M[G] . big_union(##M[G],a,z)"
     using Union_MG_Eq by auto
 qed
 
 theorem Union_MG : "M_generic(G) \<Longrightarrow> Union_ax(##M[G])"
   by (simp add:M_generic_def union_in_MG)
 
 end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/ZF_Trans_Interpretations.thy b/thys/Independence_CH/ZF_Trans_Interpretations.thy
--- a/thys/Independence_CH/ZF_Trans_Interpretations.thy
+++ b/thys/Independence_CH/ZF_Trans_Interpretations.thy
@@ -1,622 +1,665 @@
 section\<open>Further instances of axiom-schemes\<close>
 
 theory ZF_Trans_Interpretations
   imports
     Internal_ZFC_Axioms
-    Succession_Poset
+    Replacement_Instances
+
 begin
 
 locale M_ZF3 = M_ZF2 +
   assumes
     replacement_ax3:
     "replacement_assm(M,env,replacement_is_order_body_fm)"
     "replacement_assm(M,env,wfrec_replacement_order_pred_fm)"
     "replacement_assm(M,env,replacement_is_jump_cardinal_body_fm)"
-    "replacement_assm(M,env,replacement_is_aleph_fm)"
-    and
-    LambdaPair_in_M_replacement3:
-    "replacement_assm(M,env,LambdaPair_in_M_fm(is_inj_fm(0,1,2),0))"
 
 definition instances3_fms where "instances3_fms \<equiv>
   { replacement_is_order_body_fm,
     wfrec_replacement_order_pred_fm,
-    replacement_is_jump_cardinal_body_fm,
-    replacement_is_aleph_fm,
-    LambdaPair_in_M_fm(is_inj_fm(0,1,2),0) }"
-
-txt\<open>This set has 5 internalized formulas.\<close>
+    replacement_is_jump_cardinal_body_fm }"
 
 lemmas replacement_instances3_defs =
   replacement_is_order_body_fm_def wfrec_replacement_order_pred_fm_def
   replacement_is_jump_cardinal_body_fm_def
   replacement_is_aleph_fm_def
 
 declare (in M_ZF3) replacement_instances3_defs [simp]
 
 locale M_ZF3_trans = M_ZF2_trans + M_ZF3
 
 locale M_ZFC3 = M_ZFC2 + M_ZF3
 
 locale M_ZFC3_trans = M_ZFC2_trans + M_ZF3_trans
 
-locale M_ctm3 = M_ctm2 + M_ZF3_trans + M_ZF2_trans
+locale M_ZF3_ground = M_ZF3 + M_ZF_ground
 
-locale M_ctm3_AC = M_ctm3 + M_ctm1_AC + M_ZFC3_trans
+locale M_ZF3_ground_trans = M_ZF3_trans + M_ZF3_ground + M_ZF_ground_trans
 
-locale forcing_data3 = forcing_data2 + M_ctm3_AC
+locale M_ZFC3_ground = M_ZFC3 + M_ZF3_ground
+
+locale M_ZFC3_ground_trans = M_ZFC3_trans + M_ZF3_ground_trans
+
+locale M_ZFC3_ground_CH_trans = M_ZFC3_ground_trans + M_ZF_ground_CH_trans
+
+locale M_ctm3 = M_ctm2 + M_ZF3_ground_trans
+
+locale M_ctm3_AC = M_ctm3 + M_ctm1_AC + M_ZFC3_ground_trans
+
+locale M_ctm3_AC_CH = M_ctm3_AC + M_ZFC3_ground_CH_trans
 
 lemmas (in M_ZF2_trans) separation_instances =
   separation_well_ord
   separation_obase_equals separation_is_obase
   separation_PiP_rel separation_surjP_rel
   separation_radd_body separation_rmult_body
 
-lemma (in M_ZF3_trans) lam_replacement_inj_rel:
-  shows
-    "lam_replacement(##M, \<lambda>p. inj\<^bsup>##M\<^esup>(fst(p),snd(p)))"
-  using lam_replacement_iff_lam_closed[THEN iffD2,of "\<lambda>p. inj\<^bsup>M\<^esup>(fst(p),snd(p))"]
-    LambdaPair_in_M[where \<phi>="is_inj_fm(0,1,2)" and is_f="is_inj(##M)" and env="[]",OF
-      is_inj_fm_type _ is_inj_iff_sats[symmetric] inj_rel_iff,simplified]
-    arity_is_inj_fm[of 0 1 2] ord_simp_union transitivity fst_snd_closed
-    inj_rel_closed zero_in_M LambdaPair_in_M_replacement3
-  by simp
-
 arity_theorem for "is_transitive_fm"
 arity_theorem for "is_linear_fm"
 arity_theorem for "is_wellfounded_on_fm"
 arity_theorem for "is_well_ord_fm"
 
 arity_theorem for "pred_set_fm"
 arity_theorem for "image_fm"
 definition omap_wfrec_body where
   "omap_wfrec_body(A,r) \<equiv> (\<cdot>\<exists>\<cdot>image_fm(2, 0, 1) \<and>
                pred_set_fm
                 (succ(succ(succ(succ(succ(succ(succ(succ(succ(A))))))))), 3,
                  succ(succ(succ(succ(succ(succ(succ(succ(succ(r))))))))), 0) \<cdot>\<cdot>)"
 
 lemma type_omap_wfrec_body_fm :"A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> omap_wfrec_body(A,r)\<in>formula"
   unfolding omap_wfrec_body_def by simp
 
 lemma arity_aux : "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> arity(omap_wfrec_body(A,r)) = (9+\<^sub>\<omega>A) \<union> (9+\<^sub>\<omega>r)"
   unfolding omap_wfrec_body_def
   using arity_image_fm arity_pred_set_fm pred_Un_distrib union_abs2[of 3] union_abs1
   by (simp add:FOL_arities, auto simp add:Un_assoc[symmetric] union_abs1)
 
 lemma arity_omap_wfrec: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>
   arity(is_wfrec_fm(omap_wfrec_body(A,r),succ(succ(succ(r))), 1, 0)) =
   (4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)"
   using Arities.arity_is_wfrec_fm[OF _ _ _ _ _ arity_aux,of A r "3+\<^sub>\<omega>r" 1 0] pred_Un_distrib
     union_abs1 union_abs2 type_omap_wfrec_body_fm
   by auto
 
 lemma arity_isordermap: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
    arity(is_ordermap_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
   unfolding is_ordermap_fm_def
   using arity_lambda_fm[where i="(4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)",OF _ _ _ _ arity_omap_wfrec,
       unfolded omap_wfrec_body_def] pred_Un_distrib union_abs1
   by auto
 
 lemma arity_is_ordertype: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
    arity(is_ordertype_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
   unfolding is_ordertype_fm_def
   using arity_isordermap arity_image_fm pred_Un_distrib FOL_arities
   by auto
 
 arity_theorem for "is_order_body_fm"
 
 lemma arity_is_order_body: "arity(is_order_body_fm(2,0,1)) = 3"
   using arity_is_order_body_fm arity_is_ordertype ord_simp_union
   by (simp add:FOL_arities)
 
 lemma (in M_ZF3_trans) replacement_is_order_body:
   "X\<in>M \<Longrightarrow> strong_replacement(##M, is_order_body(##M,X))"
   apply(rule_tac strong_replacement_cong[
         where P="\<lambda> x f. M,[x,f,X] \<Turnstile> is_order_body_fm(2,0,1)",THEN iffD1])
    apply(rule_tac is_order_body_iff_sats[where env="[_,_,X]",symmetric])
           apply(simp_all add:zero_in_M)
   apply(rule_tac replacement_ax3(1)[unfolded replacement_assm_def, rule_format, where env="[X]",simplified])
     apply(simp_all add: arity_is_order_body )
   done
 
-lemma (in M_pre_cardinal_arith) is_order_body_abs :
-  "M(X) \<Longrightarrow> M(x) \<Longrightarrow> M(z) \<Longrightarrow> is_order_body(M, X, x, z) \<longleftrightarrow>
-   M(z) \<and> M(x) \<and> x\<in>Pow_rel(M,X\<times>X) \<and> well_ord(X, x) \<and> z = ordertype(X, x)"
-  using well_ord_abs is_well_ord_iff_wellordered is_ordertype_iff' ordertype_rel_abs
-    well_ord_is_linear subset_abs Pow_rel_char
-  unfolding is_order_body_def
-  by simp
-
-
 definition H_order_pred where
   "H_order_pred(A,r) \<equiv>  \<lambda>x f . f `` Order.pred(A, x, r)"
 
 relationalize "H_order_pred" "is_H_order_pred"
 
 lemma (in M_basic) H_order_pred_abs :
   "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(x) \<Longrightarrow> M(f) \<Longrightarrow> M(z) \<Longrightarrow>
     is_H_order_pred(M,A,r,x,f,z) \<longleftrightarrow> z = H_order_pred(A,r,x,f)"
   unfolding is_H_order_pred_def H_order_pred_def
   by simp
 
 synthesize "is_H_order_pred" from_definition assuming "nonempty"
 
 lemma (in M_ZF3_trans) wfrec_replacement_order_pred:
   "A\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> wfrec_replacement(##M, \<lambda>x g z. is_H_order_pred(##M,A,r,x,g,z) , r)"
   unfolding wfrec_replacement_def is_wfrec_def M_is_recfun_def is_H_order_pred_def
   apply(rule_tac strong_replacement_cong[
         where P="\<lambda> x f. M,[x,f,r,A] \<Turnstile> order_pred_wfrec_body_fm(3,2,1,0)",THEN iffD1])
    apply(subst order_pred_wfrec_body_def[symmetric])
    apply(rule_tac order_pred_wfrec_body_iff_sats[where env="[_,_,r,A]",symmetric])
            apply(simp_all add:zero_in_M)
   apply(rule_tac replacement_ax3(2)[unfolded replacement_assm_def, rule_format, where env="[r,A]",simplified])
     apply(simp_all add: arity_order_pred_wfrec_body_fm ord_simp_union)
   done
 
 lemma (in M_ZF3_trans) wfrec_replacement_order_pred':
   "A\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> wfrec_replacement(##M, \<lambda>x g z. z = H_order_pred(A,r,x,g) , r)"
   using wfrec_replacement_cong[OF H_order_pred_abs[of A r,rule_format] refl,THEN iffD1,
       OF _ _ _ _ _ wfrec_replacement_order_pred[of A r]]
   by simp
 
 sublocale M_ZF3_trans \<subseteq> M_pre_cardinal_arith "##M"
   using separation_instances wfrec_replacement_order_pred'[unfolded H_order_pred_def]
     replacement_is_order_eq_map[unfolded order_eq_map_def] banach_replacement
   by unfold_locales simp_all
 
-lemma (in M_ZF3_trans) replacement_ordertype:
-  "X\<in>M \<Longrightarrow> strong_replacement(##M, \<lambda>x z. z \<in> M \<and> x \<in> M \<and> x \<in> Pow\<^bsup>M\<^esup>(X \<times> X) \<and> well_ord(X, x) \<and> z = ordertype(X, x))"
-  using strong_replacement_cong[THEN iffD1,OF _ replacement_is_order_body,simplified] is_order_body_abs
-  unfolding is_order_body_def
-  by simp
-
-lemma arity_is_jump_cardinal_body: "arity(is_jump_cardinal_body'_fm(0,1)) = 2"
-  unfolding is_jump_cardinal_body'_fm_def
+lemma arity_is_jump_cardinal_body: "arity(is_jump_cardinal_body_rel_fm(0,2,3)) = 4"
+  unfolding is_jump_cardinal_body_rel_fm_def
   using arity_is_ordertype arity_is_well_ord_fm arity_is_Pow_fm arity_cartprod_fm
     arity_Replace_fm[where i=5] ord_simp_union FOL_arities
   by simp
 
+lemma arity_is_jump_cardinal_body': "arity(is_jump_cardinal_body'_rel_fm(0,1)) = 2"
+  unfolding is_jump_cardinal_body'_rel_fm_def
+  using arity_is_jump_cardinal_body arity_is_Pow_fm arity_cartprod_fm
+     ord_simp_union FOL_arities
+  by simp
+
 lemma (in M_ZF3_trans) replacement_is_jump_cardinal_body:
-  "strong_replacement(##M, is_jump_cardinal_body'(##M))"
+  "strong_replacement(##M, is_jump_cardinal_body'_rel(##M))"
   apply(rule_tac strong_replacement_cong[
-        where P="\<lambda> x f. M,[x,f] \<Turnstile> is_jump_cardinal_body'_fm(0,1)",THEN iffD1])
-   apply(rule_tac is_jump_cardinal_body'_iff_sats[where env="[_,_]",symmetric])
+        where P="\<lambda> x f. M,[x,f] \<Turnstile> is_jump_cardinal_body'_rel_fm(0,1)",THEN iffD1])
+   apply(rule_tac is_jump_cardinal_body'_rel_iff_sats[where env="[_,_]",symmetric])
         apply(simp_all add:zero_in_M)
   apply(rule_tac replacement_ax3(3)[unfolded replacement_assm_def, rule_format, where env="[]",simplified])
-   apply(simp_all add: arity_is_jump_cardinal_body )
+   apply(simp_all add: arity_is_jump_cardinal_body' )
   done
 
 lemma (in M_pre_cardinal_arith) univalent_aux2: "M(X) \<Longrightarrow> univalent(M,Pow_rel(M,X\<times>X),
   \<lambda>r z. M(z) \<and> M(r) \<and> is_well_ord(M, X, r) \<and> is_ordertype(M, X, r, z))"
   using is_well_ord_iff_wellordered
     is_ordertype_iff[of _ X]
     trans_on_subset[OF well_ord_is_trans_on]
     well_ord_is_wf[THEN wf_on_subset_A] mem_Pow_rel_abs
   unfolding univalent_def
   by (simp)
 
 lemma (in M_pre_cardinal_arith) is_jump_cardinal_body_abs :
-  "M(X) \<Longrightarrow> M(c) \<Longrightarrow> is_jump_cardinal_body'(M, X, c) \<longleftrightarrow> c = jump_cardinal_body'_rel(M,X)"
+  "M(X) \<Longrightarrow> M(c) \<Longrightarrow> is_jump_cardinal_body'_rel(M, X, c) \<longleftrightarrow> c = jump_cardinal_body'_rel(M,X)"
   using well_ord_abs is_well_ord_iff_wellordered is_ordertype_iff' ordertype_rel_abs
-    well_ord_is_linear subset_abs Pow_rel_iff Replace_abs[of "Pow_rel(M,X\<times>X)",OF _ _
-      univalent_aux2]
-  unfolding is_jump_cardinal_body'_def jump_cardinal_body'_rel_def
+    well_ord_is_linear subset_abs Pow_rel_iff
+    Replace_abs[of "Pow_rel(M,X\<times>X)",OF _ _univalent_aux2,simplified]
+  unfolding is_jump_cardinal_body'_rel_def jump_cardinal_body'_rel_def
+    is_jump_cardinal_body_rel_def  jump_cardinal_body_rel_def
   by simp
 
 lemma (in M_ZF3_trans) replacement_jump_cardinal_body:
-  "strong_replacement(##M, \<lambda>x z. z \<in> M \<and> x \<in> M \<and> z = jump_cardinal_body(##M, x))"
+  "strong_replacement(##M, \<lambda>x z.  z = jump_cardinal_body'_rel(##M,x))"
   using strong_replacement_cong[THEN iffD1,OF _ replacement_is_jump_cardinal_body,simplified]
-    jump_cardinal_body_eq is_jump_cardinal_body_abs
+     is_jump_cardinal_body_abs
   by simp
 
 sublocale M_ZF3_trans \<subseteq> M_pre_aleph "##M"
-  using replacement_ordertype replacement_jump_cardinal_body HAleph_wfrec_repl
+  using  replacement_jump_cardinal_body[unfolded jump_cardinal_body'_rel_def]
+    HAleph_wfrec_repl replacement_is_order_body[unfolded is_order_body_def]
   by unfold_locales (simp_all add: transrec_replacement_def
       wfrec_replacement_def is_wfrec_def M_is_recfun_def flip:setclass_iff)
 
 arity_theorem intermediate for "is_HAleph_fm"
 lemma arity_is_HAleph_fm: "arity(is_HAleph_fm(2, 1, 0)) = 3"
   using arity_fun_apply_fm[of "11" 0 1,simplified]
     arity_is_HAleph_fm' arity_ordinal_fm arity_is_If_fm
     arity_empty_fm arity_is_Limit_fm
     arity_is_If_fm
     arity_is_Limit_fm arity_empty_fm
     arity_Replace_fm[where i="12" and v=10 and n=3]
     pred_Un_distrib ord_simp_union
   by (simp add:FOL_arities)
 
-lemma arity_is_Aleph: "arity(is_Aleph_fm(0, 1)) = 2"
+lemma arity_is_Aleph[arity]: "arity(is_Aleph_fm(0, 1)) = 2"
   unfolding is_Aleph_fm_def
   using arity_transrec_fm[OF _ _ _ _ arity_is_HAleph_fm] ord_simp_union
   by simp
 
-lemma (in M_ZF3_trans) replacement_is_aleph:
-  "strong_replacement(##M, \<lambda>x y. Ord(x) \<and> is_Aleph(##M,x,y))"
-  apply(rule_tac strong_replacement_cong[
-        where P="\<lambda> x y. M,[x,y] \<Turnstile> And(ordinal_fm(0),is_Aleph_fm(0,1))",THEN iffD1])
-   apply (auto simp add: ordinal_iff_sats[where env="[_,_]",symmetric])
-    apply(rule_tac is_Aleph_iff_sats[where env="[_,_]",THEN iffD2],simp_all add:zero_in_M)
-   apply(rule_tac is_Aleph_iff_sats[where env="[_,_]",THEN iffD1],simp_all add:zero_in_M)
-  apply(rule_tac replacement_ax3(4)[unfolded replacement_assm_def, rule_format, where env="[]",simplified])
-   apply(simp_all add:arity_is_Aleph FOL_arities arity_ordinal_fm ord_simp_union is_Aleph_fm_type)
-  done
+definition bex_Aleph_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
+  "bex_Aleph_rel(M,x) \<equiv> \<lambda>y. \<exists>z\<in>x. y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
 
-lemma (in M_ZF3_trans) replacement_aleph_rel:
-  shows  "strong_replacement(##M, \<lambda>x y. Ord(x) \<and> y = \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)"
-  using strong_replacement_cong[THEN iffD2,OF _ replacement_is_aleph,where P1="\<lambda>x y . Ord(x) \<and> y=Aleph_rel(##M,x)"]
-    is_Aleph_iff
-  by auto
+relationalize "bex_Aleph_rel" "is_bex_Aleph"
+
+schematic_goal sats_is_bex_Aleph_fm_auto:
+  "a \<in> nat \<Longrightarrow> c \<in> nat \<Longrightarrow> env \<in> list(A) \<Longrightarrow>
+  a < length(env) \<Longrightarrow> c < length(env) \<Longrightarrow> 0 \<in> A \<Longrightarrow>
+  is_bex_Aleph(##A, nth(a, env), nth(c, env)) \<longleftrightarrow> A, env \<Turnstile> ?fm(a, c)"
+  unfolding is_bex_Aleph_def
+  by (rule iff_sats | simp)+
+
+synthesize_notc "is_bex_Aleph" from_schematic
+
+lemma is_bex_Aleph_fm_type [TC]:
+    "x \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> is_bex_Aleph_fm(x, z) \<in> formula"
+  unfolding is_bex_Aleph_fm_def by simp
+
+lemma sats_is_bex_Aleph_fm:
+    "x \<in> \<omega> \<Longrightarrow>
+    z \<in> \<omega> \<Longrightarrow> x < length(env) \<Longrightarrow> z < length(env) \<Longrightarrow>
+    env \<in> list(Aa) \<Longrightarrow>
+    0 \<in> Aa \<Longrightarrow>
+    (Aa, env \<Turnstile> is_bex_Aleph_fm(x, z)) \<longleftrightarrow>
+    is_bex_Aleph(##Aa,nth(x, env), nth(z, env))"
+  using sats_is_bex_Aleph_fm_auto unfolding is_bex_Aleph_def is_bex_Aleph_fm_def
+  by simp
+
+lemma is_bex_Aleph_iff_sats [iff_sats]:
+    "nth(x, env) = xa \<Longrightarrow>
+    nth(z, env) = za \<Longrightarrow>
+    x \<in> \<omega> \<Longrightarrow>
+    z \<in> \<omega> \<Longrightarrow> x < length(env) \<Longrightarrow> z < length(env) \<Longrightarrow>
+    env \<in> list(Aa) \<Longrightarrow>
+    0 \<in> Aa \<Longrightarrow>
+    is_bex_Aleph(##Aa, xa, za) \<longleftrightarrow>
+    Aa, env \<Turnstile> is_bex_Aleph_fm(x, z)"
+  using sats_is_bex_Aleph_fm by simp
+
+arity_theorem for "is_bex_Aleph_fm"
+
+lemma (in M_ZF1_trans) separation_is_bex_Aleph:
+  assumes "(##M)(A)"
+  shows "separation(##M,is_bex_Aleph(##M, A))"
+  using assms separation_in_ctm[where env="[A]" and \<phi>="is_bex_Aleph_fm(1,0)",
+      OF _ _ _ is_bex_Aleph_iff_sats[symmetric],
+      of "\<lambda>_.A"]
+    nonempty arity_is_bex_Aleph_fm is_bex_Aleph_fm_type
+  by (simp add:ord_simp_union)
+
+lemma (in M_pre_aleph) bex_Aleph_rel_abs:
+  assumes "Ord(u)" "M(u)" "M(v)"
+  shows "is_bex_Aleph(M, u, v) \<longleftrightarrow> bex_Aleph_rel(M,u,v)"
+  unfolding is_bex_Aleph_def bex_Aleph_rel_def
+  using assms is_Aleph_iff transM[of _ u] Ord_in_Ord
+  by simp
+
+lemma (in M_ZF3_trans) separation_bex_Aleph_rel:
+  "Ord(x) \<Longrightarrow> (##M)(x) \<Longrightarrow> separation(##M, bex_Aleph_rel(##M,x))"
+  using separation_is_bex_Aleph bex_Aleph_rel_abs
+    separation_cong[where P="is_bex_Aleph(##M,x)" and M="##M",THEN iffD1]
+  unfolding bex_Aleph_rel_def
+  by simp
 
 sublocale M_ZF3_trans \<subseteq> M_aleph "##M"
-  by (unfold_locales,simp add: replacement_aleph_rel)
+  using separation_bex_Aleph_rel[unfolded bex_Aleph_rel_def]
+  by unfold_locales
 
 sublocale M_ZF2_trans \<subseteq> M_FiniteFun "##M"
-  using separation_cons_like_rel separation_is_function
+  using separation_is_function separation_omfunspace
   by unfold_locales simp
 
 sublocale M_ZFC1_trans \<subseteq> M_AC "##M"
   using choice_ax by (unfold_locales, simp_all)
 
-sublocale M_ZFC3_trans \<subseteq> M_cardinal_AC "##M" ..
+sublocale M_ZFC3_trans \<subseteq> M_cardinal_AC "##M"
+  using lam_replacement_minimum
+  by unfold_locales simp
 
 (* TopLevel *)
 
 lemma (in M_ZF2_trans) separation_cardinal_rel_lesspoll_rel:
   "(##M)(\<kappa>) \<Longrightarrow> separation(##M, \<lambda>x. x \<prec>\<^bsup>M\<^esup> \<kappa>)"
   using separation_in_ctm[where \<phi>="( \<cdot>0 \<prec> 1\<cdot> )" and env="[\<kappa>]"]
     is_lesspoll_iff nonempty
     arity_is_cardinal_fm arity_is_lesspoll_fm arity_is_bij_fm ord_simp_union
   by (simp add:FOL_arities)
 
 sublocale M_ZFC3_trans \<subseteq> M_library "##M"
-  using separation_cardinal_rel_lesspoll_rel
+  using separation_cardinal_rel_lesspoll_rel lam_replacement_minimum
   by unfold_locales simp_all
 
 locale M_ZF4 = M_ZF3 +
   assumes
     ground_replacements4:
     "ground_replacement_assm(M,env,replacement_is_order_body_fm)"
     "ground_replacement_assm(M,env,wfrec_replacement_order_pred_fm)"
     "ground_replacement_assm(M,env,replacement_is_jump_cardinal_body_fm)"
-    "ground_replacement_assm(M,env,replacement_is_aleph_fm)"
-    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(is_inj_fm(0,1,2),0))"
-    "ground_replacement_assm(M,env,wfrec_Hfrc_at_fm)"
     "ground_replacement_assm(M,env,list_repl1_intf_fm)"
     "ground_replacement_assm(M,env,list_repl2_intf_fm)"
     "ground_replacement_assm(M,env,formula_repl2_intf_fm)"
     "ground_replacement_assm(M,env,eclose_repl2_intf_fm)"
-    "ground_replacement_assm(M,env,powapply_repl_fm)"
-    "ground_replacement_assm(M,env,phrank_repl_fm)"
     "ground_replacement_assm(M,env,wfrec_rank_fm)"
     "ground_replacement_assm(M,env,trans_repl_HVFrom_fm)"
-    "ground_replacement_assm(M,env,wfrec_Hcheck_fm)"
-    "ground_replacement_assm(M,env,repl_PHcheck_fm)"
-    "ground_replacement_assm(M,env,check_replacement_fm)"
-    "ground_replacement_assm(M,env,G_dot_in_M_fm)"
-    "ground_replacement_assm(M,env,repl_opname_check_fm)"
     "ground_replacement_assm(M,env,tl_repl_intf_fm)"
     "ground_replacement_assm(M,env,formula_repl1_intf_fm)"
     "ground_replacement_assm(M,env,eclose_repl1_intf_fm)"
-    "ground_replacement_assm(M,env,replacement_is_omega_funspace_fm)"
     "ground_replacement_assm(M,env,replacement_HAleph_wfrec_repl_body_fm)"
-    "ground_replacement_assm(M,env,replacement_is_fst2_snd2_fm)"
-    "ground_replacement_assm(M,env,replacement_is_sndfst_fst2_snd2_fm)"
     "ground_replacement_assm(M,env,replacement_is_order_eq_map_fm)"
-    "ground_replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
-    "ground_replacement_assm(M,env,banach_replacement_iterates_fm)"
-    "ground_replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
     "ground_replacement_assm(M,env,banach_iterates_fm)"
-    "ground_replacement_assm(M,env,dcwit_repl_body_fm(6,5,4,3,2,0,1))"
-    "ground_replacement_assm(M,env,Lambda_in_M_fm(fst_fm(0,1),0))"
-    "ground_replacement_assm(M,env,Lambda_in_M_fm(big_union_fm(0,1),0))"
-    "ground_replacement_assm(M,env,Lambda_in_M_fm(is_cardinal_fm(0,1),0))"
-    "ground_replacement_assm(M,env,Lambda_in_M_fm(snd_fm(0,1),0))"
-    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(image_fm(0,1,2),0))"
-    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(setdiff_fm(0,1,2),0))"
-    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(minimum_fm(0,1,2),0))"
-    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(upair_fm(0,1,2),0))"
-    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0))"
-    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(composition_fm(0,1,2),0))"
-    "ground_replacement_assm(M,env,Lambda_in_M_fm(is_converse_fm(0,1),0))"
-    "ground_replacement_assm(M,env,Lambda_in_M_fm(domain_fm(0,1),0))"
 
 definition instances4_fms where "instances4_fms \<equiv>
   { ground_repl_fm(replacement_is_order_body_fm),
     ground_repl_fm(wfrec_replacement_order_pred_fm),
     ground_repl_fm(replacement_is_jump_cardinal_body_fm),
-    ground_repl_fm(replacement_is_aleph_fm),
-    ground_repl_fm(LambdaPair_in_M_fm(is_inj_fm(0,1,2),0)),
-    ground_repl_fm(wfrec_Hfrc_at_fm),
     ground_repl_fm(list_repl1_intf_fm),
     ground_repl_fm(list_repl2_intf_fm),
     ground_repl_fm(formula_repl2_intf_fm),
     ground_repl_fm(eclose_repl2_intf_fm),
-    ground_repl_fm(powapply_repl_fm),
-    ground_repl_fm(phrank_repl_fm),
     ground_repl_fm(wfrec_rank_fm),
     ground_repl_fm(trans_repl_HVFrom_fm),
-    ground_repl_fm(wfrec_Hcheck_fm),
-    ground_repl_fm(repl_PHcheck_fm),
-    ground_repl_fm(check_replacement_fm),
-    ground_repl_fm(G_dot_in_M_fm),
-    ground_repl_fm(repl_opname_check_fm),
     ground_repl_fm(tl_repl_intf_fm),
     ground_repl_fm(formula_repl1_intf_fm),
     ground_repl_fm(eclose_repl1_intf_fm),
-    ground_repl_fm(replacement_is_omega_funspace_fm),
     ground_repl_fm(replacement_HAleph_wfrec_repl_body_fm),
-    ground_repl_fm(replacement_is_fst2_snd2_fm),
-    ground_repl_fm(replacement_is_sndfst_fst2_snd2_fm),
     ground_repl_fm(replacement_is_order_eq_map_fm),
-    ground_repl_fm(replacement_transrec_apply_image_body_fm),
-    ground_repl_fm(banach_replacement_iterates_fm),
-    ground_repl_fm(replacement_is_trans_apply_image_fm),
-    ground_repl_fm(banach_iterates_fm),
-    ground_repl_fm(dcwit_repl_body_fm(6,5,4,3,2,0,1)),
-    ground_repl_fm(Lambda_in_M_fm(fst_fm(0,1),0)),
-    ground_repl_fm(Lambda_in_M_fm(big_union_fm(0,1),0)),
-    ground_repl_fm(Lambda_in_M_fm(is_cardinal_fm(0,1),0)),
-    ground_repl_fm(Lambda_in_M_fm(snd_fm(0,1),0)),
-    ground_repl_fm(LambdaPair_in_M_fm(image_fm(0,1,2),0)),
-    ground_repl_fm(LambdaPair_in_M_fm(setdiff_fm(0,1,2),0)),
-    ground_repl_fm(LambdaPair_in_M_fm(minimum_fm(0,1,2),0)),
-    ground_repl_fm(LambdaPair_in_M_fm(upair_fm(0,1,2),0)),
-    ground_repl_fm(LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0)),
-    ground_repl_fm(LambdaPair_in_M_fm(composition_fm(0,1,2),0)),
-    ground_repl_fm(Lambda_in_M_fm(is_converse_fm(0,1),0)),
-    ground_repl_fm(Lambda_in_M_fm(domain_fm(0,1),0)) }"
+    ground_repl_fm(banach_iterates_fm) }"
 
-txt\<open>This set has 44 internalized formulas, corresponding to the total count
-of previous replacement instances.\<close>
+text\<open>This set has 15 internalized formulas, corresponding to the total
+count of previous replacement instances (apart from those 5 in
+\<^term>\<open>instances_ground_fms\<close>, and \<^term>\<open>replacement_dcwit_repl_body_fm\<close>).\<close>
 
 definition overhead where
-  "overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances3_fms \<union> instances4_fms"
+  "overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances3_fms \<union>
+     instances4_fms \<union> instances_ground_fms"
 
-txt\<open>Hence, the “overhead” to force $\CH$ and its negation consists
-of 88 replacement instances.\<close>
+definition overhead_CH where
+  "overhead_CH \<equiv> overhead \<union> { replacement_dcwit_repl_body_fm }"
+
+text\<open>Hence, the “overhead” to force $\neg\CH$ consists
+of 35 replacement instances, and one further instance is needed to
+force $\CH$.\<close>
 
 lemma instances3_fms_type[TC] : "instances3_fms \<subseteq> formula"
   unfolding instances3_fms_def replacement_is_order_body_fm_def
     wfrec_replacement_order_pred_fm_def replacement_is_jump_cardinal_body_fm_def
     replacement_is_aleph_fm_def
-  by (auto simp del: Lambda_in_M_fm_def
-      ccc_fun_closed_lemma_aux2_fm_def ccc_fun_closed_lemma_fm_def)
+  by (auto simp del: Lambda_in_M_fm_def)
 
 lemma overhead_type: "overhead \<subseteq> formula"
-  using instances1_fms_type instances2_fms_type
+  using instances1_fms_type instances2_fms_type instances_ground_fms_type
   unfolding overhead_def instances3_fms_def instances4_fms_def
     replacement_instances1_defs replacement_instances2_defs replacement_instances3_defs
+    replacement_instances_ground_defs
   using ground_repl_fm_type Lambda_in_M_fm_type
-  by (auto simp del: Lambda_in_M_fm_def
-      ccc_fun_closed_lemma_aux2_fm_def ccc_fun_closed_lemma_fm_def)
+  by (auto simp del: Lambda_in_M_fm_def)
+
+lemma overhead_CH_type: "overhead_CH \<subseteq> formula"
+  using overhead_type unfolding overhead_CH_def replacement_dcwit_repl_body_fm_def
+  by auto
 
 locale M_ZF4_trans = M_ZF3_trans + M_ZF4
 
 locale M_ZFC4 = M_ZFC3 + M_ZF4
 
 locale M_ZFC4_trans = M_ZFC3_trans + M_ZF4_trans
 
 locale M_ctm4 = M_ctm3 + M_ZF4_trans
 
 locale M_ctm4_AC = M_ctm4 + M_ctm1_AC + M_ZFC4_trans
 
-locale forcing_data4 = forcing_data3 + M_ctm4_AC
-
 lemma M_satT_imp_M_ZF2: "(M \<Turnstile> ZF) \<Longrightarrow> M_ZF2(M)"
 proof -
   assume "M \<Turnstile> ZF"
   then
   have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
     "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
     unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
     using ZFC_fm_sats[of M] by simp_all
   {
     fix \<phi> env
     assume "\<phi> \<in> formula" "env\<in>list(M)"
     moreover from \<open>M \<Turnstile> ZF\<close>
     have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
       "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
       unfolding ZF_def ZF_schemes_def by auto
     moreover from calculation
     have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
       "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
       using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
   }
   with fin
   show "M_ZF2(M)"
     by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
 qed
 
 lemma M_satT_imp_M_ZFC2:
   shows "(M \<Turnstile> ZFC) \<longrightarrow> M_ZFC2(M)"
 proof -
   have "(M \<Turnstile> ZF) \<and> choice_ax(##M) \<longrightarrow> M_ZFC2(M)"
-    using M_satT_imp_M_ZF2[of M] unfolding M_ZF2_def M_ZFC1_def M_ZFC2_def
-      M_ZC_basic_def M_ZF1_def M_AC_def by auto
+    using M_satT_imp_M_ZF2[of M]
+    unfolding M_ZF2_def M_ZFC1_def M_ZFC2_def M_ZC_basic_def M_ZF1_def M_AC_def
+    by auto
   then
   show ?thesis
     unfolding ZFC_def by auto
 qed
 
 lemma M_satT_instances12_imp_M_ZF2:
   assumes "(M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms})"
   shows "M_ZF2(M)"
 proof -
   from assms
   have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
     "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
     unfolding ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
     using ZFC_fm_sats[of M] by simp_all
   moreover
   {
     fix \<phi> env
     from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
     have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
       unfolding Zermelo_fms_def ZF_def instances1_fms_def
         instances2_fms_def by auto
     moreover
     assume "\<phi> \<in> formula" "env\<in>list(M)"
     ultimately
     have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
       using sats_ZF_separation_fm_iff by simp_all
   }
   moreover
   {
     fix \<phi> env
     assume "\<phi> \<in> instances1_fms \<union> instances2_fms" "env\<in>list(M)"
     moreover from this and \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
     have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
     ultimately
     have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
       using sats_ZF_replacement_fm_iff[of \<phi>] instances1_fms_type instances2_fms_type by auto
   }
   ultimately
   show ?thesis
     unfolding instances1_fms_def instances2_fms_def
     by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
 qed
 
+theorem M_satT_imp_M_ZF_ground_trans:
+  assumes "Transset(M)" "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms \<union> instances_ground_fms}"
+  shows "M_ZF_ground_trans(M)"
+proof -
+  from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> _\<close>
+  have "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}"
+       "M \<Turnstile> {\<cdot>Replacement(p)\<cdot> . p \<in> instances_ground_fms }"
+    by auto
+  then
+  interpret M_ZF2 M
+    using M_satT_instances12_imp_M_ZF2
+    by simp
+  from \<open>Transset(M)\<close>
+  interpret M_ZF1_trans M
+    using M_satT_imp_M_ZF2
+    by unfold_locales
+  {
+    fix \<phi> env
+    assume "\<phi> \<in> instances_ground_fms" "env\<in>list(M)"
+    moreover from this and \<open>M \<Turnstile> {\<cdot>Replacement(p)\<cdot> . p \<in> instances_ground_fms}\<close>
+    have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
+    ultimately
+    have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
+      using sats_ZF_replacement_fm_iff[of \<phi>] instances_ground_fms_type by auto
+  }
+  then
+  show ?thesis
+    unfolding instances_ground_fms_def
+    by unfold_locales (simp_all add:replacement_assm_def)
+qed
+
+theorem M_satT_imp_M_ZF_ground_CH_trans:
+  assumes
+    "Transset(M)"
+    "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms
+          \<union> instances_ground_fms \<union> {replacement_dcwit_repl_body_fm}}"
+  shows "M_ZF_ground_CH_trans(M)"
+proof -
+  from assms
+  interpret M_ZF_ground_trans M
+    using M_satT_imp_M_ZF_ground_trans by auto
+  {
+    fix env
+    assume "env \<in> list(M)"
+    moreover from assms
+    have "M, [] \<Turnstile> \<cdot>Replacement(replacement_dcwit_repl_body_fm)\<cdot>" by auto
+    ultimately
+    have "arity(replacement_dcwit_repl_body_fm) \<le> succ(succ(length(env)))
+      \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,replacement_dcwit_repl_body_fm,Cons(x,Cons(y, env))))"
+      using sats_ZF_replacement_fm_iff[of replacement_dcwit_repl_body_fm]
+      by (auto simp:replacement_dcwit_repl_body_fm_def)
+  }
+  then
+  show ?thesis
+    by unfold_locales (simp_all add:replacement_assm_def)
+qed
+
 lemma (in M_Z_basic) M_satT_Zermelo_fms: "M \<Turnstile> \<cdot>Z\<cdot>"
   using upair_ax Union_ax power_ax extensionality foundation_ax
     infinity_ax separation_ax sats_ZF_separation_fm_iff
   unfolding Zermelo_fms_def ZF_fin_def
   by auto
 
 lemma (in M_ZFC1) M_satT_ZC: "M \<Turnstile> ZC"
   using upair_ax Union_ax power_ax extensionality foundation_ax
     infinity_ax separation_ax sats_ZF_separation_fm_iff choice_ax
   unfolding ZC_def Zermelo_fms_def ZF_fin_def
   by auto
 
 locale M_ZF = M_Z_basic +
   assumes
     replacement_ax:"replacement_assm(M,env,\<phi>)"
 
 lemma M_satT_imp_M_ZF: " M \<Turnstile> ZF \<Longrightarrow> M_ZF(M)"
 proof -
   assume "M \<Turnstile> ZF"
   then
   have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
     "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
     unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
     using ZFC_fm_sats[of M] by simp_all
   {
     fix \<phi> env
     assume "\<phi> \<in> formula" "env\<in>list(M)"
     moreover from \<open>M \<Turnstile> ZF\<close>
     have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
       "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
       unfolding ZF_def ZF_schemes_def by auto
     moreover from calculation
     have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
       "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
       using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
   }
   with fin
   show "M_ZF(M)"
     unfolding M_ZF_def M_Z_basic_def M_ZF_axioms_def replacement_assm_def by simp
 qed
 
 lemma (in M_ZF) M_satT_ZF: "M \<Turnstile> ZF"
   using upair_ax Union_ax power_ax extensionality foundation_ax
     infinity_ax separation_ax sats_ZF_separation_fm_iff
     replacement_ax sats_ZF_replacement_fm_iff
   unfolding ZF_def ZF_schemes_def ZF_fin_def replacement_assm_def
   by auto
 
 lemma M_ZF_iff_M_satT: "M_ZF(M) \<longleftrightarrow> (M \<Turnstile> ZF)"
   using M_ZF.M_satT_ZF M_satT_imp_M_ZF
   by auto
 
 locale M_ZFC = M_ZF + M_ZC_basic
 
 lemma M_ZFC_iff_M_satT:
   notes iff_trans[trans]
   shows "M_ZFC(M) \<longleftrightarrow> (M \<Turnstile> ZFC)"
 proof -
   have "M_ZFC(M) \<longleftrightarrow> (M \<Turnstile> ZF) \<and> choice_ax(##M)"
     using M_ZF_iff_M_satT
     unfolding M_ZFC_def M_ZC_basic_def M_AC_def M_ZF_def by auto
   also
   have " \<dots> \<longleftrightarrow> M \<Turnstile> ZFC"
     unfolding ZFC_def by auto
   ultimately
   show ?thesis by simp
 qed
 
 lemma M_satT_imp_M_ZF4: "(M \<Turnstile> ZF) \<longrightarrow> M_ZF4(M)"
 proof
   assume "M \<Turnstile> ZF"
   then
   have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
     "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
     unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
     using ZFC_fm_sats[of M] by simp_all
   {
     fix \<phi> env
     assume "\<phi> \<in> formula" "env\<in>list(M)"
     moreover from \<open>M \<Turnstile> ZF\<close>
     have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
       "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
       unfolding ZF_def ZF_schemes_def by auto
     moreover from calculation
     have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
       "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
       using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
   }
   with fin
   show "M_ZF4(M)"
     by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
 qed
 
 lemma M_satT_imp_M_ZFC4:
   shows "(M \<Turnstile> ZFC) \<longrightarrow> M_ZFC4(M)"
 proof -
   have "(M \<Turnstile> ZF) \<and> choice_ax(##M) \<longrightarrow> M_ZFC4(M)"
     using M_satT_imp_M_ZF4[of M] unfolding M_ZF4_def M_ZFC1_def M_ZFC4_def
       M_ZF3_def M_ZFC3_def M_ZF2_def M_ZFC2_def
       M_ZC_basic_def M_ZF1_def M_AC_def by auto
   then
   show ?thesis
     unfolding ZFC_def by auto
 qed
 
 lemma M_satT_overhead_imp_M_ZF4:
   "(M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}) \<longrightarrow> M_ZFC4(M)"
 proof
   assume "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
   then
   have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)" "choice_ax(##M)"
     "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
     unfolding ZC_def ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
     using ZFC_fm_sats[of M] by simp_all
   moreover
   {
     fix \<phi> env
     from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
     have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
       unfolding ZC_def Zermelo_fms_def ZF_def overhead_def instances1_fms_def
         instances2_fms_def instances3_fms_def instances4_fms_def by auto
     moreover
     assume "\<phi> \<in> formula" "env\<in>list(M)"
     ultimately
     have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
       using sats_ZF_separation_fm_iff by simp_all
   }
   moreover
   {
     fix \<phi> env
     assume "\<phi> \<in> overhead" "env\<in>list(M)"
     moreover from this and \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
     have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
     ultimately
     have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
       using sats_ZF_replacement_fm_iff[of \<phi>] overhead_type by auto
   }
   ultimately
   show "M_ZFC4(M)"
     unfolding overhead_def instances1_fms_def
       instances2_fms_def instances3_fms_def instances4_fms_def
     by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Aleph_Relative.thy b/thys/Transitive_Models/Aleph_Relative.thy
--- a/thys/Transitive_Models/Aleph_Relative.thy
+++ b/thys/Transitive_Models/Aleph_Relative.thy
@@ -1,449 +1,464 @@
 theory Aleph_Relative
   imports
     CardinalArith_Relative
 begin
 
 definition
   HAleph :: "[i,i] \<Rightarrow> i" where
   "HAleph(i,r) \<equiv> if(\<not>(Ord(i)),i,if(i=0, nat, if(\<not>Limit(i) \<and> i\<noteq>0,
                             csucc(r`( \<Union> i )),
                                    \<Union>j\<in>i. r`j)))"
 
 reldb_add functional "Limit" "Limit"
 relationalize "Limit" "is_Limit" external
 synthesize "is_Limit" from_definition
 arity_theorem for "is_Limit_fm"
 
 relativize functional "HAleph" "HAleph_rel"
 relationalize "HAleph_rel" "is_HAleph"
 
 synthesize "is_HAleph" from_definition assuming "nonempty"
 arity_theorem intermediate for "is_HAleph_fm"
 
 lemma arity_is_HAleph_fm_aux:
   assumes
     "i \<in> nat" "r \<in> nat"
     \<comment> \<open>NOTE: assumptions are \<^bold>\<open>not\<close> used, but if omitted, next lemma fails!\<close>
   shows
     "arity(Replace_fm(8 +\<^sub>\<omega> i, \<cdot>10 +\<^sub>\<omega> r`0 is 1\<cdot>, 3)) = 9 +\<^sub>\<omega> i \<union> pred(pred(11 +\<^sub>\<omega> r))"
   using arity_Replace_fm[of "\<cdot> (10+\<^sub>\<omega>r)`0 is 1\<cdot>" "8+\<^sub>\<omega>i" 3 "(11+\<^sub>\<omega>r) \<union> 1 \<union> 2"]
     ord_simp_union
   by (auto simp:arity)
 
 lemma arity_is_HAleph_fm[arity]:
   assumes
     "i \<in> nat" "r \<in> nat" "l \<in> nat"
   shows
     "arity(is_HAleph_fm(i, r, l)) =  succ(i) \<union> succ(l) \<union> succ(r)"
   using assms pred_Un arity_is_HAleph_fm_aux arity_is_HAleph_fm'
   by auto
 
 definition
   Aleph' :: "i => i"  where
   "Aleph'(a) == transrec(a,\<lambda>i r. HAleph(i,r))"
 
 relativize functional "Aleph'" "Aleph_rel"
 relationalize "Aleph_rel" "is_Aleph"
 
 txt\<open>The extra assumptions \<^term>\<open>a < length(env)\<close> and \<^term>\<open>c < length(env)\<close>
     in this schematic goal (and the following results on synthesis that
     depend on it) are imposed by @{thm is_transrec_iff_sats}.\<close>
 schematic_goal sats_is_Aleph_fm_auto:
   "a \<in> nat \<Longrightarrow> c \<in> nat \<Longrightarrow> env \<in> list(A) \<Longrightarrow>
   a < length(env) \<Longrightarrow> c < length(env) \<Longrightarrow> 0 \<in> A \<Longrightarrow>
   is_Aleph(##A, nth(a, env), nth(c, env)) \<longleftrightarrow> A, env \<Turnstile> ?fm(a, c)"
   unfolding is_Aleph_def
 proof (rule is_transrec_iff_sats, rule_tac [1] is_HAleph_iff_sats)
   fix a0 a1 a2 a3 a4 a5 a6 a7
   let ?env' = "Cons(a0, Cons(a1, Cons(a2, Cons(a3, Cons(a4, Cons(a5, Cons(a6, Cons(a7, env))))))))"
   show "nth(2, ?env') = a2"
     "nth(1, ?env') = a1"
     "nth(0, ?env') = a0"
     "nth(c, env) = nth(c, env)"
     by simp_all
 qed simp_all
 
 synthesize_notc "is_Aleph" from_schematic
 
 notation is_Aleph_fm (\<open>\<cdot>\<aleph>'(_') is _\<cdot>\<close>)
 
 lemma is_Aleph_fm_type [TC]: "a \<in> nat \<Longrightarrow> c \<in> nat \<Longrightarrow> is_Aleph_fm(a, c) \<in> formula"
   unfolding is_Aleph_fm_def by simp
 
 lemma sats_is_Aleph_fm:
   assumes "f\<in>nat" "r\<in>nat" "env \<in> list(A)" "0\<in>A" "f < length(env)" "r< length(env)"
   shows "is_Aleph(##A, nth(f, env), nth(r, env)) \<longleftrightarrow> A, env \<Turnstile> is_Aleph_fm(f,r)"
   using assms sats_is_Aleph_fm_auto unfolding is_Aleph_def is_Aleph_fm_def by simp
 
 lemma is_Aleph_iff_sats [iff_sats]:
   assumes
     "nth(f, env) = fa" "nth(r, env) = ra" "f < length(env)" "r< length(env)"
     "f \<in> nat" "r \<in> nat" "env \<in> list(A)" "0\<in>A"
   shows "is_Aleph(##A,fa,ra) \<longleftrightarrow> A, env \<Turnstile> is_Aleph_fm(f,r)"
   using assms sats_is_Aleph_fm[of f r env A] by simp
 
 arity_theorem for "is_Aleph_fm"
 
 lemma (in M_cardinal_arith_jump) is_Limit_iff:
   assumes "M(a)"
   shows "is_Limit(M,a) \<longleftrightarrow> Limit(a)"
   unfolding is_Limit_def Limit_def using lt_abs transM[OF ltD \<open>M(a)\<close>] assms
   by auto
 
 lemma HAleph_eq_Aleph_recursive:
   "Ord(i) \<Longrightarrow> HAleph(i,r) = (if i = 0 then nat
                 else if \<exists>j. i = succ(j) then csucc(r ` (THE j. i = succ(j))) else \<Union>j<i. r ` j)"
 proof -
   assume "Ord(i)"
   moreover from this
   have "i = succ(j) \<Longrightarrow> (\<Union>succ(j)) = j" for j
     using Ord_Union_succ_eq by simp
   moreover from \<open>Ord(i)\<close>
   have "(\<exists>j. i = succ(j)) \<longleftrightarrow> \<not>Limit(i) \<and> i \<noteq> 0"
     using Ord_cases_disj by auto
   ultimately
   show ?thesis
     unfolding HAleph_def OUnion_def
     by auto
 qed
 
 lemma Aleph'_eq_Aleph: "Ord(a) \<Longrightarrow> Aleph'(a) = Aleph(a)"
   unfolding Aleph'_def Aleph_def transrec2_def
   using HAleph_eq_Aleph_recursive
   by (intro transrec_equal_on_Ord) auto
 
 reldb_rem functional "Aleph'"
 reldb_rem relational "is_Aleph"
 reldb_add functional "Aleph" "Aleph_rel"
 reldb_add relational "Aleph" "is_Aleph"
 
 abbreviation
   Aleph_r :: "[i,i\<Rightarrow>o] \<Rightarrow> i" (\<open>\<aleph>\<^bsub>_\<^esub>\<^bsup>_\<^esup>\<close>) where
   "Aleph_r(a,M) \<equiv> Aleph_rel(M,a)"
 
 abbreviation
   Aleph_r_set :: "[i,i] \<Rightarrow> i" (\<open>\<aleph>\<^bsub>_\<^esub>\<^bsup>_\<^esup>\<close>) where
   "Aleph_r_set(a,M) \<equiv> Aleph_rel(##M,a)"
 
 lemma Aleph_rel_def': "Aleph_rel(M,a) \<equiv> transrec(a, \<lambda>i r. HAleph_rel(M, i, r))"
   unfolding Aleph_rel_def .
 
 lemma succ_mem_Limit: "Limit(j) \<Longrightarrow> i \<in> j \<Longrightarrow> succ(i) \<in> j"
   using Limit_has_succ[THEN ltD] ltI Limit_is_Ord by auto
 
 locale M_pre_aleph = M_eclose + M_cardinal_arith_jump +
   assumes
     haleph_transrec_replacement: "M(a) \<Longrightarrow> transrec_replacement(M,is_HAleph(M),a)"
 
 begin
 
 lemma aux_ex_Replace_funapply:
   assumes "M(a)" "M(f)"
   shows "\<exists>x[M]. is_Replace(M, a, \<lambda>j y. f ` j = y, x)"
 proof -
   have "{f`j . j\<in>a} = {y . j\<in>a , f ` j=y}"
     "{y . j\<in>a , f ` j=y} = {y . j\<in>a , y =f ` j}"
     by auto
   moreover
   note assms
   moreover from calculation
   have "x \<in> a \<Longrightarrow> y = f `x \<Longrightarrow> M(y)" for x y
     using transM[OF _ \<open>M(a)\<close>] by auto
   moreover from assms
   have "M({f`j . j\<in>a})"
     using transM[OF _ \<open>M(a)\<close>] RepFun_closed[OF apply_replacement] by simp
   ultimately
   have 2:"is_Replace(M, a, \<lambda>j y. y = f ` j, {f`j . j\<in>a})"
     using Replace_abs[of _ _ "\<lambda>j y. y = f ` j",OF \<open>M(a)\<close>,THEN iffD2]
     by auto
   with \<open>M({f`j . j\<in>a})\<close>
   show ?thesis
     using
       is_Replace_cong[of _ _ M "\<lambda>j y. y = f ` j" "\<lambda>j y. f ` j = y", THEN iffD1,OF _ _ _ 2]
     by auto
 qed
 
 lemma is_HAleph_zero:
   assumes "M(f)"
   shows "is_HAleph(M,0,f,res) \<longleftrightarrow> res = nat"
   unfolding is_HAleph_def
   using Ord_0 If_abs is_Limit_iff is_csucc_iff assms aux_ex_Replace_funapply
   by auto
 
 lemma is_HAleph_succ:
   assumes "M(f)" "M(x)" "Ord(x)" "M(res)"
   shows "is_HAleph(M,succ(x),f,res) \<longleftrightarrow> res = csucc_rel(M,f`x)"
   unfolding is_HAleph_def
   using assms is_Limit_iff is_csucc_iff aux_ex_Replace_funapply If_abs Ord_Union_succ_eq
   by simp
 
 lemma is_HAleph_limit:
   assumes "M(f)" "M(x)" "Limit(x)" "M(res)"
   shows "is_HAleph(M,x,f,res) \<longleftrightarrow> res = (\<Union>{y . i\<in>x ,M(i) \<and> M(y) \<and> y = f`i})"
 proof -
   from assms
   have "univalent(M, x, \<lambda>j y. y = f ` j  )"
     "(\<And>xa y. xa \<in> x \<Longrightarrow> f ` xa = y \<Longrightarrow> M(y))"
     "{y . x \<in> x, f ` x = y} = {y . i\<in>x ,M(i) \<and> M(y) \<and> y = f`i}"
     using univalent_triv[of M x "\<lambda>j .f ` j"] transM[OF _ \<open>M(x)\<close>]
     by auto
   moreover
   from this
   have "univalent(M, x, \<lambda>j y. f ` j = y )"
     by (rule_tac univalent_cong[of x x M " \<lambda>j y. y = f ` j" " \<lambda>j y. f ` j=y",THEN iffD1], auto)
   moreover
   from this
   have "univalent(M, x, \<lambda>j y. M(j) \<and> M(y) \<and> f ` j = y )"
     by auto
   ultimately
   show ?thesis
     unfolding is_HAleph_def
     using assms is_Limit_iff Limit_is_Ord zero_not_Limit If_abs is_csucc_iff
       Replace_abs apply_replacement
     by auto
 qed
 
 lemma is_HAleph_iff:
   assumes "M(a)" "M(f)" "M(res)"
   shows "is_HAleph(M, a, f, res) \<longleftrightarrow> res = HAleph_rel(M, a, f)"
 proof(cases "Ord(a)")
   case True
   note Ord_cases[OF \<open>Ord(a)\<close>]
   then
   show ?thesis
   proof(cases )
     case 1
     with True assms
     show ?thesis
       using is_HAleph_zero unfolding HAleph_rel_def
       by simp
   next
     case (2 j)
     with True assms
     show ?thesis
       using is_HAleph_succ Ord_Union_succ_eq
       unfolding HAleph_rel_def
       by simp
   next
     case 3
     with assms
     show ?thesis
       using is_HAleph_limit zero_not_Limit Limit_is_Ord
       unfolding HAleph_rel_def
       by auto
   qed
 next
   case False
   then
   have "\<not>Limit(a)" "a\<noteq>0" "\<And> x . Ord(x) \<Longrightarrow> a\<noteq>succ(x)"
     using Limit_is_Ord by auto
   with False
   show ?thesis
     unfolding is_HAleph_def HAleph_rel_def
     using assms is_Limit_iff If_abs is_csucc_iff aux_ex_Replace_funapply
     by auto
 qed
 
 lemma HAleph_rel_closed [intro,simp]:
   assumes "function(f)" "M(a)" "M(f)"
   shows "M(HAleph_rel(M,a,f))"
   unfolding HAleph_rel_def
   using assms apply_replacement
   by simp
 
 lemma Aleph_rel_closed[intro, simp]:
   assumes "Ord(a)" "M(a)"
   shows "M(Aleph_rel(M,a))"
 proof -
   have "relation2(M, is_HAleph(M), HAleph_rel(M))"
     unfolding relation2_def using is_HAleph_iff assms by simp
   moreover
   have "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(HAleph_rel(M, x, g))"
     using HAleph_rel_closed by simp
   moreover
   note assms
   ultimately
   show ?thesis
     unfolding Aleph_rel_def
     using transrec_closed[of "is_HAleph(M)" a "HAleph_rel(M)"]
       haleph_transrec_replacement  by simp
 qed
 
 lemma Aleph_rel_zero: "\<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup> = nat"
   using def_transrec [OF Aleph_rel_def',of _ 0]
   unfolding HAleph_rel_def by simp
 
 lemma Aleph_rel_succ: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>succ(\<alpha>)\<^esub>\<^bsup>M\<^esup> = (\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
   using Ord_Union_succ_eq
   by (subst def_transrec [OF Aleph_rel_def'])
     (simp add:HAleph_rel_def)
 
 lemma Aleph_rel_limit:
   assumes "Limit(\<alpha>)" "M(\<alpha>)"
   shows "\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> = \<Union>{\<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup> . j \<in> \<alpha>}"
 proof -
   note trans=transM[OF _ \<open>M(\<alpha>)\<close>]
   from \<open>M(\<alpha>)\<close>
   have "\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> = HAleph_rel(M, \<alpha>, \<lambda>x\<in>\<alpha>. \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)"
     using def_transrec [OF Aleph_rel_def',of M \<alpha>] by simp
   also
   have "... = \<Union>{a . j \<in> \<alpha>, M(a) \<and> a = \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>}"
     unfolding HAleph_rel_def
     using assms zero_not_Limit Limit_is_Ord trans by auto
   also
   have "... = \<Union>{\<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup> . j \<in> \<alpha>}"
     using Aleph_rel_closed[OF _ trans] Ord_in_Ord Limit_is_Ord[OF \<open>Limit(\<alpha>)\<close>] by auto
   finally
   show ?thesis .
 qed
 
 lemma is_Aleph_iff:
   assumes "Ord(a)" "M(a)" "M(res)"
   shows "is_Aleph(M, a, res) \<longleftrightarrow> res = \<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>"
 proof -
   have "relation2(M, is_HAleph(M), HAleph_rel(M))"
     unfolding relation2_def using is_HAleph_iff assms by simp
   moreover
   have "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(HAleph_rel(M, x, g))"
     using HAleph_rel_closed by simp
   ultimately
   show ?thesis
     using assms transrec_abs haleph_transrec_replacement
     unfolding is_Aleph_def Aleph_rel_def
     by simp
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_pre_aleph\<close>\<close>
 
 locale M_aleph = M_pre_aleph +
   assumes
-    aleph_rel_replacement: "strong_replacement(M, \<lambda>x y. Ord(x) \<and> y = \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)"
+    aleph_rel_separation: "Ord(x) \<Longrightarrow> M(x) \<Longrightarrow> separation(M, \<lambda>y. \<exists>z\<in>x. y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>)"
 begin
 
 lemma Aleph_rel_cont: "Limit(l) \<Longrightarrow> M(l) \<Longrightarrow> \<aleph>\<^bsub>l\<^esub>\<^bsup>M\<^esup> = (\<Union>i<l. \<aleph>\<^bsub>i\<^esub>\<^bsup>M\<^esup>)"
   using Limit_is_Ord Aleph_rel_limit
   by (simp add:OUnion_def)
 
 lemma Ord_Aleph_rel:
   assumes "Ord(a)"
   shows "M(a) \<Longrightarrow> Ord(\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>)"
   using \<open>Ord(a)\<close>
 proof(induct a rule:trans_induct3)
   case 0
   show ?case using Aleph_rel_zero by simp
 next
   case (succ x)
   with \<open>Ord(x)\<close>
   have "M(x)" "Ord(\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)" by simp_all
   with \<open>Ord(x)\<close>
   have "Ord(csucc_rel(M,\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>))"
     using Card_rel_is_Ord Card_rel_csucc_rel
     by simp
   with \<open>Ord(x)\<close> \<open>M(x)\<close>
   show ?case using Aleph_rel_succ by simp
 next
   case (limit x)
   note trans=transM[OF _ \<open>M(x)\<close>]
   from limit
   have "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> = (\<Union>i\<in>x. \<aleph>\<^bsub>i\<^esub>\<^bsup>M\<^esup>)"
     using Aleph_rel_cont OUnion_def Limit_is_Ord
     by auto
   with limit
   show ?case using Ord_UN trans by auto
 qed
 
-lemma Card_rel_Aleph_rel [simp, intro]:
-  assumes "Ord(a)" and types: "M(a)" shows "Card\<^bsup>M\<^esup>(\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>)"
-  using assms
-proof (induct rule:trans_induct3)
-  case 0
-  then
-  show ?case
-    using Aleph_rel_zero Card_rel_nat by simp
-next
-  case (succ x)
-  then
-  show ?case
-    using Card_rel_csucc_rel Ord_Aleph_rel Aleph_rel_succ
-    by simp
-next
-  case (limit x)
-  moreover
-  from this
-  have "M({y . z \<in> x, M(y) \<and> M(z) \<and> Ord(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>})"
-    using aleph_rel_replacement
-    by auto
-  moreover
-  have "{y . z \<in> x, M(y) \<and> M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y . z \<in> x, M(y) \<and> M(z) \<and> Ord(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>}"
-    using Ord_in_Ord Limit_is_Ord[OF limit(1)] by simp
-  ultimately
-  show ?case
-    using Ord_Aleph_rel Card_nat Limit_is_Ord Card_relI
-    by (subst def_transrec [OF Aleph_rel_def'])
-      (auto simp add:HAleph_rel_def)
-qed
-
 lemma Aleph_rel_increasing:
   assumes "a < b" and types: "M(a)" "M(b)"
   shows "\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"
 proof -
   { fix x
     from assms
     have "Ord(b)"
       by (blast intro: lt_Ord2)
     moreover
     assume "M(x)"
     moreover
     note \<open>M(b)\<close>
     ultimately
     have "x < b \<Longrightarrow> \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"
     proof (induct b arbitrary: x rule: trans_induct3)
       case 0 thus ?case by simp
     next
       case (succ b)
       then
       show ?case
         using Card_rel_csucc_rel Ord_Aleph_rel Ord_Union_succ_eq lt_csucc_rel
           lt_trans[of _ "\<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>" "csucc\<^bsup>M\<^esup>(\<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>)"]
         by (subst (2) def_transrec[OF Aleph_rel_def'])
           (auto simp add: le_iff HAleph_rel_def)
     next
       case (limit l)
       then
       have sc: "succ(x) < l"
         by (blast intro: Limit_has_succ)
       then
       have "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> < (\<Union>j<l. \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>)"
         using limit Ord_Aleph_rel Ord_OUN
       proof(rule_tac OUN_upper_lt,blast intro: Card_rel_is_Ord ltD lt_Ord)
         from \<open>x<l\<close> \<open>Limit(l)\<close>
         have "Ord(x)"
           using Limit_is_Ord Ord_in_Ord
           by (auto dest!:ltD)
         with \<open>M(x)\<close>
         show "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>succ(x)\<^esub>\<^bsup>M\<^esup>"
           using Card_rel_csucc_rel Ord_Aleph_rel lt_csucc_rel
             ltD[THEN [2] Ord_in_Ord] succ_in_MI[OF \<open>M(x)\<close>]
             Aleph_rel_succ[of x]
           by (simp)
       next
         from \<open>M(l)\<close> \<open>Limit(l)\<close>
         show "Ord(\<Union>j<l. \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>)"
           using Ord_Aleph_rel lt_Ord Limit_is_Ord Ord_in_Ord
           by (rule_tac Ord_OUN)
             (auto dest:transM ltD intro!:Ord_Aleph_rel)
       qed
       then
       show ?case using limit Aleph_rel_cont by simp
     qed
   }
   with types assms
   show ?thesis by simp
 qed
 
+lemma Card_rel_Aleph_rel [simp, intro]:
+  assumes "Ord(a)" and types: "M(a)" shows "Card\<^bsup>M\<^esup>(\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>)"
+  using assms
+proof (induct rule:trans_induct3)
+  case 0
+  then
+  show ?case
+    using Aleph_rel_zero Card_rel_nat by simp
+next
+  case (succ x)
+  then
+  show ?case
+    using Card_rel_csucc_rel Ord_Aleph_rel Aleph_rel_succ
+    by simp
+next
+  case (limit x)
+  moreover from this
+  have "Ord(x)"
+    using Limit_is_Ord by simp
+  from this
+  have "{y . z \<in> x, M(y) \<and> M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y . z \<in> x, M(y) \<and> M(z) \<and> Ord(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>}"
+    using Ord_in_Ord by simp
+  moreover from \<open>Ord(x)\<close>
+  have "{y . z \<in> x, M(y) \<and> M(z) \<and> Ord(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y . z \<in> x, M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>}"
+    using Ord_in_Ord by blast
+  moreover from \<open>Ord(x)\<close> \<open>M(x)\<close>
+  have "{y . z \<in> x, M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} \<subseteq>  \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>"
+    using Aleph_rel_increasing
+    by (auto dest:ltD transM intro:ltI)
+  with calculation
+  have "{y . z \<in> x, M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y \<in> \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> . (\<exists>z \<in> x. y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>)}"
+    by (blast dest:transM)
+  with calculation
+  have "{y . z \<in> x, M(y) \<and> M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y \<in> \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> . (\<exists>z \<in> x. y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>)}"
+    by simp
+  moreover from \<open>Ord(x)\<close> \<open>M(x)\<close>
+  have "M({y \<in> \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> . (\<exists>z \<in> x. y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>)})"
+    using aleph_rel_separation
+    by simp
+  ultimately
+  show ?case
+    using Ord_Aleph_rel Card_nat Limit_is_Ord Card_relI
+    by (subst def_transrec [OF Aleph_rel_def'])
+      (auto simp add:HAleph_rel_def)
+qed
+
 lemmas nat_subset_Aleph_rel_1 =
   Ord_lt_subset[OF Ord_Aleph_rel[of 1] Aleph_rel_increasing[of 0 1,simplified],simplified]
 
 end \<comment> \<open>\<^locale>\<open>M_aleph\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Arities.thy b/thys/Transitive_Models/Arities.thy
--- a/thys/Transitive_Models/Arities.thy
+++ b/thys/Transitive_Models/Arities.thy
@@ -1,254 +1,253 @@
 section\<open>Arities of internalized formulas\<close>
 theory Arities
   imports
     Discipline_Base
 begin
 
 lemmas FOL_arities [simp del, arity] = arity_And arity_Or arity_Implies arity_Iff arity_Exists
 
 declare pred_Un_distrib[arity_aux]
 
 context
   notes FOL_arities[simp]
 begin
 
 lemma arity_upair_fm [arity] : "\<lbrakk>  t1\<in>nat ; t2\<in>nat ; up\<in>nat  \<rbrakk> \<Longrightarrow>
   arity(upair_fm(t1,t2,up)) = \<Union> {succ(t1),succ(t2),succ(up)}"
   unfolding  upair_fm_def
   using union_abs1 union_abs2 pred_Un
   by auto
 
 end
 
 lemma Un_trasposition_aux1: "r \<union> s \<union> r = r \<union> s" by auto
 
 lemma Un_trasposition_aux2:
   "r \<union> (s \<union> (r \<union> u))= r \<union> (s \<union> u)"
   "r \<union> (s \<union> (t \<union> (r \<union> u)))= r \<union> (s \<union> (t \<union> u))" by auto
 
-txt\<open>Using the previous lemmas to guide the automatic arity calculation.\<close>
+text\<open>We use the previous lemmas to guide automatic arity calculations.\<close>
 
 context
   notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp]
 begin
 
 arity_theorem for "pair_fm"
 arity_theorem for "composition_fm"
 arity_theorem for "domain_fm"
 arity_theorem for "range_fm"
 arity_theorem for "union_fm"
 arity_theorem for "image_fm"
 arity_theorem for "pre_image_fm"
 arity_theorem for "big_union_fm"
 arity_theorem for "fun_apply_fm"
 arity_theorem for "field_fm"
 arity_theorem for "empty_fm"
 arity_theorem for "cons_fm"
 arity_theorem for "succ_fm"
 arity_theorem for "number1_fm"
 arity_theorem for "function_fm"
 arity_theorem for "relation_fm"
 arity_theorem for "restriction_fm"
 arity_theorem for "typed_function_fm"
 arity_theorem for "subset_fm"
 arity_theorem for "transset_fm"
 arity_theorem for "ordinal_fm"
 arity_theorem for "limit_ordinal_fm"
 arity_theorem for "finite_ordinal_fm"
 arity_theorem for "omega_fm"
 arity_theorem for "cartprod_fm"
 arity_theorem for "singleton_fm"
 arity_theorem for "Memrel_fm"
 arity_theorem for "quasinat_fm"
 
 end \<comment> \<open>context\<close>
 
 context
   notes FOL_arities[simp]
 begin
 
 lemma arity_is_recfun_fm [arity]:
   "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat;i\<in>nat\<rbrakk> \<Longrightarrow>  arity(p) = i \<Longrightarrow>
-  arity(is_recfun_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> pred(pred(pred(pred(i))))"
+  arity(is_recfun_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> (pred^4(i))"
   unfolding is_recfun_fm_def
   using arity_upair_fm arity_pair_fm arity_pre_image_fm arity_restriction_fm
     union_abs2 pred_Un_distrib
   by auto
 
 lemma arity_is_wfrec_fm [arity]:
   "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat ; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
-    arity(is_wfrec_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> pred(pred(pred(pred(pred(i)))))"
+    arity(is_wfrec_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> (pred^5(i))"
   unfolding is_wfrec_fm_def
   using arity_succ_fm  arity_is_recfun_fm
     union_abs2 pred_Un_distrib
   by auto
 
 lemma arity_is_nat_case_fm [arity]:
   "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
     arity(is_nat_case_fm(v,p,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union> pred(pred(i))"
   unfolding is_nat_case_fm_def
   using arity_succ_fm arity_empty_fm arity_quasinat_fm
     union_abs2 pred_Un_distrib
   by auto
 
 lemma arity_iterates_MH_fm [arity]:
   assumes "isF\<in>formula" "v\<in>nat" "n\<in>nat" "g\<in>nat" "z\<in>nat" "i\<in>nat"
     "arity(isF) = i"
   shows "arity(iterates_MH_fm(isF,v,n,g,z)) =
-           succ(v) \<union> succ(n) \<union> succ(g) \<union> succ(z) \<union> pred(pred(pred(pred(i))))"
+           succ(v) \<union> succ(n) \<union> succ(g) \<union> succ(z) \<union> (pred^4(i))"
 proof -
-  let ?\<phi> = "Exists(And(fun_apply_fm(succ(succ(succ(g))), 2, 0), Forall(Implies(Equal(0, 2), isF))))"
-  let ?ar = "succ(succ(succ(g))) \<union> pred(pred(i))"
+  let ?\<phi> = "(\<cdot>\<exists>\<cdot>\<cdot>g +\<^sub>\<omega> 3`2 is 0\<cdot> \<and> (\<cdot>\<forall>\<cdot>\<cdot>0 = 2\<cdot> \<rightarrow> isF\<cdot>\<cdot>)\<cdot>\<cdot>)"
+  let ?ar = "(g +\<^sub>\<omega> 3) \<union> pred(pred(i))"
   from assms
   have "arity(?\<phi>) =?ar" "?\<phi>\<in>formula"
     using arity_fun_apply_fm
       union_abs1 union_abs2 pred_Un_distrib succ_Un_distrib Un_assoc[symmetric]
     by simp_all
   then
   show ?thesis
     unfolding iterates_MH_fm_def
     using arity_is_nat_case_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _ _ \<open>arity(?\<phi>) = ?ar\<close>] assms pred_succ_eq pred_Un_distrib
     by auto
 qed
 
 lemma arity_is_iterates_fm [arity]:
   assumes "p\<in>formula" "v\<in>nat" "n\<in>nat" "Z\<in>nat" "i\<in>nat"
     "arity(p) = i"
   shows "arity(is_iterates_fm(p,v,n,Z)) = succ(v) \<union> succ(n) \<union> succ(Z) \<union>
-          pred(pred(pred(pred(pred(pred(pred(pred(pred(pred(pred(i)))))))))))"
+          (pred^11(i))"
 proof -
   let ?\<phi> = "iterates_MH_fm(p, 7+\<^sub>\<omega>v, 2, 1, 0)"
-  let ?\<psi> = "is_wfrec_fm(?\<phi>, 0, succ(succ(n)),succ(succ(Z)))"
+  let ?\<psi> = "is_wfrec_fm(?\<phi>, 0, n +\<^sub>\<omega> 2, Z +\<^sub>\<omega> 2)"
   from \<open>v\<in>_\<close>
-  have "arity(?\<phi>) = (8+\<^sub>\<omega>v) \<union> pred(pred(pred(pred(i))))" "?\<phi>\<in>formula"
+  have "arity(?\<phi>) = (8+\<^sub>\<omega>v) \<union> (pred^4(i))" "?\<phi>\<in>formula"
     using assms arity_iterates_MH_fm union_abs2
     by simp_all
   then
-  have "arity(?\<psi>) = succ(succ(succ(n))) \<union> succ(succ(succ(Z))) \<union> (3+\<^sub>\<omega>v) \<union>
-      pred(pred(pred(pred(pred(pred(pred(pred(pred(i)))))))))"
+  have "arity(?\<psi>) = n +\<^sub>\<omega> 3 \<union> (Z +\<^sub>\<omega> 3) \<union> (3+\<^sub>\<omega>v) \<union> (pred^9(i))"
     using assms arity_is_wfrec_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _ _ \<open>arity(?\<phi>) = _\<close>] union_abs1 pred_Un_distrib
     by auto
   then
   show ?thesis
     unfolding is_iterates_fm_def
     using arity_Memrel_fm arity_succ_fm assms union_abs1 pred_Un_distrib
     by auto
 qed
 
 lemma arity_eclose_n_fm [arity]:
   assumes "A\<in>nat" "x\<in>nat" "t\<in>nat"
   shows "arity(eclose_n_fm(A,x,t)) = succ(A) \<union> succ(x) \<union> succ(t)"
 proof -
   let ?\<phi> = "big_union_fm(1,0)"
   have "arity(?\<phi>) = 2" "?\<phi>\<in>formula"
     using arity_big_union_fm union_abs2
     by auto
   with assms
   show ?thesis
     unfolding eclose_n_fm_def
     using arity_is_iterates_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _,of _ _ _ 2]
     by auto
 qed
 
 lemma arity_mem_eclose_fm [arity]:
   assumes "x\<in>nat" "t\<in>nat"
   shows "arity(mem_eclose_fm(x,t)) = succ(x) \<union> succ(t)"
 proof -
   let ?\<phi>="eclose_n_fm(x +\<^sub>\<omega> 2, 1, 0)"
   from \<open>x\<in>nat\<close>
   have "arity(?\<phi>) = x+\<^sub>\<omega>3"
     using arity_eclose_n_fm union_abs2
     by simp
   with assms
   show ?thesis
     unfolding mem_eclose_fm_def
     using arity_finite_ordinal_fm union_abs2 pred_Un_distrib
     by simp
 qed
 
 lemma arity_is_eclose_fm [arity]:
   "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(is_eclose_fm(x,t)) = succ(x) \<union> succ(t)"
   unfolding is_eclose_fm_def
   using arity_mem_eclose_fm union_abs2 pred_Un_distrib
   by auto
 
 lemma arity_Collect_fm [arity]:
   assumes "x \<in> nat" "y \<in> nat" "p\<in>formula"
   shows "arity(Collect_fm(x,p,y)) = succ(x) \<union> succ(y) \<union> pred(arity(p))"
   unfolding Collect_fm_def
   using assms pred_Un_distrib
   by auto
 
 schematic_goal arity_least_fm':
   assumes
     "i \<in> nat" "q \<in> formula"
   shows
     "arity(least_fm(q,i)) \<equiv> ?ar"
   unfolding least_fm_def
   using assms pred_Un_distrib arity_And arity_Or arity_Neg arity_Implies arity_ordinal_fm
     arity_empty_fm Un_assoc[symmetric] Un_commute
   by auto
 
 lemma arity_least_fm [arity]:
   assumes
     "i \<in> nat" "q \<in> formula"
   shows
     "arity(least_fm(q,i)) = succ(i) \<union> pred(arity(q))"
   using assms arity_least_fm'
   by auto
 
 lemma arity_Replace_fm [arity]:
   "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
     arity(Replace_fm(v,p,n)) = succ(n) \<union> succ(v) \<union> pred(pred(i))"
   unfolding Replace_fm_def
   using union_abs2 pred_Un_distrib
   by auto
 
 lemma arity_lambda_fm [arity]:
   "\<lbrakk>p\<in>formula; v\<in>nat ; n\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow>  arity(p) = i \<Longrightarrow>
     arity(lambda_fm(p,v,n)) = succ(n) \<union> (succ(v) \<union> (pred^3(i)))"
   unfolding lambda_fm_def
   using arity_pair_fm pred_Un_distrib union_abs1 union_abs2
   by simp
 
 lemma arity_transrec_fm [arity]:
   "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
      arity(is_transrec_fm(p,v,n)) = succ(v) \<union> succ(n) \<union> (pred^8(i))"
   unfolding is_transrec_fm_def
   using arity Un_assoc[symmetric] pred_Un_distrib
   by simp
 
 lemma arity_wfrec_replacement_fm :
   "\<lbrakk>p\<in>formula ; v\<in>nat ; n\<in>nat; Z\<in>nat ; i\<in>nat\<rbrakk> \<Longrightarrow> arity(p) = i \<Longrightarrow>
     arity(Exists(And(pair_fm(1,0,2),is_wfrec_fm(p,v,n,Z))))
    = 2 \<union> v \<union> n \<union> Z \<union> (pred^6(i))"
   unfolding is_wfrec_fm_def
   using arity_succ_fm  arity_is_recfun_fm union_abs2 pred_Un_distrib arity_pair_fm
   by auto
 
 end \<comment> \<open>@{thm [source] FOL_arities}\<close>
 
 declare arity_subset_fm [simp del] arity_ordinal_fm[simp del, arity] arity_transset_fm[simp del]
 
 context
   notes Un_assoc[symmetric,simp] Un_trasposition_aux1[simp]
 begin
 arity_theorem for "rtran_closure_mem_fm"
 arity_theorem for "rtran_closure_fm"
 arity_theorem for "tran_closure_fm"
 end
 
 context
   notes Un_assoc[simp] Un_trasposition_aux2[simp]
 begin
 arity_theorem for "injection_fm"
 arity_theorem for "surjection_fm"
 arity_theorem for "bijection_fm"
 arity_theorem for "order_isomorphism_fm"
 end
 
 arity_theorem for "Inl_fm"
 arity_theorem for "Inr_fm"
 arity_theorem for "pred_set_fm"
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/CardinalArith_Relative.thy b/thys/Transitive_Models/CardinalArith_Relative.thy
--- a/thys/Transitive_Models/CardinalArith_Relative.thy
+++ b/thys/Transitive_Models/CardinalArith_Relative.thy
@@ -1,1648 +1,1603 @@
 section\<open>Relative, Choice-less Cardinal Arithmetic\<close>
 
 theory CardinalArith_Relative
   imports
     Cardinal_Relative
 
 begin
 
-
-(* rvimage(?A, ?f, ?r) \<equiv> {z \<in> ?A \<times> ?A . \<exists>x y. z = \<langle>x, y\<rangle> \<and> \<langle>?f ` x, ?f ` y\<rangle> \<in> ?r} *)
 relativize functional "rvimage" "rvimage_rel" external
 relationalize "rvimage_rel" "is_rvimage"
 
 definition
   csquare_lam :: "i\<Rightarrow>i" where
   "csquare_lam(K) \<equiv> \<lambda>\<langle>x,y\<rangle>\<in>K\<times>K. \<langle>x \<union> y, x, y\<rangle>"
 
 \<comment> \<open>Can't do the next thing because split is a missing HOC\<close>
 (* relativize functional "csquare_lam" "csquare_lam_rel" *)
 relativize_tm "<fst(x) \<union> snd(x), fst(x), snd(x)>" "is_csquare_lam_body"
 
 definition
   is_csquare_lam :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
   "is_csquare_lam(M,K,l) \<equiv> \<exists>K2[M]. cartprod(M,K,K,K2) \<and>
         is_lambda(M,K2,is_csquare_lam_body(M),l)"
 
-definition jump_cardinal_body :: "[i\<Rightarrow>o,i] \<Rightarrow> i" where
-  "jump_cardinal_body(M,X) \<equiv>
-    {z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> M(r) \<and> well_ord(X, r) \<and> z = ordertype(X, r)} "
+definition jump_cardinal_body :: "[i,i] \<Rightarrow> i" where
+  "jump_cardinal_body(U,X) \<equiv>
+    {z . r \<in> U, well_ord(X, r) \<and> z = ordertype(X, r)}"
+
+definition jump_cardinal_body'  where
+  "jump_cardinal_body'(x) \<equiv> jump_cardinal_body(Pow(x\<times>x),x)"
 
 lemma (in M_cardinals) csquare_lam_closed[intro,simp]: "M(K) \<Longrightarrow> M(csquare_lam(K))"
   using csquare_lam_replacement  unfolding csquare_lam_def
   by (rule lam_closed) (auto dest:transM)
 
 locale M_pre_cardinal_arith = M_cardinals +
   assumes
     wfrec_pred_replacement:"M(A) \<Longrightarrow> M(r) \<Longrightarrow>
       wfrec_replacement(M, \<lambda>x f z. z = f `` Order.pred(A, x, r), r)"
-begin
-
-lemma ord_iso_separation: "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow>
-      separation(M, \<lambda>f. \<forall>x\<in>A. \<forall>y\<in>A. \<langle>x, y\<rangle> \<in> r \<longleftrightarrow> \<langle>f ` x, f ` y\<rangle> \<in> s)"
-  using
-    lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
-    lam_replacement_hcomp lam_replacement_fst  lam_replacement_snd
-    separation_in lam_replacement_fst lam_replacement_apply2[THEN[5] lam_replacement_hcomp2]
-    lam_replacement_identity  lam_replacement_constant
-  by(rule_tac separation_ball,rule_tac separation_ball,simp_all,rule_tac separation_iff',simp_all)
-
-end
-
-locale M_cardinal_arith = M_pre_cardinal_arith +
-  assumes
-    ordertype_replacement :
-    "M(X) \<Longrightarrow> strong_replacement(M,\<lambda> x z . M(z) \<and> M(x) \<and> x\<in>Pow_rel(M,X\<times>X) \<and> well_ord(X, x) \<and> z=ordertype(X,x))"
-    and
-    strong_replacement_jc_body :
-    "strong_replacement(M,\<lambda> x z . M(z) \<and> M(x) \<and> z = jump_cardinal_body(M,x))"
-
-lemmas (in M_cardinal_arith) surj_imp_inj_replacement =
-  surj_imp_inj_replacement1 surj_imp_inj_replacement2 surj_imp_inj_replacement4
-  lam_replacement_vimage_sing_fun[THEN lam_replacement_imp_strong_replacement]
 
 relativize_tm "\<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> r \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> s)"
   "is_rmultP"
 
 relativize functional "rmult" "rmult_rel" external
 relationalize "rmult_rel" "is_rmult"
 
 lemma (in M_trivial) rmultP_abs [absolut]: "\<lbrakk> M(r); M(s); M(z) \<rbrakk> \<Longrightarrow> is_rmultP(M,s,r,z) \<longleftrightarrow>
     (\<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> r \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> s))"
   unfolding is_rmultP_def by (auto dest:transM)
 
 definition
   is_csquare_rel :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o"  where
   "is_csquare_rel(M,K,cs) \<equiv> \<exists>K2[M]. \<exists>la[M]. \<exists>memK[M].
       \<exists>rmKK[M]. \<exists>rmKK2[M].
         cartprod(M,K,K,K2) \<and> is_csquare_lam(M,K,la) \<and>
         membership(M,K,memK) \<and> is_rmult(M,K,memK,K,memK,rmKK) \<and>
         is_rmult(M,K,memK,K2,rmKK,rmKK2) \<and> is_rvimage(M,K2,la,rmKK2,cs)"
 
 context M_basic
 begin
 
 lemma rvimage_abs[absolut]:
   assumes "M(A)" "M(f)" "M(r)" "M(z)"
   shows "is_rvimage(M,A,f,r,z) \<longleftrightarrow> z = rvimage(A,f,r)"
   using assms transM[OF _ \<open>M(A)\<close>]
   unfolding is_rvimage_def rvimage_def
   by auto
 
 lemma rmult_abs [absolut]: "\<lbrakk> M(A); M(r); M(B); M(s); M(z) \<rbrakk> \<Longrightarrow>
     is_rmult(M,A,r,B,s,z) \<longleftrightarrow> z=rmult(A,r,B,s)"
   using rmultP_abs transM[of _ "(A \<times> B) \<times> A \<times> B"]
   unfolding is_rmultP_def is_rmult_def rmult_def
   by (auto del: iffI)
 
 lemma csquare_lam_body_abs[absolut]: "M(x) \<Longrightarrow> M(z) \<Longrightarrow>
   is_csquare_lam_body(M,x,z) \<longleftrightarrow> z = <fst(x) \<union> snd(x), fst(x), snd(x)>"
   unfolding is_csquare_lam_body_def by (simp add:absolut)
 
 lemma csquare_lam_abs[absolut]: "M(K) \<Longrightarrow> M(l) \<Longrightarrow>
   is_csquare_lam(M,K,l) \<longleftrightarrow> l = (\<lambda>x\<in>K\<times>K. \<langle>fst(x) \<union> snd(x), fst(x), snd(x)\<rangle>)"
   unfolding is_csquare_lam_def
   using lambda_abs2[of "K\<times>K" "is_csquare_lam_body(M)"
       "\<lambda>x. \<langle>fst(x) \<union> snd(x), fst(x), snd(x)\<rangle>"]
   unfolding Relation1_def by (simp add:absolut)
 
 lemma csquare_lam_eq_lam:"csquare_lam(K) = (\<lambda>z\<in>K\<times>K. <fst(z) \<union> snd(z), fst(z), snd(z)>)"
 proof -
   have "(\<lambda>\<langle>x,y\<rangle>\<in>K \<times> K. \<langle>x \<union> y, x, y\<rangle>)`z =
       (\<lambda>z\<in>K\<times>K. <fst(z) \<union> snd(z), fst(z), snd(z)>)`z" if "z\<in>K\<times>K" for z
     using that by auto
   then
   show ?thesis
     unfolding csquare_lam_def
     by simp
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
 
 context M_pre_cardinal_arith
 begin
 
 lemma csquare_rel_closed[intro,simp]: "M(K) \<Longrightarrow> M(csquare_rel(K))"
   using csquare_lam_replacement unfolding csquare_rel_def
   by (intro rvimage_closed lam_closed) (auto dest:transM)
 
 (* Ugly proof ahead, please enhance *)
 lemma csquare_rel_abs[absolut]: "\<lbrakk> M(K); M(cs)\<rbrakk> \<Longrightarrow>
      is_csquare_rel(M,K,cs) \<longleftrightarrow> cs = csquare_rel(K)"
   unfolding is_csquare_rel_def csquare_rel_def
   using csquare_lam_closed[unfolded csquare_lam_eq_lam]
   by (simp add:absolut csquare_lam_eq_lam[unfolded csquare_lam_def])
 
 end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
 
 (*************   Discipline for csucc  ****************)
 relativize functional "csucc" "csucc_rel" external
 relationalize "csucc_rel" "is_csucc"
 synthesize "is_csucc" from_definition assuming "nonempty"
 arity_theorem for "is_csucc_fm"
 
 abbreviation
   csucc_r :: "[i,i\<Rightarrow>o] \<Rightarrow> i"  (\<open>'(_\<^sup>+')\<^bsup>_\<^esup>\<close>) where
   "csucc_r(x,M) \<equiv> csucc_rel(M,x)"
 
 abbreviation
   csucc_r_set :: "[i,i] \<Rightarrow> i"  (\<open>'(_\<^sup>+')\<^bsup>_\<^esup>\<close>) where
   "csucc_r_set(x,M) \<equiv> csucc_rel(##M,x)"
 
 context M_Perm
 begin
 
 rel_closed for "csucc"
   using Least_closed'[of "\<lambda> L. M(L) \<and> Card\<^bsup>M\<^esup>(L) \<and> K < L"]
   unfolding csucc_rel_def
   by simp
 
 is_iff_rel for "csucc"
   using least_abs'[of "\<lambda> L. M(L) \<and> Card\<^bsup>M\<^esup>(L) \<and> K < L" res]
     is_Card_iff
   unfolding is_csucc_def csucc_rel_def
   by (simp add:absolut)
 
 end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
 
 notation csucc_rel (\<open>csucc\<^bsup>_\<^esup>'(_')\<close>)
 
 (***************  end Discipline  *********************)
 
 context M_cardinals
 begin
 
 lemma Card_rel_Union [simp,intro,TC]:
   assumes A: "\<And>x. x\<in>A \<Longrightarrow> Card\<^bsup>M\<^esup>(x)" and
     types:"M(A)"
   shows "Card\<^bsup>M\<^esup>(\<Union>(A))"
 proof (rule Card_relI)
   show "Ord(\<Union>A)" using A
     by (simp add: Card_rel_is_Ord types transM)
 next
   fix j
   assume j: "j < \<Union>A"
   moreover from this
   have "M(j)" unfolding lt_def by (auto simp add:types dest:transM)
   from j
   have "\<exists>c\<in>A. j \<in> c \<and> Card\<^bsup>M\<^esup>(c)" using A types
     unfolding lt_def
     by (simp)
   then
   obtain c where c: "c\<in>A" "j < c" "Card\<^bsup>M\<^esup>(c)" "M(c)"
     using Card_rel_is_Ord types unfolding lt_def
     by (auto dest:transM)
   with \<open>M(j)\<close>
   have jls: "j \<prec>\<^bsup>M\<^esup> c"
     by (simp add: lt_Card_rel_imp_lesspoll_rel types)
   { assume eqp: "j \<approx>\<^bsup>M\<^esup> \<Union>A"
     have  "c \<lesssim>\<^bsup>M\<^esup> \<Union>A" using c
       by (blast intro: subset_imp_lepoll_rel types)
     also from types \<open>M(j)\<close>
     have "... \<approx>\<^bsup>M\<^esup> j"  by (rule_tac eqpoll_rel_sym [OF eqp]) (simp_all add:types)
     also have "... \<prec>\<^bsup>M\<^esup> c"  by (rule jls)
     finally have "c \<prec>\<^bsup>M\<^esup> c" by (simp_all add:\<open>M(c)\<close> \<open>M(j)\<close> types)
     with \<open>M(c)\<close>
     have False
       by (auto dest:lesspoll_rel_irrefl)
   } thus "\<not> j \<approx>\<^bsup>M\<^esup> \<Union>A" by blast
 qed (simp_all add:types)
 
 (*
 lemma Card_UN: "(!!x. x \<in> A ==> Card(K(x))) ==> Card(\<Union>x\<in>A. K(x))"
   by blast
 
 
 lemma Card_OUN [simp,intro,TC]:
      "(!!x. x \<in> A ==> Card(K(x))) ==> Card(\<Union>x<A. K(x))"
   by (auto simp add: OUnion_def Card_0)
 *)
 
 lemma in_Card_imp_lesspoll: "[| Card\<^bsup>M\<^esup>(K); b \<in> K; M(K); M(b) |] ==> b \<prec>\<^bsup>M\<^esup> K"
   apply (unfold lesspoll_rel_def)
   apply (simp add: Card_rel_iff_initial)
   apply (fast intro!: le_imp_lepoll_rel ltI leI)
   done
 
 
 subsection\<open>Cardinal addition\<close>
 
 text\<open>Note (Paulson): 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_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> A+B \<approx>\<^bsup>M\<^esup> B+A"
 proof (simp add: def_eqpoll_rel, rule rexI)
   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)"])
   assume "M(A)" "M(B)"
   then
   show "M(\<lambda>z\<in>A + B. case(Inr, Inl, z))"
     using case_replacement1
     by (rule_tac lam_closed) (auto dest:transM)
 qed
 
 lemma cadd_rel_commute: "M(i) \<Longrightarrow> M(j) \<Longrightarrow> i \<oplus>\<^bsup>M\<^esup> j = j \<oplus>\<^bsup>M\<^esup> i"
   apply (unfold cadd_rel_def)
   apply (auto intro: sum_commute_eqpoll_rel [THEN cardinal_rel_cong])
   done
 
 subsubsection\<open>Cardinal addition is associative\<close>
 
 lemma sum_assoc_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(C) \<Longrightarrow> (A+B)+C \<approx>\<^bsup>M\<^esup> A+(B+C)"
   apply (simp add: def_eqpoll_rel)
   apply (rule rexI)
    apply (rule sum_assoc_bij)
   using case_replacement2
   by (rule_tac lam_closed) (auto dest:transM)
 
 text\<open>Unconditional version requires AC\<close>
 lemma well_ord_cadd_rel_assoc:
   assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
     and
     types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)"
   shows "(i \<oplus>\<^bsup>M\<^esup> j) \<oplus>\<^bsup>M\<^esup> k = i \<oplus>\<^bsup>M\<^esup> (j \<oplus>\<^bsup>M\<^esup> k)"
 proof (simp add: assms cadd_rel_def, rule cardinal_rel_cong)
   from types
   have "|i + j|\<^bsup>M\<^esup> + k \<approx>\<^bsup>M\<^esup> (i + j) + k"
     by (auto intro!: sum_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_refl well_ord_radd i j)
   also have "...  \<approx>\<^bsup>M\<^esup> i + (j + k)"
     by (rule sum_assoc_eqpoll_rel) (simp_all add:types)
   also
   have "...  \<approx>\<^bsup>M\<^esup> i + |j + k|\<^bsup>M\<^esup>"
   proof (auto intro!: sum_eqpoll_rel_cong intro:eqpoll_rel_refl simp add:types)
     from types
     have "|j + k|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> j + k"
       using well_ord_cardinal_rel_eqpoll_rel[OF well_ord_radd, OF j k]
       by (simp)
     with types
     show "j + k \<approx>\<^bsup>M\<^esup> |j + k|\<^bsup>M\<^esup>"
       using eqpoll_rel_sym by simp
   qed
   finally show "|i + j|\<^bsup>M\<^esup> + k \<approx>\<^bsup>M\<^esup> i + |j + k|\<^bsup>M\<^esup>" by (simp_all add:types)
 qed (simp_all add:types)
 
 
 subsubsection\<open>0 is the identity for addition\<close>
 
 lemma case_id_eq: "x\<in>sum(A,B) \<Longrightarrow> case(\<lambda>z . z, \<lambda>z. z ,x) = snd(x)"
   unfolding case_def cond_def by (auto simp:Inl_def Inr_def)
 
 lemma lam_case_id: "(\<lambda>z\<in>0 + A. case(\<lambda>x. x, \<lambda>y. y, z)) = (\<lambda>z\<in>0 + A . snd(z))"
   using case_id_eq by simp
 
 lemma sum_0_eqpoll_rel: "M(A) \<Longrightarrow> 0+A \<approx>\<^bsup>M\<^esup> A"
   apply (simp add:def_eqpoll_rel)
   apply (rule rexI)
    apply (rule bij_0_sum,subst lam_case_id)
   using lam_replacement_snd[unfolded lam_replacement_def]
   by (rule lam_closed)
     (auto simp add:case_def cond_def Inr_def dest:transM)
 
 lemma cadd_rel_0 [simp]: "Card\<^bsup>M\<^esup>(K) \<Longrightarrow> M(K) \<Longrightarrow> 0 \<oplus>\<^bsup>M\<^esup> K = K"
   apply (simp add: cadd_rel_def)
   apply (simp add: sum_0_eqpoll_rel [THEN cardinal_rel_cong] Card_rel_cardinal_rel_eq)
   done
 
 subsubsection\<open>Addition by another cardinal\<close>
 
 lemma sum_lepoll_rel_self: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> A+B"
 proof (simp add: def_lepoll_rel, rule rexI)
   show "(\<lambda>x\<in>A. Inl (x)) \<in> inj(A, A + B)"
     by (simp add: inj_def)
   assume "M(A)" "M(B)"
   then
   show "M(\<lambda>x\<in>A. Inl(x))"
     using Inl_replacement1 transM[OF _ \<open>M(A)\<close>]
     by (rule_tac lam_closed) (auto simp add: Inl_def)
 qed
 
 (*Could probably weaken the premises to well_ord(K,r), or removing using AC*)
 
 lemma cadd_rel_le_self:
   assumes K: "Card\<^bsup>M\<^esup>(K)" and L: "Ord(L)" and
     types:"M(K)" "M(L)"
   shows "K \<le> (K \<oplus>\<^bsup>M\<^esup> L)"
 proof (simp add:types cadd_rel_def)
   have "K \<le> |K|\<^bsup>M\<^esup>"
     by (rule Card_rel_cardinal_rel_le [OF K]) (simp add:types)
   moreover have "|K|\<^bsup>M\<^esup> \<le> |K + L|\<^bsup>M\<^esup>" using K L
     by (blast intro: well_ord_lepoll_rel_imp_cardinal_rel_le sum_lepoll_rel_self
         well_ord_radd well_ord_Memrel Card_rel_is_Ord types)
   ultimately show "K \<le> |K + L|\<^bsup>M\<^esup>"
     by (blast intro: le_trans)
 qed
 
 subsubsection\<open>Monotonicity of addition\<close>
 
 lemma sum_lepoll_rel_mono:
   "[| A \<lesssim>\<^bsup>M\<^esup> C;  B \<lesssim>\<^bsup>M\<^esup> D; M(A); M(B); M(C); M(D) |] ==> A + B \<lesssim>\<^bsup>M\<^esup> C + D"
   apply (simp add: def_lepoll_rel)
   apply (elim rexE)
   apply (rule_tac x = "\<lambda>z\<in>A+B. case (%w. Inl(f`w), %y. Inr(fa`y), z)" in rexI)
    apply (rule_tac d = "case (%w. Inl(converse(f) `w), %y. Inr(converse(fa) ` y))"
       in lam_injective)
     apply (typecheck add: inj_is_fun, auto)
   apply (rule_tac lam_closed, auto dest:transM intro:case_replacement4)
   done
 
 lemma cadd_rel_le_mono:
   "[| K' \<le> K;  L' \<le> L;M(K');M(K);M(L');M(L) |] ==> (K' \<oplus>\<^bsup>M\<^esup> L') \<le> (K \<oplus>\<^bsup>M\<^esup> L)"
   apply (unfold cadd_rel_def)
   apply (safe dest!: le_subset_iff [THEN iffD1])
   apply (rule well_ord_lepoll_rel_imp_cardinal_rel_le)
       apply (blast intro: well_ord_radd well_ord_Memrel)
      apply (auto intro: sum_lepoll_rel_mono subset_imp_lepoll_rel)
   done
 
 subsubsection\<open>Addition of finite cardinals is "ordinary" addition\<close>
 
 lemma sum_succ_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> succ(A)+B \<approx>\<^bsup>M\<^esup> succ(A+B)"
   apply (simp add:def_eqpoll_rel)
   apply (rule rexI)
    apply (rule_tac c = "%z. if z=Inl (A) then A+B else z"
       and d = "%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)+
   apply(rule_tac lam_closed, auto dest:transM intro:if_then_range_replacement2)
   done
 
 (*Pulling the  succ(...)  outside the |...| requires m, n \<in> nat  *)
 (*Unconditional version requires AC*)
 lemma cadd_succ_lemma:
   assumes "Ord(m)" "Ord(n)" and
     types: "M(m)" "M(n)"
   shows "succ(m) \<oplus>\<^bsup>M\<^esup> n = |succ(m \<oplus>\<^bsup>M\<^esup> n)|\<^bsup>M\<^esup>"
   using types
 proof (simp add: cadd_rel_def)
   have [intro]: "m + n \<approx>\<^bsup>M\<^esup> |m + n|\<^bsup>M\<^esup>" using assms
     by (blast intro: eqpoll_rel_sym well_ord_cardinal_rel_eqpoll_rel well_ord_radd well_ord_Memrel)
 
   have "|succ(m) + n|\<^bsup>M\<^esup> = |succ(m + n)|\<^bsup>M\<^esup>"
     by (rule sum_succ_eqpoll_rel [THEN cardinal_rel_cong]) (simp_all add:types)
   also have "... = |succ(|m + n|\<^bsup>M\<^esup>)|\<^bsup>M\<^esup>"
     by (blast intro: succ_eqpoll_rel_cong cardinal_rel_cong types)
   finally show "|succ(m) + n|\<^bsup>M\<^esup> = |succ(|m + n|\<^bsup>M\<^esup>)|\<^bsup>M\<^esup>" .
 qed
 
 lemma nat_cadd_rel_eq_add:
   assumes m: "m \<in> nat" and [simp]: "n \<in> nat" shows"m \<oplus>\<^bsup>M\<^esup> n = m +\<^sub>\<omega> n"
   using m
 proof (induct m)
   case 0 thus ?case
     using transM[OF _ M_nat]
     by (auto simp add: nat_into_Card_rel)
 next
   case (succ m) thus ?case
     using transM[OF _ M_nat]
     by (simp add: cadd_succ_lemma nat_into_Card_rel Card_rel_cardinal_rel_eq)
 qed
 
 
 subsection\<open>Cardinal multiplication\<close>
 
 subsubsection\<open>Cardinal multiplication is commutative\<close>
 
 lemma prod_commute_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> A*B \<approx>\<^bsup>M\<^esup> B*A"
   apply (simp add: def_eqpoll_rel)
   apply (rule rexI)
    apply (rule_tac c = "%<x,y>.<y,x>" and d = "%<x,y>.<y,x>" in lam_bijective,
       auto)
   apply(rule_tac lam_closed, auto intro:swap_replacement dest:transM)
   done
 
 lemma cmult_rel_commute: "M(i) \<Longrightarrow> M(j) \<Longrightarrow> i \<otimes>\<^bsup>M\<^esup> j = j \<otimes>\<^bsup>M\<^esup> i"
   apply (unfold cmult_rel_def)
   apply (rule prod_commute_eqpoll_rel [THEN cardinal_rel_cong], simp_all)
   done
 
 subsubsection\<open>Cardinal multiplication is associative\<close>
 
 lemma prod_assoc_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(C) \<Longrightarrow> (A*B)*C \<approx>\<^bsup>M\<^esup> A*(B*C)"
   apply (simp add: def_eqpoll_rel)
   apply (rule rexI)
    apply (rule prod_assoc_bij)
   apply(rule_tac lam_closed, auto intro:assoc_replacement dest:transM)
   done
 
 
 text\<open>Unconditional version requires AC\<close>
 lemma well_ord_cmult_rel_assoc:
   assumes i: "well_ord(i,ri)" and j: "well_ord(j,rj)" and k: "well_ord(k,rk)"
     and
     types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)"
   shows "(i \<otimes>\<^bsup>M\<^esup> j) \<otimes>\<^bsup>M\<^esup> k = i \<otimes>\<^bsup>M\<^esup> (j \<otimes>\<^bsup>M\<^esup> k)"
 proof (simp add: assms cmult_rel_def, rule cardinal_rel_cong)
   have "|i * j|\<^bsup>M\<^esup> * k \<approx>\<^bsup>M\<^esup> (i * j) * k"
     by (auto intro!: prod_eqpoll_rel_cong
         well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_refl
         well_ord_rmult i j simp add:types)
   also have "...  \<approx>\<^bsup>M\<^esup> i * (j * k)"
     by (rule prod_assoc_eqpoll_rel, simp_all add:types)
   also have "...  \<approx>\<^bsup>M\<^esup> i * |j * k|\<^bsup>M\<^esup>"
     by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel
         eqpoll_rel_refl well_ord_rmult j k eqpoll_rel_sym types)
   finally show "|i * j|\<^bsup>M\<^esup> * k \<approx>\<^bsup>M\<^esup> i * |j * k|\<^bsup>M\<^esup>" by (simp add:types)
 qed (simp_all add:types)
 
 
 subsubsection\<open>Cardinal multiplication distributes over addition\<close>
 
 lemma sum_prod_distrib_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(C) \<Longrightarrow> (A+B)*C \<approx>\<^bsup>M\<^esup> (A*C)+(B*C)"
   apply (simp add: def_eqpoll_rel)
   apply (rule rexI)
    apply (rule sum_prod_distrib_bij)
   apply(rule_tac lam_closed, auto intro:case_replacement5 dest:transM)
   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)"
     and
     types: "M(i)" "M(ri)" "M(j)" "M(rj)" "M(k)" "M(rk)"
   shows "(i \<oplus>\<^bsup>M\<^esup> j) \<otimes>\<^bsup>M\<^esup> k = (i \<otimes>\<^bsup>M\<^esup> k) \<oplus>\<^bsup>M\<^esup> (j \<otimes>\<^bsup>M\<^esup> k)"
 proof (simp add: assms cadd_rel_def cmult_rel_def, rule cardinal_rel_cong)
   have "|i + j|\<^bsup>M\<^esup> * k \<approx>\<^bsup>M\<^esup> (i + j) * k"
     by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel
         eqpoll_rel_refl well_ord_radd i j types)
   also have "...  \<approx>\<^bsup>M\<^esup> i * k + j * k"
     by (rule sum_prod_distrib_eqpoll_rel) (simp_all add:types)
   also have "...  \<approx>\<^bsup>M\<^esup> |i * k|\<^bsup>M\<^esup> + |j * k|\<^bsup>M\<^esup>"
     by (blast intro: sum_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel
         well_ord_rmult i j k eqpoll_rel_sym types)
   finally show "|i + j|\<^bsup>M\<^esup> * k \<approx>\<^bsup>M\<^esup> |i * k|\<^bsup>M\<^esup> + |j * k|\<^bsup>M\<^esup>" by (simp add:types)
 qed (simp_all add:types)
 
 
 subsubsection\<open>Multiplication by 0 yields 0\<close>
 
 lemma prod_0_eqpoll_rel: "M(A) \<Longrightarrow> 0*A \<approx>\<^bsup>M\<^esup> 0"
   apply (simp add: def_eqpoll_rel)
   apply (rule rexI)
    apply (rule lam_bijective, auto)
   done
 
 lemma cmult_rel_0 [simp]: "M(i) \<Longrightarrow> 0 \<otimes>\<^bsup>M\<^esup> i = 0"
   by (simp add: cmult_rel_def prod_0_eqpoll_rel [THEN cardinal_rel_cong])
 
 subsubsection\<open>1 is the identity for multiplication\<close>
 
 lemma prod_singleton_eqpoll_rel: "M(x) \<Longrightarrow> M(A) \<Longrightarrow> {x}*A \<approx>\<^bsup>M\<^esup> A"
   apply (simp add: def_eqpoll_rel)
   apply (rule rexI)
    apply (rule singleton_prod_bij [THEN bij_converse_bij])
   apply (rule converse_closed)
   apply(rule_tac lam_closed, auto intro:prepend_replacement dest:transM)
   done
 
 lemma cmult_rel_1 [simp]: "Card\<^bsup>M\<^esup>(K) \<Longrightarrow> M(K) \<Longrightarrow> 1 \<otimes>\<^bsup>M\<^esup> K = K"
   apply (simp add: cmult_rel_def succ_def)
   apply (simp add: prod_singleton_eqpoll_rel[THEN cardinal_rel_cong] Card_rel_cardinal_rel_eq)
   done
 
 subsection\<open>Some inequalities for multiplication\<close>
 
 lemma prod_square_lepoll_rel: "M(A) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> A*A"
   apply (simp add:def_lepoll_rel inj_def)
   apply (rule_tac x = "\<lambda>x\<in>A. <x,x>" in rexI, simp)
   apply(rule_tac lam_closed, auto intro:id_replacement dest:transM)
   done
 
 (*Could probably weaken the premise to well_ord(K,r), or remove using AC*)
 lemma cmult_rel_square_le: "Card\<^bsup>M\<^esup>(K) \<Longrightarrow> M(K) \<Longrightarrow> K \<le> K \<otimes>\<^bsup>M\<^esup> K"
   apply (unfold cmult_rel_def)
   apply (rule le_trans)
    apply (rule_tac [2] well_ord_lepoll_rel_imp_cardinal_rel_le)
        apply (rule_tac [3] prod_square_lepoll_rel)
        apply (simp add: le_refl Card_rel_is_Ord Card_rel_cardinal_rel_eq)
       apply (blast intro: well_ord_rmult well_ord_Memrel Card_rel_is_Ord)
      apply simp_all
   done
 
 subsubsection\<open>Multiplication by a non-zero cardinal\<close>
 
 lemma prod_lepoll_rel_self: "b \<in> B \<Longrightarrow> M(b) \<Longrightarrow> M(B) \<Longrightarrow> M(A) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> A*B"
   apply (simp add: def_lepoll_rel inj_def)
   apply (rule_tac x = "\<lambda>x\<in>A. <x,b>" in rexI, simp)
   apply(rule_tac lam_closed, auto intro:pospend_replacement dest:transM)
   done
 
 (*Could probably weaken the premises to well_ord(K,r), or removing using AC*)
 lemma cmult_rel_le_self:
   "[| Card\<^bsup>M\<^esup>(K);  Ord(L);  0<L; M(K);M(L) |] ==> K \<le> (K \<otimes>\<^bsup>M\<^esup> L)"
   apply (unfold cmult_rel_def)
   apply (rule le_trans [OF Card_rel_cardinal_rel_le well_ord_lepoll_rel_imp_cardinal_rel_le])
         apply assumption apply simp
       apply (blast intro: well_ord_rmult well_ord_Memrel Card_rel_is_Ord)
      apply (auto intro: prod_lepoll_rel_self ltD)
   done
 
 subsubsection\<open>Monotonicity of multiplication\<close>
 
 lemma prod_lepoll_rel_mono:
   "[| A \<lesssim>\<^bsup>M\<^esup> C;  B \<lesssim>\<^bsup>M\<^esup> D; M(A); M(B); M(C); M(D)|] ==> A * B  \<lesssim>\<^bsup>M\<^esup>  C * D"
   apply (simp add:def_lepoll_rel)
   apply (elim rexE)
   apply (rule_tac x = "lam <w,y>:A*B. <f`w, fa`y>" in rexI)
    apply (rule_tac d = "%<w,y>. <converse (f) `w, converse (fa) `y>"
       in lam_injective)
     apply (typecheck add: inj_is_fun, auto)
   apply(rule_tac lam_closed, auto intro:prod_fun_replacement dest:transM)
   done
 
 lemma cmult_rel_le_mono:
   "[| K' \<le> K;  L' \<le> L;M(K');M(K);M(L');M(L) |] ==> (K' \<otimes>\<^bsup>M\<^esup> L') \<le> (K \<otimes>\<^bsup>M\<^esup> L)"
   apply (unfold cmult_rel_def)
   apply (safe dest!: le_subset_iff [THEN iffD1])
   apply (rule well_ord_lepoll_rel_imp_cardinal_rel_le)
       apply (blast intro: well_ord_rmult well_ord_Memrel)
      apply (auto intro: prod_lepoll_rel_mono subset_imp_lepoll_rel)
   done
 
 subsection\<open>Multiplication of finite cardinals is "ordinary" multiplication\<close>
 
 lemma prod_succ_eqpoll_rel: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> succ(A)*B \<approx>\<^bsup>M\<^esup> B + A*B"
   apply (simp add: def_eqpoll_rel)
   apply (rule rexI)
    apply (rule_tac c = "\<lambda>p. if fst(p)=A then Inl (snd(p)) else Inr (p)"
       and d = "case (%y. <A,y>, %z. z)" in lam_bijective)
       apply safe
           apply (simp_all add: succI2 if_type mem_imp_not_eq)
   apply(rule_tac lam_closed, auto intro:Inl_replacement2 dest:transM)
   done
 
 (*Unconditional version requires AC*)
 lemma cmult_rel_succ_lemma:
   "[| Ord(m);  Ord(n) ; M(m); M(n) |] ==> succ(m) \<otimes>\<^bsup>M\<^esup> n = n \<oplus>\<^bsup>M\<^esup> (m \<otimes>\<^bsup>M\<^esup> n)"
   apply (simp add: cmult_rel_def cadd_rel_def)
   apply (rule prod_succ_eqpoll_rel [THEN cardinal_rel_cong, THEN trans], simp_all)
   apply (rule cardinal_rel_cong [symmetric], simp_all)
   apply (rule sum_eqpoll_rel_cong [OF eqpoll_rel_refl well_ord_cardinal_rel_eqpoll_rel], assumption)
         apply (blast intro: well_ord_rmult well_ord_Memrel)
        apply simp_all
   done
 
 lemma nat_cmult_rel_eq_mult: "[| m \<in> nat;  n \<in> nat |] ==> m \<otimes>\<^bsup>M\<^esup> n = m#*n"
   using transM[OF _ M_nat]
   apply (induct_tac m)
    apply (simp_all add: cmult_rel_succ_lemma nat_cadd_rel_eq_add)
   done
 
 lemma cmult_rel_2: "Card\<^bsup>M\<^esup>(n) \<Longrightarrow> M(n) \<Longrightarrow> 2 \<otimes>\<^bsup>M\<^esup> n = n \<oplus>\<^bsup>M\<^esup> n"
   by (simp add: cmult_rel_succ_lemma Card_rel_is_Ord cadd_rel_commute [of _ 0])
 
 lemma sum_lepoll_rel_prod:
   assumes C: "2 \<lesssim>\<^bsup>M\<^esup> C" and
     types:"M(C)" "M(B)"
   shows "B+B \<lesssim>\<^bsup>M\<^esup> C*B"
 proof -
   have "B+B \<lesssim>\<^bsup>M\<^esup> 2*B"
     by (simp add: sum_eq_2_times types)
   also have "... \<lesssim>\<^bsup>M\<^esup> C*B"
     by (blast intro: prod_lepoll_rel_mono lepoll_rel_refl C types)
   finally show "B+B \<lesssim>\<^bsup>M\<^esup> C*B" by (simp_all add:types)
 qed
 
 lemma lepoll_imp_sum_lepoll_prod: "[| A \<lesssim>\<^bsup>M\<^esup> B; 2 \<lesssim>\<^bsup>M\<^esup> A; M(A) ;M(B) |] ==> A+B \<lesssim>\<^bsup>M\<^esup> A*B"
   by (blast intro: sum_lepoll_rel_mono sum_lepoll_rel_prod lepoll_rel_trans lepoll_rel_refl)
 
 end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
 
 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 %y. if y \<in> nat then nat_case(u, %z. z, y) else y.  \
   If f \<in> inj(nat,A) then range(f) behaves like the natural numbers.*)
 
 
 context M_pre_cardinal_arith
 begin
 
 lemma nat_cons_lepoll_rel: "nat \<lesssim>\<^bsup>M\<^esup> A \<Longrightarrow> M(A) \<Longrightarrow> M(u) ==> cons(u,A) \<lesssim>\<^bsup>M\<^esup> A"
   apply (simp add: def_lepoll_rel)
   apply (erule rexE)
   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 rexI)
    apply (rule_tac d =
       "%y. if y \<in> range(f) then nat_case (u, %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])
 proof -
   fix f
   assume "M(A)" "M(f)" "M(u)"
   then
   show "M(\<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)"
     using if_then_range_replacement transM[OF _ \<open>M(A)\<close>]
     by (rule_tac lam_closed, auto)
 qed
 
 lemma nat_cons_eqpoll_rel: "nat \<lesssim>\<^bsup>M\<^esup> A ==> M(A) \<Longrightarrow> M(u) \<Longrightarrow> cons(u,A) \<approx>\<^bsup>M\<^esup> A"
   apply (erule nat_cons_lepoll_rel [THEN eqpoll_relI], assumption+)
     apply (rule subset_consI [THEN subset_imp_lepoll_rel], simp_all)
   done
 
 lemma nat_succ_eqpoll_rel: "nat \<subseteq> A ==> M(A) \<Longrightarrow> succ(A) \<approx>\<^bsup>M\<^esup> A"
   apply (unfold succ_def)
   apply (erule subset_imp_lepoll_rel [THEN nat_cons_eqpoll_rel], simp_all)
   done
 
 lemma InfCard_rel_nat: "InfCard\<^bsup>M\<^esup>(nat)"
   apply (simp add: InfCard_rel_def)
   apply (blast intro: Card_rel_nat Card_rel_is_Ord)
   done
 
 lemma InfCard_rel_is_Card_rel: "M(K) \<Longrightarrow> InfCard\<^bsup>M\<^esup>(K) \<Longrightarrow> Card\<^bsup>M\<^esup>(K)"
   apply (simp add: InfCard_rel_def)
   done
 
 lemma InfCard_rel_Un:
   "[| InfCard\<^bsup>M\<^esup>(K);  Card\<^bsup>M\<^esup>(L); M(K); M(L) |] ==> InfCard\<^bsup>M\<^esup>(K \<union> L)"
   apply (simp add: InfCard_rel_def)
   apply (simp add: Card_rel_Un Un_upper1_le [THEN [2] le_trans]  Card_rel_is_Ord)
   done
 
 lemma InfCard_rel_is_Limit: "InfCard\<^bsup>M\<^esup>(K) ==> M(K) \<Longrightarrow> Limit(K)"
   apply (simp add: InfCard_rel_def)
   apply (erule conjE)
   apply (frule Card_rel_is_Ord, assumption)
   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_rel_def)
   apply (drule trans)
    apply (erule le_imp_subset [THEN nat_succ_eqpoll_rel, THEN cardinal_rel_cong], simp_all)
   apply (erule Ord_cardinal_rel_le [THEN lt_trans2, THEN lt_irrefl], assumption)
   apply (rule le_eqI) prefer 2
    apply (rule Ord_cardinal_rel, assumption+)
   done
 
 end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
 
 (*** An infinite cardinal equals its square (Kunen, Thm 10.12, page 29) ***)
 
-
 lemma (in M_ordertype) ordertype_abs[absolut]:
   assumes "wellordered(M,A,r)" "M(A)" "M(r)" "M(i)"
   shows "otype(M,A,r,i) \<longleftrightarrow> i = ordertype(A,r)"
-    \<comment> \<open>Awful proof, it essentially repeats the same argument twice\<close>
-proof (intro iffI)
-  note assms
-  moreover
-  assume "otype(M, A, r, i)"
-  moreover from calculation
-  obtain f j where "M(f)"  "M(j)"  "Ord(j)" "f \<in> \<langle>A, r\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>"
-    using ordertype_exists[of A r] by auto
-  moreover from calculation
-  have "\<exists>f[M]. f \<in> \<langle>A, r\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>" by auto
-  moreover
-  have "\<exists>f[M]. f \<in> \<langle>A, r\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"
+proof -
+  have eq:"j = k" if
+    "g \<in> \<langle>A, r\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>" "Ord(j)"
+    "h \<in> \<langle>A, r\<rangle> \<cong> \<langle>k, Memrel(k)\<rangle>" "Ord(k)"
+  for j k g h
   proof -
-    note calculation
+    from that
+    have "h O converse(g) \<in> \<langle>j, Memrel(j)\<rangle> \<cong> \<langle>k, Memrel(k)\<rangle>"
+      using ord_iso_sym ord_iso_trans by blast
+    with \<open>Ord(j)\<close> \<open>Ord(k)\<close>
+    show "j=k"
+      using Ord_iso_implies_eq[of j k "h O converse(g)"]
+      by simp
+  qed
+  have otypeE: "\<exists> h . h \<in> \<langle>A, r\<rangle> \<cong> \<langle>k, Memrel(k)\<rangle>" if "otype(M, A, r, k)" "M(k)" for k
+  proof -
+    note that assms
     moreover from this
     obtain h where "omap(M, A, r, h)" "M(h)"
-      using omap_exists by auto
-    moreover from calculation
-    have "h \<in> \<langle>A, r\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"
-      using omap_ord_iso obase_equals by simp
+      using that omap_exists[of A r] by auto
     moreover from calculation
-    have "h O converse(f) \<in> \<langle>j, Memrel(j)\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"
-      using ord_iso_sym ord_iso_trans by blast
-    moreover from calculation
-    have "i=j"
-      using Ord_iso_implies_eq[of j i "h O converse(f)"]
-        Ord_otype[OF _ well_ord_is_trans_on] by simp
-    ultimately
-    show ?thesis by simp
+    have "h \<in> \<langle>A, r\<rangle> \<cong> \<langle>k, Memrel(k)\<rangle>"
+      using that omap_ord_iso obase_equals by simp
+    then
+    show ?thesis ..
   qed
-  ultimately
-  show "i = ordertype(A, r)"
-    by (force intro:ordertypes_are_absolute[of A r _ i]
-        simp add:Ord_otype[OF _ well_ord_is_trans_on])
-next
-  note assms
-  moreover
-  assume "i = ordertype(A, r)"
-  moreover from calculation
-  obtain h where "omap(M, A, r, h)" "M(h)"
-    using omap_exists by auto
-  moreover from calculation
-  obtain j where "otype(M,A,r,j)" "M(j)"
-    using otype_exists by auto
-  moreover from calculation
-  have "h \<in> \<langle>A, r\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>"
-    using omap_ord_iso_otype by simp
-  moreover from calculation
-  obtain f where "f \<in> \<langle>A, r\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"
-    using ordertype_ord_iso by auto
-  moreover
-  have "j=i"
-  proof -
-    note calculation
-    moreover from this
-    have "h O converse(f) \<in> \<langle>i, Memrel(i)\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>"
-      using ord_iso_sym ord_iso_trans by blast
+  show ?thesis
+  proof(intro iffI)
+    note assms
+    moreover
+    assume "otype(M, A, r, i)"
     moreover from calculation
-    have "Ord(i)" using Ord_ordertype by simp
+    obtain f j where "M(f)" "Ord(j)" "f \<in> \<langle>A, r\<rangle> \<cong> \<langle>j, Memrel(j)\<rangle>"
+      using ordertype_exists[of A r] by auto
     ultimately
-    show "j=i"
-      using Ord_iso_implies_eq[of i j "h O converse(f)"]
-        Ord_otype[OF _ well_ord_is_trans_on] by simp
+    show "i = ordertype(A, r)"
+      using Ord_otype[OF _ well_ord_is_trans_on] eq[of f j _ i] ordertypes_are_absolute
+        otypeE[of i]
+      by auto
+  next
+    note assms
+    moreover
+    assume "i = ordertype(A, r)"
+    moreover from calculation
+    obtain j where "otype(M,A,r,j)" "M(j)"
+      using otype_exists by auto
+    ultimately
+    show "otype(M, A, r, i)"
+      using Ord_ordertype eq[of _ i _ j] Ord_otype[OF _ well_ord_is_trans_on]
+        otypeE[of j] ordertype_ord_iso[of A r]
+      by auto
   qed
-  ultimately
-  show "otype(M, A, r, i)" by simp
 qed
 
 lemma (in M_ordertype) ordertype_closed[intro,simp]: "\<lbrakk> wellordered(M,A,r);M(A);M(r)\<rbrakk> \<Longrightarrow> M(ordertype(A,r))"
   using ordertype_exists ordertypes_are_absolute by blast
 
 (*
-definition
-  jump_cardinal :: "i=>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) ==
-         \<Union>X\<in>Pow(K). {z. r \<in> Pow(K*K), well_ord(X,r) & z = ordertype(X,r)}"
+This apparent duplication of definitions is needed because in ZF-Constructible
+pairs are in their absolute version and this breaks the synthesis of formulas.
 *)
 
 relationalize "transitive_rel" "is_transitive" external
 synthesize "is_transitive" from_definition assuming "nonempty"
 arity_theorem for "is_transitive_fm"
 
 lemma (in M_trivial) is_transitive_iff_transitive_rel:
   "M(A)\<Longrightarrow> M(r) \<Longrightarrow> transitive_rel(M, A, r) \<longleftrightarrow> is_transitive(M,A, r)"
   unfolding transitive_rel_def is_transitive_def by simp
 
 relationalize "linear_rel" "is_linear" external
 synthesize "is_linear" from_definition assuming "nonempty"
 arity_theorem for "is_linear_fm"
+reldb_add relational "transitive_on" "transitive_rel"
+reldb_add relational "linear_on" "linear_rel"
+reldb_add functional "transitive_on" "transitive_rel"
+reldb_add functional "linear_on" "linear_rel"
 
 lemma (in M_trivial) is_linear_iff_linear_rel:
   "M(A)\<Longrightarrow> M(r) \<Longrightarrow> is_linear(M,A, r) \<longleftrightarrow> linear_rel(M, A, r)"
   unfolding linear_rel_def is_linear_def by simp
 
 relationalize "wellfounded_on" "is_wellfounded_on" external
 synthesize "is_wellfounded_on" from_definition assuming "nonempty"
 arity_theorem for "is_wellfounded_on_fm"
 
 lemma (in M_trivial) is_wellfounded_on_iff_wellfounded_on:
   "M(A)\<Longrightarrow> M(r) \<Longrightarrow> is_wellfounded_on(M,A, r) \<longleftrightarrow> wellfounded_on(M, A, r)"
   unfolding wellfounded_on_def is_wellfounded_on_def by simp
 
 definition
   is_well_ord :: "[i=>o,i,i]=>o" where
   \<comment> \<open>linear and wellfounded on \<open>A\<close>\<close>
   "is_well_ord(M,A,r) ==
         is_transitive(M,A,r) \<and> is_linear(M,A,r) \<and> is_wellfounded_on(M,A,r)"
 
 lemma (in M_trivial) is_well_ord_iff_wellordered:
   "M(A)\<Longrightarrow> M(r) \<Longrightarrow>  is_well_ord(M,A, r) \<longleftrightarrow> wellordered(M, A, r)"
   using is_wellfounded_on_iff_wellfounded_on is_linear_iff_linear_rel
     is_transitive_iff_transitive_rel
   unfolding wellordered_def is_well_ord_def by simp
 
+synthesize "is_well_ord" from_definition assuming "nonempty"
+arity_theorem for "is_well_ord_fm"
 reldb_add relational "well_ord" "is_well_ord"
 reldb_add functional "well_ord" "well_ord"
-synthesize "is_well_ord" from_definition assuming "nonempty"
-arity_theorem for "is_well_ord_fm"
 
 \<comment> \<open>One keyword (functional or relational) means going
     from an absolute term to that kind of term\<close>
 reldb_add relational "Order.pred" "pred_set"
 
 \<comment> \<open>The following form (twice the same argument) is only correct
     when an "\_abs" theorem is available\<close>
 reldb_add functional "Order.pred" "Order.pred"
 
 (*
 \<comment> \<open>Two keywords denote origin and destination, respectively\<close>
 reldb_add functional relational "Ord" "ordinal"
 *)
 
 relativize functional "ord_iso" "ord_iso_rel" external
   \<comment> \<open>The following corresponds to "relativize functional relational"\<close>
 relationalize "ord_iso_rel" "is_ord_iso"
 
 context M_pre_cardinal_arith
 begin
 
 is_iff_rel for "ord_iso"
   using bij_rel_iff
   unfolding is_ord_iso_def ord_iso_rel_def
   by simp
 
 rel_closed for "ord_iso"
   using ord_iso_separation unfolding ord_iso_rel_def
   by simp
 
 end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
 
 synthesize "is_ord_iso" from_definition assuming "nonempty"
 
-lemma is_lambda_iff_sats[iff_sats]:
-  assumes is_F_iff_sats:
-    "!!a0 a1 a2.
-        [|a0\<in>Aa; a1\<in>Aa; a2\<in>Aa|]
-        ==> is_F(a1, a0) \<longleftrightarrow> sats(Aa, is_F_fm, Cons(a0,Cons(a1,Cons(a2,env))))"
-  shows
-    "nth(A, env) = Ab \<Longrightarrow>
-    nth(r, env) = ra \<Longrightarrow>
-    A \<in> nat \<Longrightarrow>
-    r \<in> nat \<Longrightarrow>
-    env \<in> list(Aa) \<Longrightarrow>
-    is_lambda(##Aa, Ab, is_F, ra) \<longleftrightarrow> Aa, env \<Turnstile> lambda_fm(is_F_fm,A, r)"
-  using sats_lambda_fm[OF assms, of A r] by simp
-
-\<comment> \<open>same as @{thm sats_is_wfrec_fm}, but changing length assumptions to
-    \<^term>\<open>0\<close> being in the model\<close>
-lemma sats_is_wfrec_fm':
-  assumes MH_iff_sats:
-    "!!a0 a1 a2 a3 a4.
-        [|a0\<in>A; a1\<in>A; a2\<in>A; a3\<in>A; a4\<in>A|]
-        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(A, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
-  shows
-    "[|x \<in> nat; y \<in> nat; z \<in> nat; env \<in> list(A); 0 \<in> A|]
-       ==> sats(A, is_wfrec_fm(p,x,y,z), env) \<longleftrightarrow>
-           is_wfrec(##A, MH, nth(x,env), nth(y,env), nth(z,env))"
-  using MH_iff_sats [THEN iff_sym] nth_closed sats_is_recfun_fm
-  by (simp add: is_wfrec_fm_def is_wfrec_def) blast
-
-lemma is_wfrec_iff_sats'[iff_sats]:
-  assumes MH_iff_sats:
-    "!!a0 a1 a2 a3 a4.
-        [|a0\<in>Aa; a1\<in>Aa; a2\<in>Aa; a3\<in>Aa; a4\<in>Aa|]
-        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
-    "nth(x, env) = xx" "nth(y, env) = yy" "nth(z, env) = zz"
-    "x \<in> nat" "y \<in> nat" "z \<in> nat" "env \<in> list(Aa)" "0 \<in> Aa"
-  shows
-    "is_wfrec(##Aa, MH, xx, yy, zz) \<longleftrightarrow> Aa, env \<Turnstile> is_wfrec_fm(p,x,y,z)"
-  using assms(2-4) sats_is_wfrec_fm'[OF assms(1,5-9)] by simp
-
-lemma is_wfrec_on_iff_sats[iff_sats]:
-  assumes MH_iff_sats:
-    "!!a0 a1 a2 a3 a4.
-        [|a0\<in>Aa; a1\<in>Aa; a2\<in>Aa; a3\<in>Aa; a4\<in>Aa|]
-        ==> MH(a2, a1, a0) \<longleftrightarrow> sats(Aa, p, Cons(a0,Cons(a1,Cons(a2,Cons(a3,Cons(a4,env))))))"
-  shows
-    "nth(x, env) = xx \<Longrightarrow>
-    nth(y, env) = yy \<Longrightarrow>
-    nth(z, env) = zz \<Longrightarrow>
-    x \<in> nat \<Longrightarrow>
-    y \<in> nat \<Longrightarrow>
-    z \<in> nat \<Longrightarrow>
-    env \<in> list(Aa) \<Longrightarrow>
-    0 \<in> Aa \<Longrightarrow> is_wfrec_on(##Aa, MH, aa,xx, yy, zz) \<longleftrightarrow> Aa, env \<Turnstile> is_wfrec_fm(p,x,y,z)"
-  using assms sats_is_wfrec_fm'[OF assms] unfolding is_wfrec_on_def by simp
-
 lemma trans_on_iff_trans: "trans[A](r) \<longleftrightarrow> trans(r \<inter> A\<times>A)"
   unfolding trans_on_def trans_def by auto
 
 lemma trans_on_subset: "trans[A](r) \<Longrightarrow> B \<subseteq> A \<Longrightarrow> trans[B](r)"
   unfolding trans_on_def
   by auto
 
 lemma relation_Int: "relation(r \<inter> B\<times>B)"
   unfolding relation_def
   by auto
 
 text\<open>Discipline for \<^term>\<open>ordermap\<close>\<close>
 relativize functional "ordermap" "ordermap_rel" external
 relationalize "ordermap_rel" "is_ordermap"
 
-context M_pre_cardinal_arith
-begin
-
 lemma wfrec_on_pred_eq:
-  assumes "r \<in> Pow(A\<times>A)" "M(A)" "M(r)"
+  assumes "r \<in> Pow(A\<times>A)"
   shows "wfrec[A](r, x, \<lambda>x f. f `` Order.pred(A, x, r)) = wfrec(r, x, \<lambda>x f. f `` Order.pred(A, x, r))"
 proof -
   from \<open>r \<in> Pow(A\<times>A)\<close>
   have "r \<inter> A\<times>A = r" by auto
-  moreover from this
+  then
   show ?thesis
     unfolding wfrec_on_def by simp
 qed
 
+context M_pre_cardinal_arith
+begin
+
 lemma wfrec_on_pred_closed:
-  assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)" "M(A)" "M(r)" "x \<in> A"
+  assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow\<^bsup>M\<^esup>(A\<times>A)" "M(A)" "x \<in> A"
   shows "M(wfrec(r, x, \<lambda>x f. f `` Order.pred(A, x, r)))"
 proof -
-  from assms
+  note assms
+  moreover from this
+  have "M(r)" "M(x)"
+    using transM[of _ "Pow\<^bsup>M\<^esup>(A\<times>A)"] transM[of _ A]
+    by simp_all
+  moreover from calculation
   have "wfrec[A](r, x, \<lambda>x f. f `` Order.pred(A, x, r)) = wfrec(r, x, \<lambda>x f. f `` Order.pred(A, x, r))"
-    using wfrec_on_pred_eq by simp
-  moreover from assms
+    using wfrec_on_pred_eq Pow_rel_char
+    by simp
+  moreover from calculation
   have "M(wfrec(r, x, \<lambda>x f. f `` Order.pred(A, x, r)))"
     using wfrec_pred_replacement wf_on_imp_wf trans_on_imp_trans subset_Sigma_imp_relation
+      Pow_rel_char
     by (rule_tac MH="\<lambda>x f b. \<exists>a[M]. image(M, f, a, b) \<and> pred_set(M, A, x, r, a)" in trans_wfrec_closed)
       (auto dest:transM simp:relation2_def)
   ultimately
-  show ?thesis by simp
+  show ?thesis
+    by simp
 qed
 
 lemma wfrec_on_pred_closed':
-  assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)" "M(A)" "M(r)" "x \<in> A"
+  assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow\<^bsup>M\<^esup>(A\<times>A)" "M(A)" "x \<in> A"
   shows "M(wfrec[A](r, x, \<lambda>x f. f `` Order.pred(A, x, r)))"
-  using assms wfrec_on_pred_closed wfrec_on_pred_eq by simp
+  using assms wfrec_on_pred_closed wfrec_on_pred_eq Pow_rel_char
+  by simp
 
-
-lemma ordermap_rel_closed':
-  assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)" "M(A)" "M(r)"
+lemma ordermap_rel_closed[intro,simp]:
+  assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow\<^bsup>M\<^esup>(A\<times>A)" "M(A)"
   shows "M(ordermap_rel(M, A, r))"
 proof -
   from assms
-  have "r \<inter> A\<times>A = r" by auto
-  with assms have "wf(r)" "trans(r)" "relation(r)"
-    unfolding wf_on_def using trans_on_iff_trans relation_def by auto
-  then
+  have "r \<inter> A\<times>A = r" "r\<in>Pow(A\<times>A)" "M(r)"
+    using Pow_rel_char
+    by auto
+  with assms
+  have "wf(r)" "trans(r)" "relation(r)"
+    unfolding wf_on_def
+    using trans_on_iff_trans relation_def by auto
+  with \<open>M(A)\<close> \<open>M(r)\<close>
   have 1:"\<And> x z . M(x) \<Longrightarrow> M(z) \<Longrightarrow>
     (\<exists>y[M]. pair(M, x, y, z) \<and> is_wfrec(M, \<lambda>x f z. z = f `` Order.pred(A, x, r), r, x, y))
       \<longleftrightarrow>
     z = <x,wfrec(r,x,\<lambda>x f. f `` Order.pred(A, x, r))>"
     using trans_wfrec_abs[of r,where
         H="\<lambda>x f. f `` Order.pred(A, x, r)" and
-        MH="\<lambda>x f z . z= f `` Order.pred(A, x, r)",simplified] assms
-      wfrec_pred_replacement unfolding relation2_def
+        MH="\<lambda>x f z . z= f `` Order.pred(A, x, r)",simplified]
+      wfrec_pred_replacement
+    unfolding relation2_def
     by auto
-  then
+  with \<open>M(A)\<close> \<open>M(r)\<close>
   have "strong_replacement(M,\<lambda>x z. z = <x,wfrec(r,x,\<lambda>x f. f `` Order.pred(A, x, r))>)"
     using strong_replacement_cong[of M,OF 1,THEN iffD1,OF _ _
-        wfrec_pred_replacement[unfolded wfrec_replacement_def]] assms by simp
-  then show ?thesis
-    using Pow_iff assms
+        wfrec_pred_replacement[unfolded wfrec_replacement_def]]
+    by simp
+  with \<open>M(A)\<close> \<open>M(r)\<close> \<open>r \<in> Pow(A\<times>A)\<close> assms
+  show ?thesis
     unfolding ordermap_rel_def
-    apply(subst lam_cong[OF refl wfrec_on_pred_eq],simp_all)
-    using wfrec_on_pred_closed lam_closed
-    by simp
+    using lam_cong[OF refl wfrec_on_pred_eq] wfrec_on_pred_closed lam_closed
+    by auto
 qed
 
-lemma ordermap_rel_closed[intro,simp]:
-  assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)"
-  shows "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(ordermap_rel(M, A, r))"
-  using ordermap_rel_closed' assms by simp
-
 lemma is_ordermap_iff:
-  assumes "r \<in> Pow(A\<times>A)" "wf[A](r)" "trans[A](r)"
-    "M(A)" "M(r)" "M(res)"
+  assumes "r \<in> Pow\<^bsup>M\<^esup>(A\<times>A)" "wf[A](r)" "trans[A](r)"
+    "M(A)" "M(res)"
   shows "is_ordermap(M, A, r, res) \<longleftrightarrow> res = ordermap_rel(M, A, r)"
 proof -
-  from \<open>r \<in> Pow(A\<times>A)\<close>
-  have "r \<inter> A\<times>A = r" by auto
-  with assms have 1:"wf(r)" "trans(r)" "relation(r)"
-    unfolding wf_on_def using trans_on_iff_trans relation_def by auto
-  from assms
-  have "r \<inter> A\<times>A = r" "r \<subseteq> A\<times>A" "<x,y> \<in> r \<Longrightarrow> x\<in>A \<and> y\<in>A" for x y by auto
-  then
+  from \<open>r \<in> _\<close> \<open>M(A)\<close>
+  have "r \<inter> A\<times>A = r" "M(r)" "r \<in> Pow(A\<times>A)" "\<And> x y . <x,y>\<in>r \<Longrightarrow> x\<in>A"
+    using Pow_rel_char
+    by auto
+  with assms
+  have 1:"wf(r)" "trans(r)" "relation(r)"
+    unfolding wf_on_def
+    using trans_on_iff_trans relation_def by auto
+  with \<open>r\<in>Pow(A\<times>A)\<close>
   show ?thesis
     using ordermap_rel_closed[of r A] assms wfrec_on_pred_closed wfrec_pred_replacement 1
     unfolding is_ordermap_def ordermap_rel_def
-    apply (rule_tac lambda_abs2)
-       apply (simp_all add:Relation1_def)
-     apply clarify
-     apply (rule trans_wfrec_on_abs)
-               apply (auto dest:transM simp add: relation_Int relation2_def)
+    apply (rule_tac lambda_abs2,simp_all add:Relation1_def,clarify)
+    apply (rule trans_wfrec_on_abs)
+    apply (auto dest:transM simp add: relation_Int relation2_def)
     by(rule_tac wfrec_on_pred_closed'[of A r],auto)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
 
-synthesize "is_ordermap" from_definition assuming "nonempty"
-
 text\<open>Discipline for \<^term>\<open>ordertype\<close>\<close>
 relativize functional "ordertype" "ordertype_rel" external
 relationalize "ordertype_rel" "is_ordertype"
 
+definition is_order_body
+  where "is_order_body(M,X,r,z) \<equiv> \<exists>A[M]. cartprod(M,X,X,A) \<and> subset(M,r,A) \<and> M(z) \<and> M(r) \<and>
+           wellordered(M,X,r) \<and> is_ordertype(M,X,r,z)"
+
 context M_pre_cardinal_arith
 begin
 
 lemma is_ordertype_iff:
-  assumes "r \<in> Pow(A\<times>A)" "wf[A](r)" "trans[A](r)"
-  shows "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(res) \<Longrightarrow> is_ordertype(M, A, r, res) \<longleftrightarrow> res = ordertype_rel(M, A, r)"
+  assumes "r \<in> Pow\<^bsup>M\<^esup>(A\<times>A)" "wf[A](r)" "trans[A](r)"
+  shows "M(A) \<Longrightarrow> M(res) \<Longrightarrow> is_ordertype(M, A, r, res) \<longleftrightarrow> res = ordertype_rel(M, A, r)"
   using assms is_ordermap_iff[of r A] trans_on_iff_trans
     ordermap_rel_closed[of A r]
   unfolding is_ordertype_def ordertype_rel_def wf_on_def by simp
 
 lemma is_ordertype_iff':
-  assumes "r \<in> Pow_rel(M,A\<times>A)" "well_ord(A,r)"
-  shows "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(res) \<Longrightarrow> is_ordertype(M, A, r, res) \<longleftrightarrow> res = ordertype_rel(M, A, r)"
+  assumes "r \<in> Pow\<^bsup>M\<^esup>(A\<times>A)" "well_ord(A,r)"
+  shows "M(A) \<Longrightarrow> M(res) \<Longrightarrow> is_ordertype(M, A, r, res) \<longleftrightarrow> res = ordertype_rel(M, A, r)"
   using assms is_ordertype_iff Pow_rel_char
   unfolding well_ord_def part_ord_def tot_ord_def by simp
 
-lemma is_ordertype_iff'':
-  assumes "well_ord(A,r)" "r\<subseteq>A\<times>A"
-  shows "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(res) \<Longrightarrow> is_ordertype(M, A, r, res) \<longleftrightarrow> res = ordertype_rel(M, A, r)"
-  using assms is_ordertype_iff
-  unfolding well_ord_def part_ord_def tot_ord_def by simp
-
-end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
-
-synthesize "is_ordertype" from_definition assuming "nonempty"
-
-\<comment> \<open>NOTE: not quite the same as \<^term>\<open>jump_cardinal\<close>,
-    note \<^term>\<open>Pow(X*X)\<close>.\<close>
-definition
-  jump_cardinal' :: "i\<Rightarrow>i"  where
-  "jump_cardinal'(K) \<equiv>
-         \<Union>X\<in>Pow(K). {z. r \<in> Pow(X*X), well_ord(X,r) & z = ordertype(X,r)}"
-
-relativize functional "jump_cardinal'" "jump_cardinal'_rel" external
-relationalize "jump_cardinal'_rel" "is_jump_cardinal'"
-synthesize "is_jump_cardinal'" from_definition assuming "nonempty"
-arity_theorem for "is_jump_cardinal'_fm"
-definition jump_cardinal_body' where
-  "jump_cardinal_body'(X) \<equiv> {z . r \<in> Pow(X \<times> X),  well_ord(X, r) \<and> z = ordertype(X, r)}"
-
-relativize functional "jump_cardinal_body'" "jump_cardinal_body'_rel" external
-relationalize "jump_cardinal_body'_rel" "is_jump_cardinal_body'"
-synthesize "is_jump_cardinal_body'" from_definition assuming "nonempty"
-arity_theorem for "is_jump_cardinal_body'_fm"
-
-context M_pre_cardinal_arith
-begin
-
-lemma ordertype_rel_closed':
-  assumes "wf[A](r)" "trans[A](r)" "r \<in> Pow(A\<times>A)" "M(r)" "M(A)"
-  shows "M(ordertype_rel(M,A,r))"
-  unfolding ordertype_rel_def
-  using ordermap_rel_closed image_closed assms by simp
-
-lemma ordertype_rel_closed[intro,simp]:
-  assumes "well_ord(A,r)" "r \<in> Pow_rel(M,A\<times>A)" "M(A)"
-  shows "M(ordertype_rel(M,A,r))"
-  using assms Pow_rel_char ordertype_rel_closed'
-  unfolding well_ord_def tot_ord_def part_ord_def
-  by simp
-
 lemma ordertype_rel_abs:
   assumes "wellordered(M,X,r)" "M(X)" "M(r)"
   shows "ordertype_rel(M,X,r) = ordertype(X,r)"
   using assms ordertypes_are_absolute[of X r]
   unfolding ordertype_def ordertype_rel_def ordermap_rel_def ordermap_def
   by simp
 
-lemma univalent_aux1: "M(X) \<Longrightarrow> univalent(M,Pow_rel(M,X\<times>X),
-  \<lambda>r z. M(z) \<and> M(r) \<and> r\<in>Pow_rel(M,X\<times>X) \<and> is_well_ord(M, X, r) \<and> is_ordertype(M, X, r, z))"
-  using is_well_ord_iff_wellordered
-    is_ordertype_iff[of _ X]
-    trans_on_subset[OF well_ord_is_trans_on]
-    well_ord_is_wf[THEN wf_on_subset_A] mem_Pow_rel_abs
-  unfolding univalent_def
-  by (simp)
+lemma (in M_pre_cardinal_arith) is_order_body_abs :
+  "M(X) \<Longrightarrow> M(x) \<Longrightarrow> M(z) \<Longrightarrow> is_order_body(M, X, x, z) \<longleftrightarrow>
+   M(z) \<and> x\<in>Pow\<^bsup>M\<^esup>(X\<times>X) \<and> well_ord(X, x) \<and> z = ordertype(X, x)"
+  using is_ordertype_iff' ordertype_rel_abs well_ord_is_linear Pow_rel_char
+  unfolding is_order_body_def
+  by simp
 
-lemma jump_cardinal_body_eq :
-  "M(X) \<Longrightarrow> jump_cardinal_body(M,X) = jump_cardinal_body'_rel(M,X)"
-  unfolding jump_cardinal_body_def jump_cardinal_body'_rel_def
-  using ordertype_rel_abs
-  by auto
+lemma well_ord_restr: "well_ord(X, r) \<Longrightarrow> well_ord(X, r \<inter> X\<times>X)"
+proof -
+  have "r \<inter> X\<times>X \<inter> X\<times>X = r \<inter> X\<times>X" by auto
+  moreover
+  assume "well_ord(X, r)"
+  ultimately
+  show ?thesis
+    unfolding well_ord_def tot_ord_def part_ord_def linear_def
+      irrefl_def wf_on_def
+    by simp_all (simp only: trans_on_def, blast)
+qed
+
+lemma ordertype_restr_eq :
+  assumes "well_ord(X,r)"
+  shows "ordertype(X, r) = ordertype(X, r \<inter> X\<times>X)"
+  using ordermap_restr_eq assms unfolding ordertype_def
+  by simp
+
+lemma ordertype_rel_closed[intro,simp]:
+  assumes "well_ord(A,r)" "r \<in> Pow\<^bsup>M\<^esup>(A\<times>A)" "M(A)"
+  shows "M(ordertype_rel(M,A,r))"
+  using assms Pow_rel_char
+  unfolding well_ord_def tot_ord_def part_ord_def ordertype_rel_def
+  by simp
 
 end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
 
-context M_cardinal_arith
-begin
-lemma jump_cardinal_closed_aux1:
-  assumes "M(X)"
-  shows
-    "M(jump_cardinal_body(M,X))"
-  unfolding jump_cardinal_body_def
-  using \<open>M(X)\<close> ordertype_rel_abs
-    ordertype_replacement[OF \<open>M(X)\<close>] univalent_aux1[OF \<open>M(X)\<close>]
-    strong_replacement_closed[where A="Pow\<^bsup>M\<^esup>(X \<times> X)" and
-      P="\<lambda> r z . M(z) \<and> M(r) \<and>  r \<in> Pow\<^bsup>M\<^esup>(X \<times> X) \<and> well_ord(X, r) \<and> z = ordertype(X, r)"]
-  by auto
-
-lemma univalent_jc_body: "M(X) \<Longrightarrow> univalent(M,X,\<lambda> x z . M(z) \<and> M(x) \<and> z = jump_cardinal_body(M,x))"
-  using transM[of _ X]  jump_cardinal_closed_aux1 by auto
-
-lemma jump_cardinal_body_closed:
-  assumes "M(K)"
-  shows "M({a . X \<in> Pow\<^bsup>M\<^esup>(K), M(a) \<and> M(X) \<and> a = jump_cardinal_body(M,X)})"
-  using assms univalent_jc_body jump_cardinal_closed_aux1 strong_replacement_jc_body
-  by simp
-
-rel_closed for "jump_cardinal'"
-  using jump_cardinal_body_closed ordertype_rel_abs
-  unfolding jump_cardinal_body_def jump_cardinal'_rel_def
-  by simp
+relativize functional "jump_cardinal_body" "jump_cardinal_body_rel"
+relationalize "jump_cardinal_body_rel" "is_jump_cardinal_body_rel"
 
-is_iff_rel for "jump_cardinal'"
-proof -
-  assume types: "M(K)" "M(res)"
-  have "is_Replace(M, Pow_rel(M,X\<times>X), \<lambda>r z. M(z) \<and> M(r) \<and> is_well_ord(M, X, r) \<and> is_ordertype(M, X, r, z),
-   a) \<longleftrightarrow> a = {z . r \<in> Pow_rel(M,X\<times>X), M(z) \<and> M(r) \<and> is_well_ord(M,X,r) \<and> is_ordertype(M, X, r, z)}"
-    if "M(X)" "M(a)" for X a
-    using that univalent_aux1
-    by (rule_tac Replace_abs) (simp_all)
-  then
-  have "is_Replace(M, Pow_rel(M,X\<times>X), \<lambda>r z. M(z) \<and> M(r) \<and> is_well_ord(M, X, r) \<and> is_ordertype(M, X, r, z),
-   a) \<longleftrightarrow> a = {z . r \<in> Pow_rel(M,X\<times>X), M(z) \<and> M(r) \<and> well_ord(X, r) \<and> z = ordertype_rel(M, X, r)}"
-    if "M(X)" "M(a)" for X a
-    using that univalent_aux1 is_ordertype_iff' is_well_ord_iff_wellordered well_ord_abs by auto
-  moreover
-  have "is_Replace(M, d, \<lambda>X a. M(a) \<and> M(X) \<and>
-      a = {z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> M(r) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}, e)
-    \<longleftrightarrow>
-    e ={a . X \<in> d, M(a) \<and> M(X) \<and> a = jump_cardinal_body(M,X)}"
-    if "M(d)" "M(e)" for d e
-    using jump_cardinal_closed_aux1 that
-    unfolding jump_cardinal_body_def
-    by (rule_tac Replace_abs) simp_all
-  ultimately
-  show ?thesis
-    using Pow_rel_iff jump_cardinal_body_closed[of K] ordertype_rel_abs
-    unfolding is_jump_cardinal'_def jump_cardinal'_rel_def jump_cardinal_body_def
-    by (simp add: types)
-qed
+relativize functional "jump_cardinal_body'" "jump_cardinal_body'_rel"
+relationalize "jump_cardinal_body'_rel" "is_jump_cardinal_body'_rel"
 
-end
+\<comment> \<open>NOTE: not quite the same as \<^term>\<open>jump_cardinal\<close>,
+    note \<^term>\<open>Pow(X*X)\<close>.\<close>
+definition
+  jump_cardinal' :: "i\<Rightarrow>i"  where
+  "jump_cardinal'(K) \<equiv>
+         \<Union>X\<in>Pow(K). {z. r \<in> Pow(X*X), z = jump_cardinal_body(Pow(X*X),X)}"
 
-context M_cardinal_arith
-begin
+relativize functional "jump_cardinal" "jump_cardinal_rel" external
+relativize functional "trans_on" "transitivie_rel" external
+relationalize "jump_cardinal_rel" "is_jump_cardinal"
+
 
 lemma (in M_ordertype) ordermap_closed[intro,simp]:
   assumes "wellordered(M,A,r)" and types:"M(A)" "M(r)"
   shows "M(ordermap(A,r))"
 proof -
   note assms
   moreover from this
   obtain i f where "Ord(i)" "f \<in> ord_iso(A, r, i, Memrel(i))"
     "M(i)" "M(f)" using ordertype_exists by blast
   moreover from calculation
   have "i = ordertype(A,r)" using ordertypes_are_absolute by force
   moreover from calculation
   have "ordermap(A,r) \<in> ord_iso(A, r, i, Memrel(i))"
     using ordertype_ord_iso by simp
   ultimately
   have "f = ordermap(A,r)" using well_ord_iso_unique by fastforce
   with \<open>M(f)\<close>
   show ?thesis by simp
 qed
 
+context M_pre_cardinal_arith
+begin
+
+lemma def_jump_cardinal_body:
+  "M(X) \<Longrightarrow> M(U) \<Longrightarrow>
+  jump_cardinal_body(U,X) = {z . r \<in> U, M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}"
+  unfolding jump_cardinal_body_def
+  using ordertype_closed
+  by(rule_tac Replace_cong,auto dest:transM)
+
+lemma jump_cardinal_body_abs:
+  shows "M(A) \<Longrightarrow> jump_cardinal_body_rel(M,Pow\<^bsup>M\<^esup>(A\<times>A),A) = jump_cardinal_body(Pow\<^bsup>M\<^esup>(A\<times>A),A)"
+  unfolding jump_cardinal_body_rel_def
+  using def_jump_cardinal_body ordertype_rel_abs transM[of _ "Pow\<^bsup>M\<^esup>(A\<times>A)"]
+  by simp
+
+end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
+
+locale M_cardinal_arith = M_pre_cardinal_arith +
+  assumes
+    ordertype_replacement_ax :
+    "M(X) \<Longrightarrow> strong_replacement(M,\<lambda> x z . is_well_ord(M,X, x) \<and> is_ordertype(M,X,x,z))"
+    and
+    strong_replacement_jc_body :
+    "strong_replacement(M,\<lambda> x z . z = jump_cardinal_body_rel(M,Pow\<^bsup>M\<^esup>(x\<times>x),x))"
+begin
+
+lemma jump_cardinal_closed_aux1:
+  assumes "M(X)"
+  shows "M(jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X),X))"
+proof -
+  note \<open>M(X)\<close>
+  moreover from this
+  have "univalent(M,Pow\<^bsup>M\<^esup>(X\<times>X),
+  \<lambda>r z. M(z) \<and> r\<in>Pow\<^bsup>M\<^esup>(X\<times>X) \<and> well_ord(X, r) \<and> is_ordertype(M, X, r, z))"
+    using
+      is_ordertype_iff[of _ X]
+      trans_on_subset[OF well_ord_is_trans_on]
+      well_ord_is_wf[THEN wf_on_subset_A] mem_Pow_rel_abs
+    unfolding univalent_def
+    by simp
+  moreover from calculation
+  have "jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X),X) =
+    jump_cardinal_body_rel(M,Pow\<^bsup>M\<^esup>(X \<times> X),X)"
+    using jump_cardinal_body_abs
+    by simp
+  moreover from calculation
+  have "jump_cardinal_body_rel(M,Pow\<^bsup>M\<^esup>(X \<times> X),X) =
+  {z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> M(r) \<and> well_ord(X, r) \<and> is_ordertype(M,X, r,z)}"
+    using ordertype_rel_closed transM[of _ "Pow\<^bsup>M\<^esup>(X\<times>X)"] is_ordertype_iff'
+    unfolding jump_cardinal_body_rel_def
+    by auto
+  moreover from calculation
+  have "M({z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> M(r) \<and> well_ord(X, r) \<and> is_ordertype(M,X, r,z)})"
+    using ordertype_replacement_ax is_well_ord_iff_wellordered
+    by(rule_tac strong_replacement_closed,auto)
+  ultimately
+  show ?thesis by simp
+qed
+
+lemma jump_cardinal_body_closed:
+  assumes "M(K)"
+  shows "M({jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X),X) . X \<in> Pow\<^bsup>M\<^esup>(K)})"
+proof -
+  have "univalent(M,X,\<lambda> x z . z = jump_cardinal_body(Pow\<^bsup>M\<^esup>(x \<times> x),x))" if "M(X)" for X
+    using transM[of _ X]  jump_cardinal_closed_aux1
+    by auto
+  then
+  show ?thesis
+    using assms jump_cardinal_closed_aux1 strong_replacement_jc_body
+      transM[of _ "Pow\<^bsup>M\<^esup>(K)"] jump_cardinal_body_abs
+    by(rule_tac RepFun_closed,auto)
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_cardinal_arith\<close>\<close>
+
+context M_pre_cardinal_arith
+begin
 
 (*A general fact about ordermap*)
 lemma ordermap_eqpoll_pred:
   "[| well_ord(A,r);  x \<in> A ; M(A);M(r);M(x)|] ==> ordermap(A,r)`x \<approx>\<^bsup>M\<^esup> Order.pred(A,x,r)"
   apply (simp add: def_eqpoll_rel)
   apply (rule rexI)
-   apply (simp add: ordermap_eq_image well_ord_is_wf)
-   apply (erule ordermap_bij [THEN bij_is_inj, THEN restrict_bij,
+  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, simp)
+  apply (rule pred_subset, simp)
   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"
     and types: "M(K)" "M(x)" "M(y)"
   shows "|ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle>|\<^bsup>M\<^esup> \<le> |succ(succ(x \<union> y))|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> |succ(succ(x \<union> y))|\<^bsup>M\<^esup>"
   using types
 proof (simp add: cmult_rel_def, rule_tac well_ord_lepoll_rel_imp_cardinal_rel_le)
   let ?z="succ(x \<union> y)"
   show "well_ord(|succ(?z)|\<^bsup>M\<^esup> \<times> |succ(?z)|\<^bsup>M\<^esup>,
                  rmult(|succ(?z)|\<^bsup>M\<^esup>, Memrel(|succ(?z)|\<^bsup>M\<^esup>), |succ(?z)|\<^bsup>M\<^esup>, Memrel(|succ(?z)|\<^bsup>M\<^esup>)))"
     by (blast intro: well_ord_Memrel well_ord_rmult types)
 next
   let ?z="succ(x \<union> y)"
   have zK: "?z<K" using x y K
     by (blast intro: Un_least_lt Limit_has_succ)
   hence oz: "Ord(?z)" by (elim ltE)
   from assms
   have Mom:"M(ordermap(K \<times> K, csquare_rel(K)))"
     using well_ord_csquare Limit_is_Ord by fastforce
   then
   have "ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle> \<lesssim>\<^bsup>M\<^esup> ordermap(K \<times> K, csquare_rel(K)) ` \<langle>?z,?z\<rangle>"
     by (blast intro: ordermap_z_lt leI le_imp_lepoll_rel K x y types)
   also have "... \<approx>\<^bsup>M\<^esup>  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 (simp_all add:types)
   also have "...  \<lesssim>\<^bsup>M\<^esup> succ(?z) \<times> succ(?z)" using zK
     by (rule_tac pred_csquare_subset [THEN subset_imp_lepoll_rel]) (simp_all add:types)
   also have "... \<approx>\<^bsup>M\<^esup> |succ(?z)|\<^bsup>M\<^esup> \<times> |succ(?z)|\<^bsup>M\<^esup>" using oz
     by (blast intro: prod_eqpoll_rel_cong Ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym types)
   finally show "ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x,y\<rangle> \<lesssim>\<^bsup>M\<^esup> |succ(?z)|\<^bsup>M\<^esup> \<times> |succ(?z)|\<^bsup>M\<^esup>"
     by (simp_all add:types Mom)
   from Mom
   show "M(ordermap(K \<times> K, csquare_rel(K)) ` \<langle>x, y\<rangle>)" by (simp_all add:types)
 qed (simp_all add:types)
 
 text\<open>Kunen: "... so the order type is \<open>\<le>\<close> K"\<close>
 lemma ordertype_csquare_le_M:
   assumes IK: "InfCard\<^bsup>M\<^esup>(K)" and eq: "\<And>y. y\<in>K \<Longrightarrow> InfCard\<^bsup>M\<^esup>(y) \<Longrightarrow> M(y) \<Longrightarrow> y \<otimes>\<^bsup>M\<^esup> y = y"
     \<comment> \<open>Note the weakened hypothesis @{thm eq}\<close>
     and types: "M(K)"
   shows "ordertype(K*K, csquare_rel(K)) \<le> K"
 proof -
   have  CK: "Card\<^bsup>M\<^esup>(K)" using IK by (rule_tac InfCard_rel_is_Card_rel) (simp_all add:types)
   hence OK: "Ord(K)"  by (rule Card_rel_is_Ord) (simp_all add:types)
   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)
     from OK types
     have "M(ordertype(K \<times> K, csquare_rel(K)))"
       using well_ord_csquare by fastforce
     with i x y types
     have types': "M(K)" "M(i)" "M(x)" "M(y)"
       using types by (auto dest:transM ltD)
     show "i < K"
     proof (rule Card_rel_lt_imp_lt [OF _ Oi CK])
       have "|i|\<^bsup>M\<^esup> \<le> |succ(succ(x \<union> y))|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> |succ(succ(x \<union> y))|\<^bsup>M\<^esup>" using IK xy
         by (auto simp add: ieq types intro: InfCard_rel_is_Limit [THEN ordermap_csquare_le] types')
       moreover have "|succ(succ(x \<union> y))|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> |succ(succ(x \<union> y))|\<^bsup>M\<^esup> < K"
       proof (cases rule: Ord_linear2 [OF ou Ord_nat])
         assume "x \<union> y < nat"
         hence "|succ(succ(x \<union> y))|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> |succ(succ(x \<union> y))|\<^bsup>M\<^esup> \<in> nat"
           by (simp add: lt_def nat_cmult_rel_eq_mult nat_succI
               nat_into_Card_rel [THEN Card_rel_cardinal_rel_eq] types')
         also have "... \<subseteq> K" using IK
           by (simp add: InfCard_rel_def le_imp_subset types)
         finally show "|succ(succ(x \<union> y))|\<^bsup>M\<^esup> \<otimes>\<^bsup>M\<^esup> |succ(succ(x \<union> y))|\<^bsup>M\<^esup> < K"
           by (simp add: ltI OK)
       next
         assume natxy: "nat \<le> x \<union> y"
         hence seq: "|succ(succ(x \<union> y))|\<^bsup>M\<^esup> = |x \<union> y|\<^bsup>M\<^esup>" using xy
           by (simp add: le_imp_subset nat_succ_eqpoll_rel [THEN cardinal_rel_cong] le_succ_iff types')
         also have "... < K" using xy
           by (simp add: Un_least_lt Ord_cardinal_rel_le [THEN lt_trans1] types')
         finally have "|succ(succ(x \<union> y))|\<^bsup>M\<^esup> < K" .
         moreover have "InfCard\<^bsup>M\<^esup>(|succ(succ(x \<union> y))|\<^bsup>M\<^esup>)" using xy natxy
           by (simp add: seq InfCard_rel_def nat_le_cardinal_rel types')
         ultimately show ?thesis by (simp add: eq ltD types')
       qed
       ultimately show "|i|\<^bsup>M\<^esup> < K" by (blast intro: lt_trans1)
     qed (simp_all add:types')
   qed
 qed
 
 (*Main result: Kunen's Theorem 10.12*)
 lemma InfCard_rel_csquare_eq:
   assumes IK: "InfCard\<^bsup>M\<^esup>(K)" and
     types: "M(K)"
   shows "K \<otimes>\<^bsup>M\<^esup> K = K"
 proof -
   have  OK: "Ord(K)" using IK by (simp add: Card_rel_is_Ord InfCard_rel_is_Card_rel types)
   from OK assms
   show "K \<otimes>\<^bsup>M\<^esup> K = K"
   proof (induct rule: trans_induct)
     case (step i)
     note types = \<open>M(K)\<close> \<open>M(i)\<close>
     show "i \<otimes>\<^bsup>M\<^esup> i = i"
     proof (rule le_anti_sym)
       from step types
       have Mot:"M(ordertype(i \<times> i, csquare_rel(i)))" "M(ordermap(i \<times> i, csquare_rel(i)))"
         using well_ord_csquare Limit_is_Ord by simp_all
       then
       have "|i \<times> i|\<^bsup>M\<^esup> = |ordertype(i \<times> i, csquare_rel(i))|\<^bsup>M\<^esup>"
         by (rule_tac cardinal_rel_cong,
             simp_all add: step.hyps well_ord_csquare [THEN ordermap_bij, THEN bij_imp_eqpoll_rel] types)
       with Mot
       have "i \<otimes>\<^bsup>M\<^esup> i \<le> ordertype(i \<times> i, csquare_rel(i))"
         by (simp add: step.hyps cmult_rel_def Ord_cardinal_rel_le well_ord_csquare [THEN Ord_ordertype] types)
       moreover
       have "ordertype(i \<times> i, csquare_rel(i)) \<le> i" using step
         by (rule_tac ordertype_csquare_le_M) (simp add: types)
       ultimately show "i \<otimes>\<^bsup>M\<^esup> i \<le> i" by (rule le_trans)
     next
       show "i \<le> i \<otimes>\<^bsup>M\<^esup> i" using step
         by (blast intro: cmult_rel_square_le InfCard_rel_is_Card_rel)
     qed
   qed
 qed
 
 
 (*Corollary for arbitrary well-ordered sets (all sets, assuming AC)*)
 lemma well_ord_InfCard_rel_square_eq:
   assumes r: "well_ord(A,r)" and I: "InfCard\<^bsup>M\<^esup>(|A|\<^bsup>M\<^esup>)" and
     types: "M(A)" "M(r)"
   shows "A \<times> A \<approx>\<^bsup>M\<^esup> A"
 proof -
   have "A \<times> A \<approx>\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup> \<times> |A|\<^bsup>M\<^esup>"
     by (blast intro: prod_eqpoll_rel_cong well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym r types)
   also have "... \<approx>\<^bsup>M\<^esup> A"
   proof (rule well_ord_cardinal_rel_eqE [OF _ r])
     show "well_ord(|A|\<^bsup>M\<^esup> \<times> |A|\<^bsup>M\<^esup>, rmult(|A|\<^bsup>M\<^esup>, Memrel(|A|\<^bsup>M\<^esup>), |A|\<^bsup>M\<^esup>, Memrel(|A|\<^bsup>M\<^esup>)))"
       by (blast intro: well_ord_rmult well_ord_Memrel r types)
   next
     show "||A|\<^bsup>M\<^esup> \<times> |A|\<^bsup>M\<^esup>|\<^bsup>M\<^esup> = |A|\<^bsup>M\<^esup>" using InfCard_rel_csquare_eq I
       by (simp add: cmult_rel_def types)
   qed (simp_all add:types)
   finally show ?thesis by (simp_all add:types)
 qed
 
 lemma InfCard_rel_square_eqpoll:
   assumes "InfCard\<^bsup>M\<^esup>(K)" and types:"M(K)" shows "K \<times> K \<approx>\<^bsup>M\<^esup> K"
   using assms
   apply (rule_tac well_ord_InfCard_rel_square_eq)
-     apply (erule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN well_ord_Memrel])
-      apply (simp_all add: InfCard_rel_is_Card_rel [THEN Card_rel_cardinal_rel_eq] types)
+  apply (erule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN well_ord_Memrel])
+  apply (simp_all add: InfCard_rel_is_Card_rel [THEN Card_rel_cardinal_rel_eq] types)
   done
 
 lemma Inf_Card_rel_is_InfCard_rel: "[| Card\<^bsup>M\<^esup>(i); ~ Finite_rel(M,i) ; M(i) |] ==> InfCard\<^bsup>M\<^esup>(i)"
   by (simp add: InfCard_rel_def Card_rel_is_Ord [THEN nat_le_infinite_Ord])
 
 subsubsection\<open>Toward's Kunen's Corollary 10.13 (1)\<close>
 
 lemma InfCard_rel_le_cmult_rel_eq: "[| InfCard\<^bsup>M\<^esup>(K);  L \<le> K;  0<L; M(K) ; M(L) |] ==> K \<otimes>\<^bsup>M\<^esup> L = K"
   apply (rule le_anti_sym)
-   prefer 2
-   apply (erule ltE, blast intro: cmult_rel_le_self InfCard_rel_is_Card_rel)
+  prefer 2
+  apply (erule ltE, blast intro: cmult_rel_le_self InfCard_rel_is_Card_rel)
   apply (frule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN le_refl]) prefer 3
-    apply (rule cmult_rel_le_mono [THEN le_trans], assumption+)
-    apply (simp_all add: InfCard_rel_csquare_eq)
+  apply (rule cmult_rel_le_mono [THEN le_trans], assumption+)
+  apply (simp_all add: InfCard_rel_csquare_eq)
   done
 
 (*Corollary 10.13 (1), for cardinal multiplication*)
 lemma InfCard_rel_cmult_rel_eq: "[| InfCard\<^bsup>M\<^esup>(K);  InfCard\<^bsup>M\<^esup>(L); M(K) ; M(L) |] ==> K \<otimes>\<^bsup>M\<^esup> L = K \<union> L"
   apply (rule_tac i = K and j = L in Ord_linear_le)
-     apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord)
-   apply (rule cmult_rel_commute [THEN ssubst]) prefer 3
-     apply (rule Un_commute [THEN ssubst])
-     apply (simp_all add: InfCard_rel_is_Limit [THEN Limit_has_0] InfCard_rel_le_cmult_rel_eq
+  apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord)
+  apply (rule cmult_rel_commute [THEN ssubst]) prefer 3
+  apply (rule Un_commute [THEN ssubst])
+  apply (simp_all add: InfCard_rel_is_Limit [THEN Limit_has_0] InfCard_rel_le_cmult_rel_eq
       subset_Un_iff2 [THEN iffD1] le_imp_subset)
   done
 
 lemma InfCard_rel_cdouble_eq: "InfCard\<^bsup>M\<^esup>(K) \<Longrightarrow> M(K) \<Longrightarrow>  K \<oplus>\<^bsup>M\<^esup> K = K"
   apply (simp add: cmult_rel_2 [symmetric] InfCard_rel_is_Card_rel cmult_rel_commute)
   apply (simp add: InfCard_rel_le_cmult_rel_eq InfCard_rel_is_Limit Limit_has_0 Limit_has_succ)
   done
 
 (*Corollary 10.13 (1), for cardinal addition*)
 lemma InfCard_rel_le_cadd_rel_eq: "[| InfCard\<^bsup>M\<^esup>(K);  L \<le> K ; M(K) ; M(L)|] ==> K \<oplus>\<^bsup>M\<^esup> L = K"
   apply (rule le_anti_sym)
-   prefer 2
-   apply (erule ltE, blast intro: cadd_rel_le_self InfCard_rel_is_Card_rel)
+  prefer 2
+  apply (erule ltE, blast intro: cadd_rel_le_self InfCard_rel_is_Card_rel)
   apply (frule InfCard_rel_is_Card_rel [THEN Card_rel_is_Ord, THEN le_refl]) prefer 3
-    apply (rule cadd_rel_le_mono [THEN le_trans], assumption+)
-    apply (simp_all add: InfCard_rel_cdouble_eq)
+  apply (rule cadd_rel_le_mono [THEN le_trans], assumption+)
+  apply (simp_all add: InfCard_rel_cdouble_eq)
   done
 
 lemma InfCard_rel_cadd_rel_eq: "[| InfCard\<^bsup>M\<^esup>(K);  InfCard\<^bsup>M\<^esup>(L); M(K) ; M(L) |] ==> K \<oplus>\<^bsup>M\<^esup> L = K \<union> L"
   apply (rule_tac i = K and j = L in Ord_linear_le)
-     apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord)
-   apply (rule cadd_rel_commute [THEN ssubst]) prefer 3
-     apply (rule Un_commute [THEN ssubst])
-     apply (simp_all add: InfCard_rel_le_cadd_rel_eq subset_Un_iff2 [THEN iffD1] le_imp_subset)
+  apply (typecheck add: InfCard_rel_is_Card_rel Card_rel_is_Ord)
+  apply (rule cadd_rel_commute [THEN ssubst]) prefer 3
+  apply (rule Un_commute [THEN ssubst])
+  apply (simp_all add: InfCard_rel_le_cadd_rel_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) ==> |list(K)| = K.
 *)
 
-end \<comment> \<open>\<^locale>\<open>M_cardinal_arith\<close>\<close>
+end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
 
 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>
 
 locale M_cardinal_arith_jump = M_cardinal_arith + M_ordertype
 begin
 
-lemma well_ord_restr: "well_ord(X, r) \<Longrightarrow> well_ord(X, r \<inter> X\<times>X)"
-proof -
-  have "r \<inter> X\<times>X \<inter> X\<times>X = r \<inter> X\<times>X" by auto
-  moreover
-  assume "well_ord(X, r)"
-  ultimately
-  show ?thesis
-    unfolding well_ord_def tot_ord_def part_ord_def linear_def
-      irrefl_def wf_on_def
-    by simp_all (simp only: trans_on_def, blast)
-qed
-
-lemma ordertype_restr_eq :
-  assumes "well_ord(X,r)"
-  shows "ordertype(X, r) = ordertype(X, r \<inter> X\<times>X)"
-  using ordermap_restr_eq assms unfolding ordertype_def
-  by simp
-
 lemma def_jump_cardinal_rel_aux:
-  "X \<in> Pow\<^bsup>M\<^esup>(K) \<Longrightarrow> well_ord(X, w) \<Longrightarrow> M(K) \<Longrightarrow>
+  "X \<in> Pow\<^bsup>M\<^esup>(K) \<Longrightarrow> M(K) \<Longrightarrow>
   {z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)} =
   {z . r \<in> Pow\<^bsup>M\<^esup>(K \<times> K), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}"
 proof(rule,auto simp:Pow_rel_char dest:transM)
   let ?L="{z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}"
   let ?R="{z . r \<in> Pow\<^bsup>M\<^esup>(K \<times> K), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}"
   show "ordertype(X, r) \<in> {y . x \<in> {x \<in> Pow(X \<times> X) . M(x)}, M(y) \<and> well_ord(X, x) \<and> y = ordertype(X, x)}"
     if "M(K)" "M(r)" "r\<subseteq>K\<times>K" "X\<subseteq>K" "M(X)" "well_ord(X,r)" for r
   proof -
     from that
     have "ordertype(X,r) = ordertype(X,r\<inter>X\<times>X)" "(r\<inter>X\<times>X)\<subseteq>X\<times>X" "M(r\<inter>X\<times>X)"
       "well_ord(X,r\<inter>X\<times>X)" "wellordered(M,X,r\<inter>X\<times>X)"
       using well_ord_restr ordertype_restr_eq by auto
     moreover from this
     have "ordertype(X,r\<inter>X\<times>X) \<in> ?L"
       using that Pow_rel_char
         ReplaceI[of "\<lambda> z r . M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)" "ordertype(X,r\<inter>X\<times>X)"]
       by auto
     ultimately
-    show ?thesis using Pow_rel_char by auto
+    show ?thesis
+      using Pow_rel_char by auto
   qed
 qed
 
+lemma def_jump_cardinal_rel_aux2:
+  assumes "X \<in> Pow\<^bsup>M\<^esup>(K)" "M(K)"
+  shows "jump_cardinal_body(Pow\<^bsup>M\<^esup>(K\<times>K),X) = jump_cardinal_body(Pow\<^bsup>M\<^esup>(X\<times>X),X)"
+proof -
+  from assms
+  have "jump_cardinal_body(Pow\<^bsup>M\<^esup>(K\<times>K),X) = {z . r \<in>Pow\<^bsup>M\<^esup>(K\<times>K), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}"
+    using def_jump_cardinal_body transM[of _ "Pow\<^bsup>M\<^esup>(K)"]
+    by simp
+  also from assms
+  have "... = {z . r \<in>Pow\<^bsup>M\<^esup>(X\<times>X), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)}"
+    using def_jump_cardinal_rel_aux  transM[of _ "Pow\<^bsup>M\<^esup>(K)"]
+    by simp
+  also from assms
+  have "... = jump_cardinal_body(Pow\<^bsup>M\<^esup>(X\<times>X),X)"
+    using def_jump_cardinal_body transM[of _ "Pow\<^bsup>M\<^esup>(K)"] by auto
+  finally
+  show ?thesis .
+qed
+
 lemma def_jump_cardinal_rel:
   assumes "M(K)"
-  shows "jump_cardinal'_rel(M,K) =
-         (\<Union>X\<in>Pow_rel(M,K). {z. r \<in> Pow_rel(M,K*K), well_ord(X,r) & z = ordertype(X,r)})"
+  shows "jump_cardinal_rel(M,K) =
+         (\<Union>{jump_cardinal_body(Pow\<^bsup>M\<^esup>(K*K),X) . X\<in> Pow\<^bsup>M\<^esup>(K)})"
 proof -
-  have "M({z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)})"
-    (is "M(Replace(_,?P))")
+  have "jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X),X) = {z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> well_ord(X, r) \<and> z=ordertype(X, r)}"
     if "M(X)" for X
-    using that jump_cardinal_closed_aux1[of X] ordertype_rel_abs[of X]
-      jump_cardinal_body_def
-    by (subst Replace_cong[where P="?P"
-          and Q="\<lambda>r z. M(z) \<and> M(r) \<and> well_ord(X, r) \<and> z = ordertype_rel(M,X,r)",
-          OF refl, of "Pow\<^bsup>M\<^esup>(X \<times> X)"]) (auto dest:transM)
+    using that ordertype_closed transM[of _ "Pow\<^bsup>M\<^esup>(X\<times>X)"]
+    unfolding jump_cardinal_body_def
+    by(intro equalityI subsetI,auto)
   then
-  have "M({z . r \<in> Pow\<^bsup>M\<^esup>(Y \<times> Y), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)})"
-    if "M(Y)" "M(X)" "X \<in> Pow\<^bsup>M\<^esup>(Y)" "well_ord(X,r)" for Y X r
-    using that def_jump_cardinal_rel_aux[of X Y r, symmetric] by simp
+  have "M({z . r \<in> Pow\<^bsup>M\<^esup>(X \<times> X), M(z) \<and> well_ord(X, r) \<and> z = ordertype(X, r)})"
+    if "M(Y)" "X \<in> Pow\<^bsup>M\<^esup>(Y)" for Y X
+    using jump_cardinal_closed_aux1[of X] that transM[of _ "Pow\<^bsup>M\<^esup>(Y)"]
+      ordertype_closed transM[of _ "Pow\<^bsup>M\<^esup>(X\<times>X)"]
+    unfolding jump_cardinal_body_def
+    by auto
   moreover from \<open>M(K)\<close>
   have "R \<in> Pow\<^bsup>M\<^esup>(X \<times> X) \<Longrightarrow> X \<in> Pow\<^bsup>M\<^esup>(K) \<Longrightarrow> R \<in> Pow\<^bsup>M\<^esup>(K \<times> K)"
     for X R using mem_Pow_rel_abs transM[OF _ Pow_rel_closed, of R "X\<times>X"]
       transM[OF _ Pow_rel_closed, of X K] by auto
   ultimately
   show ?thesis
-    using assms is_ordertype_iff is_well_ord_iff_wellordered
+    using assms is_ordertype_iff
       ordertype_rel_abs transM[of _ "Pow\<^bsup>M\<^esup>(K)"] transM[of _ "Pow\<^bsup>M\<^esup>(K\<times>K)"]
-      def_jump_cardinal_rel_aux
-    unfolding jump_cardinal'_rel_def
-    apply (intro equalityI)
-     apply (auto dest:transM)
-     apply (rename_tac X R)
-     apply (rule_tac x=X in bexI)
-      apply (rule_tac x=R in ReplaceI)
-        apply auto
-    apply (rule_tac x="{y . xa \<in> Pow\<^bsup>M\<^esup>(K \<times> K), M(y) \<and> M(xa) \<and> well_ord(X, xa) \<and> y = ordertype(X, xa)}" in bexI)
-     apply auto
-    by (rule_tac x=X in ReplaceI) auto
+      def_jump_cardinal_rel_aux jump_cardinal_body_closed ordertype_closed
+    unfolding jump_cardinal_rel_def jump_cardinal_body_def
+    apply(intro equalityI subsetI,auto dest:transM[of _ "Pow\<^bsup>M\<^esup>(K)"])
+    by(rule_tac x="{z . xa \<in> Pow\<^bsup>M\<^esup>(K \<times> K), M(z) \<and> well_ord(y, xa) \<and> z = ordertype(y, xa)}" in bexI,auto)
 qed
 
-notation jump_cardinal'_rel (\<open>jump'_cardinal'_rel\<close>)
-
 lemma Ord_jump_cardinal_rel: "M(K) \<Longrightarrow> Ord(jump_cardinal_rel(M,K))"
-  apply (unfold def_jump_cardinal_rel)
+  apply (unfold def_jump_cardinal_rel jump_cardinal_body_def )
   apply (rule Ord_is_Transset [THEN [2] OrdI])
-   prefer 2 apply (blast intro!: Ord_ordertype)
+  prefer 2 apply (blast intro!: Ord_ordertype)
   apply (unfold Transset_def)
   apply (safe del: subsetI)
   apply (subst ordertype_pred_unfold, simp, safe)
   apply (rule UN_I)
-   apply (rule_tac [2] ReplaceI)
-     prefer 4 apply (blast intro: well_ord_subset elim!: predE, simp_all)
-   prefer 2 apply (blast intro: well_ord_subset elim!: predE)
+  apply (rule_tac [2] ReplaceI)
+  prefer 4 apply (blast intro: well_ord_subset elim!: predE, simp_all)
+  prefer 2 apply (blast intro: well_ord_subset elim!: predE)
 proof -
   fix X r xb
   assume "M(K)" "X \<in> Pow\<^bsup>M\<^esup>(K)" "r \<in> Pow\<^bsup>M\<^esup>(K \<times> K)" "well_ord(X, r)" "xb \<in> X"
   moreover from this
   have "M(X)" "M(r)"
     using cartprod_closed trans_Pow_rel_closed by auto
   moreover from this
   have "M(xb)" using transM[OF \<open>xb\<in>X\<close>] by simp
   ultimately
   show "Order.pred(X, xb, r) \<in> Pow\<^bsup>M\<^esup>(K)"
     using def_Pow_rel by (auto dest:predE)
 qed
 
 declare conj_cong [cong del]
   \<comment> \<open>incompatible with some of the proofs of the original theory\<close>
 
 lemma jump_cardinal_rel_iff_old:
   "M(i) \<Longrightarrow> M(K) \<Longrightarrow> i \<in> jump_cardinal_rel(M,K) \<longleftrightarrow>
       (\<exists>r[M]. \<exists>X[M]. r \<subseteq> K*K & X \<subseteq> K & well_ord(X,r) & i = ordertype(X,r))"
-  apply (unfold def_jump_cardinal_rel)
+  apply (unfold def_jump_cardinal_rel jump_cardinal_body_def)
   apply (auto del: subsetI)
-   apply (rename_tac y r)
-   apply (rule_tac x=r in rexI, intro conjI) prefer 2
-     apply (rule_tac x=y in rexI, intro conjI)
-        apply (auto dest:mem_Pow_rel transM)
-   apply (rule_tac A=r in rev_subsetD, assumption)
-   defer
-   apply (rename_tac r y)
-   apply (rule_tac x=y in bexI)
-    apply (rule_tac x=r in ReplaceI, auto)
+  apply (rename_tac y r)
+  apply (rule_tac x=r in rexI, intro conjI) prefer 2
+  apply (rule_tac x=y in rexI, intro conjI)
+  apply (auto dest:mem_Pow_rel transM)
+  apply (rule_tac A=r in rev_subsetD, assumption)
+  defer
+  apply (rename_tac r y)
+  apply (rule_tac x=y in bexI)
+  apply (rule_tac x=r in ReplaceI, auto)
   using def_Pow_rel
-    apply (force+)[2]
+  apply (force+)[2]
   apply (rule_tac A=r in rev_subsetD, assumption)
   using mem_Pow_rel[THEN conjunct1]
   apply auto
   done
 
 (*The easy part of Theorem 10.16: jump_cardinal_rel(K) exceeds K*)
 lemma K_lt_jump_cardinal_rel: "Ord(K) ==> M(K) \<Longrightarrow> K < jump_cardinal_rel(M,K)"
   apply (rule Ord_jump_cardinal_rel [THEN [2] ltI])
-   apply (rule jump_cardinal_rel_iff_old [THEN iffD2], assumption+)
-   apply (rule_tac x="Memrel(K)" in rexI)
-    apply (rule_tac x=K in rexI)
-     apply (simp add: ordertype_Memrel well_ord_Memrel)
+  apply (rule jump_cardinal_rel_iff_old [THEN iffD2], assumption+)
+  apply (rule_tac x="Memrel(K)" in rexI)
+  apply (rule_tac x=K in rexI)
+  apply (simp add: ordertype_Memrel well_ord_Memrel)
   using Memrel_closed
-     apply (simp_all add: Memrel_def subset_iff)
+  apply (simp_all add: Memrel_def subset_iff)
   done
 
+lemma def_jump_cardinal_rel':
+  assumes "M(K)"
+  shows "jump_cardinal_rel(M,K) =
+         (\<Union>X\<in>Pow\<^bsup>M\<^esup>(K). {z. r \<in> Pow\<^bsup>M\<^esup>(X*X), well_ord(X,r) & z = ordertype(X,r)})"
+proof -
+  from assms
+  have "jump_cardinal_rel(M, K) = (\<Union>X\<in>Pow\<^bsup>M\<^esup>(K). jump_cardinal_body(Pow\<^bsup>M\<^esup>(K \<times> K), X))"
+    using def_jump_cardinal_rel
+    by simp
+  also from \<open>M(K)\<close>
+  have " ... = (\<Union>X\<in>Pow\<^bsup>M\<^esup>(K). jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X), X))"
+    using def_jump_cardinal_rel_aux2
+    by simp
+  finally
+  show ?thesis
+    unfolding jump_cardinal_body_def by simp
+qed
+
+rel_closed for "jump_cardinal"
+proof -
+  fix K
+  assume "M(K)"
+  moreover from this
+  have "jump_cardinal_rel(M, K) =
+    \<Union>{jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X), X) . X\<in>Pow\<^bsup>M\<^esup>(K)}"
+    using def_jump_cardinal_rel'
+    unfolding jump_cardinal_body_def[symmetric]
+    by simp
+  moreover from calculation
+  have "M((\<Union>{jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X), X) . X\<in>Pow\<^bsup>M\<^esup>(K)}))"
+    using def_jump_cardinal_rel_aux jump_cardinal_body_closed
+    by simp
+  ultimately
+  show "M(jump_cardinal_rel(M,K))"
+    by simp
+qed
+
 (*The proof by contradiction: the bijection f yields a wellordering of X
   whose ordertype is jump_cardinal_rel(K).  *)
 lemma Card_rel_jump_cardinal_rel_lemma:
   "[| well_ord(X,r);  r \<subseteq> K * K;  X \<subseteq> K;
          f \<in> bij(ordertype(X,r), jump_cardinal_rel(M,K));
          M(X); M(r); M(K); M(f) |]
       ==> jump_cardinal_rel(M,K) \<in> jump_cardinal_rel(M,K)"
   apply (subgoal_tac "f O ordermap (X,r) \<in> bij (X, jump_cardinal_rel (M,K))")
-   prefer 2 apply (blast intro: comp_bij ordermap_bij)
-  apply (rule jump_cardinal_rel_iff_old [THEN iffD2], simp+)
+  prefer 2 apply (blast intro: comp_bij ordermap_bij)
+  apply (rule jump_cardinal_rel_iff_old [THEN iffD2],simp+)
   apply (intro rexI 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_rel [THEN well_ord_Memrel])
-     apply (simp_all add: well_ord_Memrel [THEN [2] bij_ordertype_vimage]
+  apply (rule subset_trans [OF rvimage_type Sigma_mono], assumption+)
+  apply (erule bij_is_inj [THEN well_ord_rvimage])
+  apply (rule Ord_jump_cardinal_rel [THEN well_ord_Memrel])
+  apply (simp_all add: well_ord_Memrel [THEN [2] bij_ordertype_vimage]
       ordertype_Memrel Ord_jump_cardinal_rel)
   done
 
 (*The hard part of Theorem 10.16: jump_cardinal_rel(K) is itself a cardinal*)
 lemma Card_rel_jump_cardinal_rel: "M(K) \<Longrightarrow> Card_rel(M,jump_cardinal_rel(M,K))"
   apply (rule Ord_jump_cardinal_rel [THEN Card_relI])
-    apply (simp_all add: def_eqpoll_rel)
+  apply (simp_all add: def_eqpoll_rel)
   apply (drule_tac i1=j in jump_cardinal_rel_iff_old [THEN iffD1, OF _ _ ltD, of _ K], safe)
   apply (blast intro: Card_rel_jump_cardinal_rel_lemma [THEN mem_irrefl])
   done
 
 subsection\<open>Basic Properties of Successor Cardinals\<close>
 
 lemma csucc_rel_basic: "Ord(K) ==> M(K) \<Longrightarrow> Card_rel(M,csucc_rel(M,K)) & K < csucc_rel(M,K)"
   apply (unfold csucc_rel_def)
   apply (rule LeastI[of "\<lambda>i. M(i) \<and> Card_rel(M,i) \<and> K < i", THEN conjunct2])
-   apply (blast intro: Card_rel_jump_cardinal_rel K_lt_jump_cardinal_rel Ord_jump_cardinal_rel)+
+  apply (blast intro: Card_rel_jump_cardinal_rel K_lt_jump_cardinal_rel Ord_jump_cardinal_rel)+
   done
 
 lemmas Card_rel_csucc_rel = csucc_rel_basic [THEN conjunct1]
 
 lemmas lt_csucc_rel = csucc_rel_basic [THEN conjunct2]
 
 lemma Ord_0_lt_csucc_rel: "Ord(K) ==> M(K) \<Longrightarrow> 0 < csucc_rel(M,K)"
   by (blast intro: Ord_0_le lt_csucc_rel lt_trans1)
 
 lemma csucc_rel_le: "[| Card_rel(M,L);  K<L; M(K); M(L) |] ==> csucc_rel(M,K) \<le> L"
   apply (unfold csucc_rel_def)
   apply (rule Least_le)
-   apply (blast intro: Card_rel_is_Ord)+
+  apply (blast intro: Card_rel_is_Ord)+
   done
 
 lemma lt_csucc_rel_iff: "[| Ord(i); Card_rel(M,K); M(K); M(i)|] ==> i < csucc_rel(M,K) \<longleftrightarrow> |i|\<^bsup>M\<^esup> \<le> K"
   apply (rule iffI)
-   apply (rule_tac [2] Card_rel_lt_imp_lt)
-       apply (erule_tac [2] lt_trans1)
-       apply (simp_all add: lt_csucc_rel Card_rel_csucc_rel Card_rel_is_Ord)
+  apply (rule_tac [2] Card_rel_lt_imp_lt)
+  apply (erule_tac [2] lt_trans1)
+  apply (simp_all add: lt_csucc_rel Card_rel_csucc_rel Card_rel_is_Ord)
   apply (rule notI [THEN not_lt_imp_le])
-    apply (rule Card_rel_cardinal_rel [THEN csucc_rel_le, THEN lt_trans1, THEN lt_irrefl], simp_all+)
-   apply (rule Ord_cardinal_rel_le [THEN lt_trans1])
-     apply (simp_all add: Card_rel_is_Ord)
+  apply (rule Card_rel_cardinal_rel [THEN csucc_rel_le, THEN lt_trans1, THEN lt_irrefl], simp_all+)
+  apply (rule Ord_cardinal_rel_le [THEN lt_trans1])
+  apply (simp_all add: Card_rel_is_Ord)
   done
 
 lemma Card_rel_lt_csucc_rel_iff:
   "[| Card_rel(M,K'); Card_rel(M,K); M(K'); M(K) |] ==> K' < csucc_rel(M,K) \<longleftrightarrow> K' \<le> K"
   by (simp add: lt_csucc_rel_iff Card_rel_cardinal_rel_eq Card_rel_is_Ord)
 
 lemma InfCard_rel_csucc_rel: "InfCard_rel(M,K) \<Longrightarrow> M(K) ==> InfCard_rel(M,csucc_rel(M,K))"
   by (simp add: InfCard_rel_def Card_rel_csucc_rel Card_rel_is_Ord
       lt_csucc_rel [THEN leI, THEN [2] le_trans])
 
 
 subsubsection\<open>Theorems by Krzysztof Grabczewski, proofs by lcp\<close>
 
 lemma nat_sum_eqpoll_rel_sum:
   assumes m: "m \<in> nat" and n: "n \<in> nat" shows "m + n \<approx>\<^bsup>M\<^esup> m +\<^sub>\<omega> n"
 proof -
   have "m + n \<approx>\<^bsup>M\<^esup> |m+n|\<^bsup>M\<^esup>" using m n
     by (blast intro: nat_implies_well_ord well_ord_radd well_ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym)
   also have "... = m +\<^sub>\<omega> n" using m n
     by (simp add: nat_cadd_rel_eq_add [symmetric] cadd_rel_def transM[OF _ M_nat])
   finally show ?thesis .
 qed
 
 lemma Ord_nat_subset_into_Card_rel: "[| Ord(i); i \<subseteq> nat |] ==> Card\<^bsup>M\<^esup>(i)"
   by (blast dest: Ord_subset_natD intro: Card_rel_nat nat_into_Card_rel)
 
 end \<comment> \<open>\<^locale>\<open>M_cardinal_arith_jump\<close>\<close>
+
 end
diff --git a/thys/Transitive_Models/Cardinal_AC_Relative.thy b/thys/Transitive_Models/Cardinal_AC_Relative.thy
--- a/thys/Transitive_Models/Cardinal_AC_Relative.thy
+++ b/thys/Transitive_Models/Cardinal_AC_Relative.thy
@@ -1,422 +1,441 @@
 section\<open>Relative, Cardinal Arithmetic Using AC\<close>
 
 theory Cardinal_AC_Relative
   imports
     CardinalArith_Relative
 
 begin
 
 locale M_AC =
   fixes M
   assumes
     choice_ax: "choice_ax(M)"
 
-locale M_cardinal_AC = M_cardinal_arith + M_AC
+locale M_cardinal_AC = M_cardinal_arith + M_AC +
+  assumes
+    lam_replacement_minimum:"lam_replacement(M, \<lambda>p. minimum(fst(p),snd(p)))"
 begin
 
+lemma lam_replacement_minimum_vimage:
+  "M(f) \<Longrightarrow> M(r) \<Longrightarrow> lam_replacement(M, \<lambda>x. minimum(r, f -`` {x}))"
+  using lam_replacement_minimum lam_replacement_vimage_sing_fun lam_replacement_constant
+  by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
+    (force intro: lam_replacement_identity)+
+
+lemmas surj_imp_inj_replacement4 = lam_replacement_minimum_vimage[unfolded lam_replacement_def]
+
+lemma lam_replacement_min: "M(f) \<Longrightarrow> M(r) \<Longrightarrow> lam_replacement(M, \<lambda>x . minimum(r, f -`` {x}))"
+  using lam_replacement_hcomp2[OF lam_replacement_constant[of r] lam_replacement_vimage_sing_fun]
+    lam_replacement_minimum
+  by simp
+
+lemmas surj_imp_inj_replacement =
+  surj_imp_inj_replacement1 surj_imp_inj_replacement2 surj_imp_inj_replacement4
+  lam_replacement_vimage_sing_fun[THEN lam_replacement_imp_strong_replacement]
+
 lemma well_ord_surj_imp_lepoll_rel:
   assumes "well_ord(A,r)" "h \<in> surj(A,B)" and
     types:"M(A)" "M(r)" "M(h)" "M(B)"
   shows "B \<lesssim>\<^bsup>M\<^esup> A"
 proof -
   note eq=vimage_fun_sing[OF surj_is_fun[OF \<open>h\<in>_\<close>]]
   from assms
   have "(\<lambda>b\<in>B. minimum(r, {a\<in>A. h`a=b})) \<in> inj(B,A)" (is "?f\<in>_")
     using well_ord_surj_imp_inj_inverse assms(1,2) by simp
   with assms
   have "M(?f`b)" if "b\<in>B" for b
     using apply_type[OF inj_is_fun[OF \<open>?f\<in>_\<close>]] that transM[OF _ \<open>M(A)\<close>] by simp
   with assms
   have "M(?f)"
     using lam_closed surj_imp_inj_replacement4 eq by auto
   with \<open>?f\<in>_\<close> assms
   have "?f \<in> inj\<^bsup>M\<^esup>(B,A)"
     using mem_inj_abs by simp
   with \<open>M(?f)\<close>
   show ?thesis unfolding lepoll_rel_def by auto
 qed
 
 lemma surj_imp_well_ord_M:
   assumes wos: "well_ord(A,r)" "h \<in> surj(A,B)"
     and
     types: "M(A)" "M(r)" "M(h)" "M(B)"
   shows "\<exists>s[M]. well_ord(B,s)"
   using assms lepoll_rel_well_ord
     well_ord_surj_imp_lepoll_rel by fast
 
 
 lemma choice_ax_well_ord: "M(S) \<Longrightarrow> \<exists>r[M]. well_ord(S,r)"
   using choice_ax well_ord_Memrel[THEN surj_imp_well_ord_M]
   unfolding choice_ax_def by auto
 
 lemma Finite_cardinal_rel_Finite:
   assumes "Finite(|i|\<^bsup>M\<^esup>)" "M(i)"
   shows "Finite(i)"
 proof -
   note assms
   moreover from this
   obtain r where "M(r)" "well_ord(i,r)"
     using choice_ax_well_ord by auto
   moreover from calculation
   have "|i|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> i"
     using well_ord_cardinal_rel_eqpoll_rel
     by auto
   ultimately
   show ?thesis
     using eqpoll_rel_imp_Finite
     by auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_cardinal_AC\<close>\<close>
 
 locale M_Pi_assumptions_choice = M_Pi_assumptions + M_cardinal_AC +
   assumes
     B_replacement: "strong_replacement(M, \<lambda>x y. y = B(x))"
     and
     \<comment> \<open>The next one should be derivable from (some variant)
         of B\_replacement. Proving both instances each time seems
         inconvenient.\<close>
     minimum_replacement: "M(r) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, minimum(r, B(x))\<rangle>)"
 begin
 
 lemma AC_M:
   assumes "a \<in> A" "\<And>x. x \<in> A \<Longrightarrow> \<exists>y. y \<in> B(x)"
   shows "\<exists>z[M]. z \<in> Pi\<^bsup>M\<^esup>(A, B)"
 proof -
   have "M(\<Union>x\<in>A. B(x))" using assms family_union_closed Pi_assumptions B_replacement by simp
   then
   obtain r where "well_ord(\<Union>x\<in>A. B(x),r)" "M(r)"
     using choice_ax_well_ord by blast
   let ?f="\<lambda>x\<in>A. minimum(r,B(x))"
   have "M(minimum(r, B(x)))" if "x\<in>A" for x
   proof -
     from \<open>well_ord(_,r)\<close> \<open>x\<in>A\<close>
     have "well_ord(B(x),r)" using well_ord_subset UN_upper by simp
     with assms \<open>x\<in>A\<close> \<open>M(r)\<close>
     show ?thesis using Pi_assumptions by blast
   qed
   with assms and \<open>M(r)\<close>
   have "M(?f)"
     using Pi_assumptions minimum_replacement lam_closed
     by simp
   moreover from assms and calculation
   have "?f \<in> Pi\<^bsup>M\<^esup>(A,B)"
     using lam_type[OF minimum_in, OF \<open>well_ord(\<Union>x\<in>A. B(x),r)\<close>, of A B]
       Pi_rel_char by auto
   ultimately
   show ?thesis by blast
 qed
 
 lemma AC_Pi_rel: assumes "\<And>x. x \<in> A \<Longrightarrow> \<exists>y. y \<in> B(x)"
   shows "\<exists>z[M]. z \<in> Pi\<^bsup>M\<^esup>(A, B)"
 proof (cases "A=0")
   interpret Pi0:M_Pi_assumptions_0
     using Pi_assumptions by unfold_locales auto
   case True
   then
   show ?thesis using assms by simp
 next
   case False
   then
   obtain a where "a \<in> A" by auto
       \<comment> \<open>It is noteworthy that without obtaining an element of
         \<^term>\<open>A\<close>, the final step won't work\<close>
   with assms
   show ?thesis by (blast intro!: AC_M)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions_choice\<close>\<close>
 
 
 context M_cardinal_AC
 begin
 
 subsection\<open>Strengthened Forms of Existing Theorems on Cardinals\<close>
 
 lemma cardinal_rel_eqpoll_rel: "M(A) \<Longrightarrow> |A|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A"
   apply (rule choice_ax_well_ord [THEN rexE])
    apply (auto intro:well_ord_cardinal_rel_eqpoll_rel)
   done
 
 lemmas cardinal_rel_idem = cardinal_rel_eqpoll_rel [THEN cardinal_rel_cong, simp]
 
 lemma cardinal_rel_eqE: "|X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup> ==> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> X \<approx>\<^bsup>M\<^esup> Y"
   apply (rule choice_ax_well_ord [THEN rexE], assumption)
   apply (rule choice_ax_well_ord [THEN rexE, of Y], assumption)
   apply (rule well_ord_cardinal_rel_eqE, assumption+)
   done
 
 lemma cardinal_rel_eqpoll_rel_iff: "M(X) \<Longrightarrow> M(Y) \<Longrightarrow> |X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup> \<longleftrightarrow> X \<approx>\<^bsup>M\<^esup> Y"
   by (blast intro: cardinal_rel_cong cardinal_rel_eqE)
 
 lemma cardinal_rel_disjoint_Un:
   "[| |A|\<^bsup>M\<^esup>=|B|\<^bsup>M\<^esup>;  |C|\<^bsup>M\<^esup>=|D|\<^bsup>M\<^esup>;  A \<inter> C = 0;  B \<inter> D = 0; M(A); M(B); M(C); M(D)|]
       ==> |A \<union> C|\<^bsup>M\<^esup> = |B \<union> D|\<^bsup>M\<^esup>"
   by (simp add: cardinal_rel_eqpoll_rel_iff eqpoll_rel_disjoint_Un)
 
 lemma lepoll_rel_imp_cardinal_rel_le: "A \<lesssim>\<^bsup>M\<^esup> B ==> M(A) \<Longrightarrow> M(B) \<Longrightarrow> |A|\<^bsup>M\<^esup> \<le> |B|\<^bsup>M\<^esup>"
   apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
    apply (erule well_ord_lepoll_rel_imp_cardinal_rel_le, assumption+)
   done
 
 lemma cadd_rel_assoc: "\<lbrakk>M(i); M(j); M(k)\<rbrakk> \<Longrightarrow> (i \<oplus>\<^bsup>M\<^esup> j) \<oplus>\<^bsup>M\<^esup> k = i \<oplus>\<^bsup>M\<^esup> (j \<oplus>\<^bsup>M\<^esup> k)"
   apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
    apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
     apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
      apply (rule well_ord_cadd_rel_assoc, assumption+)
   done
 
 lemma cmult_rel_assoc: "\<lbrakk>M(i); M(j); M(k)\<rbrakk> \<Longrightarrow> (i \<otimes>\<^bsup>M\<^esup> j) \<otimes>\<^bsup>M\<^esup> k = i \<otimes>\<^bsup>M\<^esup> (j \<otimes>\<^bsup>M\<^esup> k)"
   apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
    apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
     apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
      apply (rule well_ord_cmult_rel_assoc, assumption+)
   done
 
 lemma cadd_cmult_distrib: "\<lbrakk>M(i); M(j); M(k)\<rbrakk> \<Longrightarrow> (i \<oplus>\<^bsup>M\<^esup> j) \<otimes>\<^bsup>M\<^esup> k = (i \<otimes>\<^bsup>M\<^esup> k) \<oplus>\<^bsup>M\<^esup> (j \<otimes>\<^bsup>M\<^esup> k)"
   apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
    apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
     apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
      apply (rule well_ord_cadd_cmult_distrib, assumption+)
   done
 
 
 lemma InfCard_rel_square_eq: "InfCard\<^bsup>M\<^esup>(|A|\<^bsup>M\<^esup>) \<Longrightarrow> M(A) \<Longrightarrow> A\<times>A \<approx>\<^bsup>M\<^esup> A"
   apply (rule choice_ax_well_ord [THEN rexE]) prefer 2
    apply (erule well_ord_InfCard_rel_square_eq, assumption, simp_all)
   done
 
 subsection \<open>The relationship between cardinality and le-pollence\<close>
 
 lemma Card_rel_le_imp_lepoll_rel:
   assumes "|A|\<^bsup>M\<^esup> \<le> |B|\<^bsup>M\<^esup>"
     and types: "M(A)" "M(B)"
   shows "A \<lesssim>\<^bsup>M\<^esup> B"
 proof -
   have "A \<approx>\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>"
     by (rule cardinal_rel_eqpoll_rel [THEN eqpoll_rel_sym], simp_all add:types)
   also have "... \<lesssim>\<^bsup>M\<^esup> |B|\<^bsup>M\<^esup>"
     by (rule le_imp_subset [THEN subset_imp_lepoll_rel]) (rule assms, simp_all add:types)
   also have "... \<approx>\<^bsup>M\<^esup> B"
     by (rule cardinal_rel_eqpoll_rel, simp_all add:types)
   finally show ?thesis by (simp_all add:types)
 qed
 
 lemma le_Card_rel_iff: "Card\<^bsup>M\<^esup>(K) ==> M(K) \<Longrightarrow> M(A) \<Longrightarrow> |A|\<^bsup>M\<^esup> \<le> K \<longleftrightarrow> A \<lesssim>\<^bsup>M\<^esup> K"
   apply (erule Card_rel_cardinal_rel_eq [THEN subst], assumption, rule iffI,
       erule Card_rel_le_imp_lepoll_rel, assumption+)
   apply (erule lepoll_rel_imp_cardinal_rel_le, assumption+)
   done
 
 lemma cardinal_rel_0_iff_0 [simp]: "M(A) \<Longrightarrow> |A|\<^bsup>M\<^esup> = 0 \<longleftrightarrow> A = 0"
   using cardinal_rel_0 eqpoll_rel_0_iff [THEN iffD1]
     cardinal_rel_eqpoll_rel_iff [THEN iffD1, OF _ nonempty]
   by auto
 
 lemma cardinal_rel_lt_iff_lesspoll_rel:
   assumes i: "Ord(i)" and
     types: "M(i)" "M(A)"
   shows "i < |A|\<^bsup>M\<^esup> \<longleftrightarrow> i \<prec>\<^bsup>M\<^esup> A"
 proof
   assume "i < |A|\<^bsup>M\<^esup>"
   hence  "i \<prec>\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>"
     by (blast intro: lt_Card_rel_imp_lesspoll_rel types)
   also have "...  \<approx>\<^bsup>M\<^esup> A"
     by (rule cardinal_rel_eqpoll_rel) (simp_all add:types)
   finally show "i \<prec>\<^bsup>M\<^esup> A" by (simp_all add:types)
 next
   assume "i \<prec>\<^bsup>M\<^esup> A"
   also have "...  \<approx>\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>"
     by (blast intro: cardinal_rel_eqpoll_rel eqpoll_rel_sym types)
   finally have "i \<prec>\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>" by (simp_all add:types)
   thus  "i < |A|\<^bsup>M\<^esup>" using i types
     by (force intro: cardinal_rel_lt_imp_lt lesspoll_rel_cardinal_rel_lt)
 qed
 
 lemma cardinal_rel_le_imp_lepoll_rel: " i \<le> |A|\<^bsup>M\<^esup> ==> M(i) \<Longrightarrow> M(A) \<Longrightarrow>i \<lesssim>\<^bsup>M\<^esup> A"
   by (blast intro: lt_Ord Card_rel_le_imp_lepoll_rel Ord_cardinal_rel_le le_trans)
 
 
 subsection\<open>Other Applications of AC\<close>
 
 text\<open>We have an example of instantiating a locale involving higher
 order variables inside a proof, by using the assumptions of the
 first order, active locale.\<close>
 
 lemma surj_rel_implies_inj_rel:
   assumes f: "f \<in> surj\<^bsup>M\<^esup>(X,Y)" and
     types: "M(f)" "M(X)" "M(Y)"
   shows "\<exists>g[M]. g \<in> inj\<^bsup>M\<^esup>(Y,X)"
 proof -
   from types
   interpret M_Pi_assumptions_choice _ Y "\<lambda>y. f-``{y}"
     by unfold_locales (auto intro:surj_imp_inj_replacement dest:transM)
   from f AC_Pi_rel
   obtain z where z: "z \<in> Pi\<^bsup>M\<^esup>(Y, \<lambda>y. f -`` {y})"
     \<comment> \<open>In this and the following ported result, it is not clear how
         uniformly are "\_char" theorems to be used\<close>
     using surj_rel_char
     by (auto simp add: surj_def types) (fast dest: apply_Pair)
   show ?thesis
   proof
     show "z \<in> inj\<^bsup>M\<^esup>(Y, X)" "M(z)"
       using z surj_is_fun[of f X Y] f Pi_rel_char
       by (auto dest: apply_type Pi_memberD
           intro: apply_equality Pi_type f_imp_injective
           simp add:types mem_surj_abs)
   qed
 qed
 
 
 text\<open>Kunen's Lemma 10.20\<close>
 lemma surj_rel_implies_cardinal_rel_le:
   assumes f: "f \<in> surj\<^bsup>M\<^esup>(X,Y)" and
     types:"M(f)" "M(X)" "M(Y)"
   shows "|Y|\<^bsup>M\<^esup> \<le> |X|\<^bsup>M\<^esup>"
 proof (rule lepoll_rel_imp_cardinal_rel_le)
   from f [THEN surj_rel_implies_inj_rel]
   obtain g where "g \<in> inj\<^bsup>M\<^esup>(Y,X)"
     by (blast intro:types)
   then
   show "Y \<lesssim>\<^bsup>M\<^esup> X"
     using inj_rel_char
     by (auto simp add: def_lepoll_rel types)
 qed (simp_all add:types)
 
 end \<comment> \<open>\<^locale>\<open>M_cardinal_AC\<close>\<close>
 
 text\<open>The set-theoretic universe.\<close>
 
 abbreviation
   Universe :: "i\<Rightarrow>o" (\<open>\<V>\<close>) where
   "\<V>(x) \<equiv> True"
 
 lemma separation_absolute: "separation(\<V>, P)"
   unfolding separation_def
   by (rule rallI, rule_tac x="{x\<in>_ . P(x)}" in rexI) auto
 
 lemma univalent_absolute:
   assumes "univalent(\<V>, A, P)" "P(x, b)" "x \<in> A"
   shows "P(x, y) \<Longrightarrow> y = b"
   using assms
   unfolding univalent_def by force
 
 lemma replacement_absolute: "strong_replacement(\<V>, P)"
   unfolding strong_replacement_def
 proof (intro rallI impI)
   fix A
   assume "univalent(\<V>, A, P)"
   then
   show "\<exists>Y[\<V>]. \<forall>b[\<V>]. b \<in> Y \<longleftrightarrow> (\<exists>x[\<V>]. x \<in> A \<and> P(x, b))"
     by (rule_tac x="{y. x\<in>A , P(x,y)}" in rexI)
       (auto dest:univalent_absolute[of _ P])
 qed
 
 lemma Union_ax_absolute: "Union_ax(\<V>)"
   unfolding Union_ax_def big_union_def
   by (auto intro:rexI[of _ "\<Union>_"])
 
 lemma upair_ax_absolute: "upair_ax(\<V>)"
   unfolding upair_ax_def upair_def rall_def rex_def
   by (auto)
 
 lemma power_ax_absolute:"power_ax(\<V>)"
 proof -
   {
     fix x
     have "\<forall>y[\<V>]. y \<in> Pow(x) \<longleftrightarrow> (\<forall>z[\<V>]. z \<in> y \<longrightarrow> z \<in> x)"
       by auto
   }
   then
   show "power_ax(\<V>)"
     unfolding power_ax_def powerset_def subset_def by blast
 qed
 
 locale M_cardinal_UN =  M_Pi_assumptions_choice _ K X for K X +
   assumes
     \<comment> \<open>The next assumption is required by @{thm Least_closed}\<close>
     X_witness_in_M: "w \<in> X(x) \<Longrightarrow> M(x)"
     and
     lam_m_replacement:"M(f) \<Longrightarrow> strong_replacement(M,
       \<lambda>x y. y = \<langle>x, \<mu> i. x \<in> X(i), f ` (\<mu> i. x \<in> X(i)) ` x\<rangle>)"
     and
     inj_replacement:
     "M(x) \<Longrightarrow> strong_replacement(M, \<lambda>y z. y \<in> inj\<^bsup>M\<^esup>(X(x), K) \<and> z = {\<langle>x, y\<rangle>})"
     "strong_replacement(M, \<lambda>x y. y = inj\<^bsup>M\<^esup>(X(x), K))"
     "strong_replacement(M,
       \<lambda>x z. z = Sigfun(x, \<lambda>i. inj\<^bsup>M\<^esup>(X(i), K)))"
     "M(r) \<Longrightarrow> strong_replacement(M,
       \<lambda>x y. y = \<langle>x, minimum(r, inj\<^bsup>M\<^esup>(X(x), K))\<rangle>)"
 
 begin
 
 lemma UN_closed: "M(\<Union>i\<in>K. X(i))"
   using family_union_closed B_replacement Pi_assumptions by simp
 
 text\<open>Kunen's Lemma 10.21\<close>
 lemma cardinal_rel_UN_le:
   assumes K: "InfCard\<^bsup>M\<^esup>(K)"
   shows "(\<And>i. i\<in>K \<Longrightarrow> |X(i)|\<^bsup>M\<^esup> \<le> K) \<Longrightarrow> |\<Union>i\<in>K. X(i)|\<^bsup>M\<^esup> \<le> K"
 proof (simp add: K InfCard_rel_is_Card_rel le_Card_rel_iff Pi_assumptions)
   have "M(f) \<Longrightarrow> M(\<lambda>x\<in>(\<Union>x\<in>K. X(x)). \<langle>\<mu> i. x \<in> X(i), f ` (\<mu> i. x \<in> X(i)) ` x\<rangle>)" for f
     using lam_m_replacement X_witness_in_M Least_closed' Pi_assumptions UN_closed
     by (rule_tac lam_closed) (auto dest:transM)
   note types = this Pi_assumptions UN_closed
   have [intro]: "Ord(K)" by (blast intro: InfCard_rel_is_Card_rel
         Card_rel_is_Ord K types)
   interpret pii:M_Pi_assumptions_choice _ K "\<lambda>i. inj\<^bsup>M\<^esup>(X(i), K)"
     using inj_replacement Pi_assumptions transM[of _ K]
     by unfold_locales (simp_all del:mem_inj_abs)
   assume asm:"\<And>i. i\<in>K \<Longrightarrow> X(i) \<lesssim>\<^bsup>M\<^esup> K"
   then
   have "\<And>i. i\<in>K \<Longrightarrow> M(inj\<^bsup>M\<^esup>(X(i), K))"
     by (auto simp add: types)
   interpret V:M_N_Perm M "\<V>"
     using separation_absolute replacement_absolute Union_ax_absolute
       power_ax_absolute upair_ax_absolute
     by unfold_locales auto
   note bad_simps[simp del] = V.N.Forall_in_M_iff V.N.Equal_in_M_iff
     V.N.nonempty
   have abs:"inj_rel(\<V>,x,y) = inj(x,y)" for x y
     using V.N.inj_rel_char by simp
   from asm
   have "\<And>i. i\<in>K \<Longrightarrow> \<exists>f[M]. f \<in> inj\<^bsup>M\<^esup>(X(i), K)"
     by (simp add: types def_lepoll_rel)
   then
   obtain f where "f \<in> (\<Prod>i\<in>K. inj\<^bsup>M\<^esup>(X(i), K))" "M(f)"
     using pii.AC_Pi_rel pii.Pi_rel_char by auto
   with abs
   have f:"f \<in> (\<Prod>i\<in>K. inj(X(i), K))"
     using Pi_weaken_type[OF _ V.inj_rel_transfer, of f K X "\<lambda>_. K"]
       Pi_assumptions by simp
   { fix z
     assume z: "z \<in> (\<Union>i\<in>K. X(i))"
     then obtain i where i: "i \<in> K" "Ord(i)" "z \<in> X(i)"
       by (blast intro: Ord_in_Ord [of K])
     hence "(\<mu> i. z \<in> X(i)) \<le> i" by (fast intro: Least_le)
     hence "(\<mu> i. z \<in> X(i)) < K" by (best intro: lt_trans1 ltI i)
     hence "(\<mu> i. z \<in> X(i)) \<in> K" and "z \<in> X(\<mu> i. z \<in> X(i))"
       by (auto intro: LeastI ltD i)
   } note mems = this
   have "(\<Union>i\<in>K. X(i)) \<lesssim>\<^bsup>M\<^esup> K \<times> K"
   proof (simp add:types def_lepoll_rel)
     show "\<exists>f[M]. f \<in> inj(\<Union>x\<in>K. X(x), K \<times> K)"
       apply (rule rexI)
        apply (rule_tac c = "\<lambda>z. \<langle>\<mu> i. z \<in> X(i), f ` (\<mu> i. z \<in> X(i)) ` z\<rangle>"
           and d = "\<lambda>\<langle>i,j\<rangle>. converse (f`i) ` j" in lam_injective)
         apply (force intro: f inj_is_fun mems apply_type Perm.left_inverse)+
       apply (simp add:types \<open>M(f)\<close>)
       done
   qed
   also have "... \<approx>\<^bsup>M\<^esup> K"
     by (simp add: K InfCard_rel_square_eq InfCard_rel_is_Card_rel
         Card_rel_cardinal_rel_eq types)
   finally have "(\<Union>i\<in>K. X(i)) \<lesssim>\<^bsup>M\<^esup> K" by (simp_all add:types)
   then
   show ?thesis
     by (simp add: K InfCard_rel_is_Card_rel le_Card_rel_iff types)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_cardinal_UN\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Cardinal_Library_Relative.thy b/thys/Transitive_Models/Cardinal_Library_Relative.thy
--- a/thys/Transitive_Models/Cardinal_Library_Relative.thy
+++ b/thys/Transitive_Models/Cardinal_Library_Relative.thy
@@ -1,1260 +1,1258 @@
 section\<open>Cardinal Arithmetic under Choice\label{sec:cardinal-lib-rel}\<close>
 
 theory Cardinal_Library_Relative
   imports
     Replacement_Lepoll
 begin
 
 locale M_library = M_ZF_library + M_cardinal_AC +
   assumes
     separation_cardinal_rel_lesspoll_rel: "M(\<kappa>) \<Longrightarrow> separation(M, \<lambda>x . x \<prec>\<^bsup>M\<^esup> \<kappa>)"
 begin
 
 declare eqpoll_rel_refl [simp]
 
 subsection\<open>Miscellaneous\<close>
 
 lemma cardinal_rel_RepFun_apply_le:
   assumes "S \<in> A\<rightarrow>B" "M(S)" "M(A)" "M(B)"
   shows "|{S`a . a\<in>A}|\<^bsup>M\<^esup> \<le> |A|\<^bsup>M\<^esup>"
 proof -
   note assms
   moreover from this
   have "{S ` a . a \<in> A} = S``A"
     using image_eq_UN RepFun_def UN_iff by force
   moreover from calculation
   have "M(\<lambda>x\<in>A. S ` x)" "M({S ` a . a \<in> A})"
     using lam_closed[of "\<lambda> x. S`x"] apply_type[OF \<open>S\<in>_\<close>]
       transM[OF _ \<open>M(B)\<close>] image_closed
     by auto
   moreover from assms this
   have "(\<lambda>x\<in>A. S`x) \<in> surj_rel(M,A, {S`a . a\<in>A})"
     using mem_surj_abs lam_funtype[of A "\<lambda>x . S`x"]
     unfolding surj_def by auto
   ultimately
   show ?thesis
     using surj_rel_char surj_rel_implies_cardinal_rel_le by simp
 qed
 
 (* TODO: Check if we can use this lemma to prove the previous one and
     not the other way around *)
 lemma cardinal_rel_RepFun_le:
   assumes lrf:"lam_replacement(M,f)" and f_closed:"\<forall>x[M]. M(f(x))" and "M(X)"
   shows "|{f(x) . x \<in> X}|\<^bsup>M\<^esup> \<le> |X|\<^bsup>M\<^esup>"
   using \<open>M(X)\<close> f_closed cardinal_rel_RepFun_apply_le[OF lam_funtype, of X _, OF
       lrf[THEN [2] lam_replacement_iff_lam_closed[THEN iffD1, THEN rspec]]]
     lrf[THEN lam_replacement_imp_strong_replacement]
   by simp (auto simp flip:setclass_iff intro!:RepFun_closed dest:transM)
 
 lemma subset_imp_le_cardinal_rel: "A \<subseteq> B \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> |A|\<^bsup>M\<^esup> \<le> |B|\<^bsup>M\<^esup>"
   using subset_imp_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le] .
 
 lemma lt_cardinal_rel_imp_not_subset: "|A|\<^bsup>M\<^esup> < |B|\<^bsup>M\<^esup> \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> \<not> B \<subseteq> A"
   using subset_imp_le_cardinal_rel le_imp_not_lt  by blast
 
 lemma cardinal_rel_lt_csucc_rel_iff:
   "Card_rel(M,K) \<Longrightarrow> M(K) \<Longrightarrow> M(K') \<Longrightarrow> |K'|\<^bsup>M\<^esup> < (K\<^sup>+)\<^bsup>M\<^esup> \<longleftrightarrow> |K'|\<^bsup>M\<^esup> \<le> K"
   by (simp add: Card_rel_lt_csucc_rel_iff)
 
 end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
 
 locale M_cardinal_UN_nat = M_cardinal_UN _ \<omega> X for X
 begin
 lemma cardinal_rel_UN_le_nat:
   assumes "\<And>i. i\<in>\<omega> \<Longrightarrow> |X(i)|\<^bsup>M\<^esup> \<le> \<omega>"
   shows "|\<Union>i\<in>\<omega>. X(i)|\<^bsup>M\<^esup> \<le> \<omega>"
 proof -
   from assms
   show ?thesis
     by (simp add: cardinal_rel_UN_le InfCard_rel_nat)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_cardinal_UN_nat\<close>\<close>
 
 locale M_cardinal_UN_inj = M_library +
   j:M_cardinal_UN _ J +
   y:M_cardinal_UN _ K "\<lambda>k. if k\<in>range(f) then X(converse(f)`k) else 0" for J K f +
 assumes
   f_inj: "f \<in> inj_rel(M,J,K)"
 begin
 
 lemma inj_rel_imp_cardinal_rel_UN_le:
   notes [dest] = InfCard_is_Card Card_is_Ord
   fixes Y
   defines "Y(k) \<equiv> if k\<in>range(f) then X(converse(f)`k) else 0"
   assumes "InfCard\<^bsup>M\<^esup>(K)" "\<And>i. i\<in>J \<Longrightarrow> |X(i)|\<^bsup>M\<^esup> \<le> K"
   shows "|\<Union>i\<in>J. X(i)|\<^bsup>M\<^esup> \<le> K"
 proof -
   have "M(K)" "M(J)" "\<And>w x. w \<in> X(x) \<Longrightarrow> M(x)"
     using y.Pi_assumptions j.Pi_assumptions j.X_witness_in_M by simp_all
   then
   have "M(f)"
     using inj_rel_char f_inj by simp
   note inM = \<open>M(f)\<close> \<open>M(K)\<close> \<open>M(J)\<close> \<open>\<And>w x. w \<in> X(x) \<Longrightarrow> M(x)\<close>
   have "i\<in>J \<Longrightarrow> f`i \<in> K" for i
     using inj_rel_is_fun[OF f_inj] apply_type
       function_space_rel_char by (auto simp add:inM)
   have "(\<Union>i\<in>J. X(i)) \<subseteq> (\<Union>i\<in>K. Y(i))"
   proof (standard, elim UN_E)
     fix x i
     assume "i\<in>J" "x\<in>X(i)"
     with \<open>i\<in>J \<Longrightarrow> f`i \<in> K\<close>
     have "x \<in> Y(f`i)" "f`i \<in> K"
       unfolding Y_def
       using inj_is_fun right_inverse f_inj
       by (auto simp add:inM Y_def intro: apply_rangeI)
     then
     show "x \<in> (\<Union>i\<in>K. Y(i))" by auto
   qed
   then
   have "|\<Union>i\<in>J. X(i)|\<^bsup>M\<^esup> \<le> |\<Union>i\<in>K. Y(i)|\<^bsup>M\<^esup>"
     using subset_imp_le_cardinal_rel j.UN_closed y.UN_closed
     unfolding Y_def by (simp add:inM)
   moreover
   note assms \<open>\<And>i. i\<in>J \<Longrightarrow> f`i \<in> K\<close> inM
   moreover from this
   have "k\<in>range(f) \<Longrightarrow> converse(f)`k \<in> J" for k
     using inj_rel_converse_fun[OF f_inj]
       range_fun_subset_codomain function_space_rel_char by simp
   ultimately
   show "|\<Union>i\<in>J. X(i)|\<^bsup>M\<^esup> \<le> K"
     using InfCard_rel_is_Card_rel[THEN Card_rel_is_Ord,THEN Ord_0_le, of K]
     by (rule_tac le_trans[OF _ y.cardinal_rel_UN_le])
       (auto intro:Ord_0_le simp:Y_def)+
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_cardinal_UN_inj\<close>\<close>
 
 locale M_cardinal_UN_lepoll = M_library + M_replacement_lepoll _ "\<lambda>_. X" +
   j:M_cardinal_UN _ J for J
 begin
 
 (* FIXME: this "LEQpoll" should be "LEPOLL"; same correction in Delta System *)
 lemma leqpoll_rel_imp_cardinal_rel_UN_le:
   notes [dest] = InfCard_is_Card Card_is_Ord
   assumes "InfCard\<^bsup>M\<^esup>(K)" "J \<lesssim>\<^bsup>M\<^esup> K" "\<And>i. i\<in>J \<Longrightarrow> |X(i)|\<^bsup>M\<^esup> \<le> K"
     "M(K)"
   shows "|\<Union>i\<in>J. X(i)|\<^bsup>M\<^esup> \<le> K"
 proof -
   from \<open>J \<lesssim>\<^bsup>M\<^esup> K\<close>
   obtain f where "f \<in> inj_rel(M,J,K)" "M(f)" by blast
   moreover
   let ?Y="\<lambda>k. if k\<in>range(f) then X(converse(f)`k) else 0"
   note \<open>M(K)\<close>
   moreover from calculation
   have "k \<in> range(f) \<Longrightarrow> converse(f)`k \<in> J" for k
     using mem_inj_rel[THEN inj_converse_fun, THEN apply_type]
       j.Pi_assumptions by blast
   moreover from \<open>M(f)\<close>
   have "w \<in> ?Y(x) \<Longrightarrow> M(x)" for w x
     by (cases "x\<in>range(f)") (auto dest:transM)
   moreover from calculation
   interpret M_Pi_assumptions_choice _ K ?Y
     using j.Pi_assumptions lepoll_assumptions
   proof (unfold_locales, auto dest:transM)
     show "strong_replacement(M, \<lambda>y z. False)"
       unfolding strong_replacement_def by auto
   qed
   from calculation
   interpret M_cardinal_UN_inj _ _ _ _ f
     using lepoll_assumptions
     by unfold_locales auto
   from assms
   show ?thesis using inj_rel_imp_cardinal_rel_UN_le by simp
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_cardinal_UN_lepoll\<close>\<close>
 
 context M_library
 begin
 
 lemma cardinal_rel_lt_csucc_rel_iff':
   includes Ord_dests
   assumes "Card_rel(M,\<kappa>)"
     and types:"M(\<kappa>)" "M(X)"
   shows "\<kappa> < |X|\<^bsup>M\<^esup> \<longleftrightarrow> (\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> |X|\<^bsup>M\<^esup>"
   using assms cardinal_rel_lt_csucc_rel_iff[of \<kappa> X] Card_rel_csucc_rel[of \<kappa>]
     not_le_iff_lt[of "(\<kappa>\<^sup>+)\<^bsup>M\<^esup>" "|X|\<^bsup>M\<^esup>"] not_le_iff_lt[of "|X|\<^bsup>M\<^esup>" \<kappa>]
   by blast
 
 lemma lepoll_rel_imp_subset_bij_rel:
   assumes "M(X)" "M(Y)"
   shows "X \<lesssim>\<^bsup>M\<^esup> Y \<longleftrightarrow> (\<exists>Z[M]. Z \<subseteq> Y \<and> Z \<approx>\<^bsup>M\<^esup> X)"
 proof
   assume "X \<lesssim>\<^bsup>M\<^esup> Y"
   then
   obtain j where  "j \<in> inj_rel(M,X,Y)"
     by blast
   with assms
   have "range(j) \<subseteq> Y" "j \<in> bij_rel(M,X,range(j))" "M(range(j))" "M(j)"
     using inj_rel_bij_rel_range inj_rel_char
       inj_rel_is_fun[THEN range_fun_subset_codomain,of j X Y]
     by auto
   with assms
   have "range(j) \<subseteq> Y" "X \<approx>\<^bsup>M\<^esup> range(j)"
     unfolding eqpoll_rel_def by auto
   with assms \<open>M(j)\<close>
   show "\<exists>Z[M]. Z \<subseteq> Y \<and> Z \<approx>\<^bsup>M\<^esup> X"
     using eqpoll_rel_sym[OF \<open>X \<approx>\<^bsup>M\<^esup> range(j)\<close>]
     by auto
 next
   assume "\<exists>Z[M]. Z \<subseteq> Y \<and> Z \<approx>\<^bsup>M\<^esup> X"
   then
   obtain Z f where "f \<in> bij_rel(M,Z,X)" "Z \<subseteq> Y" "M(Z)" "M(f)"
     unfolding eqpoll_rel_def by blast
   with assms
   have "converse(f) \<in> inj_rel(M,X,Y)" "M(converse(f))"
     using inj_rel_weaken_type[OF bij_rel_converse_bij_rel[THEN bij_rel_is_inj_rel],of f Z X Y]
     by auto
   then
   show "X \<lesssim>\<^bsup>M\<^esup> Y"
     unfolding lepoll_rel_def by auto
 qed
 
 text\<open>The following result proves to be very useful when combining
      \<^term>\<open>cardinal_rel\<close> and \<^term>\<open>eqpoll_rel\<close> in a calculation.\<close>
 
 lemma cardinal_rel_Card_rel_eqpoll_rel_iff:
   "Card_rel(M,\<kappa>) \<Longrightarrow> M(\<kappa>) \<Longrightarrow> M(X) \<Longrightarrow> |X|\<^bsup>M\<^esup> = \<kappa> \<longleftrightarrow> X \<approx>\<^bsup>M\<^esup> \<kappa>"
   using Card_rel_cardinal_rel_eq[of \<kappa>] cardinal_rel_eqpoll_rel_iff[of X \<kappa>] by auto
 
 lemma lepoll_rel_imp_lepoll_rel_cardinal_rel:
   assumes"X \<lesssim>\<^bsup>M\<^esup> Y"  "M(X)" "M(Y)"
   shows "X \<lesssim>\<^bsup>M\<^esup> |Y|\<^bsup>M\<^esup>"
   using assms cardinal_rel_Card_rel_eqpoll_rel_iff[of "|Y|\<^bsup>M\<^esup>" Y]
     Card_rel_cardinal_rel
     lepoll_rel_eq_trans[of _ _ "|Y|\<^bsup>M\<^esup>"] by simp
 
 lemma lepoll_rel_Un:
   assumes "InfCard_rel(M,\<kappa>)" "A \<lesssim>\<^bsup>M\<^esup> \<kappa>" "B \<lesssim>\<^bsup>M\<^esup> \<kappa>" "M(A)" "M(B)" "M(\<kappa>)"
   shows "A \<union> B \<lesssim>\<^bsup>M\<^esup> \<kappa>"
 proof -
   from assms
   have "A \<union> B \<lesssim>\<^bsup>M\<^esup> sum(A,B)"
     using Un_lepoll_rel_sum by simp
   moreover
   note assms
   moreover from this
   have "|sum(A,B)|\<^bsup>M\<^esup> \<le> \<kappa> \<oplus>\<^bsup>M\<^esup> \<kappa>"
     using sum_lepoll_rel_mono[of A \<kappa> B \<kappa>] lepoll_rel_imp_cardinal_rel_le
     unfolding cadd_rel_def by auto
   ultimately
   show ?thesis
     using InfCard_rel_cdouble_eq Card_rel_cardinal_rel_eq
       InfCard_rel_is_Card_rel Card_rel_le_imp_lepoll_rel[of "sum(A,B)" \<kappa>]
       lepoll_rel_trans[of "A\<union>B"]
     by auto
 qed
 
 lemma cardinal_rel_Un_le:
   assumes "InfCard_rel(M,\<kappa>)" "|A|\<^bsup>M\<^esup> \<le> \<kappa>" "|B|\<^bsup>M\<^esup> \<le> \<kappa>" "M(\<kappa>)" "M(A)" "M(B)"
   shows "|A \<union> B|\<^bsup>M\<^esup> \<le> \<kappa>"
   using assms lepoll_rel_Un le_Card_rel_iff InfCard_rel_is_Card_rel by auto
 
 lemma Finite_cardinal_rel_iff': "M(i) \<Longrightarrow> Finite(|i|\<^bsup>M\<^esup>) \<longleftrightarrow> Finite(i)"
   using eqpoll_rel_imp_Finite_iff[OF cardinal_rel_eqpoll_rel]
   by auto
 
 lemma cardinal_rel_subset_of_Card_rel:
   assumes "Card_rel(M,\<gamma>)" "a \<subseteq> \<gamma>" "M(a)" "M(\<gamma>)"
   shows "|a|\<^bsup>M\<^esup> < \<gamma> \<or> |a|\<^bsup>M\<^esup> = \<gamma>"
 proof -
   from assms
   have "|a|\<^bsup>M\<^esup> < |\<gamma>|\<^bsup>M\<^esup> \<or> |a|\<^bsup>M\<^esup> = |\<gamma>|\<^bsup>M\<^esup>"
     using subset_imp_le_cardinal_rel[THEN le_iff[THEN iffD1]] by simp
   with assms
   show ?thesis
     using Card_rel_cardinal_rel_eq by auto
 qed
 
 lemma cardinal_rel_cases:
   includes Ord_dests
   assumes "M(\<gamma>)" "M(X)"
   shows "Card_rel(M,\<gamma>) \<Longrightarrow> |X|\<^bsup>M\<^esup> < \<gamma> \<longleftrightarrow> \<not> |X|\<^bsup>M\<^esup> \<ge> \<gamma>"
   using assms not_le_iff_lt Card_rel_is_Ord Ord_cardinal_rel
   by auto
 
 end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
 
 subsection\<open>Countable and uncountable sets\<close>
 
 definition (* FIXME: From Cardinal_Library, on the context of AC *)
   countable :: "i\<Rightarrow>o" where
   "countable(X) \<equiv> X \<lesssim> \<omega>"
 
 relativize functional "countable" "countable_rel" external
 relationalize "countable_rel" "is_countable"
 
 notation countable_rel (\<open>countable\<^bsup>_\<^esup>'(_')\<close>)
 
 abbreviation
   countable_r_set  :: "[i,i]\<Rightarrow>o"  (\<open>countable\<^bsup>_\<^esup>'(_')\<close>) where
   "countable\<^bsup>M\<^esup>(i) \<equiv> countable_rel(##M,i)"
 
 context M_library
 begin
 
 lemma countableI[intro]: "X \<lesssim>\<^bsup>M\<^esup> \<omega> \<Longrightarrow> countable_rel(M,X)"
   unfolding countable_rel_def by simp
 
 lemma countableD[dest]: "countable_rel(M,X) \<Longrightarrow> X \<lesssim>\<^bsup>M\<^esup> \<omega>"
   unfolding countable_rel_def by simp
 
 lemma countable_rel_iff_cardinal_rel_le_nat: "M(X) \<Longrightarrow> countable_rel(M,X) \<longleftrightarrow> |X|\<^bsup>M\<^esup> \<le> \<omega>"
   using le_Card_rel_iff[of \<omega> X] Card_rel_nat
   unfolding countable_rel_def by simp
 
 lemma lepoll_rel_countable_rel: "X \<lesssim>\<^bsup>M\<^esup> Y \<Longrightarrow> countable_rel(M,Y) \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> countable_rel(M,X)"
   using lepoll_rel_trans[of X Y] by blast
 
 \<comment> \<open>Next lemma can be proved without using AC\<close>
 lemma surj_rel_countable_rel:
   "countable_rel(M,X) \<Longrightarrow> f \<in> surj_rel(M,X,Y) \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> M(f) \<Longrightarrow> countable_rel(M,Y)"
   using surj_rel_implies_cardinal_rel_le[of f X Y, THEN le_trans]
     countable_rel_iff_cardinal_rel_le_nat by simp
 
 lemma Finite_imp_countable_rel: "Finite_rel(M,X) \<Longrightarrow> M(X) \<Longrightarrow> countable_rel(M,X)"
   unfolding Finite_rel_def
   by (auto intro:InfCard_rel_nat nats_le_InfCard_rel[of _ \<omega>,
         THEN le_imp_lepoll_rel] dest!:eq_lepoll_rel_trans[of X _ \<omega>] )
 
 end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
 
 lemma (in M_cardinal_UN_lepoll) countable_rel_imp_countable_rel_UN:
   assumes "countable_rel(M,J)" "\<And>i. i\<in>J \<Longrightarrow> countable_rel(M,X(i))"
   shows "countable_rel(M,\<Union>i\<in>J. X(i))"
   using assms leqpoll_rel_imp_cardinal_rel_UN_le[of \<omega>] InfCard_rel_nat
     InfCard_rel_is_Card_rel j.UN_closed
     countable_rel_iff_cardinal_rel_le_nat j.Pi_assumptions
     Card_rel_le_imp_lepoll_rel[of J \<omega>] Card_rel_cardinal_rel_eq[of \<omega>]
   by auto
 
 locale M_cardinal_library = M_library + M_replacement +
   assumes
     lam_replacement_inj_rel:"lam_replacement(M, \<lambda>x. inj\<^bsup>M\<^esup>(fst(x),snd(x)))"
     and
-    cdlt_assms: "M(G) \<Longrightarrow> M(Q) \<Longrightarrow> separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> Q))"
-    and
     cardinal_lib_assms1:
     "M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow>
        separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. if M(x) then x else 0,b,f,i)\<rangle>)"
     and
     cardinal_lib_assms2:
     "M(A') \<Longrightarrow> M(G) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow>
         separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if M(a) then G`a else 0,b,f,i)\<rangle>)"
     and
     cardinal_lib_assms3:
     "M(A') \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> M(F) \<Longrightarrow>
         separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if M(a) then F-``{a} else 0,b,f,i)\<rangle>)"
     and
-    lam_replacement_cardinal_rel : "lam_replacement(M, cardinal_rel(M))"
+    cardinal_rel_separation :
+    "separation(M, \<lambda>\<langle>x,y\<rangle>. cardinal_rel(M,x) = y)"
     and
-    cardinal_lib_assms6:
-    "M(f) \<Longrightarrow> M(\<beta>) \<Longrightarrow> Ord(\<beta>) \<Longrightarrow>
-      strong_replacement(M, \<lambda>x y. x\<in>\<beta> \<and> y = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a))\<rangle>)"
+    separation_cardinal_rel_lt :
+    "M(\<gamma>) \<Longrightarrow> separation(M, \<lambda>Z . cardinal_rel(M,Z) < \<gamma>)"
 
 begin
 
-lemma cardinal_lib_assms5 :
-  "M(\<gamma>) \<Longrightarrow> Ord(\<gamma>) \<Longrightarrow> separation(M, \<lambda>Z . cardinal_rel(M,Z) < \<gamma>)"
-  unfolding lt_def
-  using separation_in lam_replacement_constant[of \<gamma>] separation_univ lam_replacement_cardinal_rel
-  unfolding lt_def
-  by simp_all
-
-lemma separation_dist: "separation(M, \<lambda> x . \<exists>a. \<exists>b . x=\<langle>a,b\<rangle> \<and> a\<noteq>b)"
-  using separation_pair separation_neg separation_eq lam_replacement_fst lam_replacement_snd
-  by simp
+lemma cdlt_assms: "M(G) \<Longrightarrow> M(Q) \<Longrightarrow> separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> Q))"
+  using lam_replacement_snd lam_replacement_fst lam_replacement_hcomp separation_in
+    lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+  by (rule_tac separation_ball,simp_all,rule_tac separation_iff',auto)
+    (rule_tac separation_all,auto simp:lam_replacement_constant)
 
 lemma cdlt_assms': "M(x) \<Longrightarrow> M(Q) \<Longrightarrow> separation(M, \<lambda>a .  \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q)"
   using separation_in[OF _
       lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair] _
       lam_replacement_constant]
     separation_ball lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
   by simp_all
 
 lemma countable_rel_union_countable_rel:
   assumes "\<And>x. x \<in> C \<Longrightarrow> countable_rel(M,x)" "countable_rel(M,C)" "M(C)"
   shows "countable_rel(M,\<Union>C)"
 proof -
   have "x \<in> (if M(i) then i else 0) \<Longrightarrow> M(i)" for x i
     by (cases "M(i)") auto
   then
   interpret M_replacement_lepoll M "\<lambda>_ x. if M(x) then x else 0"
     using  lam_replacement_if[OF lam_replacement_identity
         lam_replacement_constant[OF nonempty], where b=M] lam_replacement_inj_rel
+      lam_replacement_minimum
   proof(unfold_locales,auto simp add: separation_def)
     fix b f
     assume "M(b)" "M(f)"
     show "lam_replacement(M, \<lambda>x. \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. if M(x) then x else 0, b, f, i))"
     proof (cases "b=0")
       case True
       with \<open>M(f)\<close>
       show ?thesis
         using cardinal_lib_assms1
         by (simp_all; rule_tac lam_Least_assumption_ifM_b0)+
     next
       case False
       with \<open>M(f)\<close> \<open>M(b)\<close>
       show ?thesis
-        using cardinal_lib_assms1 separation_Ord
+        using cardinal_lib_assms1 separation_Ord lam_replacement_minimum
         by (rule_tac lam_Least_assumption_ifM_bnot0) auto
     qed
   qed
   note \<open>M(C)\<close>
   moreover
   have  "w \<in> (if M(x) then x else 0) \<Longrightarrow> M(x)" for w x
     by (cases "M(x)") auto
   ultimately
   interpret M_cardinal_UN_lepoll _ "\<lambda>c. if M(c) then c else 0" C
-    using lepoll_assumptions
-    by unfold_locales simp_all
+    using lepoll_assumptions lam_replacement_minimum
+    by unfold_locales auto
   have "(if M(i) then i else 0) = i" if "i\<in>C" for i
     using transM[OF _ \<open>M(C)\<close>] that by simp
   then
   show ?thesis
     using assms countable_rel_imp_countable_rel_UN by simp
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_cardinal_library\<close>\<close>
 
 abbreviation
   uncountable_rel :: "[i\<Rightarrow>o,i]\<Rightarrow>o" where
   "uncountable_rel(M,X) \<equiv> \<not> countable_rel(M,X)"
 
-context M_cardinal_library
+context M_library
 begin
 
 lemma uncountable_rel_iff_nat_lt_cardinal_rel:
   "M(X) \<Longrightarrow> uncountable_rel(M,X) \<longleftrightarrow> \<omega> < |X|\<^bsup>M\<^esup>"
   using countable_rel_iff_cardinal_rel_le_nat not_le_iff_lt by simp
 
 lemma uncountable_rel_not_empty: "uncountable_rel(M,X) \<Longrightarrow> X \<noteq> 0"
   using empty_lepoll_relI by auto
 
 lemma uncountable_rel_imp_Infinite: "uncountable_rel(M,X) \<Longrightarrow> M(X) \<Longrightarrow> Infinite(X)"
   using uncountable_rel_iff_nat_lt_cardinal_rel[of X] lepoll_rel_nat_imp_Infinite[of X]
     cardinal_rel_le_imp_lepoll_rel[of \<omega> X] leI
   by simp
 
 lemma uncountable_rel_not_subset_countable_rel:
   assumes "countable_rel(M,X)" "uncountable_rel(M,Y)" "M(X)" "M(Y)"
   shows "\<not> (Y \<subseteq> X)"
   using assms lepoll_rel_trans subset_imp_lepoll_rel[of Y X]
   by blast
 
 
 subsection\<open>Results on Aleph\_rels\<close>
 
 lemma nat_lt_Aleph_rel1: "\<omega> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
   by (simp add: Aleph_rel_succ Aleph_rel_zero lt_csucc_rel)
 
 lemma zero_lt_Aleph_rel1: "0 < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
   by (rule lt_trans[of _ "\<omega>"], auto simp add: ltI nat_lt_Aleph_rel1)
 
 lemma le_Aleph_rel1_nat: "M(k) \<Longrightarrow> Card_rel(M,k) \<Longrightarrow> k<\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> k \<le> \<omega>"
   by (simp add: Aleph_rel_succ Aleph_rel_zero Card_rel_lt_csucc_rel_iff Card_rel_nat)
 
 lemma lesspoll_rel_Aleph_rel_succ:
   assumes "Ord(\<alpha>)"
     and types:"M(\<alpha>)" "M(d)"
   shows "d \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>succ(\<alpha>)\<^esub>\<^bsup>M\<^esup> \<longleftrightarrow> d \<lesssim>\<^bsup>M\<^esup> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>"
   using assms Aleph_rel_succ Card_rel_is_Ord Ord_Aleph_rel lesspoll_rel_csucc_rel
   by simp
 
 lemma cardinal_rel_Aleph_rel [simp]: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> |\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>|\<^bsup>M\<^esup> = \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>"
   using Card_rel_cardinal_rel_eq by simp
 
 \<comment> \<open>Could be proved without using AC\<close>
 lemma Aleph_rel_lesspoll_rel_increasing:
   includes Aleph_rel_intros
   assumes "M(b)" "M(a)"
   shows "a < b \<Longrightarrow> \<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"
   using assms
     cardinal_rel_lt_iff_lesspoll_rel[of "\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"]
     Aleph_rel_increasing[of a b] Card_rel_cardinal_rel_eq[of "\<aleph>\<^bsub>b\<^esub>"]
     lt_Ord lt_Ord2 Card_rel_Aleph_rel[THEN Card_rel_is_Ord]
   by auto
 
 lemma uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1:
   includes Ord_dests
   assumes "M(X)"
   notes Aleph_rel_zero[simp] Card_rel_nat[simp] Aleph_rel_succ[simp]
   shows "uncountable_rel(M,X) \<longleftrightarrow> (\<exists>S[M]. S \<subseteq> X \<and> S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)"
 proof
   assume "uncountable_rel(M,X)"
   with \<open>M(X)\<close>
   have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> X"
     using uncountable_rel_iff_nat_lt_cardinal_rel cardinal_rel_lt_csucc_rel_iff'
       cardinal_rel_le_imp_lepoll_rel by auto
   with \<open>M(X)\<close>
   obtain S where "M(S)" "S \<subseteq> X" "S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     using lepoll_rel_imp_subset_bij_rel by auto
   then
   show "\<exists>S[M]. S \<subseteq> X \<and> S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     using cardinal_rel_cong Card_rel_csucc_rel[of \<omega>] Card_rel_cardinal_rel_eq by auto
 next
   note Aleph_rel_lesspoll_rel_increasing[of 1 0,simplified]
   assume "\<exists>S[M]. S \<subseteq> X \<and> S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
   moreover
   have eq:"\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = (\<omega>\<^sup>+)\<^bsup>M\<^esup>" by auto
   moreover from calculation \<open>M(X)\<close>
   have A:"(\<omega>\<^sup>+)\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> X"
     using subset_imp_lepoll_rel[THEN [2] eq_lepoll_rel_trans, of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" _ X,
         OF eqpoll_rel_sym] by auto
   with \<open>M(X)\<close>
   show "uncountable_rel(M,X)"
     using
       lesspoll_rel_trans1[OF lepoll_rel_trans[OF A _] \<open>\<omega> \<prec>\<^bsup>M\<^esup> (\<omega>\<^sup>+)\<^bsup>M\<^esup>\<close>]
       lesspoll_rel_not_refl
     by auto
 qed
 
 lemma UN_if_zero: "M(K) \<Longrightarrow> (\<Union>x\<in>K. if M(x) then G ` x else 0) =(\<Union>x\<in>K. G ` x)"
   using transM[of _ K] by auto
 
 lemma mem_F_bound1:
   fixes F G
   defines "F \<equiv> \<lambda>_ x. if M(x) then G`x else 0"
   shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> domain(G) )"
   using apply_0 unfolding F_def
   by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
 
+end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
+
+context M_cardinal_library
+begin
+
 lemma lt_Aleph_rel_imp_cardinal_rel_UN_le_nat: "function(G) \<Longrightarrow> domain(G) \<lesssim>\<^bsup>M\<^esup> \<omega> \<Longrightarrow>
    \<forall>n\<in>domain(G). |G`n|\<^bsup>M\<^esup><\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> M(G) \<Longrightarrow> |\<Union>n\<in>domain(G). G`n|\<^bsup>M\<^esup>\<le>\<omega>"
 proof -
   assume "M(G)"
   moreover from this
   have "x \<in> (if M(i) then G ` i else 0) \<Longrightarrow> M(i)" for x i
     by (cases "M(i)") auto
   moreover
   have "separation(M, M)" unfolding separation_def by auto
   ultimately
   interpret M_replacement_lepoll M "\<lambda>_ x. if M(x) then G`x else 0"
     using lam_replacement_inj_rel cardinal_lib_assms2 mem_F_bound1[of _ _ G]
-      lam_if_then_replacement_apply
+      lam_if_then_replacement_apply lam_replacement_minimum
     by (unfold_locales, simp_all)
       (rule lam_Least_assumption_general[where U="\<lambda>_. domain(G)"], auto)
   note \<open>M(G)\<close>
   moreover
   have  "w \<in> (if M(x) then G ` x else 0) \<Longrightarrow> M(x)" for w x
     by (cases "M(x)") auto
   ultimately
   interpret M_cardinal_UN_lepoll _  "\<lambda>n. if M(n) then G`n else 0" "domain(G)"
     using lepoll_assumptions1[where S="domain(G)",unfolded lepoll_assumptions1_def]
       cardinal_lib_assms2 lepoll_assumptions
     by (unfold_locales, auto)
   assume "function(G)"
   let ?N="domain(G)" and ?R="\<Union>n\<in>domain(G). G`n"
   assume "?N \<lesssim>\<^bsup>M\<^esup> \<omega>"
   assume Eq1: "\<forall>n\<in>?N. |G`n|\<^bsup>M\<^esup><\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
   {
     fix n
     assume "n\<in>?N"
     with Eq1 \<open>M(G)\<close>
     have "|G`n|\<^bsup>M\<^esup> \<le> \<omega>"
       using le_Aleph_rel1_nat[of "|G ` n|\<^bsup>M\<^esup>"] leqpoll_rel_imp_cardinal_rel_UN_le
         UN_if_zero[of "domain(G)" G]
       by (auto dest:transM)
   }
   then
   have "n\<in>?N \<Longrightarrow> |G`n|\<^bsup>M\<^esup> \<le> \<omega>" for n .
   moreover
   note \<open>?N \<lesssim>\<^bsup>M\<^esup> \<omega>\<close> \<open>M(G)\<close>
   moreover
   have "(if M(i) then G ` i else 0) \<subseteq> G ` i" for i
     by auto
   with \<open>M(G)\<close>
   have "|if M(i) then G ` i else 0|\<^bsup>M\<^esup> \<le> |G ` i|\<^bsup>M\<^esup>" for i
   proof(cases "M(i)")
     case True
     with \<open>M(G)\<close> show ?thesis using Ord_cardinal_rel[OF apply_closed]
       by simp
   next
     case False
     then
     have "i\<notin>domain(G)"
       using transM[OF _ domain_closed[OF \<open>M(G)\<close>]] by auto
     then
     show ?thesis
       using Ord_cardinal_rel[OF apply_closed] apply_0 by simp
   qed
   ultimately
   show ?thesis
     using InfCard_rel_nat leqpoll_rel_imp_cardinal_rel_UN_le[of \<omega>]
       UN_if_zero[of "domain(G)" G]
       le_trans[of "|if M(_) then G ` _ else 0|\<^bsup>M\<^esup>" "|G ` _|\<^bsup>M\<^esup>" \<omega>]
     by auto blast
 qed
 
 lemma Aleph_rel1_eq_cardinal_rel_vimage: "f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<^bsup>M\<^esup>\<omega> \<Longrightarrow> \<exists>n\<in>\<omega>. |f-``{n}|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
 proof -
   assume "f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<^bsup>M\<^esup>\<omega>"
   then
   have "function(f)" "domain(f) = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "range(f)\<subseteq>\<omega>" "f\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>" "M(f)"
     using mem_function_space_rel[OF \<open>f\<in>_\<close>] domain_of_fun fun_is_function range_fun_subset_codomain
       function_space_rel_char
     by auto
   let ?G="\<lambda>n\<in>range(f). f-``{n}"
   from \<open>f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>\<close>
   have "range(f) \<subseteq> \<omega>" "domain(?G) = range(f)"
     using range_fun_subset_codomain
     by simp_all
   from \<open>f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>\<close> \<open>M(f)\<close> \<open>range(f) \<subseteq> \<omega>\<close>
   have "M(f-``{n})" if "n \<in> range(f)" for n
     using that transM[of _ \<omega>] by auto
   with \<open>M(f)\<close> \<open>range(f) \<subseteq> \<omega>\<close>
   have "domain(?G) \<lesssim>\<^bsup>M\<^esup> \<omega>" "M(?G)"
     using subset_imp_lepoll_rel lam_closed[of "\<lambda>x . f-``{x}"] cardinal_lib_assms4
     by simp_all
   have "function(?G)" by (simp add:function_lam)
   from \<open>f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>\<close>
   have "n\<in>\<omega> \<Longrightarrow> f-``{n} \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" for n
     using Pi_vimage_subset by simp
   with \<open>range(f) \<subseteq> \<omega>\<close>
   have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = (\<Union>n\<in>range(f). f-``{n})"
   proof (intro equalityI, intro subsetI)
     fix x
     assume "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     with \<open>f:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<omega>\<close> \<open>function(f)\<close> \<open>domain(f) = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
     have "x \<in> f-``{f`x}" "f`x \<in> range(f)"
       using function_apply_Pair vimage_iff apply_rangeI by simp_all
     then
     show "x \<in> (\<Union>n\<in>range(f). f-``{n})" by auto
   qed auto
   {
     assume "\<forall>n\<in>range(f). |f-``{n}|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     then
     have "\<forall>n\<in>domain(?G). |?G`n|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
       using zero_lt_Aleph_rel1 by (auto)
     with \<open>function(?G)\<close> \<open>domain(?G) \<lesssim>\<^bsup>M\<^esup> \<omega>\<close> \<open>M(?G)\<close>
     have "|\<Union>n\<in>domain(?G). ?G`n|\<^bsup>M\<^esup>\<le>\<omega>"
       using lt_Aleph_rel_imp_cardinal_rel_UN_le_nat[of ?G]
       by auto
     then
     have "|\<Union>n\<in>range(f). f-``{n}|\<^bsup>M\<^esup>\<le>\<omega>" by simp
     with \<open>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = _\<close>
     have "|\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>|\<^bsup>M\<^esup> \<le> \<omega>" by auto
     then
     have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<le> \<omega>"
       using Card_rel_Aleph_rel Card_rel_cardinal_rel_eq
       by auto
     then
     have "False"
       using nat_lt_Aleph_rel1 by (blast dest:lt_trans2)
   }
   with \<open>range(f)\<subseteq>\<omega>\<close> \<open>M(f)\<close>
   obtain n where "n\<in>\<omega>" "\<not>(|f -`` {n}|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "M(f -`` {n})"
     using nat_into_M by auto
   moreover from this
   have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<le> |f-``{n}|\<^bsup>M\<^esup>"
     using not_lt_iff_le Card_rel_is_Ord by simp
   moreover
   note \<open>n\<in>\<omega> \<Longrightarrow> f-``{n} \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
   ultimately
   show ?thesis
     using subset_imp_le_cardinal_rel[THEN le_anti_sym, of _ "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"]
       Card_rel_Aleph_rel Card_rel_cardinal_rel_eq
     by auto
 qed
 
 \<comment> \<open>There is some asymmetry between assumptions and conclusion
     (\<^term>\<open>eqpoll_rel\<close> versus \<^term>\<open>cardinal_rel\<close>)\<close>
 
 lemma eqpoll_rel_Aleph_rel1_cardinal_rel_vimage:
   assumes "Z \<approx>\<^bsup>M\<^esup> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "f \<in> Z \<rightarrow>\<^bsup>M\<^esup> \<omega>" "M(Z)"
   shows "\<exists>n\<in>\<omega>. |f-``{n}|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
 proof -
   have "M(1)" "M(\<omega>)" by simp_all
   then
   have "M(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" by simp
   with assms \<open>M(1)\<close>
   obtain g where A:"g\<in>bij_rel(M,\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>,Z)" "M(g)"
     using eqpoll_rel_sym unfolding eqpoll_rel_def by blast
   with \<open>f : Z \<rightarrow>\<^bsup>M\<^esup> \<omega>\<close> assms
   have "M(f)" "converse(g) \<in> bij_rel(M,Z, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "f\<in>Z\<rightarrow>\<omega>" "g\<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>Z"
     using bij_rel_is_fun_rel bij_rel_converse_bij_rel bij_rel_char function_space_rel_char
     by simp_all
   with \<open>g\<in>bij_rel(M,\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>,Z)\<close> \<open>M(g)\<close>
   have "f O g : \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow>\<^bsup>M\<^esup> \<omega>" "M(converse(g))"
     using comp_fun[OF _ \<open>f\<in> Z\<rightarrow>_\<close>,of g] function_space_rel_char
     by simp_all
   then
   obtain n where "n\<in>\<omega>" "|(f O g)-``{n}|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     using Aleph_rel1_eq_cardinal_rel_vimage
     by auto
   with \<open>M(f)\<close> \<open>M(converse(g))\<close>
   have "M(converse(g) `` (f -`` {n}))" "f -`` {n} \<subseteq> Z"
     using image_comp converse_comp Pi_iff[THEN iffD1,OF \<open>f\<in>Z\<rightarrow>\<omega>\<close>] vimage_subset
     unfolding vimage_def
     using transM[OF \<open>n\<in>\<omega>\<close>]
     by auto
   from \<open>n\<in>\<omega>\<close> \<open>|(f O g)-``{n}|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
   have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = |converse(g) `` (f -``{n})|\<^bsup>M\<^esup>"
     using image_comp converse_comp unfolding vimage_def
     by auto
   also from \<open>converse(g) \<in> bij_rel(M,Z, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close> \<open>f: Z\<rightarrow>\<^bsup>M\<^esup> \<omega>\<close> \<open>M(Z)\<close> \<open>M(f)\<close> \<open>M(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close>
     \<open>M(converse(g) `` (f -`` {n}))\<close>
   have "\<dots> = |f -``{n}|\<^bsup>M\<^esup>"
     using range_of_subset_eqpoll_rel[of "converse(g)" Z  _ "f -``{n}",
         OF bij_rel_is_inj_rel[OF \<open>converse(g)\<in>_\<close>] \<open>f -`` {n} \<subseteq> Z\<close>]
       cardinal_rel_cong vimage_closed[OF singleton_closed[OF transM[OF \<open>n\<in>\<omega>\<close>]],of f]
     by auto
   finally
   show ?thesis using \<open>n\<in>_\<close> by auto
 qed
 
+end \<comment> \<open>\<^locale>\<open>M_cardinal_library\<close>\<close>
 
 subsection\<open>Applications of transfinite recursive constructions\<close>
 
-definition
-  rec_constr :: "[i,i] \<Rightarrow> i" where
-  "rec_constr(f,\<alpha>) \<equiv> transrec(\<alpha>,\<lambda>a g. f`(g``a))"
+locale M_cardinal_library_extra = M_cardinal_library +
+  assumes
+    replacement_trans_apply_image:
+    "M(f) \<Longrightarrow> M(\<beta>) \<Longrightarrow> Ord(\<beta>) \<Longrightarrow>
+      strong_replacement(M, \<lambda>x y. x\<in>\<beta> \<and> y = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a))\<rangle>)"
+begin
 
-text\<open>The function \<^term>\<open>rec_constr\<close> allows to perform \<^emph>\<open>recursive
-     constructions\<close>: given a choice function on the powerset of some
-     set, a transfinite sequence is created by successively choosing
-     some new element.
-
-     The next result explains its use.\<close>
-
-lemma rec_constr_unfold: "rec_constr(f,\<alpha>) = f`({rec_constr(f,\<beta>). \<beta>\<in>\<alpha>})"
-  using def_transrec[OF rec_constr_def, of f \<alpha>] image_lam by simp
-
-lemma rec_constr_type:
+lemma rec_constr_type_rel:
   assumes "f:Pow_rel(M,G)\<rightarrow>\<^bsup>M\<^esup> G" "Ord(\<alpha>)" "M(G)"
   shows "M(\<alpha>) \<Longrightarrow> rec_constr(f,\<alpha>) \<in> G"
   using assms(2)
 proof(induct rule:trans_induct)
   case (step \<beta>)
   with assms
   have "{rec_constr(f, x) . x \<in> \<beta>} = {y . x \<in> \<beta>, y=rec_constr(f, x)}" (is "_ = ?Y")
     "M(f)"
     using transM[OF _ \<open>M(\<beta>)\<close>] function_space_rel_char  Ord_in_Ord
     by auto
   moreover from assms this step \<open>M(\<beta>)\<close> \<open>Ord(\<beta>)\<close>
   have "M({y . x \<in> \<beta>, y=<x,rec_constr(f, x)>})" (is "M(?Z)")
-    using strong_replacement_closed[OF cardinal_lib_assms6(1),of f \<beta> \<beta>,OF _ _ _ _
+    using strong_replacement_closed[OF replacement_trans_apply_image,of f \<beta> \<beta>,OF _ _ _ _
         univalent_conjI2[where P="\<lambda>x _ . x\<in>\<beta>",OF univalent_triv]]
       transM[OF _ \<open>M(\<beta>)\<close>] transM[OF step(2) \<open>M(G)\<close>] Ord_in_Ord
     unfolding rec_constr_def
     by auto
   moreover from assms this step \<open>M(\<beta>)\<close> \<open>Ord(\<beta>)\<close>
   have "?Y = {snd(y) . y\<in>?Z}"
   proof(intro equalityI, auto)
     fix u
     assume "u\<in>\<beta>"
     with assms this step \<open>M(\<beta>)\<close> \<open>Ord(\<beta>)\<close>
     have "<u,rec_constr(f,u)> \<in> ?Z"  "rec_constr(f, u) = snd(<u,rec_constr(f,u)>)"
       by auto
     then
     show "\<exists>x\<in>{y . x \<in> \<beta>, y = \<langle>x, rec_constr(f, x)\<rangle>}. rec_constr(f, u) = snd(x)"
       using bexI[of _ u] by force
   qed
   moreover from \<open>M(?Z)\<close> \<open>?Y = _\<close>
   have "M(?Y)"
     using
       RepFun_closed[OF lam_replacement_imp_strong_replacement[OF lam_replacement_snd] \<open>M(?Z)\<close>]
       fst_snd_closed[THEN conjunct2] transM[OF _ \<open>M(?Z)\<close>]
     by simp
   moreover from assms step
   have "{rec_constr(f, x) . x \<in> \<beta>} \<in> Pow(G)" (is "?X\<in>_")
     using transM[OF _ \<open>M(\<beta>)\<close>] function_space_rel_char
     by auto
   moreover from assms calculation step
   have "M(?X)"
     by simp
   moreover from calculation \<open>M(G)\<close>
   have "?X\<in>Pow_rel(M,G)"
     using Pow_rel_char by simp
   ultimately
   have "f`?X \<in> G"
     using assms apply_type[OF mem_function_space_rel[of f],of "Pow_rel(M,G)" G ?X]
     by auto
   then
   show ?case
     by (subst rec_constr_unfold,simp)
 qed
 
 lemma rec_constr_closed :
   assumes "f:Pow_rel(M,G)\<rightarrow>\<^bsup>M\<^esup> G" "Ord(\<alpha>)" "M(G)" "M(\<alpha>)"
   shows "M(rec_constr(f,\<alpha>))"
-  using transM[OF rec_constr_type \<open>M(G)\<close>] assms by auto
+  using transM[OF rec_constr_type_rel \<open>M(G)\<close>] assms by auto
 
 lemma lambda_rec_constr_closed :
   assumes "Ord(\<gamma>)" "M(\<gamma>)" "M(f)" "f:Pow_rel(M,G)\<rightarrow>\<^bsup>M\<^esup> G" "M(G)"
   shows "M(\<lambda>\<alpha>\<in>\<gamma> . rec_constr(f,\<alpha>))"
-  using lam_closed2[OF cardinal_lib_assms6(1),unfolded rec_constr_def[symmetric],of f \<gamma>]
-    rec_constr_type[OF \<open>f\<in>_\<close> Ord_in_Ord[of \<gamma>]] transM[OF _ \<open>M(G)\<close>] assms
+  using lam_closed2[OF replacement_trans_apply_image,unfolded rec_constr_def[symmetric],of f \<gamma>]
+    rec_constr_type_rel[OF \<open>f\<in>_\<close> Ord_in_Ord[of \<gamma>]] transM[OF _ \<open>M(G)\<close>] assms
   by simp
 
 text\<open>The next lemma is an application of recursive constructions.
      It works under the assumption that whenever the already constructed
      subsequence is small enough, another element can be added.\<close>
 
 lemma bounded_cardinal_rel_selection:
   includes Ord_dests
   assumes
     "\<And>Z. |Z|\<^bsup>M\<^esup> < \<gamma> \<Longrightarrow> Z \<subseteq> G \<Longrightarrow> M(Z) \<Longrightarrow> \<exists>a\<in>G. \<forall>s\<in>Z. <s,a>\<in>Q" "b\<in>G" "Card_rel(M,\<gamma>)"
     "M(G)" "M(Q)" "M(\<gamma>)"
   shows
     "\<exists>S[M]. S : \<gamma> \<rightarrow>\<^bsup>M\<^esup> G \<and> (\<forall>\<alpha> \<in> \<gamma>. \<forall>\<beta> \<in> \<gamma>.  \<alpha><\<beta> \<longrightarrow> <S`\<alpha>,S`\<beta>>\<in>Q)"
 proof -
   from assms
   have "M(x) \<Longrightarrow> M({a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})" for x
-    using cdlt_assms' by simp
+    using separation_orthogonal by simp
   let ?cdlt\<gamma>="{Z\<in>Pow_rel(M,G) . |Z|\<^bsup>M\<^esup><\<gamma>}" \<comment> \<open>“cardinal\_rel less than \<^term>\<open>\<gamma>\<close>”\<close>
     and ?inQ="\<lambda>Y.{a\<in>G. \<forall>s\<in>Y. <s,a>\<in>Q}"
   from \<open>M(G)\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close>
   have "M(?cdlt\<gamma>)" "Ord(\<gamma>)"
-    using cardinal_lib_assms5[OF \<open>M(\<gamma>)\<close>] Card_rel_is_Ord
+    using separation_cardinal_rel_lt[OF \<open>M(\<gamma>)\<close>] Card_rel_is_Ord
     by simp_all
   from assms
   have H:"\<exists>a. a \<in> ?inQ(Y)" if "Y\<in>?cdlt\<gamma>" for Y
   proof -
     {
       fix Y
       assume "Y\<in>?cdlt\<gamma>"
       then
       have A:"Y\<in>Pow_rel(M,G)" "|Y|\<^bsup>M\<^esup><\<gamma>"  by simp_all
       then
       have "Y\<subseteq>G" "M(Y)" using Pow_rel_char[OF \<open>M(G)\<close>] by simp_all
       with A
       obtain a where "a\<in>G" "\<forall>s\<in>Y. <s,a>\<in>Q"
         using assms(1) by force
       with \<open>M(G)\<close>
       have "\<exists>a. a \<in> ?inQ(Y)" by auto
     }
     then show ?thesis using that by simp
   qed
   then
   have "\<exists>f[M]. f \<in> Pi_rel(M,?cdlt\<gamma>,?inQ) \<and> f \<in> Pi(?cdlt\<gamma>,?inQ)"
   proof -
     from \<open>\<And>x. M(x) \<Longrightarrow> M({a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})\<close> \<open>M(G)\<close>
     have "x \<in> {Z \<in> Pow\<^bsup>M\<^esup>(G) . |Z|\<^bsup>M\<^esup> < \<gamma>} \<Longrightarrow> M({a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})" for x
       by (auto dest:transM)
     with\<open>M(G)\<close> \<open>\<And>x. M(x) \<Longrightarrow> M({a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})\<close> \<open>M(Q)\<close> \<open>M(?cdlt\<gamma>)\<close>
     interpret M_Pi_assumptions_choice M ?cdlt\<gamma> ?inQ
       using cdlt_assms[where Q=Q] lam_replacement_Collect_ball_Pair[THEN
           lam_replacement_imp_strong_replacement] surj_imp_inj_replacement3
         lam_replacement_hcomp2[OF lam_replacement_constant
           lam_replacement_Collect_ball_Pair _ _ lam_replacement_minimum,
           unfolded lam_replacement_def]
         lam_replacement_hcomp lam_replacement_Sigfun[OF
           lam_replacement_Collect_ball_Pair, of G Q, THEN
-          lam_replacement_imp_strong_replacement] cdlt_assms'
+          lam_replacement_imp_strong_replacement] separation_orthogonal
       by unfold_locales (blast dest: transM, auto dest:transM)
     show ?thesis using AC_Pi_rel Pi_rel_char H by auto
   qed
   then
   obtain f where f_type:"f \<in> Pi_rel(M,?cdlt\<gamma>,?inQ)" "f \<in> Pi(?cdlt\<gamma>,?inQ)" and "M(f)"
     by auto
   moreover
   define Cb where "Cb \<equiv> \<lambda>_\<in>Pow_rel(M,G)-?cdlt\<gamma>. b"
   moreover from \<open>b\<in>G\<close> \<open>M(?cdlt\<gamma>)\<close> \<open>M(G)\<close>
   have "Cb \<in> Pow_rel(M,G)-?cdlt\<gamma> \<rightarrow> G" "M(Cb)"
     using lam_closed[of "\<lambda>_.b" "Pow_rel(M,G)-?cdlt\<gamma>"]
       tag_replacement transM[OF \<open>b\<in>G\<close>]
     unfolding Cb_def by auto
   moreover
   note \<open>Card_rel(M,\<gamma>)\<close>
   ultimately
   have "f \<union> Cb : (\<Prod>x\<in>Pow_rel(M,G). ?inQ(x) \<union> G)" using
       fun_Pi_disjoint_Un[ of f ?cdlt\<gamma>  ?inQ Cb "Pow_rel(M,G)-?cdlt\<gamma>" "\<lambda>_.G"]
       Diff_partition[of "{Z\<in>Pow_rel(M,G). |Z|\<^bsup>M\<^esup><\<gamma>}" "Pow_rel(M,G)", OF Collect_subset]
     by auto
   moreover
   have "?inQ(x) \<union> G = G" for x by auto
   moreover from calculation
   have "f \<union> Cb : Pow_rel(M,G) \<rightarrow> G"
     using function_space_rel_char by simp
   ultimately
   have "f \<union> Cb : Pow_rel(M,G) \<rightarrow>\<^bsup>M\<^esup> G"
     using function_space_rel_char \<open>M(f)\<close> \<open>M(Cb)\<close> Pow_rel_closed \<open>M(G)\<close>
     by auto
   define S where "S\<equiv>\<lambda>\<alpha>\<in>\<gamma>. rec_constr(f \<union> Cb, \<alpha>)"
   from \<open>f \<union> Cb: Pow_rel(M,G) \<rightarrow>\<^bsup>M\<^esup> G\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close> \<open>M(G)\<close>
   have "S : \<gamma> \<rightarrow> G" "M(f \<union> Cb)"
     unfolding S_def
-    using Ord_in_Ord[OF Card_rel_is_Ord] rec_constr_type lam_type transM[OF _ \<open>M(\<gamma>)\<close>]
+    using Ord_in_Ord[OF Card_rel_is_Ord] rec_constr_type_rel lam_type transM[OF _ \<open>M(\<gamma>)\<close>]
       function_space_rel_char
     by auto
   moreover from \<open>f\<union>Cb \<in> _\<rightarrow>\<^bsup>M\<^esup> G\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close> \<open>M(G)\<close> \<open>M(f \<union> Cb)\<close> \<open>Ord(\<gamma>)\<close>
   have "M(S)"
     unfolding S_def
     using lambda_rec_constr_closed
     by simp
   moreover
-  have "\<forall>\<alpha>\<in>\<gamma>. \<forall>\<beta>\<in>\<gamma>. \<alpha> < \<beta> \<longrightarrow> <S ` \<alpha>, S ` \<beta>>\<in>Q"
+  have "\<forall>\<alpha>\<in>\<gamma>. \<forall>\<beta>\<in>\<gamma>. \<alpha> < \<beta> \<longrightarrow> \<langle>S`\<alpha>, S`\<beta>\<rangle> \<in> Q"
   proof (intro ballI impI)
     fix \<alpha> \<beta>
     assume "\<beta>\<in>\<gamma>"
     with \<open>Card_rel(M,\<gamma>)\<close> \<open>M(S)\<close> \<open>M(\<gamma>)\<close>
     have "\<beta>\<subseteq>\<gamma>" "M(S``\<beta>)" "M(\<beta>)" "{S`x . x \<in> \<beta>} = {restrict(S,\<beta>)`x . x \<in> \<beta>}"
       using transM[OF \<open>\<beta>\<in>\<gamma>\<close> \<open>M(\<gamma>)\<close>] image_closed Card_rel_is_Ord OrdmemD
       by auto
     with \<open>\<beta>\<in>_\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close>
     have "{rec_constr(f \<union> Cb, x) . x\<in>\<beta>} = {S`x . x \<in> \<beta>}"
       using Ord_trans[OF _ _ Card_rel_is_Ord, of _ \<beta> \<gamma>]
       unfolding S_def
       by auto
     moreover from \<open>\<beta>\<in>\<gamma>\<close> \<open>S : \<gamma> \<rightarrow> G\<close> \<open>Card_rel(M,\<gamma>)\<close> \<open>M(\<gamma>)\<close> \<open>M(S``\<beta>)\<close>
     have "{S`x . x \<in> \<beta>} \<subseteq> G" "M({S`x . x \<in> \<beta>})"
       using Ord_trans[OF _ _ Card_rel_is_Ord, of _ \<beta> \<gamma>]
         apply_type[of S \<gamma> "\<lambda>_. G"]
       by(auto,simp add:image_fun_subset[OF \<open>S\<in>_\<close> \<open>\<beta>\<subseteq>_\<close>])
     moreover from \<open>Card_rel(M,\<gamma>)\<close> \<open>\<beta>\<in>\<gamma>\<close> \<open>S\<in>_\<close> \<open>\<beta>\<subseteq>\<gamma>\<close> \<open>M(S)\<close> \<open>M(\<beta>)\<close> \<open>M(G)\<close> \<open>M(\<gamma>)\<close>
     have "|{S`x . x \<in> \<beta>}|\<^bsup>M\<^esup> < \<gamma>"
       using
         \<open>{S`x . x\<in>\<beta>} = {restrict(S,\<beta>)`x . x\<in>\<beta>}\<close>[symmetric]
         cardinal_rel_RepFun_apply_le[of "restrict(S,\<beta>)" \<beta> G,
           OF restrict_type2[of S \<gamma> "\<lambda>_.G" \<beta>] restrict_closed]
         Ord_in_Ord Ord_cardinal_rel
         lt_trans1[of "|{S`x . x \<in> \<beta>}|\<^bsup>M\<^esup>" "|\<beta>|\<^bsup>M\<^esup>" \<gamma>]
         Card_rel_lt_iff[THEN iffD2, of \<beta> \<gamma>, OF _ _ _ _ ltI]
         Card_rel_is_Ord
       by auto
     moreover
     have "\<forall>x\<in>\<beta>. <S`x, f ` {S`x . x \<in> \<beta>}> \<in> Q"
     proof -
       from calculation and f_type
       have "f ` {S`x . x \<in> \<beta>} \<in> {a\<in>G. \<forall>x\<in>\<beta>. <S`x,a>\<in>Q}"
         using apply_type[of f ?cdlt\<gamma> ?inQ "{S`x . x \<in> \<beta>}"]
           Pow_rel_char[OF \<open>M(G)\<close>]
         by simp
       then
       show ?thesis by simp
     qed
     moreover
     assume "\<alpha>\<in>\<gamma>" "\<alpha> < \<beta>"
     moreover from this
     have "\<alpha>\<in>\<beta>" using ltD by simp
     moreover
     note \<open>\<beta>\<in>\<gamma>\<close> \<open>Cb \<in> Pow_rel(M,G)-?cdlt\<gamma> \<rightarrow> G\<close>
     ultimately
-    show "<S ` \<alpha>, S ` \<beta>>\<in>Q"
+    show "\<langle>S`\<alpha>, S`\<beta>\<rangle>\<in>Q"
       using fun_disjoint_apply1[of "{S`x . x \<in> \<beta>}" Cb f]
         domain_of_fun[of Cb] ltD[of \<alpha> \<beta>]
       by (subst (2) S_def, auto) (subst rec_constr_unfold, auto)
   qed
   moreover
   note \<open>M(G)\<close> \<open>M(\<gamma>)\<close>
   ultimately
   show ?thesis using function_space_rel_char by auto
 qed
 
 text\<open>The following basic result can, in turn, be proved by a
      bounded-cardinal\_rel selection.\<close>
 lemma Infinite_iff_lepoll_rel_nat: "M(Z) \<Longrightarrow> Infinite(Z) \<longleftrightarrow> \<omega> \<lesssim>\<^bsup>M\<^esup> Z"
 proof
   define Distinct where "Distinct = {<x,y> \<in> Z\<times>Z . x\<noteq>y}"
   have "Distinct = {xy \<in> Z\<times>Z . \<exists>a b. xy = \<langle>a, b\<rangle> \<and> a \<noteq> b}" (is "_=?A")
     unfolding Distinct_def by auto
   moreover
   assume "Infinite(Z)" "M(Z)"
   moreover from calculation
   have "M(Distinct)"
-    using cardinal_lib_assms6 separation_dist by simp
+    using separation_dist by simp
   from \<open>Infinite(Z)\<close> \<open>M(Z)\<close>
   obtain b where "b\<in>Z"
     using Infinite_not_empty by auto
   {
     fix Y
     assume "|Y|\<^bsup>M\<^esup> < \<omega>" "M(Y)"
     then
     have "Finite(Y)"
       using Finite_cardinal_rel_iff' ltD nat_into_Finite by auto
     with \<open>Infinite(Z)\<close>
     have "Z \<noteq> Y" by auto
   }
   moreover
   have "(\<And>W. M(W) \<Longrightarrow> |W|\<^bsup>M\<^esup> < \<omega> \<Longrightarrow> W \<subseteq> Z \<Longrightarrow> \<exists>a\<in>Z. \<forall>s\<in>W. <s,a>\<in>Distinct)"
   proof -
     fix W
     assume "M(W)" "|W|\<^bsup>M\<^esup> < \<omega>" "W \<subseteq> Z"
     moreover from this
     have "Finite_rel(M,W)"
       using
         cardinal_rel_closed[OF \<open>M(W)\<close>] Card_rel_nat
         lt_Card_rel_imp_lesspoll_rel[of \<omega>,simplified,OF _ \<open>|W|\<^bsup>M\<^esup> < \<omega>\<close>]
         lesspoll_rel_nat_is_Finite_rel[of W]
         eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym[OF cardinal_rel_eqpoll_rel,of W]
         lesspoll_rel_trans1[of W "|W|\<^bsup>M\<^esup>" \<omega>] by auto
     moreover from calculation
     have "\<not>Z\<subseteq>W"
       using equalityI \<open>Infinite(Z)\<close> by auto
     moreover from calculation
     show "\<exists>a\<in>Z. \<forall>s\<in>W. <s,a>\<in>Distinct"
       unfolding Distinct_def by auto
   qed
   moreover from \<open>b\<in>Z\<close> \<open>M(Z)\<close> \<open>M(Distinct)\<close> this
   obtain S where "S : \<omega> \<rightarrow>\<^bsup>M\<^esup> Z" "M(S)" "\<forall>\<alpha>\<in>\<omega>. \<forall>\<beta>\<in>\<omega>. \<alpha> < \<beta> \<longrightarrow> <S`\<alpha>,S`\<beta>> \<in> Distinct"
     using bounded_cardinal_rel_selection[OF _ \<open>b\<in>Z\<close> Card_rel_nat,of Distinct]
     by blast
   moreover from this
   have "\<alpha> \<in> \<omega> \<Longrightarrow> \<beta> \<in> \<omega> \<Longrightarrow> \<alpha>\<noteq>\<beta> \<Longrightarrow> S`\<alpha> \<noteq> S`\<beta>" for \<alpha> \<beta>
     unfolding Distinct_def
     by (rule_tac lt_neq_symmetry[of "\<omega>" "\<lambda>\<alpha> \<beta>. S`\<alpha> \<noteq> S`\<beta>"])
       auto
   moreover from this \<open>S\<in>_\<close> \<open>M(Z)\<close>
   have "S\<in>inj(\<omega>,Z)" using function_space_rel_char unfolding inj_def by auto
   ultimately
   show "\<omega> \<lesssim>\<^bsup>M\<^esup> Z"
     unfolding lepoll_rel_def using inj_rel_char \<open>M(Z)\<close> by auto
 next
   assume "\<omega> \<lesssim>\<^bsup>M\<^esup> Z" "M(Z)"
   then
   show "Infinite(Z)" using lepoll_rel_nat_imp_Infinite by simp
 qed
 
 lemma Infinite_InfCard_rel_cardinal_rel: "Infinite(Z) \<Longrightarrow> M(Z) \<Longrightarrow> InfCard_rel(M,|Z|\<^bsup>M\<^esup>)"
   using lepoll_rel_eq_trans eqpoll_rel_sym lepoll_rel_nat_imp_Infinite
     Infinite_iff_lepoll_rel_nat Inf_Card_rel_is_InfCard_rel cardinal_rel_eqpoll_rel
   by simp
 
 lemma (in M_trans) mem_F_bound2:
   fixes F A
   defines "F \<equiv> \<lambda>_ x. if M(x) then A-``{x} else 0"
   shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> range(A))"
   using apply_0 unfolding F_def
   by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
 
 lemma Finite_to_one_rel_surj_rel_imp_cardinal_rel_eq:
   assumes "F \<in> Finite_to_one_rel(M,Z,Y) \<inter> surj_rel(M,Z,Y)" "Infinite(Z)" "M(Z)" "M(Y)"
   shows "|Y|\<^bsup>M\<^esup> = |Z|\<^bsup>M\<^esup>"
 proof -
   have sep_true: "separation(M, M)" unfolding separation_def by auto
   note \<open>M(Z)\<close> \<open>M(Y)\<close>
   moreover from this assms
   have "M(F)" "F \<in> Z \<rightarrow> Y"
     unfolding Finite_to_one_rel_def
     using function_space_rel_char by simp_all
   moreover from this
   have "x \<in> (if M(i) then F -`` {i} else 0) \<Longrightarrow> M(i)" for x i
     by (cases "M(i)") auto
   moreover from calculation
   interpret M_replacement_lepoll M "\<lambda>_ x. if M(x) then F-``{x} else 0"
     using lam_replacement_inj_rel mem_F_bound2 cardinal_lib_assms3
-      lam_replacement_vimage_sing_fun
+      lam_replacement_vimage_sing_fun lam_replacement_minimum
       lam_replacement_if[OF _
         lam_replacement_constant[OF nonempty],where b=M] sep_true
     by (unfold_locales, simp_all)
       (rule lam_Least_assumption_general[where U="\<lambda>_. range(F)"], auto)
   have "w \<in> (if M(y) then F-``{y} else 0) \<Longrightarrow> M(y)" for w y
     by (cases "M(y)") auto
   moreover from \<open>F\<in>_\<inter>_\<close>
   have 0:"Finite(F-``{y})" if "y\<in>Y" for y
     unfolding Finite_to_one_rel_def
     using vimage_fun_sing \<open>F\<in>Z\<rightarrow>Y\<close> transM[OF that \<open>M(Y)\<close>] transM[OF _ \<open>M(Z)\<close>] that by simp
   ultimately
   interpret M_cardinal_UN_lepoll _ "\<lambda>y. if M(y) then F-``{y} else 0" Y
     using cardinal_lib_assms3 lepoll_assumptions
     by unfold_locales  (auto dest:transM simp del:mem_inj_abs)
   from \<open>F\<in>Z\<rightarrow>Y\<close>
   have "Z = (\<Union>y\<in>Y. {x\<in>Z . F`x = y})"
     using apply_type by auto
   then
   show ?thesis
   proof (cases "Finite(Y)")
     case True
     with \<open>Z = (\<Union>y\<in>Y. {x\<in>Z . F`x = y})\<close> and assms and \<open>F\<in>Z\<rightarrow>Y\<close>
     show ?thesis
       using Finite_RepFun[THEN [2] Finite_Union, of Y "\<lambda>y. F-``{y}"] 0 vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>]
       by simp
   next
     case False
     moreover from this \<open>M(Y)\<close>
     have "Y \<lesssim>\<^bsup>M\<^esup> |Y|\<^bsup>M\<^esup>"
       using cardinal_rel_eqpoll_rel eqpoll_rel_sym eqpoll_rel_imp_lepoll_rel by auto
     moreover
     note assms
     moreover from \<open>F\<in>_\<inter>_\<close>
     have "Finite({x\<in>Z . F`x = y})" "M(F-``{y})" if "y\<in>Y" for y
       unfolding Finite_to_one_rel_def
       using transM[OF that  \<open>M(Y)\<close>] transM[OF _ \<open>M(Z)\<close>] vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>] that
       by simp_all
     moreover from calculation
     have "|{x\<in>Z . F`x = y}|\<^bsup>M\<^esup> \<in> \<omega>" if "y\<in>Y" for y
       using Finite_cardinal_rel_in_nat that transM[OF that \<open>M(Y)\<close>] vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>] that
       by simp
     moreover from calculation
     have "|{x\<in>Z . F`x = y}|\<^bsup>M\<^esup> \<le> |Y|\<^bsup>M\<^esup>" if "y\<in>Y" for y
       using Infinite_imp_nats_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le,
           of _ "|{x\<in>Z . F`x = y}|\<^bsup>M\<^esup>"]
         that cardinal_rel_idem transM[OF that \<open>M(Y)\<close>] vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>]
       by auto
     ultimately
     have "|\<Union>y\<in>Y. {x\<in>Z . F`x = y}|\<^bsup>M\<^esup> \<le> |Y|\<^bsup>M\<^esup>"
       using leqpoll_rel_imp_cardinal_rel_UN_le
         Infinite_InfCard_rel_cardinal_rel[of Y] vimage_fun_sing[OF \<open>F\<in>Z\<rightarrow>Y\<close>]
       by(auto simp add:transM[OF _ \<open>M(Y)\<close>])
     moreover from \<open>F \<in> Finite_to_one_rel(M,Z,Y) \<inter> surj_rel(M,Z,Y)\<close> \<open>M(Z)\<close> \<open>M(F)\<close> \<open>M(Y)\<close>
     have "|Y|\<^bsup>M\<^esup> \<le> |Z|\<^bsup>M\<^esup>"
       using surj_rel_implies_cardinal_rel_le by auto
     moreover
     note \<open>Z = (\<Union>y\<in>Y. {x\<in>Z . F`x = y})\<close>
     ultimately
     show ?thesis
       using le_anti_sym by auto
   qed
 qed
 
 lemma cardinal_rel_map_Un:
   assumes "Infinite(X)" "Finite(b)" "M(X)" "M(b)"
   shows "|{a \<union> b . a \<in> X}|\<^bsup>M\<^esup> = |X|\<^bsup>M\<^esup>"
 proof -
   have "(\<lambda>a\<in>X. a \<union> b) \<in> Finite_to_one_rel(M,X,{a \<union> b . a \<in> X})"
     "(\<lambda>a\<in>X. a \<union> b) \<in>  surj_rel(M,X,{a \<union> b . a \<in> X})"
     "M({a \<union> b . a \<in> X})"
     unfolding def_surj_rel
   proof
     fix d
     have "Finite({a \<in> X . a \<union> b = d})" (is "Finite(?Y(b,d))")
       using \<open>Finite(b)\<close>
     proof (induct arbitrary:d)
       case 0
       have "{a \<in> X . a \<union> 0 = d} = (if d\<in>X then {d} else 0)"
         by auto
       then
       show ?case by simp
     next
       case (cons c b)
       from \<open>c \<notin> b\<close>
       have "?Y(cons(c,b),d) \<subseteq> (if c\<in>d then ?Y(b,d) \<union> ?Y(b,d-{c}) else 0)"
         by auto
       with cons
       show ?case
         using subset_Finite
         by simp
     qed
     moreover
     assume "d \<in> {x \<union> b . x \<in> X}"
     ultimately
     show "Finite({a \<in> X . M(a) \<and> (\<lambda>x\<in>X. x \<union> b) ` a = d})"
       using subset_Finite[of "{a \<in> X . M(a) \<and> (\<lambda>x\<in>X. x \<union> b) ` a = d}"
           "{a \<in> X . (\<lambda>x\<in>X. x \<union> b) ` a = d}"] by auto
   next
     note \<open>M(X)\<close> \<open>M(b)\<close>
     moreover
     show "M(\<lambda>a\<in>X. a \<union> b)"
       using lam_closed[of "\<lambda> x . x\<union>b",OF _ \<open>M(X)\<close>] Un_closed[OF transM[OF _ \<open>M(X)\<close>] \<open>M(b)\<close>]
         tag_union_replacement[OF \<open>M(b)\<close>]
       by simp
     moreover from this
     have "{a \<union> b . a \<in> X} = (\<lambda>x\<in>X. x \<union> b) `` X"
       using image_lam by simp
     with calculation
     show "M({a \<union> b . a \<in> X})" by auto
     moreover from calculation
     show "(\<lambda>a\<in>X. a \<union> b) \<in> X \<rightarrow>\<^bsup>M\<^esup> {a \<union> b . a \<in> X}"
       using function_space_rel_char by (auto intro:lam_funtype)
     ultimately
     show "(\<lambda>a\<in>X. a \<union> b) \<in> surj\<^bsup>M\<^esup>(X,{a \<union> b . a \<in> X})" "M({a \<union> b . a \<in> X})"
       using surj_rel_char function_space_rel_char
       unfolding surj_def by auto
   next
   qed (simp add:\<open>M(X)\<close>)
   moreover from assms this
   show ?thesis
     using Finite_to_one_rel_surj_rel_imp_cardinal_rel_eq by simp
 qed
 
+end \<comment> \<open>\<^locale>\<open>M_cardinal_library_extra\<close>\<close>
+
+context M_library
+begin
+
 subsection\<open>Results on relative cardinal exponentiation\<close>
 
 lemma cexp_rel_eqpoll_rel_cong:
   assumes
     "A \<approx>\<^bsup>M\<^esup> A'" "B \<approx>\<^bsup>M\<^esup> B'" "M(A)" "M(A')" "M(B)" "M(B')"
   shows
     "A\<^bsup>\<up>B,M\<^esup> = A'\<^bsup>\<up>B',M\<^esup>"
   unfolding cexp_rel_def using cardinal_rel_eqpoll_rel_iff
     function_space_rel_eqpoll_rel_cong assms
   by simp
 
 lemma cexp_rel_cexp_rel_cmult:
   assumes "M(\<kappa>)" "M(\<nu>1)" "M(\<nu>2)"
   shows "(\<kappa>\<^bsup>\<up>\<nu>1,M\<^esup>)\<^bsup>\<up>\<nu>2,M\<^esup> = \<kappa>\<^bsup>\<up>\<nu>2 \<otimes>\<^bsup>M\<^esup> \<nu>1,M\<^esup>"
 proof -
   have "(\<kappa>\<^bsup>\<up>\<nu>1,M\<^esup>)\<^bsup>\<up>\<nu>2,M\<^esup> = (\<nu>1 \<rightarrow>\<^bsup>M\<^esup> \<kappa>)\<^bsup>\<up>\<nu>2,M\<^esup>"
     using cardinal_rel_eqpoll_rel
     by (intro cexp_rel_eqpoll_rel_cong) (simp_all add:assms cexp_rel_def)
   also from assms
   have " \<dots> = \<kappa>\<^bsup>\<up>\<nu>2 \<times> \<nu>1,M\<^esup>"
     unfolding cexp_rel_def using curry_eqpoll_rel[THEN cardinal_rel_cong] by blast
   also
   have " \<dots> = \<kappa>\<^bsup>\<up>\<nu>2 \<otimes>\<^bsup>M\<^esup> \<nu>1,M\<^esup>"
     using cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym]
     unfolding cmult_rel_def by (intro cexp_rel_eqpoll_rel_cong) (auto simp add:assms)
   finally
   show ?thesis .
 qed
 
 lemma cardinal_rel_Pow_rel: "M(X) \<Longrightarrow> |Pow_rel(M,X)|\<^bsup>M\<^esup> = 2\<^bsup>\<up>X,M\<^esup>" \<comment> \<open>Perhaps it's better with |X|\<close>
   using cardinal_rel_eqpoll_rel_iff[THEN iffD2,
       OF _ _ Pow_rel_eqpoll_rel_function_space_rel]
   unfolding cexp_rel_def by simp
 
 lemma cantor_cexp_rel:
   assumes "Card_rel(M,\<nu>)" "M(\<nu>)"
   shows "\<nu> < 2\<^bsup>\<up>\<nu>,M\<^esup>"
   using assms Card_rel_is_Ord Card_rel_cexp_rel
 proof (intro not_le_iff_lt[THEN iffD1] notI)
   assume "2\<^bsup>\<up>\<nu>,M\<^esup> \<le> \<nu>"
   with assms
   have "|Pow_rel(M,\<nu>)|\<^bsup>M\<^esup> \<le> \<nu>"
     using cardinal_rel_Pow_rel[of \<nu>] by simp
   with assms
   have "Pow_rel(M,\<nu>) \<lesssim>\<^bsup>M\<^esup> \<nu>"
     using cardinal_rel_eqpoll_rel_iff Card_rel_le_imp_lepoll_rel Card_rel_cardinal_rel_eq
     by auto
   then
   obtain g where "g \<in> inj_rel(M,Pow_rel(M,\<nu>), \<nu>)"
     by blast
   moreover
   note \<open>M(\<nu>)\<close>
   moreover from calculation
   have "M(g)" by (auto dest:transM)
   ultimately
   show "False"
     using cantor_inj_rel by simp
 qed simp
 
 lemma countable_iff_lesspoll_rel_Aleph_rel_one:
   notes iff_trans[trans]
   assumes "M(C)"
   shows "countable\<^bsup>M\<^esup>(C) \<longleftrightarrow> C \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
   using assms lesspoll_rel_csucc_rel[of \<omega> C] Aleph_rel_succ Aleph_rel_zero
   unfolding countable_rel_def by simp
 
 
 lemma countable_iff_le_rel_Aleph_rel_one:
   notes iff_trans[trans]
   assumes "M(C)"
   shows "countable\<^bsup>M\<^esup>(C) \<longleftrightarrow> |C|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
 proof -
   from assms
   have "countable\<^bsup>M\<^esup>(C) \<longleftrightarrow> C \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     using countable_iff_lesspoll_rel_Aleph_rel_one
     by simp
   also from assms
   have "\<dots> \<longleftrightarrow> |C|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     using cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym, THEN eq_lesspoll_rel_trans]
     by (auto intro:cardinal_rel_eqpoll_rel[THEN eq_lesspoll_rel_trans])
   finally
   show ?thesis .
 qed
 
-end \<comment> \<open>\<^locale>\<open>M_cardinal_library\<close>\<close>
+end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
 
 (* TODO: This can be generalized. *)
 lemma (in M_cardinal_library) countable_fun_imp_countable_image:
   assumes "f:C \<rightarrow>\<^bsup>M\<^esup> B" "countable\<^bsup>M\<^esup>(C)" "\<And>c. c\<in>C \<Longrightarrow> countable\<^bsup>M\<^esup>(f`c)"
     "M(C)" "M(B)"
   shows "countable\<^bsup>M\<^esup>(\<Union>(f``C))"
   using assms function_space_rel_char image_fun[of f]
     cardinal_rel_RepFun_apply_le[of f C B]
     countable_rel_iff_cardinal_rel_le_nat[THEN iffD1, THEN [2] le_trans, of _ ]
     countable_rel_iff_cardinal_rel_le_nat
   by (rule_tac countable_rel_union_countable_rel)
     (auto dest:transM del:imageE)
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Cardinal_Relative.thy b/thys/Transitive_Models/Cardinal_Relative.thy
--- a/thys/Transitive_Models/Cardinal_Relative.thy
+++ b/thys/Transitive_Models/Cardinal_Relative.thy
@@ -1,1292 +1,1331 @@
 section\<open>Relative, Choice-less Cardinal Numbers\<close>
 
 theory Cardinal_Relative
   imports
     Lambda_Replacement
     Univ_Relative
 begin
 
 txt\<open>The following command avoids that a commonly used one-letter variable be
 captured by the definition of the constructible universe \<^term>\<open>L\<close>.\<close>
 hide_const (open) L
 
 txt\<open>We also return to the old notation for \<^term>\<open>sum\<close> to preserve the old
 Constructibility code.\<close>
 no_notation oadd (infixl \<open>+\<close> 65)
 notation sum (infixr \<open>+\<close> 65)
 
 definition
   Finite_rel   :: "[i\<Rightarrow>o,i]=>o"  where
   "Finite_rel(M,A) \<equiv> \<exists>om[M]. \<exists>n[M]. omega(M,om) \<and> n\<in>om \<and> eqpoll_rel(M,A,n)"
 
 definition
   banach_functor :: "[i,i,i,i,i] \<Rightarrow> i" where
   "banach_functor(X,Y,f,g,W) \<equiv> X - g``(Y - f``W)"
 
+lemma banach_functor_subset: "banach_functor(X,Y,f,g,W) \<subseteq> X"
+  unfolding banach_functor_def by auto
+
 definition
   is_banach_functor :: "[i\<Rightarrow>o,i,i,i,i,i,i]\<Rightarrow>o"  where
   "is_banach_functor(M,X,Y,f,g,W,b) \<equiv>
       \<exists>fW[M]. \<exists>YfW[M]. \<exists>gYfW[M]. image(M,f,W,fW) \<and> setdiff(M,Y,fW,YfW) \<and>
                                  image(M,g,YfW,gYfW) \<and> setdiff(M,X,gYfW,b)"
 
 
 lemma (in M_basic) banach_functor_abs :
   assumes "M(X)" "M(Y)" "M(f)" "M(g)"
   shows "relation1(M,is_banach_functor(M,X,Y,f,g),banach_functor(X,Y,f,g))"
   unfolding relation1_def is_banach_functor_def banach_functor_def
   using assms
   by simp
 
 lemma (in M_basic) banach_functor_closed:
   assumes "M(X)" "M(Y)" "M(f)" "M(g)"
   shows "\<forall>W[M]. M(banach_functor(X,Y,f,g,W))"
   unfolding banach_functor_def using assms image_closed
   by simp
 
-locale M_cardinals = M_ordertype + M_trancl + M_Perm + M_replacement_extra +
+context M_trancl
+begin
+
+lemma iterates_banach_functor_closed:
+  assumes "n\<in>\<omega>" "M(X)" "M(Y)" "M(f)" "M(g)"
+  shows "M(banach_functor(X,Y,f,g)^n(0))"
+  using assms banach_functor_closed
+  by (induct) simp_all
+
+lemma banach_repl_iter':
+  assumes
+    "\<And>A. M(A) \<Longrightarrow> separation(M, \<lambda>b. \<exists>x\<in>A. x \<in> \<omega> \<and> b = banach_functor(X, Y, f, g)^x (0))"
+    "M(X)" "M(Y)" "M(f)" "M(g)"
+  shows
+    "strong_replacement(M, \<lambda>x y. x\<in>nat \<and> y = banach_functor(X, Y, f, g)^x (0))"
+  unfolding strong_replacement_def
+proof clarsimp
+  fix A
+  let ?Z="{b \<in> Pow\<^bsup>M\<^esup>(X) . (\<exists>x\<in>A. x \<in> \<omega> \<and> b = banach_functor(X, Y, f, g)^x (0))}"
+  assume "M(A)"
+  moreover
+  note assms
+  moreover from calculation
+  have "M(?Z)" by simp
+  moreover from assms(2-)
+  have "b \<in> ?Z \<longleftrightarrow> (\<exists>x\<in>A. x \<in> \<omega> \<and> b = banach_functor(X, Y, f, g)^x (0))" for b
+    by (auto, rename_tac x, induct_tac x, (auto simp:def_Pow_rel)[1],
+        rule_tac def_Pow_rel[THEN iffD2, OF iterates_banach_functor_closed[of _ X Y f g]])
+          (simp_all add:banach_functor_subset)
+  ultimately
+  show "\<exists>Z[M]. \<forall>b[M]. b \<in> Z \<longleftrightarrow> (\<exists>x\<in>A. x \<in> \<omega> \<and> b = banach_functor(X, Y, f, g)^x (0))"
+    by (intro rexI[of _ ?Z]) simp
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_trancl\<close>\<close>
+
+locale M_cardinals = M_ordertype + M_trancl + M_Perm + M_replacement +
   assumes
     radd_separation: "M(R) \<Longrightarrow> M(S) \<Longrightarrow>
     separation(M, \<lambda>z.
       (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>) \<or>
          (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x', x\<rangle> \<in> R) \<or>
          (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y', y\<rangle> \<in> S))"
     and
     rmult_separation: "M(b) \<Longrightarrow> M(d) \<Longrightarrow> separation(M,
     \<lambda>z. \<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> b \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> d))"
     and
     banach_repl_iter: "M(X) \<Longrightarrow> M(Y) \<Longrightarrow> M(f) \<Longrightarrow> M(g) \<Longrightarrow>
                strong_replacement(M, \<lambda>x y. x\<in>nat \<and> y = banach_functor(X, Y, f, g)^x (0))"
 begin
 
 lemma rvimage_separation: "M(f) \<Longrightarrow> M(r) \<Longrightarrow>
     separation(M, \<lambda>z. \<exists>x y. z = \<langle>x, y\<rangle> \<and> \<langle>f ` x, f ` y\<rangle> \<in> r)"
-  using separation_pair separation_in
+  using separation_Pair separation_in
     lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
     lam_replacement_constant lam_replacement_apply2[THEN[5] lam_replacement_hcomp2,OF lam_replacement_constant[of f]]
     lam_replacement_fst lam_replacement_snd
     lam_replacement_identity lam_replacement_hcomp
   by(simp_all)
 
 lemma radd_closed[intro,simp]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> M(c) \<Longrightarrow> M(d) \<Longrightarrow> M(radd(a,b,c,d))"
   using radd_separation by (auto simp add: radd_def)
 
 lemma rmult_closed[intro,simp]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> M(c) \<Longrightarrow> M(d) \<Longrightarrow> M(rmult(a,b,c,d))"
   using rmult_separation by (auto simp add: rmult_def)
 
 end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
 
 lemma (in M_cardinals) is_cardinal_iff_Least:
   assumes "M(A)" "M(\<kappa>)"
   shows "is_cardinal(M,A,\<kappa>) \<longleftrightarrow> \<kappa> = (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)"
   using is_cardinal_iff assms
   unfolding cardinal_rel_def by simp
 
 subsection\<open>The Schroeder-Bernstein Theorem\<close>
 text\<open>See Davey and Priestly, page 106\<close>
 
 context M_cardinals
 begin
 
 (** Lemma: Banach's Decomposition Theorem **)
 
 lemma bnd_mono_banach_functor: "bnd_mono(X, banach_functor(X,Y,f,g))"
   unfolding bnd_mono_def banach_functor_def
   by blast
 
 lemma inj_Inter:
   assumes "g \<in> inj(Y,X)" "A\<noteq>0" "\<forall>a\<in>A. a \<subseteq> Y"
   shows "g``(\<Inter>A) = (\<Inter>a\<in>A. g``a)"
 proof (intro equalityI subsetI)
   fix x
   from assms
   obtain a where "a\<in>A" by blast
   moreover
   assume "x \<in> (\<Inter>a\<in>A. g `` a)"
   ultimately
   have x_in_im: "x \<in> g``y" if "y\<in>A" for y
     using that by auto
   have exists: "\<exists>z \<in> y. x = g`z" if "y\<in>A" for y
   proof -
     note that
     moreover from this and x_in_im
     have "x \<in> g``y" by simp
     moreover from calculation
     have "x \<in> g``y" by simp
     moreover
     note assms
     ultimately
     show ?thesis
       using image_fun[OF inj_is_fun] by auto
   qed
   with \<open>a\<in>A\<close>
   obtain z where "z \<in> a" "x = g`z" by auto
   moreover
   have "z \<in> y" if "y\<in>A" for y
   proof -
     from that and exists
     obtain w where "w \<in> y" "x = g`w" by auto
     moreover from this \<open>x = g`z\<close> assms that \<open>a\<in>A\<close> \<open>z\<in>a\<close>
     have "z = w" unfolding inj_def by blast
     ultimately
     show ?thesis by simp
   qed
   moreover
   note assms
   moreover from calculation
   have "z \<in> \<Inter>A" by auto
   moreover from calculation
   have "z \<in> Y" by blast
   ultimately
   show "x \<in> g `` (\<Inter>A)"
     using inj_is_fun[THEN funcI, of g] by fast
 qed auto
 
 lemma contin_banach_functor:
   assumes "g \<in> inj(Y,X)"
   shows "contin(banach_functor(X,Y,f,g))"
   unfolding contin_def
 proof (intro allI impI)
   fix A
   assume "directed(A)"
   then
   have "A \<noteq> 0"
     unfolding directed_def ..
   have "banach_functor(X, Y, f, g, \<Union>A) = X - g``(Y - f``(\<Union>A))"
     unfolding banach_functor_def ..
   also
   have " \<dots> = X - g``(Y - (\<Union>a\<in>A. f``a))"
     by auto
   also from \<open>A\<noteq>0\<close>
   have " \<dots> = X - g``(\<Inter>a\<in>A. Y-f``a)"
     by auto
   also from \<open>A\<noteq>0\<close> and assms
   have " \<dots> = X - (\<Inter>a\<in>A. g``(Y-f``a))"
     using inj_Inter[of g Y X "{Y-f``a. a\<in>A}" ] by fastforce
   also from \<open>A\<noteq>0\<close>
   have " \<dots> = (\<Union>a\<in>A. X - g``(Y-f``a))" by simp
   also
   have " \<dots> = (\<Union>a\<in>A. banach_functor(X, Y, f, g, a))"
     unfolding banach_functor_def ..
   finally
   show "banach_functor(X,Y,f,g,\<Union>A) = (\<Union>a\<in>A. banach_functor(X,Y,f,g,a))" .
 qed
 
 lemma lfp_banach_functor:
   assumes "g\<in>inj(Y,X)"
   shows "lfp(X, banach_functor(X,Y,f,g)) =
        (\<Union>n\<in>nat. banach_functor(X,Y,f,g)^n (0))"
   using assms lfp_eq_Union bnd_mono_banach_functor contin_banach_functor
   by simp
 
 lemma lfp_banach_functor_closed:
   assumes "M(g)" "M(X)" "M(Y)" "M(f)" "g\<in>inj(Y,X)"
   shows "M(lfp(X, banach_functor(X,Y,f,g)))"
 proof -
   from assms
   have "M(banach_functor(X,Y,f,g)^n (0))" if "n\<in>nat" for n
     by(rule_tac nat_induct[OF that],simp_all add:banach_functor_closed)
   with assms
   show ?thesis
     using family_union_closed'[OF banach_repl_iter M_nat] lfp_banach_functor
     by simp
 qed
 
 lemma banach_decomposition_rel:
   "[| M(f); M(g); M(X); M(Y); f \<in> X->Y;  g \<in> inj(Y,X) |] ==>
       \<exists>XA[M]. \<exists>XB[M]. \<exists>YA[M]. \<exists>YB[M].
          (XA \<inter> XB = 0) & (XA \<union> XB = X) &
          (YA \<inter> YB = 0) & (YA \<union> YB = Y) &
          f``XA=YA & g``YB=XB"
   apply (intro rexI conjI)
            apply (rule_tac [6] Banach_last_equation)
            apply (rule_tac [5] refl)
           apply (assumption |
       rule inj_is_fun Diff_disjoint Diff_partition fun_is_rel
       image_subset lfp_subset)+
   using lfp_banach_functor_closed[of g X Y f]
   unfolding banach_functor_def by simp_all
 
 lemma schroeder_bernstein_closed:
   "[| M(f); M(g); M(X); M(Y); f \<in> inj(X,Y);  g \<in> inj(Y,X) |] ==> \<exists>h[M]. h \<in> bij(X,Y)"
   apply (insert banach_decomposition_rel [of f g X Y])
   apply (simp add: inj_is_fun)
   apply (auto)
   apply (rule_tac x="restrict(f,XA) \<union> converse(restrict(g,YB))" in rexI)
    apply (auto intro!: restrict_bij bij_disjoint_Un intro: bij_converse_bij)
   done
 
 (** Equipollence is an equivalence relation **)
 
 lemma mem_Pow_rel: "M(r) \<Longrightarrow> a \<in> Pow_rel(M,r) \<Longrightarrow> a \<in> Pow(r) \<and> M(a)"
   using Pow_rel_char by simp
 
 lemma mem_bij_abs[simp]: "\<lbrakk>M(f);M(A);M(B)\<rbrakk> \<Longrightarrow>  f \<in> bij\<^bsup>M\<^esup>(A,B) \<longleftrightarrow> f\<in>bij(A,B)"
   using bij_rel_char by simp
 
 lemma mem_inj_abs[simp]: "\<lbrakk>M(f);M(A);M(B)\<rbrakk> \<Longrightarrow>  f \<in> inj\<^bsup>M\<^esup>(A,B) \<longleftrightarrow> f\<in>inj(A,B)"
   using inj_rel_char by simp
 
 lemma mem_surj_abs: "\<lbrakk>M(f);M(A);M(B)\<rbrakk> \<Longrightarrow>  f \<in> surj\<^bsup>M\<^esup>(A,B) \<longleftrightarrow> f\<in>surj(A,B)"
   using surj_rel_char by simp
 
 lemma bij_imp_eqpoll_rel:
   assumes "f \<in> bij(A,B)" "M(f)" "M(A)" "M(B)"
   shows "A \<approx>\<^bsup>M\<^esup> B"
   using assms by (auto simp add:def_eqpoll_rel)
 
 lemma eqpoll_rel_refl: "M(A) \<Longrightarrow> A \<approx>\<^bsup>M\<^esup> A"
   using bij_imp_eqpoll_rel[OF id_bij, OF id_closed] .
 
 lemma eqpoll_rel_sym: "X \<approx>\<^bsup>M\<^esup> Y \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow>  Y \<approx>\<^bsup>M\<^esup> X"
   unfolding def_eqpoll_rel using converse_closed
   by (auto intro: bij_converse_bij)
 
 lemma eqpoll_rel_trans [trans]:
   "[|X \<approx>\<^bsup>M\<^esup> Y;  Y \<approx>\<^bsup>M\<^esup> Z;  M(X); M(Y) ; M(Z) |] ==> X \<approx>\<^bsup>M\<^esup> Z"
   unfolding def_eqpoll_rel by (auto intro: comp_bij)
 
 (** Le-pollence is a partial ordering **)
 
 lemma subset_imp_lepoll_rel: "X \<subseteq> Y \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> X \<lesssim>\<^bsup>M\<^esup> Y"
   unfolding def_lepoll_rel using id_subset_inj id_closed
   by simp blast
 
 lemmas lepoll_rel_refl = subset_refl [THEN subset_imp_lepoll_rel, simp]
 
 lemmas le_imp_lepoll_rel = le_imp_subset [THEN subset_imp_lepoll_rel]
 
 lemma eqpoll_rel_imp_lepoll_rel: "X \<approx>\<^bsup>M\<^esup> Y ==> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> X \<lesssim>\<^bsup>M\<^esup> Y"
   unfolding def_eqpoll_rel bij_def def_lepoll_rel using bij_is_inj
   by (auto)
 
 lemma lepoll_rel_trans [trans]:
   assumes
     "X \<lesssim>\<^bsup>M\<^esup> Y" "Y \<lesssim>\<^bsup>M\<^esup> Z" "M(X)" "M(Y)" "M(Z)"
   shows
     "X \<lesssim>\<^bsup>M\<^esup> Z"
   using assms def_lepoll_rel
   by (auto intro: comp_inj)
 
 lemma eq_lepoll_rel_trans [trans]:
   assumes
     "X \<approx>\<^bsup>M\<^esup> Y"  "Y \<lesssim>\<^bsup>M\<^esup> Z" "M(X)" "M(Y)" "M(Z)"
   shows
     "X \<lesssim>\<^bsup>M\<^esup> Z"
   using assms
   by (blast intro: eqpoll_rel_imp_lepoll_rel lepoll_rel_trans)
 
 lemma lepoll_rel_eq_trans [trans]:
   assumes "X \<lesssim>\<^bsup>M\<^esup> Y"  "Y \<approx>\<^bsup>M\<^esup> Z" "M(X)" "M(Y)" "M(Z)"
   shows "X \<lesssim>\<^bsup>M\<^esup> Z"
   using assms
     eqpoll_rel_imp_lepoll_rel[of Y Z] lepoll_rel_trans[of X Y Z]
   by simp
 
 lemma eqpoll_relI: "\<lbrakk> X \<lesssim>\<^bsup>M\<^esup> Y; Y \<lesssim>\<^bsup>M\<^esup> X; M(X) ; M(Y) \<rbrakk> \<Longrightarrow> X \<approx>\<^bsup>M\<^esup> Y"
   unfolding def_lepoll_rel def_eqpoll_rel using schroeder_bernstein_closed
   by auto
 
 lemma eqpoll_relE:
   "[| X \<approx>\<^bsup>M\<^esup> Y; [| X \<lesssim>\<^bsup>M\<^esup> Y; Y \<lesssim>\<^bsup>M\<^esup> X |] ==> P ;  M(X) ; M(Y) |] ==> P"
   by (blast intro: eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym)
 
 lemma eqpoll_rel_iff: "M(X) \<Longrightarrow> M(Y) \<Longrightarrow> X \<approx>\<^bsup>M\<^esup> Y \<longleftrightarrow> X \<lesssim>\<^bsup>M\<^esup> Y & Y \<lesssim>\<^bsup>M\<^esup> X"
   by (blast intro: eqpoll_relI elim: eqpoll_relE)
 
 lemma lepoll_rel_0_is_0: "A \<lesssim>\<^bsup>M\<^esup> 0 \<Longrightarrow> M(A) \<Longrightarrow> A = 0"
   using def_lepoll_rel
   by (cases "A=0") (auto simp add: inj_def)
 
 (* \<^term>\<open>M(Y) \<Longrightarrow> 0 \<lesssim>\<^bsup>M\<^esup> Y\<close> *)
 lemmas empty_lepoll_relI = empty_subsetI [THEN subset_imp_lepoll_rel, OF nonempty]
 
 lemma lepoll_rel_0_iff: "M(A) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> 0 \<longleftrightarrow> A=0"
   by (blast intro: lepoll_rel_0_is_0 lepoll_rel_refl)
 
 lemma Un_lepoll_rel_Un:
   "[| A \<lesssim>\<^bsup>M\<^esup> B; C \<lesssim>\<^bsup>M\<^esup> D; B \<inter> D = 0; M(A); M(B); M(C); M(D) |] ==> A \<union> C \<lesssim>\<^bsup>M\<^esup> B \<union> D"
   using def_lepoll_rel using inj_disjoint_Un[of _ A B _ C D] if_then_replacement
   apply (auto)
   apply (rule, assumption)
   apply (auto intro!:lam_closed elim:transM)+
   done
 
 lemma eqpoll_rel_0_is_0: "A \<approx>\<^bsup>M\<^esup> 0 \<Longrightarrow> M(A) \<Longrightarrow> A = 0"
   using eqpoll_rel_imp_lepoll_rel lepoll_rel_0_is_0 nonempty
   by blast
 
 lemma eqpoll_rel_0_iff: "M(A) \<Longrightarrow> A \<approx>\<^bsup>M\<^esup> 0 \<longleftrightarrow> A=0"
   by (blast intro: eqpoll_rel_0_is_0 eqpoll_rel_refl)
 
 lemma eqpoll_rel_disjoint_Un:
   "[| A \<approx>\<^bsup>M\<^esup> B;  C \<approx>\<^bsup>M\<^esup> D;  A \<inter> C = 0;  B \<inter> D = 0; M(A); M(B); M(C) ; M(D) |]
      ==> A \<union> C \<approx>\<^bsup>M\<^esup> B \<union> D"
   by (auto intro: bij_disjoint_Un simp add:def_eqpoll_rel)
 
 subsection\<open>lesspoll\_rel: contributions by Krzysztof Grabczewski\<close>
 
 lemma lesspoll_rel_not_refl: "M(i) \<Longrightarrow> ~ (i \<prec>\<^bsup>M\<^esup> i)"
   by (simp add: lesspoll_rel_def eqpoll_rel_refl)
 
 lemma lesspoll_rel_irrefl: "i \<prec>\<^bsup>M\<^esup> i ==> M(i) \<Longrightarrow> P"
   by (simp add: lesspoll_rel_def eqpoll_rel_refl)
 
 lemma lesspoll_rel_imp_lepoll_rel: "\<lbrakk>A \<prec>\<^bsup>M\<^esup> B; M(A); M(B)\<rbrakk>\<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> B"
   by (unfold lesspoll_rel_def, blast)
 
 lemma rvimage_closed [intro,simp]:
   assumes
     "M(A)" "M(f)" "M(r)"
   shows
     "M(rvimage(A,f,r))"
   unfolding rvimage_def using assms rvimage_separation by auto
 
 lemma lepoll_rel_well_ord: "[| A \<lesssim>\<^bsup>M\<^esup> B; well_ord(B,r); M(A); M(B); M(r) |] ==> \<exists>s[M]. well_ord(A,s)"
   unfolding def_lepoll_rel by (auto intro:well_ord_rvimage)
 
 lemma lepoll_rel_iff_leqpoll_rel: "\<lbrakk>M(A); M(B)\<rbrakk> \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> B \<longleftrightarrow> A \<prec>\<^bsup>M\<^esup> B | A \<approx>\<^bsup>M\<^esup> B"
   apply (unfold lesspoll_rel_def)
   apply (blast intro: eqpoll_relI elim: eqpoll_relE)
   done
 
 end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
 
 context M_cardinals
 begin
 
 lemma inj_rel_is_fun_M: "f \<in> inj\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(f) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> f \<in> A \<rightarrow>\<^bsup>M\<^esup> B"
   using inj_is_fun function_space_rel_char by simp
 
 \<comment> \<open>In porting the following theorem, I tried to follow the Discipline
 strictly, though finally only an approach maximizing the use of
 absoluteness results (@{thm function_space_rel_char inj_rel_char}) was
  the one paying dividends.\<close>
 lemma inj_rel_not_surj_rel_succ:
   notes mem_inj_abs[simp del]
   assumes fi: "f \<in> inj\<^bsup>M\<^esup>(A, succ(m))" and fns: "f \<notin> surj\<^bsup>M\<^esup>(A, succ(m))"
     and types: "M(f)" "M(A)" "M(m)"
   shows "\<exists>f[M]. f \<in> inj\<^bsup>M\<^esup>(A,m)"
 proof -
   from fi [THEN inj_rel_is_fun_M] fns types
   obtain y where y: "y \<in> succ(m)" "\<And>x. x\<in>A \<Longrightarrow> f ` x \<noteq> y" "M(y)"
     by (auto simp add: def_surj_rel)
   show ?thesis
   proof
     from types and \<open>M(y)\<close>
     show "M(\<lambda>z\<in>A. if f ` z = m then y else f ` z)"
       using transM[OF _ \<open>M(A)\<close>] lam_if_then_apply_replacement2 lam_replacement_iff_lam_closed
       by (auto)
     with types y fi
     have "(\<lambda>z\<in>A. if f`z = m then y else f`z) \<in> A\<rightarrow>\<^bsup>M\<^esup> m"
       using function_space_rel_char inj_rel_char inj_is_fun[of f A "succ(m)"]
       by (auto intro!: if_type [THEN lam_type] dest: apply_funtype)
     with types y fi
     show "(\<lambda>z\<in>A. if f`z = m then y else f`z) \<in> inj\<^bsup>M\<^esup>(A, m)"
       by (simp add: def_inj_rel) blast
   qed
 qed
 
 (** Variations on transitivity **)
 
 lemma lesspoll_rel_trans [trans]:
   "[| X \<prec>\<^bsup>M\<^esup> Y; Y \<prec>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) |] ==> X \<prec>\<^bsup>M\<^esup> Z"
   apply (unfold lesspoll_rel_def)
   apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans)
   done
 
 lemma lesspoll_rel_trans1 [trans]:
   "[| X \<lesssim>\<^bsup>M\<^esup> Y; Y \<prec>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) |] ==> X \<prec>\<^bsup>M\<^esup> Z"
   apply (unfold lesspoll_rel_def)
   apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans)
   done
 
 lemma lesspoll_rel_trans2 [trans]:
   "[|  X \<prec>\<^bsup>M\<^esup> Y; Y \<lesssim>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z)|] ==> X \<prec>\<^bsup>M\<^esup> Z"
   apply (unfold lesspoll_rel_def)
   apply (blast elim: eqpoll_relE intro: eqpoll_relI lepoll_rel_trans)
   done
 
 lemma eq_lesspoll_rel_trans [trans]:
   "[| X \<approx>\<^bsup>M\<^esup> Y; Y \<prec>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) |] ==> X \<prec>\<^bsup>M\<^esup> Z"
   by (blast intro: eqpoll_rel_imp_lepoll_rel lesspoll_rel_trans1)
 
 lemma lesspoll_rel_eq_trans [trans]:
   "[| X \<prec>\<^bsup>M\<^esup> Y; Y \<approx>\<^bsup>M\<^esup> Z; M(X); M(Y) ; M(Z) |] ==> X \<prec>\<^bsup>M\<^esup> Z"
   by (blast intro: eqpoll_rel_imp_lepoll_rel lesspoll_rel_trans2)
 
 lemma is_cardinal_cong:
   assumes "X \<approx>\<^bsup>M\<^esup> Y" "M(X)" "M(Y)"
   shows "\<exists>\<kappa>[M]. is_cardinal(M,X,\<kappa>) \<and> is_cardinal(M,Y,\<kappa>)"
 proof -
   from assms
   have "(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> X) = (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> Y)"
     by (intro Least_cong) (auto intro: comp_bij bij_converse_bij simp add:def_eqpoll_rel)
   moreover from assms
   have "M(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> X)"
     using Least_closed' by fastforce
   moreover
   note assms
   ultimately
   show ?thesis
     using is_cardinal_iff_Least
     by auto
 qed
 
 \<comment> \<open>ported from Cardinal\<close>
 lemma cardinal_rel_cong: "X \<approx>\<^bsup>M\<^esup> Y \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow> |X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup>"
   apply (simp add: def_eqpoll_rel cardinal_rel_def)
   apply (rule Least_cong)
   apply (auto intro: comp_bij bij_converse_bij)
   done
 
 lemma well_ord_is_cardinal_eqpoll_rel:
   assumes "well_ord(A,r)" shows "is_cardinal(M,A,\<kappa>) \<Longrightarrow> M(A) \<Longrightarrow> M(\<kappa>) \<Longrightarrow> M(r) \<Longrightarrow> \<kappa> \<approx>\<^bsup>M\<^esup> A"
 proof (subst is_cardinal_iff_Least[THEN iffD1, of A \<kappa>])
   assume "M(A)" "M(\<kappa>)" "M(r)" "is_cardinal(M,A,\<kappa>)"
   moreover from assms and calculation
   obtain f i where "M(f)" "Ord(i)" "M(i)" "f \<in> bij(A,i)"
     using ordertype_exists[of A r] ord_iso_is_bij by auto
   moreover
   have "M(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)"
     using Least_closed' by fastforce
   ultimately
   show "(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A) \<approx>\<^bsup>M\<^esup> A"
     using assms[THEN well_ord_imp_relativized]
       LeastI[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A" i] Ord_ordertype[OF assms]
       bij_converse_bij[THEN bij_imp_eqpoll_rel, of f] by simp
 qed
 
 lemmas Ord_is_cardinal_eqpoll_rel = well_ord_Memrel[THEN well_ord_is_cardinal_eqpoll_rel]
 
 
 (**********************************************************************)
 (****************** Results imported from Cardinal.thy ****************)
 (**********************************************************************)
 
 section\<open>Porting from \<^theory>\<open>ZF.Cardinal\<close>\<close>
 
 txt\<open>The following results were ported more or less directly from \<^theory>\<open>ZF.Cardinal\<close>\<close>
 
 \<comment> \<open>This result relies on various closure properties and
    thus cannot be translated directly\<close>
 lemma well_ord_cardinal_rel_eqpoll_rel:
   assumes r: "well_ord(A,r)" and "M(A)" "M(r)" shows "|A|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A"
   using assms well_ord_is_cardinal_eqpoll_rel is_cardinal_iff
   by blast
 
 lemmas Ord_cardinal_rel_eqpoll_rel = well_ord_Memrel[THEN well_ord_cardinal_rel_eqpoll_rel]
 
 lemma Ord_cardinal_rel_idem: "Ord(A) \<Longrightarrow> M(A) \<Longrightarrow> ||A|\<^bsup>M\<^esup>|\<^bsup>M\<^esup> = |A|\<^bsup>M\<^esup>"
   by (rule_tac Ord_cardinal_rel_eqpoll_rel [THEN cardinal_rel_cong]) auto
 
 lemma well_ord_cardinal_rel_eqE:
   assumes woX: "well_ord(X,r)" and woY: "well_ord(Y,s)" and eq: "|X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup>"
     and types: "M(X)" "M(r)" "M(Y)" "M(s)"
   shows "X \<approx>\<^bsup>M\<^esup> Y"
 proof -
   from types
   have "X \<approx>\<^bsup>M\<^esup> |X|\<^bsup>M\<^esup>" by (blast intro: well_ord_cardinal_rel_eqpoll_rel [OF woX] eqpoll_rel_sym)
   also
   have "... = |Y|\<^bsup>M\<^esup>" by (rule eq)
   also from types
   have "... \<approx>\<^bsup>M\<^esup> Y" by (rule_tac well_ord_cardinal_rel_eqpoll_rel [OF woY])
   finally show ?thesis  by (simp add:types)
 qed
 
 lemma well_ord_cardinal_rel_eqpoll_rel_iff:
   "[| well_ord(X,r);  well_ord(Y,s); M(X); M(r); M(Y); M(s) |] ==> |X|\<^bsup>M\<^esup> = |Y|\<^bsup>M\<^esup> \<longleftrightarrow> X \<approx>\<^bsup>M\<^esup> Y"
   by (blast intro: cardinal_rel_cong well_ord_cardinal_rel_eqE)
 
 lemma Ord_cardinal_rel_le: "Ord(i) \<Longrightarrow> M(i) ==> |i|\<^bsup>M\<^esup> \<le> i"
   unfolding cardinal_rel_def
   using eqpoll_rel_refl Least_le by simp
 
 lemma Card_rel_cardinal_rel_eq: "Card\<^bsup>M\<^esup>(K) ==> M(K) \<Longrightarrow> |K|\<^bsup>M\<^esup> = K"
   apply (unfold Card_rel_def)
   apply (erule sym)
   done
 
 lemma Card_relI: "[| Ord(i);  !!j. j<i \<Longrightarrow> M(j) ==> ~(j \<approx>\<^bsup>M\<^esup> i); M(i) |] ==> Card\<^bsup>M\<^esup>(i)"
   apply (unfold Card_rel_def cardinal_rel_def)
   apply (subst Least_equality)
      apply (blast intro: eqpoll_rel_refl)+
   done
 
 lemma Card_rel_is_Ord: "Card\<^bsup>M\<^esup>(i) ==> M(i) \<Longrightarrow> Ord(i)"
   apply (unfold Card_rel_def cardinal_rel_def)
   apply (erule ssubst)
   apply (rule Ord_Least)
   done
 
 lemma Card_rel_cardinal_rel_le: "Card\<^bsup>M\<^esup>(K) ==> M(K) \<Longrightarrow> K \<le> |K|\<^bsup>M\<^esup>"
   apply (simp (no_asm_simp) add: Card_rel_is_Ord Card_rel_cardinal_rel_eq)
   done
 
 lemma Ord_cardinal_rel [simp,intro!]: "M(A) \<Longrightarrow> Ord(|A|\<^bsup>M\<^esup>)"
   apply (unfold cardinal_rel_def)
   apply (rule Ord_Least)
   done
 
 lemma Card_rel_iff_initial: assumes types:"M(K)"
   shows "Card\<^bsup>M\<^esup>(K) \<longleftrightarrow> Ord(K) & (\<forall>j[M]. j<K \<longrightarrow> ~ (j \<approx>\<^bsup>M\<^esup> K))"
 proof -
   { fix j
     assume K: "Card\<^bsup>M\<^esup>(K)" "M(j) \<and> j \<approx>\<^bsup>M\<^esup> K"
     assume "j < K"
     also have "... = (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> K)" using K
       by (simp add: Card_rel_def cardinal_rel_def types)
     finally have "j < (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> K)" .
     then have "False" using K
       by (best intro: less_LeastE[of "\<lambda>j. M(j) \<and> j \<approx>\<^bsup>M\<^esup> K"])
   }
   with types
   show ?thesis
     by (blast intro: Card_relI Card_rel_is_Ord)
 qed
 
 lemma lt_Card_rel_imp_lesspoll_rel: "[| Card\<^bsup>M\<^esup>(a); i<a; M(a); M(i) |] ==> i \<prec>\<^bsup>M\<^esup> a"
   apply (unfold lesspoll_rel_def)
   apply (frule Card_rel_iff_initial [THEN iffD1], assumption)
   apply (blast intro!: leI [THEN le_imp_lepoll_rel])
   done
 
 lemma Card_rel_0: "Card\<^bsup>M\<^esup>(0)"
   apply (rule Ord_0 [THEN Card_relI])
    apply (auto elim!: ltE)
   done
 
 lemma Card_rel_Un: "[| Card\<^bsup>M\<^esup>(K);  Card\<^bsup>M\<^esup>(L); M(K); M(L) |] ==> Card\<^bsup>M\<^esup>(K \<union> L)"
   apply (rule Ord_linear_le [of K L])
      apply (simp_all add: subset_Un_iff [THEN iffD1]  Card_rel_is_Ord le_imp_subset
       subset_Un_iff2 [THEN iffD1])
   done
 
 lemma Card_rel_cardinal_rel [iff]: assumes types:"M(A)" shows "Card\<^bsup>M\<^esup>(|A|\<^bsup>M\<^esup>)"
   using assms
 proof (unfold cardinal_rel_def)
   show "Card\<^bsup>M\<^esup>(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)"
   proof (cases "\<exists>i[M]. Ord (i) \<and> i \<approx>\<^bsup>M\<^esup> A")
     case False thus ?thesis           \<comment> \<open>degenerate case\<close>
       using Least_0[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"] Card_rel_0
       by fastforce
   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>\<^bsup>M\<^esup> A" "M(i)" by blast
     show ?thesis
     proof (rule Card_relI [OF Ord_Least], rule notI)
       fix j
       assume j: "j < (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)" and "M(j)"
       assume "j \<approx>\<^bsup>M\<^esup> (\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A)"
       also have "... \<approx>\<^bsup>M\<^esup> A" using i LeastI[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"] by (auto)
       finally have "j \<approx>\<^bsup>M\<^esup> A"
         using Least_closed'[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"] by (simp add: \<open>M(j)\<close> types)
       thus False
         using \<open>M(j)\<close> by (blast intro:less_LeastE [OF _ j])
     qed (auto intro:Least_closed)
   qed
 qed
 
 lemma cardinal_rel_eq_lemma:
   assumes i:"|i|\<^bsup>M\<^esup> \<le> j" and j: "j \<le> i" and types: "M(i)" "M(j)"
   shows "|j|\<^bsup>M\<^esup> = |i|\<^bsup>M\<^esup>"
 proof (rule eqpoll_relI [THEN cardinal_rel_cong])
   show "j \<lesssim>\<^bsup>M\<^esup> i" by (rule le_imp_lepoll_rel [OF j]) (simp_all add:types)
 next
   have Oi: "Ord(i)" using j by (rule le_Ord2)
   with types
   have "i \<approx>\<^bsup>M\<^esup> |i|\<^bsup>M\<^esup>"
     by (blast intro: Ord_cardinal_rel_eqpoll_rel eqpoll_rel_sym)
   also from types
   have "... \<lesssim>\<^bsup>M\<^esup> j"
     by (blast intro: le_imp_lepoll_rel i)
   finally show "i \<lesssim>\<^bsup>M\<^esup> j" by (simp_all add:types)
 qed (simp_all add:types)
 
 lemma cardinal_rel_mono:
   assumes ij: "i \<le> j" and types:"M(i)" "M(j)" shows "|i|\<^bsup>M\<^esup> \<le> |j|\<^bsup>M\<^esup>"
   using Ord_cardinal_rel [OF \<open>M(i)\<close>] Ord_cardinal_rel [OF \<open>M(j)\<close>]
 proof (cases rule: Ord_linear_le)
   case le then show ?thesis .
 next
   case ge
   have i: "Ord(i)" using ij
     by (simp add: lt_Ord)
   have ci: "|i|\<^bsup>M\<^esup> \<le> j"
     by (blast intro: Ord_cardinal_rel_le ij le_trans i types)
   have "|i|\<^bsup>M\<^esup> = ||i|\<^bsup>M\<^esup>|\<^bsup>M\<^esup>"
     by (auto simp add: Ord_cardinal_rel_idem i types)
   also have "... = |j|\<^bsup>M\<^esup>"
     by (rule cardinal_rel_eq_lemma [OF ge ci]) (simp_all add:types)
   finally have "|i|\<^bsup>M\<^esup> = |j|\<^bsup>M\<^esup>" .
   thus ?thesis by (simp add:types)
 qed
 
 lemma cardinal_rel_lt_imp_lt: "[| |i|\<^bsup>M\<^esup> < |j|\<^bsup>M\<^esup>;  Ord(i);  Ord(j); M(i); M(j) |] ==> i < j"
   apply (rule Ord_linear2 [of i j], assumption+)
   apply (erule lt_trans2 [THEN lt_irrefl])
   apply (erule cardinal_rel_mono, assumption+)
   done
 
 lemma Card_rel_lt_imp_lt: "[| |i|\<^bsup>M\<^esup> < K;  Ord(i);  Card\<^bsup>M\<^esup>(K); M(i); M(K)|] ==> i < K"
   by (simp (no_asm_simp) add: cardinal_rel_lt_imp_lt Card_rel_is_Ord Card_rel_cardinal_rel_eq)
 
 lemma Card_rel_lt_iff: "[| Ord(i);  Card\<^bsup>M\<^esup>(K); M(i); M(K) |] ==> (|i|\<^bsup>M\<^esup> < K) \<longleftrightarrow> (i < K)"
   by (blast intro: Card_rel_lt_imp_lt Ord_cardinal_rel_le [THEN lt_trans1])
 
 lemma Card_rel_le_iff: "[| Ord(i);  Card\<^bsup>M\<^esup>(K); M(i); M(K) |] ==> (K \<le> |i|\<^bsup>M\<^esup>) \<longleftrightarrow> (K \<le> i)"
   by (simp add: Card_rel_lt_iff Card_rel_is_Ord not_lt_iff_le [THEN iff_sym])
 
 lemma well_ord_lepoll_rel_imp_cardinal_rel_le:
   assumes wB: "well_ord(B,r)" and AB: "A \<lesssim>\<^bsup>M\<^esup> B"
     and
     types: "M(B)" "M(r)" "M(A)"
   shows "|A|\<^bsup>M\<^esup> \<le> |B|\<^bsup>M\<^esup>"
   using Ord_cardinal_rel [OF \<open>M(A)\<close>] Ord_cardinal_rel [OF \<open>M(B)\<close>]
 proof (cases rule: Ord_linear_le)
   case le thus ?thesis .
 next
   case ge
   from lepoll_rel_well_ord [OF AB wB]
   obtain s where s: "well_ord(A, s)" "M(s)" by (blast intro:types)
   have "B \<approx>\<^bsup>M\<^esup> |B|\<^bsup>M\<^esup>" by (blast intro: wB eqpoll_rel_sym well_ord_cardinal_rel_eqpoll_rel types)
   also have "... \<lesssim>\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>" by (rule le_imp_lepoll_rel [OF ge]) (simp_all add:types)
   also have "... \<approx>\<^bsup>M\<^esup> A" by (rule well_ord_cardinal_rel_eqpoll_rel [OF s(1) _ s(2)]) (simp_all add:types)
   finally have "B \<lesssim>\<^bsup>M\<^esup> A" by (simp_all add:types)
   hence "A \<approx>\<^bsup>M\<^esup> B" by (blast intro: eqpoll_relI AB types)
   hence "|A|\<^bsup>M\<^esup> = |B|\<^bsup>M\<^esup>" by (rule cardinal_rel_cong) (simp_all add:types)
   thus ?thesis by (simp_all add:types)
 qed
 
 lemma lepoll_rel_cardinal_rel_le: "[| A \<lesssim>\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) |] ==> |A|\<^bsup>M\<^esup> \<le> i"
   using Memrel_closed
   apply (rule_tac le_trans)
    apply (erule well_ord_Memrel [THEN well_ord_lepoll_rel_imp_cardinal_rel_le], assumption+)
   apply (erule Ord_cardinal_rel_le, assumption)
   done
 
 lemma lepoll_rel_Ord_imp_eqpoll_rel: "[| A \<lesssim>\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) |] ==> |A|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A"
   by (blast intro: lepoll_rel_cardinal_rel_le well_ord_Memrel well_ord_cardinal_rel_eqpoll_rel dest!: lepoll_rel_well_ord)
 
 lemma lesspoll_rel_imp_eqpoll_rel: "[| A \<prec>\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) |] ==> |A|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A"
   using lepoll_rel_Ord_imp_eqpoll_rel[OF lesspoll_rel_imp_lepoll_rel] .
 
 lemma lesspoll_cardinal_lt_rel:
   shows "[| A \<prec>\<^bsup>M\<^esup> i; Ord(i); M(i); M(A) |] ==> |A|\<^bsup>M\<^esup> < i"
 proof -
   assume assms:"A \<prec>\<^bsup>M\<^esup> i" \<open>Ord(i)\<close> \<open>M(i)\<close> \<open>M(A)\<close>
   then
   have A:"Ord(|A|\<^bsup>M\<^esup>)" "|A|\<^bsup>M\<^esup> \<approx>\<^bsup>M\<^esup> A" "M(|A|\<^bsup>M\<^esup>)"
     using Ord_cardinal_rel lesspoll_rel_imp_eqpoll_rel
     by simp_all
   with assms
   have "|A|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> i"
     using eq_lesspoll_rel_trans by auto
   consider "|A|\<^bsup>M\<^esup>\<in>i" | "|A|\<^bsup>M\<^esup>=i" | "i\<in>|A|\<^bsup>M\<^esup>"
     using Ord_linear[OF \<open>Ord(i)\<close> \<open>Ord(|A|\<^bsup>M\<^esup>)\<close>] by auto
   then
   have "|A|\<^bsup>M\<^esup> < i"
   proof(cases)
     case 1
     then show ?thesis using ltI \<open>Ord(i)\<close> by simp
   next
     case 2
     with \<open>|A|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> i\<close> \<open>M(i)\<close>
     show ?thesis using lesspoll_rel_irrefl by simp
   next
     case 3
     with \<open>Ord(|A|\<^bsup>M\<^esup>)\<close>
     have "i<|A|\<^bsup>M\<^esup>" using ltI by simp
     with \<open>M(A)\<close> A \<open>M(i)\<close>
     have "i \<prec>\<^bsup>M\<^esup> |A|\<^bsup>M\<^esup>"
       using lt_Card_rel_imp_lesspoll_rel Card_rel_cardinal_rel by simp
     with \<open>M(|A|\<^bsup>M\<^esup>)\<close> \<open>M(i)\<close>
     show ?thesis
       using lesspoll_rel_irrefl lesspoll_rel_trans[OF \<open>|A|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> i\<close> \<open>i \<prec>\<^bsup>M\<^esup> _ \<close>]
       by simp
   qed
   then show ?thesis by simp
 qed
 
 lemma cardinal_rel_subset_Ord: "[|A<=i; Ord(i); M(A); M(i)|] ==> |A|\<^bsup>M\<^esup> \<subseteq> i"
   apply (drule subset_imp_lepoll_rel [THEN lepoll_rel_cardinal_rel_le])
        apply (auto simp add: lt_def)
   apply (blast intro: Ord_trans)
   done
 
 \<comment> \<open>The next lemma is the first with several porting issues\<close>
 lemma cons_lepoll_rel_consD:
   "[| cons(u,A) \<lesssim>\<^bsup>M\<^esup> cons(v,B);  u\<notin>A;  v\<notin>B; M(u); M(A); M(v); M(B) |] ==> A \<lesssim>\<^bsup>M\<^esup> B"
   apply (simp add: def_lepoll_rel, unfold inj_def, safe)
   apply (rule_tac x = "\<lambda>x\<in>A. if f`x=v then f`u else f`x" in rexI)
    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 (auto simp add:transM[of _ A])
   using lam_replacement_iff_lam_closed  lam_if_then_apply_replacement
   by simp
 
 lemma cons_eqpoll_rel_consD: "[| cons(u,A) \<approx>\<^bsup>M\<^esup> cons(v,B);  u\<notin>A;  v\<notin>B; M(u); M(A); M(v); M(B) |] ==> A \<approx>\<^bsup>M\<^esup> B"
   apply (simp add: eqpoll_rel_iff)
   apply (blast intro: cons_lepoll_rel_consD)
   done
 
 lemma succ_lepoll_rel_succD: "succ(m) \<lesssim>\<^bsup>M\<^esup> succ(n) \<Longrightarrow> M(m) \<Longrightarrow> M(n) ==> m \<lesssim>\<^bsup>M\<^esup> n"
   apply (unfold succ_def)
   apply (erule cons_lepoll_rel_consD)
        apply (rule mem_not_refl)+
      apply assumption+
   done
 
 lemma nat_lepoll_rel_imp_le:
   "m \<in> nat ==> n \<in> nat \<Longrightarrow> m \<lesssim>\<^bsup>M\<^esup> n \<Longrightarrow> M(m) \<Longrightarrow> M(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: def_lepoll_rel inj_def)
   next
     case (succ n') thus ?thesis using succ.hyps \<open> succ(m) \<lesssim>\<^bsup>M\<^esup> n\<close>
       by (blast dest!: succ_lepoll_rel_succD)
   qed
 qed
 
 lemma nat_eqpoll_rel_iff: "[| m \<in> nat; n \<in> nat; M(m); M(n) |] ==> m \<approx>\<^bsup>M\<^esup> n \<longleftrightarrow> m = n"
   apply (rule iffI)
    apply (blast intro: nat_lepoll_rel_imp_le le_anti_sym elim!: eqpoll_relE)
   apply (simp add: eqpoll_rel_refl)
   done
 
 lemma nat_into_Card_rel:
   assumes n: "n \<in> nat" and types: "M(n)" shows "Card\<^bsup>M\<^esup>(n)"
   using types
   apply (subst Card_rel_def)
 proof (unfold cardinal_rel_def, rule sym)
   have "Ord(n)" using n  by auto
   moreover
   { fix i
     assume "i < n" "M(i)" "i \<approx>\<^bsup>M\<^esup> n"
     hence False using n
       by (auto simp add: lt_nat_in_nat [THEN nat_eqpoll_rel_iff] types)
   }
   ultimately show "(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> n) = n" by (auto intro!: Least_equality types eqpoll_rel_refl)
 qed
 
 lemmas cardinal_rel_0 = nat_0I [THEN nat_into_Card_rel, THEN Card_rel_cardinal_rel_eq, simplified, iff]
 lemmas cardinal_rel_1 = nat_1I [THEN nat_into_Card_rel, THEN Card_rel_cardinal_rel_eq, simplified, iff]
 
 lemma succ_lepoll_rel_natE: "[| succ(n) \<lesssim>\<^bsup>M\<^esup> n;  n \<in> nat |] ==> P"
   by (rule nat_lepoll_rel_imp_le [THEN lt_irrefl], auto)
 
 lemma nat_lepoll_rel_imp_ex_eqpoll_rel_n:
   "[| n \<in> nat;  nat \<lesssim>\<^bsup>M\<^esup> X ; M(n); M(X)|] ==> \<exists>Y[M]. Y \<subseteq> X & n \<approx>\<^bsup>M\<^esup> Y"
   apply (simp add: def_lepoll_rel def_eqpoll_rel)
   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
 
 lemma lepoll_rel_succ: "M(i) \<Longrightarrow> i \<lesssim>\<^bsup>M\<^esup> succ(i)"
   by (blast intro: subset_imp_lepoll_rel)
 
 lemma lepoll_rel_imp_lesspoll_rel_succ:
   assumes A: "A \<lesssim>\<^bsup>M\<^esup> m" and m: "m \<in> nat"
     and types: "M(A)" "M(m)"
   shows "A \<prec>\<^bsup>M\<^esup> succ(m)"
 proof -
   { assume "A \<approx>\<^bsup>M\<^esup> succ(m)"
     hence "succ(m) \<approx>\<^bsup>M\<^esup> A" by (rule eqpoll_rel_sym) (auto simp add:types)
     also have "... \<lesssim>\<^bsup>M\<^esup> m" by (rule A)
     finally have "succ(m) \<lesssim>\<^bsup>M\<^esup> m" by (auto simp add:types)
     hence False by (rule succ_lepoll_rel_natE) (rule m) }
   moreover have "A \<lesssim>\<^bsup>M\<^esup> succ(m)" by (blast intro: lepoll_rel_trans A lepoll_rel_succ types)
   ultimately show ?thesis by (auto simp add: types lesspoll_rel_def)
 qed
 
 lemma lesspoll_rel_succ_imp_lepoll_rel:
   "[| A \<prec>\<^bsup>M\<^esup> succ(m); m \<in> nat; M(A); M(m) |] ==> A \<lesssim>\<^bsup>M\<^esup> m"
 proof -
   {
     assume "m \<in> nat" "M(A)" "M(m)" "A \<lesssim>\<^bsup>M\<^esup> succ(m)"
       "\<forall>f\<in>inj\<^bsup>M\<^esup>(A, succ(m)). f \<notin> surj\<^bsup>M\<^esup>(A, succ(m))"
     moreover from this
     obtain f where "M(f)" "f\<in>inj\<^bsup>M\<^esup>(A,succ(m))"
       using def_lepoll_rel by auto
     moreover from calculation
     have "f \<notin> surj\<^bsup>M\<^esup>(A, succ(m))" by simp
     ultimately
     have "\<exists>f[M]. f \<in> inj\<^bsup>M\<^esup>(A, m)"
       using inj_rel_not_surj_rel_succ by auto
   }
   from this
   show "\<lbrakk> A \<prec>\<^bsup>M\<^esup> succ(m); m \<in> nat; M(A); M(m) \<rbrakk> \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> m"
     unfolding lepoll_rel_def eqpoll_rel_def bij_rel_def lesspoll_rel_def
     by (simp del:mem_inj_abs)
 qed
 
 lemma lesspoll_rel_succ_iff: "m \<in> nat \<Longrightarrow> M(A) ==> A \<prec>\<^bsup>M\<^esup> succ(m) \<longleftrightarrow> A \<lesssim>\<^bsup>M\<^esup> m"
   by (blast intro!: lepoll_rel_imp_lesspoll_rel_succ lesspoll_rel_succ_imp_lepoll_rel)
 
 lemma lepoll_rel_succ_disj: "[| A \<lesssim>\<^bsup>M\<^esup> succ(m);  m \<in> nat; M(A) ; M(m)|] ==> A \<lesssim>\<^bsup>M\<^esup> m | A \<approx>\<^bsup>M\<^esup> succ(m)"
   apply (rule disjCI)
   apply (rule lesspoll_rel_succ_imp_lepoll_rel)
      prefer 2 apply assumption
     apply (simp (no_asm_simp) add: lesspoll_rel_def, assumption+)
   done
 
 lemma lesspoll_rel_cardinal_rel_lt: "[| A \<prec>\<^bsup>M\<^esup> i; Ord(i); M(A); M(i) |] ==> |A|\<^bsup>M\<^esup> < i"
   apply (unfold lesspoll_rel_def, clarify)
   apply (frule lepoll_rel_cardinal_rel_le, assumption+) \<comment> \<open>because of types\<close>
   apply (blast intro: well_ord_Memrel well_ord_cardinal_rel_eqpoll_rel [THEN eqpoll_rel_sym]
       dest: lepoll_rel_well_ord  elim!: leE)
   done
 
 
 lemma lt_not_lepoll_rel:
   assumes n: "n<i" "n \<in> nat"
     and types:"M(n)" "M(i)" shows "~ i \<lesssim>\<^bsup>M\<^esup> n"
 proof -
   { assume i: "i \<lesssim>\<^bsup>M\<^esup> n"
     have "succ(n) \<lesssim>\<^bsup>M\<^esup> i" using n
       by (elim ltE, blast intro: Ord_succ_subsetI [THEN subset_imp_lepoll_rel] types)
     also have "... \<lesssim>\<^bsup>M\<^esup> n" by (rule i)
     finally have "succ(n) \<lesssim>\<^bsup>M\<^esup> n" by (simp add:types)
     hence False  by (rule succ_lepoll_rel_natE) (rule n) }
   thus ?thesis by auto
 qed
 
 text\<open>A slightly weaker version of \<open>nat_eqpoll_rel_iff\<close>\<close>
 lemma Ord_nat_eqpoll_rel_iff:
   assumes i: "Ord(i)" and n: "n \<in> nat"
     and types: "M(i)" "M(n)"
   shows "i \<approx>\<^bsup>M\<^esup> 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_rel_iff n types)
 next
   case eq
   thus ?thesis by (simp add: eqpoll_rel_refl types)
 next
   case gt
   hence  "~ i \<lesssim>\<^bsup>M\<^esup> n" using n  by (rule lt_not_lepoll_rel) (simp_all add: types)
   hence  "~ i \<approx>\<^bsup>M\<^esup> n" using n  by (blast intro: eqpoll_rel_imp_lepoll_rel types)
   moreover have "i \<noteq> n" using \<open>n<i\<close> by auto
   ultimately show ?thesis by blast
 qed
 
 lemma Card_rel_nat: "Card\<^bsup>M\<^esup>(nat)"
 proof -
   { fix i
     assume i: "i < nat" "i \<approx>\<^bsup>M\<^esup> nat" "M(i)"
     hence "~ nat \<lesssim>\<^bsup>M\<^esup> i"
       by (simp add: lt_def lt_not_lepoll_rel)
     hence False using i
       by (simp add: eqpoll_rel_iff)
   }
   hence "(\<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> nat) = nat" by (blast intro: Least_equality eqpoll_rel_refl)
   thus ?thesis
     by (auto simp add: Card_rel_def cardinal_rel_def)
 qed
 
 lemma nat_le_cardinal_rel: "nat \<le> i \<Longrightarrow> M(i) ==> nat \<le> |i|\<^bsup>M\<^esup>"
   apply (rule Card_rel_nat [THEN Card_rel_cardinal_rel_eq, THEN subst], simp_all)
   apply (erule cardinal_rel_mono, simp_all)
   done
 
 lemma n_lesspoll_rel_nat: "n \<in> nat ==> n \<prec>\<^bsup>M\<^esup> nat"
   by (blast intro: Card_rel_nat ltI lt_Card_rel_imp_lesspoll_rel)
 
 lemma cons_lepoll_rel_cong:
   "[| A \<lesssim>\<^bsup>M\<^esup> B;  b \<notin> B; M(A); M(B); M(b); M(a) |] ==> cons(a,A) \<lesssim>\<^bsup>M\<^esup> cons(b,B)"
   apply (subst (asm) def_lepoll_rel, simp_all, subst def_lepoll_rel, simp_all, safe)
   apply (rule_tac x = "\<lambda>y\<in>cons (a,A) . if y=a then b else f`y" in rexI)
    apply (rule_tac d = "%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])+
   apply (auto intro:lam_closed lam_if_then_replacement simp add:transM[of _ A])
   done
 
 lemma cons_eqpoll_rel_cong:
   "[| A \<approx>\<^bsup>M\<^esup> B;  a \<notin> A;  b \<notin> B;  M(A); M(B); M(a) ; M(b) |] ==> cons(a,A) \<approx>\<^bsup>M\<^esup> cons(b,B)"
   by (simp add: eqpoll_rel_iff cons_lepoll_rel_cong)
 
 lemma cons_lepoll_rel_cons_iff:
   "[| a \<notin> A;  b \<notin> B; M(a); M(A); M(b); M(B) |] ==> cons(a,A) \<lesssim>\<^bsup>M\<^esup> cons(b,B)  \<longleftrightarrow>  A \<lesssim>\<^bsup>M\<^esup> B"
   by (blast intro: cons_lepoll_rel_cong cons_lepoll_rel_consD)
 
 lemma cons_eqpoll_rel_cons_iff:
   "[| a \<notin> A;  b \<notin> B; M(a); M(A); M(b); M(B) |] ==> cons(a,A) \<approx>\<^bsup>M\<^esup> cons(b,B)  \<longleftrightarrow>  A \<approx>\<^bsup>M\<^esup> B"
   by (blast intro: cons_eqpoll_rel_cong cons_eqpoll_rel_consD)
 
 lemma singleton_eqpoll_rel_1: "M(a) \<Longrightarrow> {a} \<approx>\<^bsup>M\<^esup> 1"
   apply (unfold succ_def)
   apply (blast intro!: eqpoll_rel_refl [THEN cons_eqpoll_rel_cong])
   done
 
 lemma cardinal_rel_singleton: "M(a) \<Longrightarrow> |{a}|\<^bsup>M\<^esup> = 1"
   apply (rule singleton_eqpoll_rel_1 [THEN cardinal_rel_cong, THEN trans])
      apply (simp (no_asm) add: nat_into_Card_rel [THEN Card_rel_cardinal_rel_eq])
     apply auto
   done
 
 lemma not_0_is_lepoll_rel_1: "A \<noteq> 0 ==> M(A) \<Longrightarrow> 1 \<lesssim>\<^bsup>M\<^esup> 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= "%y. y \<lesssim>\<^bsup>M\<^esup> cons (x, A-{x})" in subst)
     apply auto
 proof -
   fix x
   assume "M(A)"
   then
   show "x \<in> A \<Longrightarrow> {0} \<lesssim>\<^bsup>M\<^esup> cons(x, A - {x})"
     by (auto intro: cons_lepoll_rel_cong transM[OF _ \<open>M(A)\<close>] subset_imp_lepoll_rel)
 qed
 
 
 lemma succ_eqpoll_rel_cong: "A \<approx>\<^bsup>M\<^esup> B \<Longrightarrow> M(A) \<Longrightarrow> M(B) ==> succ(A) \<approx>\<^bsup>M\<^esup> succ(B)"
   apply (unfold succ_def)
   apply (simp add: cons_eqpoll_rel_cong mem_not_refl)
   done
 
 text\<open>The next result was not straightforward to port, and even a
 different statement was needed.\<close>
 
 lemma sum_bij_rel:
   "[| f \<in> bij\<^bsup>M\<^esup>(A,C); g \<in> bij\<^bsup>M\<^esup>(B,D); M(f); M(A); M(C); M(g); M(B); M(D)|]
       ==> (\<lambda>z\<in>A+B. case(%x. Inl(f`x), %y. Inr(g`y), z)) \<in> bij\<^bsup>M\<^esup>(A+B, C+D)"
 proof -
   assume asm:"f \<in> bij\<^bsup>M\<^esup>(A,C)" "g \<in> bij\<^bsup>M\<^esup>(B,D)" "M(f)" "M(A)" "M(C)" "M(g)" "M(B)" "M(D)"
   then
   have "M(\<lambda>z\<in>A+B. case(%x. Inl(f`x), %y. Inr(g`y), z))"
     using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
     by (auto intro:case_replacement4[THEN lam_closed])
   with asm
   show ?thesis
     apply simp
     apply (rule_tac d = "case (%x. Inl (converse(f)`x), %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
 qed
 
 lemma sum_bij_rel':
   assumes "f \<in> bij\<^bsup>M\<^esup>(A,C)" "g \<in> bij\<^bsup>M\<^esup>(B,D)" "M(f)"
     "M(A)" "M(C)" "M(g)" "M(B)" "M(D)"
   shows
     "(\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z)) \<in> bij(A+B, C+D)"
     "M(\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z))"
 proof -
   from assms
   show "M(\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z))"
     using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
     by (auto intro:case_replacement4[THEN lam_closed])
   with assms
   show "(\<lambda>z\<in>A+B. case(\<lambda>x. Inl(f`x), \<lambda>y. Inr(g`y), z)) \<in> bij(A+B, C+D)"
     apply simp
     apply (rule_tac d = "case (%x. Inl (converse(f)`x), %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
 qed
 
 lemma sum_eqpoll_rel_cong:
   assumes "A \<approx>\<^bsup>M\<^esup> C" "B \<approx>\<^bsup>M\<^esup> D" "M(A)" "M(C)" "M(B)" "M(D)"
   shows "A+B \<approx>\<^bsup>M\<^esup> C+D"
   using assms
 proof (simp add: def_eqpoll_rel, safe, rename_tac g)
   fix f g
   assume  "M(f)" "f \<in> bij(A, C)" "M(g)" "g \<in> bij(B, D)"
   with assms
   obtain h where "h\<in>bij(A+B, C+D)" "M(h)"
     using sum_bij_rel'[of f A C g B D] by simp
   then
   show "\<exists>f[M]. f \<in> bij(A + B, C + D)"
     by auto
 qed
 
 lemma prod_bij_rel':
   assumes "f \<in> bij\<^bsup>M\<^esup>(A,C)" "g \<in> bij\<^bsup>M\<^esup>(B,D)" "M(f)"
     "M(A)" "M(C)" "M(g)" "M(B)" "M(D)"
   shows
     "(\<lambda><x,y>\<in>A*B. <f`x, g`y>) \<in> bij(A*B, C*D)"
     "M(\<lambda><x,y>\<in>A*B. <f`x, g`y>)"
 proof -
   from assms
   show "M((\<lambda><x,y>\<in>A*B. <f`x, g`y>))"
     using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
       transM[OF _ cartprod_closed, of _ A B]
     by (auto intro:prod_fun_replacement[THEN lam_closed, of f g "A\<times>B"])
   with assms
   show "(\<lambda><x,y>\<in>A*B. <f`x, g`y>) \<in> bij(A*B, C*D)"
     apply simp
     apply (rule_tac d = "%<x,y>. <converse (f) `x, 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
 qed
 
 lemma prod_eqpoll_rel_cong:
   assumes "A \<approx>\<^bsup>M\<^esup> C" "B \<approx>\<^bsup>M\<^esup> D" "M(A)" "M(C)" "M(B)" "M(D)"
   shows "A\<times>B \<approx>\<^bsup>M\<^esup> C\<times>D"
   using assms
 proof (simp add: def_eqpoll_rel, safe, rename_tac g)
   fix f g
   assume  "M(f)" "f \<in> bij(A, C)" "M(g)" "g \<in> bij(B, D)"
   with assms
   obtain h where "h\<in>bij(A\<times>B, C\<times>D)" "M(h)"
     using prod_bij_rel'[of f A C g B D] by simp
   then
   show "\<exists>f[M]. f \<in> bij(A \<times> B, C \<times> D)"
     by auto
 qed
 
 lemma inj_rel_disjoint_eqpoll_rel:
   "[| f \<in> inj\<^bsup>M\<^esup>(A,B);  A \<inter> B = 0;M(f); M(A);M(B) |] ==> A \<union> (B - range(f)) \<approx>\<^bsup>M\<^esup> B"
   apply (simp add: def_eqpoll_rel)
   apply (rule rexI)
    apply (rule_tac c = "%x. if x \<in> A then f`x else x"
       and d = "%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])
 proof -
   assume "f \<in> inj(A, B)" "A \<inter> B = 0" "M(f)" "M(A)" "M(B)"
   then
   show "M(\<lambda>x\<in>A \<union> (B - range(f)). if x \<in> A then f ` x else x)"
     using  transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
       lam_replacement_iff_lam_closed lam_if_then_replacement2
     by auto
 qed
 
 lemma Diff_sing_lepoll_rel:
   "[| a \<in> A;  A \<lesssim>\<^bsup>M\<^esup> succ(n); M(a); M(A); M(n) |] ==> A - {a} \<lesssim>\<^bsup>M\<^esup> n"
   apply (unfold succ_def)
   apply (rule cons_lepoll_rel_consD)
         apply (rule_tac [3] mem_not_refl)
        apply (erule cons_Diff [THEN ssubst], simp_all)
   done
 
 lemma lepoll_rel_Diff_sing:
   assumes A: "succ(n) \<lesssim>\<^bsup>M\<^esup> A"
     and types: "M(n)" "M(A)" "M(a)"
   shows "n \<lesssim>\<^bsup>M\<^esup> A - {a}"
 proof -
   have "cons(n,n) \<lesssim>\<^bsup>M\<^esup> A" using A
     by (unfold succ_def)
   also from types
   have "... \<lesssim>\<^bsup>M\<^esup> cons(a, A-{a})"
     by (blast intro: subset_imp_lepoll_rel)
   finally have "cons(n,n) \<lesssim>\<^bsup>M\<^esup> cons(a, A-{a})" by (simp_all add:types)
   with types
   show ?thesis
     by (blast intro: cons_lepoll_rel_consD mem_irrefl)
 qed
 
 lemma Diff_sing_eqpoll_rel: "[| a \<in> A; A \<approx>\<^bsup>M\<^esup> succ(n); M(a); M(A); M(n) |] ==> A - {a} \<approx>\<^bsup>M\<^esup> n"
   by (blast intro!: eqpoll_relI
       elim!: eqpoll_relE
       intro: Diff_sing_lepoll_rel lepoll_rel_Diff_sing)
 
 lemma lepoll_rel_1_is_sing: "[| A \<lesssim>\<^bsup>M\<^esup> 1; a \<in> A ;M(a); M(A) |] ==> A = {a}"
   apply (frule Diff_sing_lepoll_rel, assumption+, simp)
   apply (drule lepoll_rel_0_is_0, simp)
   apply (blast elim: equalityE)
   done
 
 lemma Un_lepoll_rel_sum: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> A \<union> B \<lesssim>\<^bsup>M\<^esup> A+B"
   apply (simp add: def_lepoll_rel)
   apply (rule_tac x = "\<lambda>x\<in>A \<union> B. if x\<in>A then Inl (x) else Inr (x)" in rexI)
    apply (rule_tac d = "%z. snd (z)" in lam_injective)
     apply force
    apply (simp add: Inl_def Inr_def)
 proof -
   assume "M(A)" "M(B)"
   then
   show "M(\<lambda>x\<in>A \<union> B. if x \<in> A then Inl(x) else Inr(x))"
     using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>] if_then_Inj_replacement
     by (rule_tac lam_closed) auto
 qed
 
 lemma well_ord_Un_M:
   assumes "well_ord(X,R)" "well_ord(Y,S)"
     and types: "M(X)" "M(R)" "M(Y)" "M(S)"
   shows "\<exists>T[M]. well_ord(X \<union> Y, T)"
   using assms
   by (erule_tac well_ord_radd [THEN [3] Un_lepoll_rel_sum [THEN lepoll_rel_well_ord]])
     (auto simp add: types)
 
 lemma disj_Un_eqpoll_rel_sum: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> A \<inter> B = 0 \<Longrightarrow> A \<union> B \<approx>\<^bsup>M\<^esup> A + B"
   apply (simp add: def_eqpoll_rel)
   apply (rule_tac x = "\<lambda>a\<in>A \<union> B. if a \<in> A then Inl (a) else Inr (a)" in rexI)
    apply (rule_tac d = "%z. case (%x. x, %x. x, z)" in lam_bijective)
       apply auto
 proof -
   assume "M(A)" "M(B)"
   then
   show "M(\<lambda>x\<in>A \<union> B. if x \<in> A then Inl(x) else Inr(x))"
     using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>] if_then_Inj_replacement
     by (rule_tac lam_closed) auto
 qed
 
 lemma eqpoll_rel_imp_Finite_rel_iff: "A \<approx>\<^bsup>M\<^esup> B ==> M(A) \<Longrightarrow> M(B) \<Longrightarrow> Finite_rel(M,A) \<longleftrightarrow> Finite_rel(M,B)"
   apply (unfold Finite_rel_def)
   apply (blast intro: eqpoll_rel_trans eqpoll_rel_sym)
   done
 
 \<comment> \<open>It seems reasonable to have the absoluteness of \<^term>\<open>Finite\<close> here,
 and deduce the rest of the results from this.
 
 Perhaps modularize that proof to have absoluteness of injections and
 bijections of finite sets (cf. @{thm lesspoll_rel_succ_imp_lepoll_rel}.\<close>
 
 lemma Finite_abs[simp]: assumes "M(A)" shows "Finite_rel(M,A) \<longleftrightarrow> Finite(A)"
   unfolding Finite_rel_def Finite_def
 proof (simp, intro iffI)
   assume "\<exists>n\<in>nat. A \<approx>\<^bsup>M\<^esup> n"
   then
   obtain n where "A \<approx>\<^bsup>M\<^esup> n" "n\<in>nat" by blast
   with assms
   show "\<exists>n\<in>nat. A \<approx> n"
     unfolding eqpoll_def using nat_into_M by (auto simp add:def_eqpoll_rel)
 next
   fix n
   assume "\<exists>n\<in>nat. A \<approx> n"
   then
   obtain n where "A \<approx> n" "n\<in>nat" by blast
   moreover from this
   obtain f where "f \<in> bij(A,n)" unfolding eqpoll_def by auto
   moreover
   note assms
   moreover from calculation
   have "converse(f) \<in> n\<rightarrow>A"  using bij_is_fun by simp
   moreover from calculation
   have "M(converse(f))" using transM[of _ "n\<rightarrow>A"] by simp
   moreover from calculation
   have "M(f)" using bij_is_fun
       fun_is_rel[of "f" A "\<lambda>_. n", THEN converse_converse]
       converse_closed[of "converse(f)"] by simp
   ultimately
   show "\<exists>n\<in>nat. A \<approx>\<^bsup>M\<^esup> n"
     by (force dest:nat_into_M simp add:def_eqpoll_rel)
 qed
 
 (*
 \<comment> \<open>From the next result, the relative versions of
 @{thm Finite_Fin_lemma} and @{thm Fin_lemma} should follow\<close>
 lemma nat_eqpoll_imp_eqpoll_rel:
   assumes "n \<in> nat" "A \<approx> n" and types:"M(n)" "M(A)"
   shows "A \<approx>\<^bsup>M\<^esup> n"
 *)
 
 lemma lepoll_rel_nat_imp_Finite_rel:
   assumes A: "A \<lesssim>\<^bsup>M\<^esup> n" and n: "n \<in> nat"
     and types: "M(A)" "M(n)"
   shows "Finite_rel(M,A)"
 proof -
   have "A \<lesssim>\<^bsup>M\<^esup> n \<Longrightarrow> Finite_rel(M,A)" using n
   proof (induct n)
     case 0
     hence "A = 0" by (rule lepoll_rel_0_is_0, simp_all add:types)
     thus ?case by simp
   next
     case (succ n)
     hence "A \<lesssim>\<^bsup>M\<^esup> n \<or> A \<approx>\<^bsup>M\<^esup> succ(n)" by (blast dest: lepoll_rel_succ_disj intro:types)
     thus ?case using succ by (auto simp add: Finite_rel_def types)
   qed
   thus ?thesis using A .
 qed
 
 lemma lesspoll_rel_nat_is_Finite_rel:
   "A \<prec>\<^bsup>M\<^esup> nat \<Longrightarrow> M(A) \<Longrightarrow> Finite_rel(M,A)"
   apply (unfold Finite_rel_def)
   apply (auto dest: ltD lesspoll_rel_cardinal_rel_lt
       lesspoll_rel_imp_eqpoll_rel [THEN eqpoll_rel_sym])
   done
 
 lemma lepoll_rel_Finite_rel:
   assumes Y: "Y \<lesssim>\<^bsup>M\<^esup> X" and X: "Finite_rel(M,X)"
     and types:"M(Y)" "M(X)"
   shows "Finite_rel(M,Y)"
 proof -
   obtain n where n: "n \<in> nat" "X \<approx>\<^bsup>M\<^esup> n" "M(n)" using X
     by (auto simp add: Finite_rel_def)
   have "Y \<lesssim>\<^bsup>M\<^esup> X"         by (rule Y)
   also have "... \<approx>\<^bsup>M\<^esup> n"  by (rule n)
   finally have "Y \<lesssim>\<^bsup>M\<^esup> n" by (simp_all add:types \<open>M(n)\<close>)
   thus ?thesis using n
     by (simp add: lepoll_rel_nat_imp_Finite_rel types \<open>M(n)\<close> del:Finite_abs)
 qed
 
 lemma succ_lepoll_rel_imp_not_empty: "succ(x) \<lesssim>\<^bsup>M\<^esup> y ==> M(x) \<Longrightarrow> M(y) \<Longrightarrow> y \<noteq> 0"
   by (fast dest!: lepoll_rel_0_is_0)
 
 lemma eqpoll_rel_succ_imp_not_empty: "x \<approx>\<^bsup>M\<^esup> succ(n) ==> M(x) \<Longrightarrow> M(n) \<Longrightarrow> x \<noteq> 0"
   by (fast elim!: eqpoll_rel_sym [THEN eqpoll_rel_0_is_0, THEN succ_neq_0])
 
 lemma Finite_subset_closed:
   assumes "Finite(B)" "B\<subseteq>A" "M(A)"
   shows "M(B)"
 proof -
   from \<open>Finite(B)\<close> \<open>B\<subseteq>A\<close>
   show ?thesis
   proof(induct,simp)
     case (cons x D)
     with assms
     have "M(D)" "x\<in>A"
       unfolding cons_def by auto
     then
     show ?case using transM[OF _ \<open>M(A)\<close>] by simp
   qed
 qed
 
 lemma Finite_Pow_abs:
   assumes "Finite(A)" " M(A)"
   shows "Pow(A) = Pow_rel(M,A)"
   using Finite_subset_closed[OF subset_Finite] assms Pow_rel_char
   by auto
 
 lemma Finite_Pow_rel:
   assumes "Finite(A)" "M(A)"
   shows "Finite(Pow_rel(M,A))"
   using Finite_Pow Finite_Pow_abs[symmetric] assms by simp
 
 lemma Pow_rel_0 [simp]: "Pow_rel(M,0) = {0}"
   using Finite_Pow_abs[of 0] by simp
 
 lemma eqpoll_rel_imp_Finite: "A \<approx>\<^bsup>M\<^esup> B \<Longrightarrow> Finite(A) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> Finite(B)"
 proof -
   assume "A \<approx>\<^bsup>M\<^esup> B" "Finite(A)" "M(A)" "M(B)"
   then obtain f n g where "f\<in>bij(A,B)" "n\<in>nat" "g\<in>bij(A,n)"
     unfolding Finite_def eqpoll_def eqpoll_rel_def
     using bij_rel_char
     by auto
   then
   have "g O converse(f) \<in> bij(B,n)"
     using bij_converse_bij comp_bij by simp
   with \<open>n\<in>_\<close>
   show"Finite(B)"
     unfolding Finite_def eqpoll_def by auto
 qed
 
 lemma eqpoll_rel_imp_Finite_iff: "A \<approx>\<^bsup>M\<^esup> B \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> Finite(A) \<longleftrightarrow> Finite(B)"
   using eqpoll_rel_imp_Finite eqpoll_rel_sym by force
 
 end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
 
 end
diff --git a/thys/Transitive_Models/Delta_System_Relative.thy b/thys/Transitive_Models/Delta_System_Relative.thy
--- a/thys/Transitive_Models/Delta_System_Relative.thy
+++ b/thys/Transitive_Models/Delta_System_Relative.thy
@@ -1,418 +1,378 @@
 section\<open>The Delta System Lemma, Relativized\label{sec:dsl-rel}\<close>
 
 theory Delta_System_Relative
   imports
     Cardinal_Library_Relative
 begin
 
-(* FIXME: The following code (definition and 3 lemmas) is extracted
-   from Delta_System where it is unnecesarily under the context of AC *)
-definition
-  delta_system :: "i \<Rightarrow> o" where
-  "delta_system(D) \<equiv> \<exists>r. \<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
-
-lemma delta_systemI[intro]:
-  assumes "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
-  shows "delta_system(D)"
-  using assms unfolding delta_system_def by simp
-
-lemma delta_systemD[dest]:
-  "delta_system(D) \<Longrightarrow> \<exists>r. \<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
-  unfolding delta_system_def by simp
-
-lemma delta_system_root_eq_Inter:
-  assumes "delta_system(D)"
-  shows "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = \<Inter>D"
-proof (clarify, intro equalityI, auto)
-  fix A' B' x C
-  assume hyp:"A'\<in>D" "B'\<in> D" "A'\<noteq>B'" "x\<in>A'" "x\<in>B'" "C\<in>D"
-  with assms
-  obtain r where delta:"\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
-    by auto
-  show "x \<in> C"
-  proof (cases "C=A'")
-    case True
-    with hyp and assms
-    show ?thesis by simp
-  next
-    case False
-    moreover
-    note hyp
-    moreover from calculation and delta
-    have "r = C \<inter> A'" "A' \<inter> B' = r" "x\<in>r" by auto
-    ultimately
-    show ?thesis by simp
-  qed
-qed
-
 relativize functional "delta_system" "delta_system_rel" external
 
-locale M_delta = M_cardinal_library +
+locale M_delta = M_cardinal_library_extra +
   assumes
     countable_lepoll_assms:
     "M(G) \<Longrightarrow> M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> separation(M, \<lambda>y. \<exists>x\<in>A.
                           y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. {xa \<in> G . x \<in> xa}, b, f, i)\<rangle>)"
 begin
 
-lemmas cardinal_replacement = lam_replacement_cardinal_rel[unfolded lam_replacement_def]
-
 lemma disjoint_separation: "M(c) \<Longrightarrow> separation(M, \<lambda> x. \<exists>a. \<exists>b. x=\<langle>a,b\<rangle> \<and> a \<inter> b = c)"
-  using separation_pair separation_eq lam_replacement_constant lam_replacement_Int
+  using separation_Pair separation_eq lam_replacement_constant lam_replacement_Int
   by simp
 
 lemma insnd_ball: "M(G) \<Longrightarrow> separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> fst(p) \<in> x)"
   using separation_ball separation_iff' lam_replacement_fst lam_replacement_snd
     separation_in lam_replacement_hcomp
   by simp
 
 lemma (in M_trans) mem_F_bound6:
   fixes F G
   defines "F \<equiv> \<lambda>_ x. Collect(G, (\<in>)(x))"
   shows "x\<in>F(G,c) \<Longrightarrow> c \<in> (range(f) \<union> \<Union>G)"
   using apply_0 unfolding F_def
   by (cases "M(c)", auto simp:F_def)
 
 lemma delta_system_Aleph_rel1:
   assumes "\<forall>A\<in>F. Finite(A)" "F \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(F)"
   shows "\<exists>D[M]. D \<subseteq> F \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
 proof -
   have "M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})" for G p
   proof -
     assume "M(G)" "M(p)"
     have "{A\<in>G . p \<in> A} = G \<inter> (Memrel({p} \<union> G) `` {p})"
       unfolding Memrel_def by auto
     with \<open>M(G)\<close> \<open>M(p)\<close>
     show ?thesis by simp
   qed
-  from \<open>M(F)\<close>
+  from \<open>\<forall>A\<in>F. Finite(A)\<close> \<open>M(F)\<close>
   have "M(\<lambda>A\<in>F. |A|\<^bsup>M\<^esup>)"
-    using cardinal_replacement
-    by (rule_tac lam_closed) (auto dest:transM)
+    using cardinal_rel_separation Finite_cardinal_rel_in_nat[OF _ transM[of _ F]]
+      separation_imp_lam_closed[of _ "cardinal_rel(M)" \<omega>]
+    by simp
   text\<open>Since all members are finite,\<close>
   with \<open>\<forall>A\<in>F. Finite(A)\<close> \<open>M(F)\<close>
   have "(\<lambda>A\<in>F. |A|\<^bsup>M\<^esup>) : F \<rightarrow>\<^bsup>M\<^esup> \<omega>" (is "?cards : _")
     by (simp add:mem_function_space_rel_abs, rule_tac lam_type)
       (force dest:transM)
   moreover from this
   have a:"?cards -`` {n} = { A\<in>F . |A|\<^bsup>M\<^esup> = n }" for n
     using vimage_lam by auto
   moreover
   note \<open>F \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(F)\<close>
   moreover from calculation
   text\<open>there are uncountably many have the same cardinal:\<close>
   obtain n where "n\<in>\<omega>" "|?cards -`` {n}|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     using eqpoll_rel_Aleph_rel1_cardinal_rel_vimage[of F ?cards] by auto
   moreover
   define G where "G \<equiv> ?cards -`` {n}"
   moreover from calculation and \<open>M(?cards)\<close>
   have "M(G)" by blast
   moreover from calculation
   have "G \<subseteq> F" by auto
   ultimately
   text\<open>Therefore, without loss of generality, we can assume that all
   elements of the family have cardinality \<^term>\<open>n\<in>\<omega>\<close>.\<close>
   have "A\<in>G \<Longrightarrow> |A|\<^bsup>M\<^esup> = n" and "G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" and "M(G)" for A
     using cardinal_rel_Card_rel_eqpoll_rel_iff by auto
   with \<open>n\<in>\<omega>\<close>
   text\<open>So we prove the result by induction on this \<^term>\<open>n\<close> and
   generalizing \<^term>\<open>G\<close>, since the argument requires changing the
   family in order to apply the inductive hypothesis.\<close>
   have "\<exists>D[M]. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
   proof (induct arbitrary:G)
     case 0 \<comment> \<open>This case is impossible\<close>
     then
     have "G \<subseteq> {0}"
       using cardinal_rel_0_iff_0 by (blast dest:transM)
     with \<open>G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(G)\<close>
     show ?case
       using nat_lt_Aleph_rel1 subset_imp_le_cardinal_rel[of G "{0}"]
         lt_trans2 cardinal_rel_Card_rel_eqpoll_rel_iff by auto
   next
     case (succ n)
     have "\<forall>a\<in>G. Finite(a)"
     proof
       fix a
       assume "a \<in> G"
       moreover
       note \<open>M(G)\<close> \<open>n\<in>\<omega>\<close>
       moreover from calculation
       have "M(a)" by (auto dest: transM)
       moreover from succ and \<open>a\<in>G\<close>
       have "|a|\<^bsup>M\<^esup> = succ(n)" by simp
       ultimately
       show "Finite(a)"
         using Finite_cardinal_rel_iff' nat_into_Finite[of "succ(n)"]
         by fastforce
     qed
     show "\<exists>D[M]. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
     proof (cases "\<exists>p[M]. {A\<in>G . p \<in> A} \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>")
       case True \<comment> \<open>the positive case, uncountably many sets with a
                     common element\<close>
       then
       obtain p where "{A\<in>G . p \<in> A} \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(p)" by blast
       moreover
       note 1=\<open>M(G)\<close> \<open>M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})\<close> singleton_closed[OF \<open>M(p)\<close>]
       moreover from this
       have "M({x - {p} . x \<in> {x \<in> G . p \<in> x}})"
         using RepFun_closed[OF lam_replacement_Diff'[THEN
               lam_replacement_imp_strong_replacement]]
           Diff_closed[OF transM[OF _ 1(2)]] by auto
       moreover from 1
       have "M(converse(\<lambda>x\<in>{x \<in> G . p \<in> x}. x - {p}))" (is "M(converse(?h))")
         using converse_closed[of ?h] lam_closed[OF diff_Pair_replacement]
           Diff_closed[OF transM[OF _ 1(2)]]
         by auto
       moreover from calculation
       have "{A-{p} . A\<in>{X\<in>G. p\<in>X}} \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" (is "?F \<approx>\<^bsup>M\<^esup> _")
         using Diff_bij_rel[of "{A\<in>G . p \<in> A}" "{p}", THEN
             comp_bij_rel[OF bij_rel_converse_bij_rel, where C="\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>",
               THEN bij_rel_imp_eqpoll_rel, of _ _ ?F]]
         unfolding eqpoll_rel_def
         by (auto simp del:mem_bij_abs)
       text\<open>Now using the hypothesis of the successor case,\<close>
       moreover from \<open>\<And>A. A\<in>G \<Longrightarrow> |A|\<^bsup>M\<^esup>=succ(n)\<close> \<open>\<forall>a\<in>G. Finite(a)\<close>
         and this \<open>M(G)\<close>
       have "p\<in>A \<Longrightarrow> A\<in>G \<Longrightarrow> |A - {p}|\<^bsup>M\<^esup> = n" for A
         using Finite_imp_succ_cardinal_rel_Diff[of _ p] by (force dest: transM)
       moreover
       have "\<forall>a\<in>?F. Finite(a)"
       proof (clarsimp)
         fix A
         assume "p\<in>A" "A\<in>G"
         with \<open>\<And>A. p \<in> A \<Longrightarrow> A \<in> G \<Longrightarrow> |A - {p}|\<^bsup>M\<^esup> = n\<close> and \<open>n\<in>\<omega>\<close> \<open>M(G)\<close>
         have "Finite(|A - {p}|\<^bsup>M\<^esup>)"
           using nat_into_Finite by simp
         moreover from \<open>p\<in>A\<close> \<open>A\<in>G\<close> \<open>M(G)\<close>
         have "M(A - {p})" by (auto dest: transM)
         ultimately
         show "Finite(A - {p})"
           using Finite_cardinal_rel_iff' by simp
       qed
       moreover
       text\<open>we may apply the inductive hypothesis to the new family \<^term>\<open>?F\<close>:\<close>
       note \<open>(\<And>A. A \<in> ?F \<Longrightarrow> |A|\<^bsup>M\<^esup> = n) \<Longrightarrow> ?F \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> M(?F) \<Longrightarrow>
              \<exists>D[M]. D \<subseteq> ?F \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
       moreover
       note 1=\<open>M(G)\<close> \<open>M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})\<close> singleton_closed[OF \<open>M(p)\<close>]
       moreover from this
       have "M({x - {p} . x \<in> {x \<in> G . p \<in> x}})"
         using RepFun_closed[OF lam_replacement_Diff'[THEN
               lam_replacement_imp_strong_replacement]]
           Diff_closed[OF transM[OF _ 1(2)]] by auto
       ultimately
       obtain D where "D\<subseteq>{A-{p} . A\<in>{X\<in>G. p\<in>X}}" "delta_system(D)" "D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(D)"
         by auto
       moreover from this
       obtain r where "\<forall>A\<in>D. \<forall>B\<in>D. A \<noteq> B \<longrightarrow> A \<inter> B = r"
         by fastforce
       then
       have "\<forall>A\<in>D.\<forall>B\<in>D. A\<union>{p} \<noteq> B\<union>{p}\<longrightarrow>(A \<union> {p}) \<inter> (B \<union> {p}) = r\<union>{p}"
         by blast
       ultimately
       have "delta_system({B \<union> {p} . B\<in>D})" (is "delta_system(?D)")
         by fastforce
       moreover from \<open>M(D)\<close> \<open>M(p)\<close>
       have "M(?D)"
         using RepFun_closed un_Pair_replacement transM[of _ D] by auto
       moreover from \<open>D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(D)\<close>
       have "Infinite(D)" "|D|\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
         using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1[THEN iffD2,
             THEN uncountable_rel_imp_Infinite, of D]
           cardinal_rel_eqpoll_rel_iff[of D "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"] \<open>M(D)\<close> \<open>D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
         by auto
       moreover from this \<open>M(?D)\<close> \<open>M(D)\<close> \<open>M(p)\<close>
       have "?D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
         using cardinal_rel_map_Un[of D "{p}"] naturals_lt_nat
           cardinal_rel_eqpoll_rel_iff[THEN iffD1] by simp
       moreover
       note \<open>D \<subseteq> {A-{p} . A\<in>{X\<in>G. p\<in>X}}\<close>
       have "?D \<subseteq> G"
       proof -
         {
           fix A
           assume "A\<in>G" "p\<in>A"
           moreover from this
           have "A = A - {p} \<union> {p}"
             by blast
           ultimately
           have "A -{p} \<union> {p} \<in> G"
             by auto
         }
         with \<open>D \<subseteq> {A-{p} . A\<in>{X\<in>G. p\<in>X}}\<close>
         show ?thesis
           by blast
       qed
       moreover
       note \<open>M(?D)\<close>
       ultimately
       show "\<exists>D[M]. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" by auto
     next
       case False
       note \<open>\<not> (\<exists>p[M]. {A \<in> G . p \<in> A} \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close> \<comment> \<open>the other case\<close>
         \<open>M(G)\<close> \<open>\<And>p. M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})\<close>
       moreover from \<open>G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> and this
       have "M(p) \<Longrightarrow> {A \<in> G . p \<in> A} \<lesssim>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" (is "_ \<Longrightarrow> ?G(p) \<lesssim>\<^bsup>M\<^esup> _") for p
         by (auto intro!:lepoll_rel_eq_trans[OF subset_imp_lepoll_rel] dest:transM)
       moreover from calculation
       have "M(p) \<Longrightarrow> ?G(p) \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" for p
         using \<open>M(G) \<Longrightarrow> M(p) \<Longrightarrow> M({A\<in>G . p \<in> A})\<close>
         unfolding lesspoll_rel_def by simp
       moreover from calculation
       have "M(p) \<Longrightarrow> ?G(p) \<lesssim>\<^bsup>M\<^esup> \<omega>" for p
         using lesspoll_rel_Aleph_rel_succ[of 0] Aleph_rel_zero by auto
       moreover
       have "{A \<in> G . S \<inter> A \<noteq> 0} = (\<Union>p\<in>S. ?G(p))" for S
         by auto
       moreover from calculation
       have "M(S) \<Longrightarrow> i \<in> S \<Longrightarrow> M({x \<in> G . i \<in> x})" for i S
         by (auto dest: transM)
       moreover
       have "M(S) \<Longrightarrow> countable_rel(M,S) \<Longrightarrow> countable_rel(M,{A \<in> G . S \<inter> A \<noteq> 0})" for S
       proof -
         from \<open>M(G)\<close>
         interpret M_replacement_lepoll M "\<lambda>_ x. Collect(G, (\<in>)(x))"
           using countable_lepoll_assms lam_replacement_inj_rel separation_in_rev
             lam_replacement_Collect[OF _ _ insnd_ball] mem_F_bound6[of _ G]
+            lam_replacement_minimum
           by unfold_locales
             (auto dest:transM intro:lam_Least_assumption_general[of _  _ _ _ Union])
         fix S
         assume "M(S)"
         with \<open>M(G)\<close> \<open>\<And>i. M(S) \<Longrightarrow> i \<in> S \<Longrightarrow> M({x \<in> G . i \<in> x})\<close>
         interpret M_cardinal_UN_lepoll _ ?G S
           using lepoll_assumptions
           by unfold_locales (auto dest:transM)
         assume "countable_rel(M,S)"
         with \<open>M(S)\<close> calculation(6) calculation(7,8)[of S]
         show "countable_rel(M,{A \<in> G . S \<inter> A \<noteq> 0})"
           using InfCard_rel_nat Card_rel_nat
             le_Card_rel_iff[THEN iffD2, THEN [3] leqpoll_rel_imp_cardinal_rel_UN_le,
               THEN [4] le_Card_rel_iff[THEN iffD1], of \<omega>] j.UN_closed
           unfolding countable_rel_def by (auto dest: transM)
       qed
       define Disjoint where "Disjoint = {<A,B> \<in> G\<times>G . B \<inter> A = 0}"
       have "Disjoint = {x \<in> G\<times>G . \<exists> a b. x=<a,b> \<and> a\<inter>b=0}"
         unfolding Disjoint_def by force
       with \<open>M(G)\<close>
       have "M(Disjoint)"
         using disjoint_separation by simp
       text\<open>For every countable\_rel subfamily of \<^term>\<open>G\<close> there is another some
       element disjoint from all of them:\<close>
       have "\<exists>A\<in>G. \<forall>S\<in>X. <S,A>\<in>Disjoint" if "|X|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "X \<subseteq> G" "M(X)" for X
       proof -
         note \<open>n\<in>\<omega>\<close> \<open>M(G)\<close>
         moreover from this and \<open>\<And>A. A\<in>G \<Longrightarrow> |A|\<^bsup>M\<^esup> = succ(n)\<close>
         have "|A|\<^bsup>M\<^esup>= succ(n)" "M(A)" if "A\<in>G" for A
           using that Finite_cardinal_rel_eq_cardinal[of A] Finite_cardinal_rel_iff'[of A]
             nat_into_Finite transM[of A G] by (auto dest:transM)
         ultimately
         have "A\<in>G \<Longrightarrow> Finite(A)" for A
           using cardinal_rel_Card_rel_eqpoll_rel_iff[of "succ(n)" A]
             Finite_cardinal_rel_eq_cardinal[of A] nat_into_Card_rel[of "succ(n)"]
             nat_into_M[of n] unfolding Finite_def eqpoll_rel_def by (auto)
         with \<open>X\<subseteq>G\<close> \<open>M(X)\<close>
         have "A\<in>X \<Longrightarrow> countable_rel(M,A)" for A
           using Finite_imp_countable_rel by (auto dest: transM)
         moreover from \<open>M(X)\<close>
         have "M(\<Union>X)" by simp
         moreover
         note \<open>|X|\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(X)\<close>
         ultimately
         have "countable_rel(M,\<Union>X)"
           using Card_rel_nat[THEN cardinal_rel_lt_csucc_rel_iff, of X]
             countable_rel_union_countable_rel[of X]
             countable_rel_iff_cardinal_rel_le_nat[of X] Aleph_rel_succ
             Aleph_rel_zero by simp
         with \<open>M(\<Union>X)\<close> \<open>M(_) \<Longrightarrow> countable_rel(M,_) \<Longrightarrow> countable_rel(M,{A \<in> G . _  \<inter> A \<noteq> 0})\<close>
         have "countable_rel(M,{A \<in> G . (\<Union>X) \<inter> A \<noteq> 0})" by simp
         with \<open>G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(G)\<close>
         obtain B where "B\<in>G" "B \<notin> {A \<in> G . (\<Union>X) \<inter> A \<noteq> 0}"
           using nat_lt_Aleph_rel1 cardinal_rel_Card_rel_eqpoll_rel_iff[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G]
             uncountable_rel_not_subset_countable_rel
             [of "{A \<in> G . (\<Union>X) \<inter> A \<noteq> 0}" G]
             uncountable_rel_iff_nat_lt_cardinal_rel[of G]
           by force
         then
         have "\<exists>A\<in>G. \<forall>S\<in>X. A \<inter> S = 0" by auto
         with \<open>X\<subseteq>G\<close>
         show "\<exists>A\<in>G. \<forall>S\<in>X. <S,A>\<in>Disjoint" unfolding Disjoint_def
           using subsetD by simp
       qed
       moreover from \<open>G \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(G)\<close>
       obtain b where "b\<in>G"
         using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1
           uncountable_rel_not_empty by blast
       ultimately
       text\<open>Hence, the hypotheses to perform a bounded-cardinal selection
       are satisfied,\<close>
       obtain S where "S:\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<rightarrow>\<^bsup>M\<^esup>G" "\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> \<beta>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> \<alpha><\<beta> \<Longrightarrow> <S`\<alpha>, S`\<beta>> \<in>Disjoint"
         for \<alpha> \<beta>
         using bounded_cardinal_rel_selection[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G Disjoint] \<open>M(Disjoint)\<close>
         by force
       moreover from this \<open>n\<in>\<omega>\<close> \<open>M(G)\<close>
       have inM:"M(S)" "M(n)" "\<And>x. x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> S ` x \<in> G" "\<And>x. x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> M(x)"
         using function_space_rel_char by (auto dest: transM)
       ultimately
       have "\<alpha> \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> \<beta> \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> \<alpha>\<noteq>\<beta> \<Longrightarrow> S`\<alpha> \<inter> S`\<beta> = 0" for \<alpha> \<beta>
         unfolding Disjoint_def
         using lt_neq_symmetry[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<lambda>\<alpha> \<beta>. S`\<alpha> \<inter> S`\<beta> = 0"] Card_rel_is_Ord
         by auto (blast)
       text\<open>and a symmetry argument shows that obtained \<^term>\<open>S\<close> is
       an injective  \<^term>\<open>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>-sequence of disjoint elements of \<^term>\<open>G\<close>.\<close>
       moreover from this and \<open>\<And>A. A\<in>G \<Longrightarrow> |A|\<^bsup>M\<^esup> = succ(n)\<close> inM
         \<open>S : \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow>\<^bsup>M\<^esup> G\<close> \<open>M(G)\<close>
       have "S \<in> inj_rel(M,\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, G)"
         using def_inj_rel[OF Aleph_rel_closed \<open>M(G)\<close>, of 1]
       proof (clarsimp)
         fix w x
         from inM
         have "a \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> b \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> a \<noteq> b \<Longrightarrow> S ` a \<noteq> S ` b" for a b
           using \<open>\<And>A. A\<in>G \<Longrightarrow> |A|\<^bsup>M\<^esup> = succ(n)\<close>[THEN [4] cardinal_rel_succ_not_0[THEN [4]
                 Int_eq_zero_imp_not_eq[OF calculation, of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<lambda>x. x"],
                 of "\<lambda>_.n"], OF _ _ _ _ apply_closed] by auto
         moreover
         assume "w \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "S ` w = S ` x"
         ultimately
         show "w = x" by blast
       qed
       moreover from this \<open>M(G)\<close>
       have "range(S) \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
         using inj_rel_bij_rel_range eqpoll_rel_sym unfolding eqpoll_rel_def
         by (blast dest: transM)
       moreover
       note \<open>M(G)\<close>
       moreover from calculation
       have "range(S) \<subseteq> G"
         using inj_rel_is_fun range_fun_subset_codomain
         by (fastforce dest: transM)
       moreover
       note \<open>M(S)\<close>
       ultimately
       show "\<exists>D[M]. D \<subseteq> G \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
         using inj_rel_is_fun ZF_Library.range_eq_image[of S "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G]
           image_function[OF fun_is_function, OF inj_rel_is_fun, of S "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G]
           domain_of_fun[OF inj_rel_is_fun, of S "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" G] apply_replacement[of S]
         by (rule_tac x="S``\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" in rexI) (auto dest:transM intro!:RepFun_closed)
       text\<open>This finishes the successor case and hence the proof.\<close>
     qed
   qed
   with \<open>G \<subseteq> F\<close>
   show ?thesis by blast
 qed
 
 lemma delta_system_uncountable_rel:
   assumes "\<forall>A\<in>F. Finite(A)" "uncountable_rel(M,F)" "M(F)"
   shows "\<exists>D[M]. D \<subseteq> F \<and> delta_system(D) \<and> D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
 proof -
   from assms
   obtain S where "S \<subseteq> F" "S \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(S)"
     using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1[of F] by auto
   moreover from \<open>\<forall>A\<in>F. Finite(A)\<close> and this
   have "\<forall>A\<in>S. Finite(A)" by auto
   ultimately
   show ?thesis using delta_system_Aleph_rel1[of S]
     by (auto dest:transM)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_delta\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Discipline_Base.thy b/thys/Transitive_Models/Discipline_Base.thy
--- a/thys/Transitive_Models/Discipline_Base.thy
+++ b/thys/Transitive_Models/Discipline_Base.thy
@@ -1,658 +1,659 @@
 theory Discipline_Base
   imports
     "ZF-Constructible.Rank"
-    ZF_Miscellanea
     M_Basic_No_Repl
     Relativization
+    ZF_Miscellanea
 
 begin
 
+hide_const (open) Order.pred
 declare [[syntax_ambiguity_warning = false]]
 
 subsection\<open>Discipline of relativization of basic concepts\<close>
 
 definition
   is_singleton :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
   "is_singleton(A,x,z) \<equiv> \<exists>c[A]. empty(A,c) \<and> is_cons(A,x,c,z)"
 
 lemma (in M_trivial) singleton_abs[simp] :
   "\<lbrakk> M(x) ; M(s) \<rbrakk> \<Longrightarrow> is_singleton(M,x,s) \<longleftrightarrow> s = {x}"
   unfolding is_singleton_def using nonempty by simp
 
 synthesize "singleton" from_definition "is_singleton"
 notation singleton_fm (\<open>\<cdot>{_} is _\<cdot>\<close>)
 
 (* TODO: check if the following lemmas should be here or not? *)
 lemma (in M_trivial) singleton_closed [simp]:
   "M(x) \<Longrightarrow> M({x})"
   by simp
 
 lemma (in M_trivial) Upair_closed[simp]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> M(Upair(a,b))"
   using Upair_eq_cons by simp
 
 
 text\<open>The following named theorems gather instances of transitivity
 that arise from closure theorems\<close>
 named_theorems trans_closed
 
 definition
   is_hcomp :: "[i\<Rightarrow>o,i\<Rightarrow>i\<Rightarrow>o,i\<Rightarrow>i\<Rightarrow>o,i,i] \<Rightarrow> o" where
   "is_hcomp(M,is_f,is_g,a,w) \<equiv> \<exists>z[M]. is_g(a,z) \<and> is_f(z,w)"
 
 lemma (in M_trivial) is_hcomp_abs:
   assumes
     is_f_abs:"\<And>a z. M(a) \<Longrightarrow> M(z) \<Longrightarrow> is_f(a,z) \<longleftrightarrow> z = f(a)" and
     is_g_abs:"\<And>a z. M(a) \<Longrightarrow> M(z) \<Longrightarrow> is_g(a,z) \<longleftrightarrow> z = g(a)" and
     g_closed:"\<And>a. M(a) \<Longrightarrow> M(g(a))"
     "M(a)" "M(w)"
   shows
     "is_hcomp(M,is_f,is_g,a,w) \<longleftrightarrow> w = f(g(a))"
   unfolding is_hcomp_def using assms by simp
 
 definition
   hcomp_fm :: "[i\<Rightarrow>i\<Rightarrow>i,i\<Rightarrow>i\<Rightarrow>i,i,i] \<Rightarrow> i" where
   "hcomp_fm(pf,pg,a,w) \<equiv> Exists(And(pg(succ(a),0),pf(0,succ(w))))"
 
 lemma sats_hcomp_fm:
   assumes
     f_iff_sats:"\<And>a b z. a\<in>nat \<Longrightarrow> b\<in>nat \<Longrightarrow> z\<in>M \<Longrightarrow>
                  is_f(nth(a,Cons(z,env)),nth(b,Cons(z,env))) \<longleftrightarrow> sats(M,pf(a,b),Cons(z,env))"
     and
     g_iff_sats:"\<And>a b z. a\<in>nat \<Longrightarrow> b\<in>nat \<Longrightarrow> z\<in>M \<Longrightarrow>
                 is_g(nth(a,Cons(z,env)),nth(b,Cons(z,env))) \<longleftrightarrow> sats(M,pg(a,b),Cons(z,env))"
     and
     "a\<in>nat" "w\<in>nat" "env\<in>list(M)"
   shows
     "sats(M,hcomp_fm(pf,pg,a,w),env) \<longleftrightarrow> is_hcomp(##M,is_f,is_g,nth(a,env),nth(w,env))"
 proof -
   have "sats(M, pf(0, succ(w)), Cons(x, env)) \<longleftrightarrow> is_f(x,nth(w,env))" if "x\<in>M" "w\<in>nat" for x w
     using f_iff_sats[of 0 "succ(w)" x] that by simp
   moreover
   have "sats(M, pg(succ(a), 0), Cons(x, env)) \<longleftrightarrow> is_g(nth(a,env),x)" if "x\<in>M" "a\<in>nat" for x a
     using g_iff_sats[of "succ(a)" 0 x] that by simp
   ultimately
   show ?thesis unfolding hcomp_fm_def is_hcomp_def using assms by simp
 qed
 
 
 definition
   hcomp_r :: "[i\<Rightarrow>o,[i\<Rightarrow>o,i,i]\<Rightarrow>o,[i\<Rightarrow>o,i,i]\<Rightarrow>o,i,i] \<Rightarrow> o" where
   "hcomp_r(M,is_f,is_g,a,w) \<equiv> \<exists>z[M]. is_g(M,a,z) \<and> is_f(M,z,w)"
 
 definition
   is_hcomp2_2 :: "[i\<Rightarrow>o,[i\<Rightarrow>o,i,i,i]\<Rightarrow>o,[i\<Rightarrow>o,i,i,i]\<Rightarrow>o,[i\<Rightarrow>o,i,i,i]\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
   "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w) \<equiv> \<exists>g1ab[M]. \<exists>g2ab[M].
        is_g1(M,a,b,g1ab) \<and> is_g2(M,a,b,g2ab) \<and> is_f(M,g1ab,g2ab,w)"
 
 lemma (in M_trivial) hcomp_abs:
   assumes
     is_f_abs:"\<And>a z. M(a) \<Longrightarrow> M(z) \<Longrightarrow> is_f(M,a,z) \<longleftrightarrow> z = f(a)" and
     is_g_abs:"\<And>a z. M(a) \<Longrightarrow> M(z) \<Longrightarrow> is_g(M,a,z) \<longleftrightarrow> z = g(a)" and
     g_closed:"\<And>a. M(a) \<Longrightarrow> M(g(a))"
     "M(a)" "M(w)"
   shows
     "hcomp_r(M,is_f,is_g,a,w) \<longleftrightarrow> w = f(g(a))"
   unfolding hcomp_r_def using assms by simp
 
 lemma hcomp_uniqueness:
   assumes
     uniq_is_f:
     "\<And>r d d'. M(r) \<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow> is_f(M, r, d) \<Longrightarrow> is_f(M, r, d') \<Longrightarrow>
                d = d'"
     and
     uniq_is_g:
     "\<And>r d d'. M(r) \<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow> is_g(M, r, d) \<Longrightarrow> is_g(M, r, d') \<Longrightarrow>
                d = d'"
     and
     "M(a)" "M(w)" "M(w')"
     "hcomp_r(M,is_f,is_g,a,w)"
     "hcomp_r(M,is_f,is_g,a,w')"
   shows
     "w=w'"
 proof -
   from assms
   obtain z z' where "is_g(M, a, z)" "is_g(M, a, z')"
     "is_f(M,z,w)" "is_f(M,z',w')"
     "M(z)" "M(z')"
     unfolding hcomp_r_def by blast
   moreover from this and uniq_is_g and \<open>M(a)\<close>
   have "z=z'" by blast
   moreover note uniq_is_f and \<open>M(w)\<close> \<open>M(w')\<close>
   ultimately
   show ?thesis by blast
 qed
 
 lemma hcomp_witness:
   assumes
     wit_is_f: "\<And>r. M(r) \<Longrightarrow> \<exists>d[M]. is_f(M,r,d)" and
     wit_is_g: "\<And>r. M(r) \<Longrightarrow> \<exists>d[M]. is_g(M,r,d)" and
     "M(a)"
   shows
     "\<exists>w[M]. hcomp_r(M,is_f,is_g,a,w)"
 proof -
   from \<open>M(a)\<close> and wit_is_g
   obtain z where "is_g(M,a,z)" "M(z)" by blast
   moreover from this and wit_is_f
   obtain w where "is_f(M,z,w)" "M(w)" by blast
   ultimately
   show ?thesis
     using assms unfolding hcomp_r_def by auto
 qed
 
 lemma (in M_trivial) hcomp2_2_abs:
   assumes
     is_f_abs:"\<And>r1 r2 z. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow>  M(z) \<Longrightarrow> is_f(M,r1,r2,z) \<longleftrightarrow> z = f(r1,r2)" and
     is_g1_abs:"\<And>r1 r2 z. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow>  M(z) \<Longrightarrow> is_g1(M,r1,r2,z) \<longleftrightarrow> z = g1(r1,r2)" and
     is_g2_abs:"\<And>r1 r2 z. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow>  M(z) \<Longrightarrow> is_g2(M,r1,r2,z) \<longleftrightarrow> z = g2(r1,r2)" and
     types: "M(a)" "M(b)" "M(w)" "M(g1(a,b))" "M(g2(a,b))"
   shows
     "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w) \<longleftrightarrow> w = f(g1(a,b),g2(a,b))"
   unfolding is_hcomp2_2_def using assms
     \<comment> \<open>We only need some particular cases of the abs assumptions\<close>
     (* is_f_abs types is_g1_abs[of a b] is_g2_abs[of a b] *)
   by simp
 
 lemma hcomp2_2_uniqueness:
   assumes
     uniq_is_f:
     "\<And>r1 r2 d d'. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow>
         is_f(M, r1, r2 , d) \<Longrightarrow> is_f(M, r1, r2, d') \<Longrightarrow>  d = d'"
     and
     uniq_is_g1:
     "\<And>r1 r2 d d'. M(r1) \<Longrightarrow> M(r2)\<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow> is_g1(M, r1,r2, d) \<Longrightarrow> is_g1(M, r1,r2, d') \<Longrightarrow>
                d = d'"
     and
     uniq_is_g2:
     "\<And>r1 r2 d d'. M(r1) \<Longrightarrow> M(r2)\<Longrightarrow> M(d) \<Longrightarrow> M(d') \<Longrightarrow> is_g2(M, r1,r2, d) \<Longrightarrow> is_g2(M, r1,r2, d') \<Longrightarrow>
                d = d'"
     and
     "M(a)" "M(b)" "M(w)" "M(w')"
     "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w)"
     "is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w')"
   shows
     "w=w'"
 proof -
   from assms
   obtain z z' y y' where "is_g1(M, a,b, z)" "is_g1(M, a,b, z')"
     "is_g2(M, a,b, y)" "is_g2(M, a,b, y')"
     "is_f(M,z,y,w)" "is_f(M,z',y',w')"
     "M(z)" "M(z')" "M(y)" "M(y')"
     unfolding is_hcomp2_2_def by force
   moreover from this and uniq_is_g1 uniq_is_g2 and \<open>M(a)\<close> \<open>M(b)\<close>
   have "z=z'" "y=y'" by blast+
   moreover note uniq_is_f and \<open>M(w)\<close> \<open>M(w')\<close>
   ultimately
   show ?thesis by blast
 qed
 
 lemma hcomp2_2_witness:
   assumes
     wit_is_f: "\<And>r1 r2. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> \<exists>d[M]. is_f(M,r1,r2,d)" and
     wit_is_g1: "\<And>r1 r2. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> \<exists>d[M]. is_g1(M,r1,r2,d)" and
     wit_is_g2: "\<And>r1 r2. M(r1) \<Longrightarrow> M(r2) \<Longrightarrow> \<exists>d[M]. is_g2(M,r1,r2,d)" and
     "M(a)" "M(b)"
   shows
     "\<exists>w[M]. is_hcomp2_2(M,is_f,is_g1,is_g2,a,b,w)"
 proof -
   from \<open>M(a)\<close> \<open>M(b)\<close> and wit_is_g1
   obtain g1a where "is_g1(M,a,b,g1a)" "M(g1a)" by blast
   moreover from \<open>M(a)\<close> \<open>M(b)\<close> and wit_is_g2
   obtain g2a where "is_g2(M,a,b,g2a)" "M(g2a)" by blast
   moreover from calculation and wit_is_f
   obtain w where "is_f(M,g1a,g2a,w)" "M(w)" by blast
   ultimately
   show ?thesis
     using assms unfolding is_hcomp2_2_def by auto
 qed
 
 lemma (in M_trivial) extensionality_trans:
   assumes
     "M(d) \<and> (\<forall>x[M]. x\<in>d  \<longleftrightarrow> P(x))"
     "M(d') \<and> (\<forall>x[M]. x\<in>d' \<longleftrightarrow> P(x))"
   shows
     "d=d'"
 proof -
   from assms
   have "\<forall>x. x\<in>d \<longleftrightarrow> P(x) \<and> M(x)"
     using transM[of _ d] by auto
   moreover from assms
   have  "\<forall>x. x\<in>d' \<longleftrightarrow> P(x) \<and> M(x)"
     using transM[of _ d'] by auto
   ultimately
   show ?thesis by auto
 qed
 
 definition
   lt_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
   "lt_rel(M,a,b) \<equiv> a\<in>b \<and> ordinal(M,b)"
 
 lemma (in M_trans) lt_abs[absolut]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> lt_rel(M,a,b) \<longleftrightarrow> a<b"
   unfolding lt_rel_def lt_def by auto
 
 definition
   le_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
   "le_rel(M,a,b) \<equiv> \<exists>sb[M]. successor(M,b,sb) \<and> lt_rel(M,a,sb)"
 
 lemma (in M_trivial) le_abs[absolut]: "M(a) \<Longrightarrow> M(b) \<Longrightarrow> le_rel(M,a,b) \<longleftrightarrow> a\<le>b"
   unfolding le_rel_def by (simp add:absolut)
 
 subsection\<open>Discipline for \<^term>\<open>Pow\<close>\<close>
 
 definition
   is_Pow :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
   "is_Pow(M,A,z) \<equiv> M(z) \<and> (\<forall>x[M]. x \<in> z \<longleftrightarrow> subset(M,x,A))"
 
 definition
   Pow_rel :: "[i\<Rightarrow>o,i] \<Rightarrow> i" (\<open>Pow\<^bsup>_\<^esup>'(_')\<close>) where
   "Pow_rel(M,r) \<equiv> THE d. is_Pow(M,r,d)"
 
 abbreviation
   Pow_r_set ::  "[i,i] \<Rightarrow> i" (\<open>Pow\<^bsup>_\<^esup>'(_')\<close>) where
   "Pow_r_set(M) \<equiv> Pow_rel(##M)"
 
 context M_basic_no_repl
 begin
 
 lemma is_Pow_uniqueness:
   assumes
     "M(r)"
     "is_Pow(M,r,d)" "is_Pow(M,r,d')"
   shows
     "d=d'"
   using assms extensionality_trans
   unfolding is_Pow_def
   by simp
 
 lemma is_Pow_witness: "M(r) \<Longrightarrow> \<exists>d[M]. is_Pow(M,r,d)"
   using power_ax unfolding power_ax_def powerset_def is_Pow_def
   by simp \<comment> \<open>We have to do this by hand, using axioms\<close>
 
 lemma is_Pow_closed : "\<lbrakk> M(r);is_Pow(M,r,d) \<rbrakk> \<Longrightarrow> M(d)"
   unfolding is_Pow_def by simp
 
 lemma Pow_rel_closed[intro,simp]: "M(r) \<Longrightarrow> M(Pow_rel(M,r))"
   unfolding Pow_rel_def
   using is_Pow_closed theI[OF ex1I[of "\<lambda>d. is_Pow(M,r,d)"], OF _ is_Pow_uniqueness[of r]]
     is_Pow_witness
   by fastforce
 
 lemmas trans_Pow_rel_closed[trans_closed] = transM[OF _ Pow_rel_closed]
 
 text\<open>The proof of \<^term>\<open>f_rel_iff\<close> lemma is schematic and it can reused by copy-paste
      replacing appropriately.\<close>
 
 lemma Pow_rel_iff:
   assumes "M(r)"  "M(d)"
   shows "is_Pow(M,r,d) \<longleftrightarrow> d = Pow_rel(M,r)"
 proof (intro iffI)
   assume "d = Pow_rel(M,r)"
   with assms
   show "is_Pow(M, r, d)"
     using is_Pow_uniqueness[of r] is_Pow_witness
       theI[OF ex1I[of "\<lambda>d. is_Pow(M,r,d)"], OF _ is_Pow_uniqueness[of r]]
     unfolding Pow_rel_def
     by auto
 next
   assume "is_Pow(M, r, d)"
   with assms
   show "d = Pow_rel(M,r)"
     using is_Pow_uniqueness unfolding Pow_rel_def
     by (auto del:the_equality intro:the_equality[symmetric])
 qed
 
 text\<open>The next "def\_" result really corresponds to @{thm Pow_iff}\<close>
 lemma def_Pow_rel: "M(A) \<Longrightarrow> M(r) \<Longrightarrow> A\<in>Pow_rel(M,r) \<longleftrightarrow> A \<subseteq> r"
   using Pow_rel_iff[OF _ Pow_rel_closed, of r r]
   unfolding is_Pow_def by simp
 
 lemma Pow_rel_char: "M(r) \<Longrightarrow> Pow_rel(M,r) = {A\<in>Pow(r). M(A)}"
 proof -
   assume "M(r)"
   moreover from this
   have "x \<in> Pow_rel(M,r) \<Longrightarrow> x\<subseteq>r" "M(x) \<Longrightarrow> x \<subseteq> r \<Longrightarrow> x \<in> Pow_rel(M,r)" for x
     using def_Pow_rel by (auto intro!:trans_Pow_rel_closed)
   ultimately
   show ?thesis
     using trans_Pow_rel_closed by blast
 qed
 
 lemma mem_Pow_rel_abs: "M(a) \<Longrightarrow> M(r) \<Longrightarrow> a \<in> Pow_rel(M,r) \<longleftrightarrow> a \<in> Pow(r)"
   using Pow_rel_char by simp
 
 end \<comment> \<open>\<^locale>\<open>M_basic_no_repl\<close>\<close>
 
 (******************  end Discipline  **********************)
 
 
 (**********************************************************)
 subsection\<open>Discipline for \<^term>\<open>PiP\<close>\<close>
 
 definition
   PiP_rel:: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
   "PiP_rel(M,A,f) \<equiv> \<exists>df[M]. is_domain(M,f,df) \<and> subset(M,A,df) \<and>
                              is_function(M,f)"
 
 context M_basic
 begin
 
 lemma def_PiP_rel:
   assumes
     "M(A)" "M(f)"
   shows
     "PiP_rel(M,A,f) \<longleftrightarrow> A \<subseteq> domain(f) \<and> function(f)"
   using assms unfolding PiP_rel_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
 
 (******************  end Discipline  **********************)
 
 (*
 Sigma(A,B) == \<Union>x\<in>A. \<Union>y\<in>B(x). {\<langle>x,y\<rangle>}
            == \<Union> {  (\<Union>y\<in>B(x). {\<langle>x,y\<rangle>})  . x\<in>A}
            == \<Union> {  (\<Union>y\<in>B(x). {\<langle>x,y\<rangle>})  . x\<in>A}
            == \<Union> {  ( \<Union> { {\<langle>x,y\<rangle>} . y\<in>B(x)} )  . x\<in>A}
                      ----------------------
                            Sigfun(x,B)
 *)
 
 definition \<comment> \<open>FIX THIS: not completely relational. Can it be?\<close>
   Sigfun :: "[i,i\<Rightarrow>i]\<Rightarrow>i"  where
   "Sigfun(x,B) \<equiv> \<Union>y\<in>B(x). {\<langle>x,y\<rangle>}"
 
 lemma Sigma_Sigfun: "Sigma(A,B) = \<Union> {Sigfun(x,B) . x\<in>A}"
   unfolding Sigma_def Sigfun_def ..
 
 definition \<comment> \<open>FIX THIS: not completely relational. Can it be?\<close>
   is_Sigfun :: "[i\<Rightarrow>o,i,i\<Rightarrow>i,i]\<Rightarrow>o"  where
   "is_Sigfun(M,x,B,Sd) \<equiv> M(Sd) \<and> (\<exists>RB[M]. is_Replace(M,B(x),\<lambda>y z. z={\<langle>x,y\<rangle>},RB)
                          \<and> big_union(M,RB,Sd))"
 
 
 context M_trivial
 begin
 
 lemma is_Sigfun_abs:
   assumes
     "strong_replacement(M,\<lambda>y z. z={\<langle>x,y\<rangle>})"
     "M(x)" "M(B(x))" "M(Sd)"
   shows
     "is_Sigfun(M,x,B,Sd) \<longleftrightarrow> Sd = Sigfun(x,B)"
 proof -
   have "\<Union>{z . y \<in> B(x), z = {\<langle>x, y\<rangle>}} = (\<Union>y\<in>B(x). {\<langle>x, y\<rangle>})" by auto
   then
   show ?thesis
     using assms transM[OF _ \<open>M(B(x))\<close>] Replace_abs
     unfolding is_Sigfun_def Sigfun_def by auto
 qed
 
 lemma Sigfun_closed:
   assumes
     "strong_replacement(M, \<lambda>y z. y \<in> B(x) \<and> z = {\<langle>x, y\<rangle>})"
     "M(x)" "M(B(x))"
   shows
     "M(Sigfun(x,B))"
   using assms transM[OF _ \<open>M(B(x))\<close>] RepFun_closed2
   unfolding Sigfun_def by simp
 
 lemmas trans_Sigfun_closed[trans_closed] = transM[OF _ Sigfun_closed]
 
 end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
 
 definition
   is_Sigma :: "[i\<Rightarrow>o,i,i\<Rightarrow>i,i]\<Rightarrow>o"  where
   "is_Sigma(M,A,B,S) \<equiv> M(S) \<and> (\<exists>RSf[M].
       is_Replace(M,A,\<lambda>x z. z=Sigfun(x,B),RSf) \<and> big_union(M,RSf,S))"
 
 locale M_Pi = M_basic +
   assumes
     Pi_separation: "M(A) \<Longrightarrow> separation(M, PiP_rel(M,A))"
     and
     Pi_replacement:
     "M(x) \<Longrightarrow> M(y) \<Longrightarrow>
       strong_replacement(M, \<lambda>ya z. ya \<in> y \<and> z = {\<langle>x, ya\<rangle>})"
     "M(y) \<Longrightarrow>
       strong_replacement(M, \<lambda>x z. z = (\<Union>xa\<in>y. {\<langle>x, xa\<rangle>}))"
 
 locale M_Pi_assumptions = M_Pi +
   fixes A B
   assumes
     Pi_assumptions:
     "M(A)"
     "\<And>x. x\<in>A \<Longrightarrow>  M(B(x))"
     "\<forall>x\<in>A. strong_replacement(M, \<lambda>y z. y \<in> B(x) \<and> z = {\<langle>x, y\<rangle>})"
     "strong_replacement(M,\<lambda>x z. z=Sigfun(x,B))"
 begin
 
 lemma Sigma_abs[simp]:
   assumes
     "M(S)"
   shows
     "is_Sigma(M,A,B,S) \<longleftrightarrow> S = Sigma(A,B)"
 proof -
   have "\<Union>{z . x \<in> A, z = Sigfun(x, B)} = (\<Union>x\<in>A. Sigfun(x, B))"
     by auto
   with assms
   show ?thesis
     using Replace_abs[of A _ "\<lambda>x z. z=Sigfun(x,B)"]
       Sigfun_closed Sigma_Sigfun[of A B] transM[of _ A]
       Pi_assumptions is_Sigfun_abs
     unfolding is_Sigma_def by simp
 qed
 
 lemma Sigma_closed[intro,simp]: "M(Sigma(A,B))"
 proof -
   have "(\<Union>x\<in>A. Sigfun(x, B)) = \<Union>{z . x \<in> A, z = Sigfun(x, B)}"
     by auto
   then
   show ?thesis
     using Sigma_Sigfun[of A B] transM[of _ A]
       Sigfun_closed Pi_assumptions
     by simp
 qed
 
 lemmas trans_Sigma_closed[trans_closed] = transM[OF _ Sigma_closed]
 
 end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions\<close>\<close>
 
 (**********************************************************)
 subsection\<open>Discipline for \<^term>\<open>Pi\<close>\<close>
 
 definition (* completely relational *)
   is_Pi :: "[i\<Rightarrow>o,i,i\<Rightarrow>i,i]\<Rightarrow>o"  where
   "is_Pi(M,A,B,I) \<equiv> M(I) \<and> (\<exists>S[M]. \<exists>PS[M]. is_Sigma(M,A,B,S) \<and>
        is_Pow(M,S,PS) \<and>
        is_Collect(M,PS,PiP_rel(M,A),I))"
 
 definition
   Pi_rel :: "[i\<Rightarrow>o,i,i\<Rightarrow>i] \<Rightarrow> i"  (\<open>Pi\<^bsup>_\<^esup>'(_,_')\<close>) where
   "Pi_rel(M,A,B) \<equiv> THE d. is_Pi(M,A,B,d)"
 
 abbreviation
   Pi_r_set ::  "[i,i,i\<Rightarrow>i] \<Rightarrow> i" (\<open>Pi\<^bsup>_\<^esup>'(_,_')\<close>) where
   "Pi_r_set(M,A,B) \<equiv> Pi_rel(##M,A,B)"
 
 
 context M_basic
 begin
 
 lemmas Pow_rel_iff = mbnr.Pow_rel_iff
 lemmas Pow_rel_char = mbnr.Pow_rel_char
 lemmas mem_Pow_rel_abs = mbnr.mem_Pow_rel_abs
 lemmas Pow_rel_closed = mbnr.Pow_rel_closed
 lemmas def_Pow_rel = mbnr.def_Pow_rel
 lemmas trans_Pow_rel_closed = mbnr.trans_Pow_rel_closed
 
 end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
 
 context M_Pi_assumptions
 begin
 
 lemma is_Pi_uniqueness:
   assumes
     "is_Pi(M,A,B,d)" "is_Pi(M,A,B,d')"
   shows
     "d=d'"
   using assms Pi_assumptions extensionality_trans
     Pow_rel_iff
   unfolding is_Pi_def by simp
 
 
 lemma is_Pi_witness: "\<exists>d[M]. is_Pi(M,A,B,d)"
   using Pow_rel_iff Pi_separation Pi_assumptions
   unfolding is_Pi_def by simp
 
 lemma is_Pi_closed : "is_Pi(M,A,B,d) \<Longrightarrow> M(d)"
   unfolding is_Pi_def by simp
 
 lemma Pi_rel_closed[intro,simp]:  "M(Pi_rel(M,A,B))"
 proof -
   have "is_Pi(M, A, B, THE xa. is_Pi(M, A, B, xa))"
     using Pi_assumptions
       theI[OF ex1I[of "is_Pi(M,A,B)"], OF _ is_Pi_uniqueness]
       is_Pi_witness is_Pi_closed
     by auto
   then show ?thesis
     using is_Pi_closed
     unfolding Pi_rel_def
     by simp
 qed
 
 \<comment> \<open>From this point on, the higher order variable \<^term>\<open>y\<close> must be
 explicitly instantiated, and proof methods are slower\<close>
 
 lemmas trans_Pi_rel_closed[trans_closed] = transM[OF _ Pi_rel_closed]
 
 lemma Pi_rel_iff:
   assumes "M(d)"
   shows "is_Pi(M,A,B,d) \<longleftrightarrow> d = Pi_rel(M,A,B)"
 proof (intro iffI)
   assume "d = Pi_rel(M,A,B)"
   moreover
   note assms
   moreover from this
   obtain e where "M(e)" "is_Pi(M,A,B,e)"
     using is_Pi_witness by blast
   ultimately
   show "is_Pi(M, A, B, d)"
     using is_Pi_uniqueness is_Pi_witness is_Pi_closed
       theI[OF ex1I[of "is_Pi(M,A,B)"], OF _ is_Pi_uniqueness, of e]
     unfolding Pi_rel_def
     by simp
 next
   assume "is_Pi(M, A, B, d)"
   with assms
   show "d = Pi_rel(M,A,B)"
     using is_Pi_uniqueness is_Pi_closed unfolding Pi_rel_def
     by (blast del:the_equality intro:the_equality[symmetric])
 qed
 
 lemma def_Pi_rel:
   "Pi_rel(M,A,B) = {f\<in>Pow_rel(M,Sigma(A,B)). A\<subseteq>domain(f) \<and> function(f)}"
 proof -
   have "Pi_rel(M,A, B) \<subseteq> Pow_rel(M,Sigma(A,B))"
     using Pi_assumptions Pi_rel_iff[of "Pi_rel(M,A,B)"] Pow_rel_iff
     unfolding is_Pi_def by auto
   moreover
   have "f \<in> Pi_rel(M,A, B) \<Longrightarrow> A\<subseteq>domain(f) \<and> function(f)" for f
     using Pi_assumptions Pi_rel_iff[of "Pi_rel(M,A,B)"]
       def_PiP_rel[of A f] trans_closed Pow_rel_iff
     unfolding is_Pi_def by simp
   moreover
   have "f \<in> Pow_rel(M,Sigma(A,B)) \<Longrightarrow> A\<subseteq>domain(f) \<and> function(f) \<Longrightarrow> f \<in> Pi_rel(M,A, B)" for f
     using Pi_rel_iff[of "Pi_rel(M,A,B)"] Pi_assumptions
       def_PiP_rel[of A f] trans_closed Pow_rel_iff
     unfolding is_Pi_def by simp
   ultimately
   show ?thesis by force
 qed
 
 lemma Pi_rel_char: "Pi_rel(M,A,B) = {f\<in>Pi(A,B). M(f)}"
   using Pi_assumptions def_Pi_rel Pow_rel_char[OF Sigma_closed] unfolding Pi_def
   by fastforce
 
 lemma mem_Pi_rel_abs:
   assumes "M(f)"
   shows  "f \<in> Pi_rel(M,A,B) \<longleftrightarrow> f \<in> Pi(A,B)"
   using assms Pi_rel_char by simp
 
 end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions\<close>\<close>
 
 text\<open>The next locale (and similar ones below) are used to
 show the relationship between versions of simple (i.e.
 $\Sigma_1^{\mathit{ZF}}$, $\Pi_1^{\mathit{ZF}}$) concepts in two
 different transitive models.\<close>
 locale M_N_Pi_assumptions = M:M_Pi_assumptions + N:M_Pi_assumptions N for N +
   assumes
     M_imp_N:"M(x) \<Longrightarrow> N(x)"
 begin
 
 lemma Pi_rel_transfer: "Pi\<^bsup>M\<^esup>(A,B) \<subseteq> Pi\<^bsup>N\<^esup>(A,B)"
   using  M.Pi_rel_char N.Pi_rel_char M_imp_N by auto
 
 end \<comment> \<open>\<^locale>\<open>M_N_Pi_assumptions\<close>\<close>
 
 
 (******************  end Discipline  **********************)
 
 locale M_Pi_assumptions_0 = M_Pi_assumptions _ 0
 begin
 
 text\<open>This is used in the proof of \<^term>\<open>AC_Pi_rel\<close>\<close>
 lemma Pi_rel_empty1[simp]: "Pi\<^bsup>M\<^esup>(0,B) = {0}"
   using Pi_assumptions Pow_rel_char
   by (unfold def_Pi_rel function_def) (auto)
 
 end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions_0\<close>\<close>
 
 context M_Pi_assumptions
 begin
 
 subsection\<open>Auxiliary ported results on \<^term>\<open>Pi_rel\<close>, now unused\<close>
 lemma Pi_rel_iff':
   assumes types:"M(f)"
   shows
     "f \<in> Pi_rel(M,A,B) \<longleftrightarrow> function(f) \<and> f \<subseteq> Sigma(A,B) \<and> A \<subseteq> domain(f)"
   using assms Pow_rel_char
   by (simp add:def_Pi_rel, blast)
 
 
 lemma lam_type_M:
   assumes "M(A)" "\<And>x. x\<in>A \<Longrightarrow>  M(B(x))"
     "\<And>x. x \<in> A \<Longrightarrow> b(x)\<in>B(x)" "strong_replacement(M,\<lambda>x y. y=\<langle>x, b(x)\<rangle>) "
   shows "(\<lambda>x\<in>A. b(x)) \<in> Pi_rel(M,A,B)"
 proof (auto simp add: lam_def def_Pi_rel function_def)
   from assms
   have "M({\<langle>x, b(x)\<rangle> . x \<in> A})"
     using Pi_assumptions transM[OF _ \<open>M(A)\<close>]
     by (rule_tac RepFun_closed, auto intro!:transM[OF _ \<open>\<And>x. x\<in>A \<Longrightarrow>  M(B(x))\<close>])
   with assms
   show "{\<langle>x, b(x)\<rangle> . x \<in> A} \<in> Pow\<^bsup>M\<^esup>(Sigma(A, B))"
     using Pow_rel_char by auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions\<close>\<close>
 
 locale M_Pi_assumptions2 = M_Pi_assumptions +
   PiC: M_Pi_assumptions _ _ C for C
 begin
 
 lemma Pi_rel_type:
   assumes "f \<in> Pi\<^bsup>M\<^esup>(A,C)" "\<And>x. x \<in> A \<Longrightarrow> f`x \<in> B(x)"
     and types: "M(f)"
   shows "f \<in> Pi\<^bsup>M\<^esup>(A,B)"
   using assms Pi_assumptions
   by (simp only: Pi_rel_iff' PiC.Pi_rel_iff')
     (blast dest: function_apply_equality)
 
 lemma Pi_rel_weaken_type:
   assumes "f \<in> Pi\<^bsup>M\<^esup>(A,B)" "\<And>x. x \<in> A \<Longrightarrow> B(x) \<subseteq> C(x)"
     and types: "M(f)"
   shows "f \<in> Pi\<^bsup>M\<^esup>(A,C)"
   using assms Pi_assumptions
   by (simp only: Pi_rel_iff' PiC.Pi_rel_iff')
     (blast intro: Pi_rel_type  dest: apply_type)
 
 end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions2\<close>\<close>
 
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Discipline_Cardinal.thy b/thys/Transitive_Models/Discipline_Cardinal.thy
--- a/thys/Transitive_Models/Discipline_Cardinal.thy
+++ b/thys/Transitive_Models/Discipline_Cardinal.thy
@@ -1,175 +1,173 @@
 theory Discipline_Cardinal
   imports
     Discipline_Function
 begin
 
-declare [[syntax_ambiguity_warning = false]]
-
 relativize functional "cardinal" "cardinal_rel" external
 relationalize "cardinal_rel" "is_cardinal"
 synthesize "is_cardinal" from_definition assuming "nonempty"
 
 notation is_cardinal_fm (\<open>cardinal'(_') is _\<close>)
 
 abbreviation
   cardinal_r :: "[i,i\<Rightarrow>o] \<Rightarrow> i" (\<open>|_|\<^bsup>_\<^esup>\<close>) where
   "|x|\<^bsup>M\<^esup> \<equiv> cardinal_rel(M,x)"
 
 abbreviation
   cardinal_r_set :: "[i,i]\<Rightarrow>i"  (\<open>|_|\<^bsup>_\<^esup>\<close>) where
   "|x|\<^bsup>M\<^esup> \<equiv> cardinal_rel(##M,x)"
 
 context M_trivial begin
 rel_closed for "cardinal"
   using Least_closed'[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"]
   unfolding cardinal_rel_def
   by simp
 end
 
 manual_arity intermediate for "is_Int_fm"
   unfolding is_Int_fm_def
   using arity pred_Un_distrib
   by (simp)
 
 arity_theorem for "is_Int_fm"
 
 arity_theorem for "is_funspace_fm"
 
 arity_theorem for "is_function_space_fm"
 
 arity_theorem for "surjP_rel_fm"
 
 arity_theorem intermediate for "is_surj_fm"
 
 lemma arity_is_surj_fm [arity] :
   "A \<in> nat \<Longrightarrow> B \<in> nat \<Longrightarrow> I \<in> nat \<Longrightarrow> arity(is_surj_fm(A, B, I)) = succ(A) \<union> succ(B) \<union> succ(I)"
   using arity_is_surj_fm' pred_Un_distrib
   by auto
 
 arity_theorem for "injP_rel_fm"
 
 arity_theorem intermediate for "is_inj_fm"
 
 lemma arity_is_inj_fm [arity]:
   "A \<in> nat \<Longrightarrow> B \<in> nat \<Longrightarrow> I \<in> nat \<Longrightarrow> arity(is_inj_fm(A, B, I)) = succ(A) \<union> succ(B) \<union> succ(I)"
   using arity_is_inj_fm' pred_Un_distrib
   by auto
 
 arity_theorem for "is_bij_fm"
 
 arity_theorem for "is_eqpoll_fm"
 
 arity_theorem for "is_cardinal_fm"
 
 context M_Perm begin
 
 is_iff_rel for "cardinal"
   using least_abs'[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"]
     is_eqpoll_iff
   unfolding is_cardinal_def cardinal_rel_def
   by simp
 end
 
 reldb_add functional "Ord" "Ord"
 reldb_add relational "Ord" "ordinal"
 reldb_add functional "lt" "lt"
 reldb_add relational "lt" "lt_rel"
 synthesize "lt_rel" from_definition
 notation lt_rel_fm (\<open>\<cdot>_ < _\<cdot>\<close>)
 arity_theorem intermediate for "lt_rel_fm"
 
 lemma arity_lt_rel_fm[arity]: "a \<in> nat \<Longrightarrow> b \<in> nat \<Longrightarrow> arity(lt_rel_fm(a, b)) = succ(a) \<union> succ(b)"
   using arity_lt_rel_fm'
   by auto
 
 relativize functional "Card" "Card_rel" external
 relationalize "Card_rel" "is_Card"
 synthesize "is_Card" from_definition assuming "nonempty"
 notation is_Card_fm (\<open>\<cdot>Card'(_')\<cdot>\<close>)
 arity_theorem for "is_Card_fm"
 
 notation Card_rel (\<open>Card\<^bsup>_\<^esup>'(_')\<close>)
 
 lemma (in M_Perm) is_Card_iff: "M(A) \<Longrightarrow> is_Card(M, A) \<longleftrightarrow> Card\<^bsup>M\<^esup>(A)"
   using is_cardinal_iff
   unfolding is_Card_def Card_rel_def by simp
 
 abbreviation
   Card_r_set  :: "[i,i]\<Rightarrow>o"  (\<open>Card\<^bsup>_\<^esup>'(_')\<close>) where
   "Card\<^bsup>M\<^esup>(i) \<equiv> Card_rel(##M,i)"
 
 relativize functional "InfCard" "InfCard_rel" external
 relationalize "InfCard_rel" "is_InfCard"
 synthesize "is_InfCard" from_definition assuming "nonempty"
 notation is_InfCard_fm (\<open>\<cdot>InfCard'(_')\<cdot>\<close>)
 arity_theorem for "is_InfCard_fm"
 
 notation InfCard_rel (\<open>InfCard\<^bsup>_\<^esup>'(_')\<close>)
 
 abbreviation
   InfCard_r_set  :: "[i,i]\<Rightarrow>o"  (\<open>InfCard\<^bsup>_\<^esup>'(_')\<close>) where
   "InfCard\<^bsup>M\<^esup>(i) \<equiv> InfCard_rel(##M,i)"
 
 relativize functional "cadd" "cadd_rel" external
 
 abbreviation
   cadd_r :: "[i,i\<Rightarrow>o,i] \<Rightarrow> i" (\<open>_ \<oplus>\<^bsup>_\<^esup> _\<close> [66,1,66] 65) where
   "A \<oplus>\<^bsup>M\<^esup> B \<equiv> cadd_rel(M,A,B)"
 
 context M_basic begin
 rel_closed for "cadd"
   using cardinal_rel_closed
   unfolding cadd_rel_def
   by simp
 end
 
 (* relativization *)
 
 relationalize "cadd_rel" "is_cadd"
 
 manual_schematic for "is_cadd" assuming "nonempty"
   unfolding is_cadd_def
   by (rule iff_sats sum_iff_sats | simp)+
 synthesize "is_cadd" from_schematic
 
 arity_theorem for "sum_fm"
 
 arity_theorem for "is_cadd_fm"
 
 context M_Perm begin
 is_iff_rel for "cadd"
   using is_cardinal_iff
   unfolding is_cadd_def cadd_rel_def
   by simp
 end
 
 relativize functional "cmult" "cmult_rel" external
 
 abbreviation
   cmult_r :: "[i,i\<Rightarrow>o,i] \<Rightarrow> i" (\<open>_ \<otimes>\<^bsup>_\<^esup> _\<close> [66,1,66] 65) where
   "A \<otimes>\<^bsup>M\<^esup> B \<equiv> cmult_rel(M,A,B)"
 
 (* relativization *)
 relationalize "cmult_rel" "is_cmult"
 
 declare cartprod_iff_sats [iff_sats]
 
 synthesize "is_cmult" from_definition assuming "nonempty"
 
 arity_theorem for "is_cmult_fm"
 
 context M_Perm begin
 
 rel_closed for "cmult"
   using cardinal_rel_closed
   unfolding cmult_rel_def
   by simp
 
 is_iff_rel for "cmult"
   using is_cardinal_iff
   unfolding is_cmult_def cmult_rel_def
   by simp
 
 end
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Discipline_Function.thy b/thys/Transitive_Models/Discipline_Function.thy
--- a/thys/Transitive_Models/Discipline_Function.thy
+++ b/thys/Transitive_Models/Discipline_Function.thy
@@ -1,917 +1,963 @@
 theory Discipline_Function
   imports
     Arities
 begin
 
 (**********************************************************)
 paragraph\<open>Discipline for \<^term>\<open>fst\<close>\<close>
 
 
 (* ftype(p) \<equiv> THE a. \<exists>b. p = \<langle>a, b\<rangle> *)
 arity_theorem for "empty_fm"
 arity_theorem for "upair_fm"
 arity_theorem for "pair_fm"
 definition
   is_fst :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
   "is_fst(M,x,t) \<equiv> (\<exists>z[M]. pair(M,t,z,x)) \<or>
                        (\<not>(\<exists>z[M]. \<exists>w[M]. pair(M,w,z,x)) \<and> empty(M,t))"
 synthesize "fst" from_definition "is_fst"
 notation fst_fm (\<open>\<cdot>fst'(_') is _\<cdot>\<close>)
 
 arity_theorem for "fst_fm"
 
 definition fst_rel ::  "[i\<Rightarrow>o,i] \<Rightarrow> i"  where
   "fst_rel(M,p) \<equiv> THE d. M(d) \<and> is_fst(M,p,d)"
 
 reldb_add relational "fst" "is_fst"
 reldb_add functional "fst" "fst_rel"
 
 definition
   is_snd :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
   "is_snd(M,x,t) \<equiv> (\<exists>z[M]. pair(M,z,t,x)) \<or>
                        (\<not>(\<exists>z[M]. \<exists>w[M]. pair(M,z,w,x)) \<and> empty(M,t))"
 synthesize "snd" from_definition "is_snd"
 notation snd_fm (\<open>\<cdot>snd'(_') is _\<cdot>\<close>)
 arity_theorem for "snd_fm"
 
 definition snd_rel ::  "[i\<Rightarrow>o,i] \<Rightarrow> i"  where
   "snd_rel(M,p) \<equiv> THE d. M(d) \<and> is_snd(M,p,d)"
 
 
 reldb_add relational "snd" "is_snd"
 reldb_add functional "snd" "snd_rel"
 
 context M_trans
 begin
 
 lemma fst_snd_closed:
   assumes "M(p)"
   shows "M(fst(p)) \<and> M(snd(p))"
   unfolding fst_def snd_def using assms
   by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto)
 
 lemma fst_closed[intro,simp]: "M(x) \<Longrightarrow> M(fst(x))"
   using fst_snd_closed by auto
 
 lemma snd_closed[intro,simp]: "M(x) \<Longrightarrow> M(snd(x))"
   using fst_snd_closed by auto
 
 lemma fst_abs [absolut]:
   "\<lbrakk>M(p); M(x) \<rbrakk> \<Longrightarrow> is_fst(M,p,x) \<longleftrightarrow> x = fst(p)"
   unfolding is_fst_def fst_def
   by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto)
 
 lemma snd_abs [absolut]:
   "\<lbrakk>M(p); M(y) \<rbrakk> \<Longrightarrow> is_snd(M,p,y) \<longleftrightarrow> y = snd(p)"
   unfolding is_snd_def snd_def
   by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto)
 
 lemma empty_rel_abs : "M(x) \<Longrightarrow> M(0) \<Longrightarrow> x = 0 \<longleftrightarrow> x = (THE d. M(d) \<and> empty(M, d))"
   unfolding the_def
   using transM
   by auto
 
 lemma fst_rel_abs:
   assumes "M(p)"
-  shows "fst(p) = fst_rel(M,p)"
+  shows "fst_rel(M,p) = fst(p)"
   using fst_abs assms
   unfolding fst_def fst_rel_def
   by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto;rule_tac the_equality[symmetric],simp_all)
 
 lemma snd_rel_abs:
   assumes "M(p)"
-  shows "snd(p) = snd_rel(M,p)"
+  shows " snd_rel(M,p) = snd(p)"
   using snd_abs assms
   unfolding snd_def snd_rel_def
   by (cases "\<exists>a. \<exists>b. p = \<langle>a, b\<rangle>";auto;rule_tac the_equality[symmetric],simp_all)
 
 end \<comment> \<open>\<^locale>\<open>M_trans\<close>\<close>
 
 relativize functional "first" "first_rel" external
 relativize functional "minimum" "minimum_rel" external
 context M_trans
 begin
 
 lemma minimum_closed[simp,intro]:
   assumes "M(A)"
   shows "M(minimum(r,A))"
   using first_is_elem the_equality_if transM[OF _ \<open>M(A)\<close>]
   by(cases "\<exists>x . first(x,A,r)",auto simp:minimum_def)
 
 lemma first_abs :
   assumes "M(B)"
   shows "first(z,B,r) \<longleftrightarrow> first_rel(M,z,B,r)"
   unfolding first_def first_rel_def using assms by auto
 
 (* TODO: find a naming convention for absoluteness results like this.
 See notes/TODO.txt
 *)
 lemma minimum_abs:
   assumes "M(B)"
   shows "minimum(r,B) = minimum_rel(M,r,B)"
 proof -
   from assms
   have "first(b, B, r) \<longleftrightarrow> M(b) \<and> first_rel(M,b,B,r)" for b
     using first_abs
   proof (auto)
     fix b
     assume "first_rel(M,b,B,r)"
     with \<open>M(B)\<close>
     have "b\<in>B" using first_abs first_is_elem by simp
     with \<open>M(B)\<close>
     show "M(b)" using transM[OF \<open>b\<in>B\<close>] by simp
   qed
   with assms
   show ?thesis unfolding minimum_rel_def minimum_def
     by simp
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_trans\<close>\<close>
 
 subsection\<open>Discipline for \<^term>\<open>function_space\<close>\<close>
 
 definition
   is_function_space :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o"  where
   "is_function_space(M,A,B,fs) \<equiv> M(fs) \<and> is_funspace(M,A,B,fs)"
 
 definition
   function_space_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i"  where
   "function_space_rel(M,A,B) \<equiv> THE d. is_function_space(M,A,B,d)"
 
 reldb_rem absolute "Pi"
 reldb_add relational "Pi" "is_function_space"
 reldb_add functional "Pi" "function_space_rel"
 
 abbreviation
   function_space_r :: "[i,i\<Rightarrow>o,i] \<Rightarrow> i" (\<open>_ \<rightarrow>\<^bsup>_\<^esup> _\<close> [61,1,61] 60) where
   "A \<rightarrow>\<^bsup>M\<^esup> B \<equiv> function_space_rel(M,A,B)"
 
 abbreviation
   function_space_r_set ::  "[i,i,i] \<Rightarrow> i" (\<open>_ \<rightarrow>\<^bsup>_\<^esup> _\<close> [61,1,61] 60) where
   "function_space_r_set(A,M) \<equiv> function_space_rel(##M,A)"
 
 context M_Pi
 begin
 
 lemma is_function_space_uniqueness:
   assumes
     "M(r)" "M(B)"
     "is_function_space(M,r,B,d)" "is_function_space(M,r,B,d')"
   shows
     "d=d'"
   using assms extensionality_trans
   unfolding is_function_space_def is_funspace_def
   by simp
 
 lemma is_function_space_witness:
   assumes "M(A)" "M(B)"
   shows "\<exists>d[M]. is_function_space(M,A,B,d)"
 proof -
   from assms
   interpret M_Pi_assumptions M A "\<lambda>_. B"
     using Pi_replacement Pi_separation
     by unfold_locales (auto dest:transM simp add:Sigfun_def)
   have "\<forall>f[M]. f \<in> Pi_rel(M,A, \<lambda>_. B) \<longleftrightarrow> f \<in> A \<rightarrow> B"
     using Pi_rel_char by simp
   with assms
   show ?thesis unfolding is_funspace_def is_function_space_def by auto
 qed
 
 lemma is_function_space_closed :
   "is_function_space(M,A,B,d) \<Longrightarrow> M(d)"
   unfolding is_function_space_def by simp
 
 \<comment> \<open>adding closure to simpset and claset\<close>
 lemma function_space_rel_closed[intro,simp]:
   assumes "M(x)" "M(y)"
   shows "M(function_space_rel(M,x,y))"
 proof -
   have "is_function_space(M, x, y, THE xa. is_function_space(M, x, y, xa))"
     using assms
       theI[OF ex1I[of "is_function_space(M,x,y)"], OF _ is_function_space_uniqueness[of x y]]
       is_function_space_witness
     by auto
   then show ?thesis
     using assms is_function_space_closed
     unfolding function_space_rel_def
     by blast
 qed
 
 lemmas trans_function_space_rel_closed[trans_closed] = transM[OF _ function_space_rel_closed]
 
 lemma is_function_space_iff:
   assumes "M(x)" "M(y)" "M(d)"
   shows "is_function_space(M,x,y,d) \<longleftrightarrow> d = function_space_rel(M,x,y)"
 proof (intro iffI)
   assume "d = function_space_rel(M,x,y)"
   moreover
   note assms
   moreover from this
   obtain e where "M(e)" "is_function_space(M,x,y,e)"
     using is_function_space_witness by blast
   ultimately
   show "is_function_space(M, x, y, d)"
     using is_function_space_uniqueness[of x y] is_function_space_witness
       theI[OF ex1I[of "is_function_space(M,x,y)"], OF _ is_function_space_uniqueness[of x y], of e]
     unfolding function_space_rel_def
     by auto
 next
   assume "is_function_space(M, x, y, d)"
   with assms
   show "d = function_space_rel(M,x,y)"
     using is_function_space_uniqueness unfolding function_space_rel_def
     by (blast del:the_equality intro:the_equality[symmetric])
 qed
 
 
 lemma def_function_space_rel:
   assumes "M(A)" "M(y)"
   shows "function_space_rel(M,A,y) = Pi_rel(M,A,\<lambda>_. y)"
 proof -
   from assms
   interpret M_Pi_assumptions M A "\<lambda>_. y"
     using Pi_replacement Pi_separation
     by unfold_locales (auto dest:transM simp add:Sigfun_def)
   from assms
   have "x\<in>function_space_rel(M,A,y) \<longleftrightarrow> x\<in>Pi_rel(M,A,\<lambda>_. y)" if "M(x)" for x
     using that
       is_function_space_iff[of A y, OF _ _ function_space_rel_closed, of A y]
       def_Pi_rel Pi_rel_char mbnr.Pow_rel_char
     unfolding is_function_space_def is_funspace_def by (simp add:Pi_def)
   with assms
   show ?thesis \<comment> \<open>At this point, quoting "trans\_rules" doesn't work\<close>
     using transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(y)\<close>]
       transM[OF _ Pi_rel_closed] by blast
 qed
 
 lemma function_space_rel_char:
   assumes "M(A)" "M(y)"
   shows "function_space_rel(M,A,y) = {f \<in> A \<rightarrow> y. M(f)}"
 proof -
   from assms
   interpret M_Pi_assumptions M A "\<lambda>_. y"
     using Pi_replacement Pi_separation
     by unfold_locales (auto dest:transM simp add:Sigfun_def)
   show ?thesis
     using assms def_function_space_rel Pi_rel_char
     by simp
 qed
 
 lemma mem_function_space_rel_abs:
   assumes "M(A)" "M(y)" "M(f)"
   shows "f \<in> function_space_rel(M,A,y) \<longleftrightarrow>  f \<in> A \<rightarrow> y"
   using assms function_space_rel_char by simp
 
 end \<comment> \<open>\<^locale>\<open>M_Pi\<close>\<close>
 
 locale M_N_Pi = M:M_Pi + N:M_Pi N for N +
   assumes
     M_imp_N:"M(x) \<Longrightarrow> N(x)"
 begin
 
 lemma function_space_rel_transfer: "M(A) \<Longrightarrow> M(B) \<Longrightarrow>
                           function_space_rel(M,A,B) \<subseteq> function_space_rel(N,A,B)"
   using M.function_space_rel_char N.function_space_rel_char
   by (auto dest!:M_imp_N)
 
 end \<comment> \<open>\<^locale>\<open>M_N_Pi\<close>\<close>
 
 (*****************  end Discipline  ***********************)
 
 abbreviation
   "is_apply \<equiv> fun_apply"
   \<comment> \<open>It is not necessary to perform the Discipline for \<^term>\<open>is_apply\<close>
   since it is absolute in this context\<close>
 
 subsection\<open>Discipline for \<^term>\<open>Collect\<close> terms.\<close>
 
 text\<open>We have to isolate the predicate involved and apply the
 Discipline to it.\<close>
 
 (*************** Discipline for injP ******************)
 
 
 definition (* completely relational *)
   injP_rel:: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" where
   "injP_rel(M,A,f) \<equiv> \<forall>w[M]. \<forall>x[M]. \<forall>fw[M]. \<forall>fx[M]. w\<in>A \<and> x\<in>A \<and>
             is_apply(M,f,w,fw) \<and> is_apply(M,f,x,fx) \<and> fw=fx\<longrightarrow> w=x"
 
 synthesize "injP_rel" from_definition assuming "nonempty"
 
 arity_theorem for "injP_rel_fm"
 
 context M_basic
 begin
 
 \<comment> \<open>I'm undecided on keeping the relative quantifiers here.
     Same with \<^term>\<open>surjP\<close> below. It might relieve from changing
     @{thm exI allI} to @{thm rexI rallI} in some proofs.
     I wonder if this escalates well. Assuming that all terms
     appearing in the "def\_" theorem are in \<^term>\<open>M\<close> and using
     @{thm transM}, it might do.\<close>
 lemma def_injP_rel:
   assumes
     "M(A)" "M(f)"
   shows
     "injP_rel(M,A,f) \<longleftrightarrow> (\<forall>w[M]. \<forall>x[M]. w\<in>A \<and> x\<in>A \<and> f`w=f`x \<longrightarrow> w=x)"
   using assms unfolding injP_rel_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
 
 (******************  end Discipline  **********************)
 
 (**********************************************************)
 subsection\<open>Discipline for \<^term>\<open>inj\<close>\<close>
 
 definition (* completely relational *)
   is_inj   :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o"  where
   "is_inj(M,A,B,I) \<equiv> M(I) \<and> (\<exists>F[M]. is_function_space(M,A,B,F) \<and>
        is_Collect(M,F,injP_rel(M,A),I))"
 
 
 declare typed_function_iff_sats Collect_iff_sats [iff_sats]
 
 synthesize "is_funspace" from_definition assuming "nonempty"
 arity_theorem for "is_funspace_fm"
 
 synthesize "is_function_space" from_definition assuming "nonempty"
 notation is_function_space_fm (\<open>\<cdot>_ \<rightarrow> _ is _\<cdot>\<close>)
 
 arity_theorem for "is_function_space_fm"
 
 synthesize "is_inj" from_definition assuming "nonempty"
 notation is_inj_fm (\<open>\<cdot>inj'(_,_') is _\<cdot>\<close>)
 
 arity_theorem intermediate for "is_inj_fm"
 
 lemma arity_is_inj_fm[arity]:
   "A \<in> nat \<Longrightarrow>
     B \<in> nat \<Longrightarrow> I \<in> nat \<Longrightarrow> arity(is_inj_fm(A, B, I)) = succ(A) \<union> succ(B) \<union> succ(I)"
   using arity_is_inj_fm' by (auto simp:pred_Un_distrib arity)
 
 definition
   inj_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>inj\<^bsup>_\<^esup>'(_,_')\<close>) where
   "inj_rel(M,A,B) \<equiv> THE d. is_inj(M,A,B,d)"
 
 abbreviation
   inj_r_set ::  "[i,i,i] \<Rightarrow> i" (\<open>inj\<^bsup>_\<^esup>'(_,_')\<close>) where
   "inj_r_set(M) \<equiv> inj_rel(##M)"
 
 locale M_inj = M_Pi +
   assumes
     injP_separation: "M(r) \<Longrightarrow> separation(M,injP_rel(M, r))"
 begin
 
 lemma is_inj_uniqueness:
   assumes
     "M(r)" "M(B)"
     "is_inj(M,r,B,d)" "is_inj(M,r,B,d')"
   shows
     "d=d'"
   using assms is_function_space_iff extensionality_trans
   unfolding is_inj_def by simp
 
 lemma is_inj_witness: "M(r) \<Longrightarrow> M(B)\<Longrightarrow> \<exists>d[M]. is_inj(M,r,B,d)"
   using injP_separation is_function_space_iff
   unfolding is_inj_def by simp
 
 lemma is_inj_closed :
   "is_inj(M,x,y,d) \<Longrightarrow> M(d)"
   unfolding is_inj_def by simp
 
 lemma inj_rel_closed[intro,simp]:
   assumes "M(x)" "M(y)"
   shows "M(inj_rel(M,x,y))"
 proof -
   have "is_inj(M, x, y, THE xa. is_inj(M, x, y, xa))"
     using assms
       theI[OF ex1I[of "is_inj(M,x,y)"], OF _ is_inj_uniqueness[of x y]]
       is_inj_witness
     by auto
   then show ?thesis
     using assms is_inj_closed
     unfolding inj_rel_def
     by blast
 qed
 
 lemmas trans_inj_rel_closed[trans_closed] = transM[OF _ inj_rel_closed]
 
 lemma inj_rel_iff:
   assumes "M(x)" "M(y)" "M(d)"
   shows "is_inj(M,x,y,d) \<longleftrightarrow> d = inj_rel(M,x,y)"
 proof (intro iffI)
   assume "d = inj_rel(M,x,y)"
   moreover
   note assms
   moreover from this
   obtain e where "M(e)" "is_inj(M,x,y,e)"
     using is_inj_witness by blast
   ultimately
   show "is_inj(M, x, y, d)"
     using is_inj_uniqueness[of x y] is_inj_witness
       theI[OF ex1I[of "is_inj(M,x,y)"], OF _ is_inj_uniqueness[of x y], of e]
     unfolding inj_rel_def
     by auto
 next
   assume "is_inj(M, x, y, d)"
   with assms
   show "d = inj_rel(M,x,y)"
     using is_inj_uniqueness unfolding inj_rel_def
     by (blast del:the_equality intro:the_equality[symmetric])
 qed
 
 lemma def_inj_rel:
   assumes "M(A)" "M(B)"
   shows "inj_rel(M,A,B) =
          {f \<in> function_space_rel(M,A,B).  \<forall>w[M]. \<forall>x[M]. w\<in>A \<and> x\<in>A \<and> f`w = f`x \<longrightarrow> w=x}"
     (is "_ = Collect(_,?P)")
 proof -
   from assms
   have "inj_rel(M,A,B) \<subseteq> function_space_rel(M,A,B)"
     using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff
     unfolding is_inj_def by auto
   moreover from assms
   have "f \<in> inj_rel(M,A,B) \<Longrightarrow> ?P(f)" for f
     using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff
       def_injP_rel transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(B)\<close>]
     unfolding is_inj_def by auto
   moreover from assms
   have "f \<in> function_space_rel(M,A,B) \<Longrightarrow> ?P(f) \<Longrightarrow> f \<in> inj_rel(M,A,B)" for f
     using inj_rel_iff[of A B "inj_rel(M,A,B)"] is_function_space_iff
       def_injP_rel transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(B)\<close>]
     unfolding is_inj_def by auto
   ultimately
   show ?thesis by force
 qed
 
 lemma inj_rel_char:
   assumes "M(A)" "M(B)"
   shows "inj_rel(M,A,B) = {f \<in> inj(A,B). M(f)}"
 proof -
   from assms
   interpret M_Pi_assumptions M A "\<lambda>_. B"
     using Pi_replacement Pi_separation
     by unfold_locales (auto dest:transM simp add:Sigfun_def)
   from assms
   show ?thesis
     using def_inj_rel[OF assms] def_function_space_rel[OF assms]
       transM[OF _ \<open>M(A)\<close>] Pi_rel_char
     unfolding inj_def
     by auto
 qed
 
 
 end \<comment> \<open>\<^locale>\<open>M_inj\<close>\<close>
 
 locale M_N_inj = M:M_inj + N:M_inj N for N +
   assumes
     M_imp_N:"M(x) \<Longrightarrow> N(x)"
 begin
 
 lemma inj_rel_transfer: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> inj_rel(M,A,B) \<subseteq> inj_rel(N,A,B)"
   using M.inj_rel_char N.inj_rel_char
   by (auto dest!:M_imp_N)
 
 end \<comment> \<open>\<^locale>\<open>M_N_inj\<close>\<close>
 
 
 (***************  end Discipline  *********************)
 
 (*************** Discipline for surjP ******************)
 
 definition
   surjP_rel:: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
   "surjP_rel(M,A,B,f) \<equiv>
     \<forall>y[M]. \<exists>x[M]. \<exists>fx[M]. y\<in>B \<longrightarrow> x\<in>A \<and> is_apply(M,f,x,fx) \<and> fx=y"
 
 synthesize "surjP_rel" from_definition assuming "nonempty"
 
 context M_basic
 begin
 
 lemma def_surjP_rel:
   assumes
     "M(A)" "M(B)" "M(f)"
   shows
     "surjP_rel(M,A,B,f) \<longleftrightarrow> (\<forall>y[M]. \<exists>x[M]. y\<in>B \<longrightarrow> x\<in>A \<and> f`x=y)"
   using assms unfolding surjP_rel_def by auto
 
 end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
 
 (******************  end Discipline  **********************)
 
 (**********************************************************)
 subsection\<open>Discipline for \<^term>\<open>surj\<close>\<close>
 
 definition (* completely relational *)
   is_surj   :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o"  where
   "is_surj(M,A,B,I) \<equiv> M(I) \<and> (\<exists>F[M]. is_function_space(M,A,B,F) \<and>
        is_Collect(M,F,surjP_rel(M,A,B),I))"
 
 synthesize "is_surj" from_definition assuming "nonempty"
 notation is_surj_fm (\<open>\<cdot>surj'(_,_') is _\<cdot>\<close>)
 
 definition
   surj_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>surj\<^bsup>_\<^esup>'(_,_')\<close>) where
   "surj_rel(M,A,B) \<equiv> THE d. is_surj(M,A,B,d)"
 
 abbreviation
   surj_r_set ::  "[i,i,i] \<Rightarrow> i" (\<open>surj\<^bsup>_\<^esup>'(_,_')\<close>) where
   "surj_r_set(M) \<equiv> surj_rel(##M)"
 
 locale M_surj = M_Pi +
   assumes
     surjP_separation: "M(A)\<Longrightarrow>M(B)\<Longrightarrow>separation(M,\<lambda>x. surjP_rel(M,A,B,x))"
 begin
 
 lemma is_surj_uniqueness:
   assumes
     "M(r)" "M(B)"
     "is_surj(M,r,B,d)" "is_surj(M,r,B,d')"
   shows
     "d=d'"
   using assms is_function_space_iff extensionality_trans
   unfolding is_surj_def by simp
 
 lemma is_surj_witness: "M(r) \<Longrightarrow> M(B)\<Longrightarrow> \<exists>d[M]. is_surj(M,r,B,d)"
   using surjP_separation is_function_space_iff
   unfolding is_surj_def by simp
 
 lemma is_surj_closed :
   "is_surj(M,x,y,d) \<Longrightarrow> M(d)"
   unfolding is_surj_def by simp
 
 lemma surj_rel_closed[intro,simp]:
   assumes "M(x)" "M(y)"
   shows "M(surj_rel(M,x,y))"
 proof -
   have "is_surj(M, x, y, THE xa. is_surj(M, x, y, xa))"
     using assms
       theI[OF ex1I[of "is_surj(M,x,y)"], OF _ is_surj_uniqueness[of x y]]
       is_surj_witness
     by auto
   then show ?thesis
     using assms is_surj_closed
     unfolding surj_rel_def
     by blast
 qed
 
 lemmas trans_surj_rel_closed[trans_closed] = transM[OF _ surj_rel_closed]
 
 lemma surj_rel_iff:
   assumes "M(x)" "M(y)" "M(d)"
   shows "is_surj(M,x,y,d) \<longleftrightarrow> d = surj_rel(M,x,y)"
 proof (intro iffI)
   assume "d = surj_rel(M,x,y)"
   moreover
   note assms
   moreover from this
   obtain e where "M(e)" "is_surj(M,x,y,e)"
     using is_surj_witness by blast
   ultimately
   show "is_surj(M, x, y, d)"
     using is_surj_uniqueness[of x y] is_surj_witness
       theI[OF ex1I[of "is_surj(M,x,y)"], OF _ is_surj_uniqueness[of x y], of e]
     unfolding surj_rel_def
     by auto
 next
   assume "is_surj(M, x, y, d)"
   with assms
   show "d = surj_rel(M,x,y)"
     using is_surj_uniqueness unfolding surj_rel_def
     by (blast del:the_equality intro:the_equality[symmetric])
 qed
 
 lemma def_surj_rel:
   assumes "M(A)" "M(B)"
   shows "surj_rel(M,A,B) =
          {f \<in> function_space_rel(M,A,B). \<forall>y[M]. \<exists>x[M]. y\<in>B \<longrightarrow> x\<in>A \<and> f`x=y }"
     (is "_ = Collect(_,?P)")
 proof -
   from assms
   have "surj_rel(M,A,B) \<subseteq> function_space_rel(M,A,B)"
     using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff
     unfolding is_surj_def by auto
   moreover from assms
   have "f \<in> surj_rel(M,A,B) \<Longrightarrow> ?P(f)" for f
     using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff
       def_surjP_rel transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(B)\<close>]
     unfolding is_surj_def by auto
   moreover from assms
   have "f \<in> function_space_rel(M,A,B) \<Longrightarrow> ?P(f) \<Longrightarrow> f \<in> surj_rel(M,A,B)" for f
     using surj_rel_iff[of A B "surj_rel(M,A,B)"] is_function_space_iff
       def_surjP_rel transM[OF _ function_space_rel_closed, OF _ \<open>M(A)\<close> \<open>M(B)\<close>]
     unfolding is_surj_def by auto
   ultimately
   show ?thesis by force
 qed
 
 lemma surj_rel_char:
   assumes "M(A)" "M(B)"
   shows "surj_rel(M,A,B) = {f \<in> surj(A,B). M(f)}"
 proof -
   from assms
   interpret M_Pi_assumptions M A "\<lambda>_. B"
     using Pi_replacement Pi_separation
     by unfold_locales (auto dest:transM simp add:Sigfun_def)
   from assms
   show ?thesis
     using def_surj_rel[OF assms] def_function_space_rel[OF assms]
       transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>] Pi_rel_char
     unfolding surj_def
     by auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_surj\<close>\<close>
 
 locale M_N_surj = M:M_surj + N:M_surj N for N +
   assumes
     M_imp_N:"M(x) \<Longrightarrow> N(x)"
 begin
 
 lemma surj_rel_transfer: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> surj_rel(M,A,B) \<subseteq> surj_rel(N,A,B)"
   using M.surj_rel_char N.surj_rel_char
   by (auto dest!:M_imp_N)
 
 end \<comment> \<open>\<^locale>\<open>M_N_surj\<close>\<close>
 
 (***************  end Discipline  *********************)
 
 definition
   is_Int :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o"  where
   "is_Int(M,A,B,I) \<equiv> M(I) \<and> (\<forall>x[M]. x \<in> I \<longleftrightarrow> x \<in> A \<and> x \<in> B)"
 
 reldb_rem relational "inter"
 reldb_add absolute relational "ZF_Base.Int" "is_Int"
 
 synthesize "is_Int" from_definition assuming "nonempty"
 notation is_Int_fm (\<open>_ \<inter> _ is _\<close>)
 
 context M_basic
 begin
 
 lemma is_Int_closed :
   "is_Int(M,A,B,I) \<Longrightarrow> M(I)"
   unfolding is_Int_def by simp
 
 lemma is_Int_abs:
   assumes
     "M(A)" "M(B)" "M(I)"
   shows
     "is_Int(M,A,B,I) \<longleftrightarrow> I = A \<inter> B"
   using assms transM[OF _ \<open>M(B)\<close>] transM[OF _ \<open>M(I)\<close>]
   unfolding is_Int_def by blast
 
 lemma is_Int_uniqueness:
   assumes
     "M(r)" "M(B)"
     "is_Int(M,r,B,d)" "is_Int(M,r,B,d')"
   shows
     "d=d'"
 proof -
   have "M(d)" and "M(d')"
     using assms is_Int_closed by simp+
   then show ?thesis
     using assms is_Int_abs by simp
 qed
 
 text\<open>Note: @{thm Int_closed} already in \<^theory>\<open>ZF-Constructible.Relative\<close>.\<close>
 
 end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
 
 (**********************************************************)
 subsection\<open>Discipline for \<^term>\<open>bij\<close>\<close>
 
 reldb_add functional "inj" "inj_rel"
 reldb_add functional relational "inj_rel" "is_inj"
 reldb_add functional "surj" "surj_rel"
 reldb_add functional relational "surj_rel" "is_surj"
 relativize functional "bij" "bij_rel" external
 relationalize "bij_rel" "is_bij"
 
 (* definition (* completely relational *)
   is_bij   :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o"  where
   "is_bij(M,A,B,bj) \<equiv> M(bj) \<and> is_hcomp2_2(M,is_Int,is_inj,is_surj,A,B,bj)"
 
 definition
   bij_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>bij\<^bsup>_\<^esup>'(_,_')\<close>) where
   "bij_rel(M,A,B) \<equiv> THE d. is_bij(M,A,B,d)" *)
 
 synthesize "is_bij" from_definition assuming "nonempty"
 notation is_bij_fm (\<open>\<cdot>bij'(_,_') is _\<cdot>\<close>)
 
 abbreviation
   bij_r_class ::  "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>bij\<^bsup>_\<^esup>'(_,_')\<close>) where
   "bij_r_class \<equiv> bij_rel"
 
 abbreviation
   bij_r_set ::  "[i,i,i] \<Rightarrow> i" (\<open>bij\<^bsup>_\<^esup>'(_,_')\<close>) where
   "bij_r_set(M) \<equiv> bij_rel(##M)"
 
 locale M_Perm = M_Pi + M_inj + M_surj
 begin
 
 lemma is_bij_closed : "is_bij(M,f,y,d) \<Longrightarrow> M(d)"
   unfolding is_bij_def using is_Int_closed is_inj_witness is_surj_witness by auto
 
 lemma bij_rel_closed[intro,simp]:
   assumes "M(x)" "M(y)"
   shows "M(bij_rel(M,x,y))"
   unfolding bij_rel_def
   using assms Int_closed surj_rel_closed inj_rel_closed
   by auto
 
 lemmas trans_bij_rel_closed[trans_closed] = transM[OF _ bij_rel_closed]
 
 lemma bij_rel_iff:
   assumes "M(x)" "M(y)" "M(d)"
   shows "is_bij(M,x,y,d) \<longleftrightarrow> d = bij_rel(M,x,y)"
   unfolding is_bij_def bij_rel_def
   using assms surj_rel_iff inj_rel_iff is_Int_abs
   by auto
 
 lemma def_bij_rel:
   assumes "M(A)" "M(B)"
   shows "bij_rel(M,A,B) = inj_rel(M,A,B) \<inter> surj_rel(M,A,B)"
   using assms bij_rel_iff inj_rel_iff surj_rel_iff
     is_Int_abs\<comment> \<open>For absolute terms, "\_abs" replaces "\_iff".
                  Also, in this case "\_closed" is in the simpset.\<close>
   unfolding is_bij_def by simp
 
 lemma bij_rel_char:
   assumes "M(A)" "M(B)"
   shows "bij_rel(M,A,B) = {f \<in> bij(A,B). M(f)}"
   using assms def_bij_rel inj_rel_char surj_rel_char
   unfolding bij_def\<comment> \<open>Unfolding this might be a pattern already\<close>
   by auto
 
 end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
 
 locale M_N_Perm = M_N_Pi + M_N_inj + M_N_surj + M:M_Perm + N:M_Perm N
 
 begin
 
 lemma bij_rel_transfer: "M(A) \<Longrightarrow> M(B) \<Longrightarrow> bij_rel(M,A,B) \<subseteq> bij_rel(N,A,B)"
   using M.bij_rel_char N.bij_rel_char
   by (auto dest!:M_imp_N)
 
 end \<comment> \<open>\<^locale>\<open>M_N_Perm\<close>\<close>
 
 (***************  end Discipline  *********************)
 
+context M_Perm
+begin
+
+lemma mem_bij_rel: "\<lbrakk>f \<in> bij\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f\<in>bij(A,B)"
+  using bij_rel_char by simp
+
+lemma mem_inj_rel: "\<lbrakk>f \<in> inj\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f\<in>inj(A,B)"
+  using inj_rel_char by simp
+
+lemma mem_surj_rel: "\<lbrakk>f \<in> surj\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f\<in>surj(A,B)"
+  using surj_rel_char by simp
+
+end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
+
 (******************************************************)
 subsection\<open>Discipline for \<^term>\<open>eqpoll\<close>\<close>
 
 relativize functional "eqpoll" "eqpoll_rel" external
 relationalize "eqpoll_rel" "is_eqpoll"
 
 synthesize "is_eqpoll" from_definition assuming "nonempty"
 arity_theorem for "is_eqpoll_fm"
 notation is_eqpoll_fm (\<open>\<cdot>_ \<approx> _\<cdot>\<close>)
 
 context M_Perm begin
 
 is_iff_rel for "eqpoll"
   using bij_rel_iff unfolding is_eqpoll_def eqpoll_rel_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
 
 abbreviation
   eqpoll_r :: "[i,i\<Rightarrow>o,i] => o" (\<open>_ \<approx>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
   "A \<approx>\<^bsup>M\<^esup> B \<equiv> eqpoll_rel(M,A,B)"
 
 abbreviation
   eqpoll_r_set ::  "[i,i,i] \<Rightarrow> o" (\<open>_ \<approx>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
   "eqpoll_r_set(A,M) \<equiv> eqpoll_rel(##M,A)"
 
 context M_Perm
 begin
 
 lemma def_eqpoll_rel:
   assumes
     "M(A)" "M(B)"
   shows
     "eqpoll_rel(M,A,B) \<longleftrightarrow> (\<exists>f[M]. f \<in> bij_rel(M,A,B))"
   using assms bij_rel_iff
   unfolding eqpoll_rel_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
 
 context M_N_Perm
 begin
 
 (* the next lemma is not part of the discipline *)
 lemma eqpoll_rel_transfer: assumes "A \<approx>\<^bsup>M\<^esup> B" "M(A)" "M(B)"
   shows "A \<approx>\<^bsup>N\<^esup> B"
 proof -
   note assms
   moreover from this
   obtain f where "f \<in> bij\<^bsup>M\<^esup>(A,B)" "N(f)"
     using M.def_eqpoll_rel by (auto dest!:M_imp_N)
   moreover from calculation
   have "f \<in> bij\<^bsup>N\<^esup>(A,B)"
     using bij_rel_transfer by (auto)
   ultimately
   show ?thesis
     using N.def_eqpoll_rel by (blast dest!:M_imp_N)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_N_Perm\<close>\<close>
 
 (******************  end Discipline  ******************)
 
 (******************************************************)
 subsection\<open>Discipline for \<^term>\<open>lepoll\<close>\<close>
 
 relativize functional "lepoll" "lepoll_rel" external
 relationalize "lepoll_rel" "is_lepoll"
 
 synthesize "is_lepoll" from_definition assuming "nonempty"
 notation is_lepoll_fm (\<open>\<cdot>_ \<lesssim> _\<cdot>\<close>)
 arity_theorem for "is_lepoll_fm"
 
 context M_inj begin
 
 is_iff_rel for "lepoll"
   using inj_rel_iff unfolding is_lepoll_def lepoll_rel_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_inj\<close>\<close>
 
 abbreviation
   lepoll_r :: "[i,i\<Rightarrow>o,i] => o" (\<open>_ \<lesssim>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
   "A \<lesssim>\<^bsup>M\<^esup> B \<equiv> lepoll_rel(M,A,B)"
 
 abbreviation
   lepoll_r_set ::  "[i,i,i] \<Rightarrow> o" (\<open>_ \<lesssim>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
   "lepoll_r_set(A,M) \<equiv> lepoll_rel(##M,A)"
 
 context M_Perm
 begin
 
 lemma def_lepoll_rel:
   assumes
     "M(A)" "M(B)"
   shows
     "lepoll_rel(M,A,B) \<longleftrightarrow> (\<exists>f[M]. f \<in> inj_rel(M,A,B))"
   using assms inj_rel_iff
   unfolding lepoll_rel_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
 
 context M_N_Perm
 begin
 
 (* the next lemma is not part of the discipline *)
 lemma lepoll_rel_transfer: assumes "A \<lesssim>\<^bsup>M\<^esup> B" "M(A)" "M(B)"
   shows "A \<lesssim>\<^bsup>N\<^esup> B"
 proof -
   note assms
   moreover from this
   obtain f where "f \<in> inj\<^bsup>M\<^esup>(A,B)" "N(f)"
     using M.def_lepoll_rel by (auto dest!:M_imp_N)
   moreover from calculation
   have "f \<in> inj\<^bsup>N\<^esup>(A,B)"
     using inj_rel_transfer by (auto)
   ultimately
   show ?thesis
     using N.def_lepoll_rel by (blast dest!:M_imp_N)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_N_Perm\<close>\<close>
 
 (******************  end Discipline  ******************)
 
 (******************************************************)
 subsection\<open>Discipline for \<^term>\<open>lesspoll\<close>\<close>
 
 relativize functional "lesspoll" "lesspoll_rel" external
 relationalize "lesspoll_rel" "is_lesspoll"
 
 synthesize "is_lesspoll" from_definition assuming "nonempty"
 notation is_lesspoll_fm (\<open>\<cdot>_ \<prec> _\<cdot>\<close>)
 arity_theorem for "is_lesspoll_fm"
 
 context M_Perm begin
 
 is_iff_rel for "lesspoll"
   using is_lepoll_iff is_eqpoll_iff
   unfolding is_lesspoll_def lesspoll_rel_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
 
 abbreviation
   lesspoll_r :: "[i,i\<Rightarrow>o,i] => o" (\<open>_ \<prec>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
   "A \<prec>\<^bsup>M\<^esup> B \<equiv> lesspoll_rel(M,A,B)"
 
 abbreviation
   lesspoll_r_set ::  "[i,i,i] \<Rightarrow> o" (\<open>_ \<prec>\<^bsup>_\<^esup> _\<close> [51,1,51] 50) where
   "lesspoll_r_set(A,M) \<equiv> lesspoll_rel(##M,A)"
 
 text\<open>Since \<^term>\<open>lesspoll_rel\<close> is defined as a propositional
 combination of older terms, there is no need for a separate ``def''
 theorem for it.\<close>
 
 text\<open>Note that \<^term>\<open>lesspoll_rel\<close> is neither $\Sigma_1^{\mathit{ZF}}$ nor
  $\Pi_1^{\mathit{ZF}}$, so there is no ``transfer'' theorem for it.\<close>
 
+definition
+  Powapply :: "[i,i] \<Rightarrow> i"  where
+  "Powapply(f,y) \<equiv> Pow(f`y)"
+
+reldb_add functional "Pow" "Pow_rel"
+reldb_add relational "Pow" "is_Pow"
+
+declare Replace_iff_sats[iff_sats]
+synthesize "is_Pow" from_definition assuming "nonempty"
+arity_theorem for "is_Pow_fm"
+
+relativize functional "Powapply" "Powapply_rel"
+relationalize "Powapply_rel" "is_Powapply"
+synthesize "is_Powapply" from_definition assuming "nonempty"
+arity_theorem for "is_Powapply_fm"
+
+notation Powapply_rel (\<open>Powapply\<^bsup>_\<^esup>'(_,_')\<close>)
+
+context M_basic
+begin
+
+rel_closed for "Powapply"
+  unfolding Powapply_rel_def
+  by simp
+
+is_iff_rel for "Powapply"
+  using Pow_rel_iff
+  unfolding is_Powapply_def Powapply_rel_def
+  by simp
+
+end \<comment>\<open>\<^locale>\<open>M_basic\<close>\<close>
+
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/FiniteFun_Relative.thy b/thys/Transitive_Models/FiniteFun_Relative.thy
--- a/thys/Transitive_Models/FiniteFun_Relative.thy
+++ b/thys/Transitive_Models/FiniteFun_Relative.thy
@@ -1,421 +1,463 @@
 section\<open>Relativization of Finite Functions\<close>
 theory FiniteFun_Relative
   imports
     Lambda_Replacement
 begin
 
 lemma FiniteFunI :
   assumes  "f\<in>Fin(A\<times>B)" "function(f)"
   shows "f \<in> A -||> B"
   using assms
 proof(induct)
   case 0
   then show ?case using emptyI by simp
 next
   case (cons p f)
   moreover
   from assms this
   have "fst(p)\<in>A" "snd(p)\<in>B" "function(f)"
     using snd_type[OF \<open>p\<in>_\<close>] function_subset
     by auto
   moreover
   from \<open>function(cons(p,f))\<close> \<open>p\<notin>f\<close> \<open>p\<in>_\<close>
   have "fst(p)\<notin>domain(f)"
     unfolding function_def
     by force
   ultimately
   show ?case
     using consI[of "fst(p)" _ "snd(p)"]
     by auto
 qed
 
 subsection\<open>The set of finite binary sequences\<close>
 
 text\<open>We implement the poset for adding one Cohen real, the set
 $2^{<\omega}$ of finite binary sequences.\<close>
 
 definition
   seqspace :: "[i,i] \<Rightarrow> i" (\<open>_\<^bsup><_\<^esup>\<close> [100,1]100) where
   "B\<^bsup><\<alpha>\<^esup> \<equiv> \<Union>n\<in>\<alpha>. (n\<rightarrow>B)"
 
-schematic_goal seqspace_fm_auto:
-  assumes
-    "i \<in> nat" "j \<in> nat" "h\<in>nat" "env \<in> list(A)"
-  shows
-    "(\<exists>om\<in>A. omega(##A,om) \<and> nth(i,env) \<in> om \<and> is_funspace(##A, nth(i,env), nth(h,env), nth(j,env))) \<longleftrightarrow> (A, env \<Turnstile> (?sqsprp(i,j,h)))"
-  unfolding is_funspace_def
-  by (insert assms ; (rule iff_sats | simp)+)
-
-synthesize "seqspace_rel" from_schematic "seqspace_fm_auto"
-arity_theorem for "seqspace_rel_fm"
-
 lemma seqspaceI[intro]: "n\<in>\<alpha> \<Longrightarrow> f:n\<rightarrow>B \<Longrightarrow> f\<in>B\<^bsup><\<alpha>\<^esup>"
   unfolding seqspace_def by blast
 
 lemma seqspaceD[dest]: "f\<in>B\<^bsup><\<alpha>\<^esup> \<Longrightarrow> \<exists>n\<in>\<alpha>. f:n\<rightarrow>B"
   unfolding seqspace_def by blast
 
-locale M_seqspace =  M_trancl + M_replacement +
+locale M_pre_seqspace =  M_trancl + M_replacement + M_Pi
+begin
+
+lemma function_space_subset_Pow_rel:
+  assumes "n\<in>\<omega>" "M(B)"
+  shows "n\<rightarrow>B \<subseteq> Pow\<^bsup>M\<^esup>(\<Union>(\<omega>\<rightarrow>\<^bsup>M\<^esup>B))"
+proof -
+  {
+    fix f p
+    assume "f \<subseteq> n \<times> B" "p \<in> f"
+    with assms
+    obtain x y where "p =\<langle>x,y\<rangle>" "x\<in>n" "y\<in>B" by auto
+    with assms
+    have "p \<in> (\<lambda>_\<in>\<omega>. y)"
+      using Ord_trans[of _ _ \<omega>] lam_constant_eq_cartprod by simp
+    moreover
+    note assms and \<open>y\<in>B\<close>
+    moreover from this
+    have "M(\<lambda>_\<in>\<omega>. y)" using lam_constant_eq_cartprod by (auto dest:transM)
+    moreover from calculation
+    have "(\<lambda>_\<in>\<omega>. y) : \<omega> \<rightarrow>\<^bsup>M\<^esup> B"
+      using mem_function_space_rel_abs[of \<omega> B, THEN iffD2]
+      by simp
+    ultimately
+    have "\<exists>B\<in>\<omega> \<rightarrow>\<^bsup>M\<^esup> B. p \<in> B"
+      by (rule_tac x="\<lambda>_\<in>\<omega>. y" in bexI)
+  }
+  with assms
+  show ?thesis
+    by (auto dest:transM intro!:mem_Pow_rel_abs[THEN iffD2])
+      (unfold Pi_def, auto)
+qed
+
+lemma seqspace_subset_Pow_rel:
+  assumes "M(B)"
+  shows "B\<^bsup><\<omega>\<^esup> \<subseteq> Pow\<^bsup>M\<^esup>(\<Union>(\<omega>\<rightarrow>\<^bsup>M\<^esup>B))"
+  using assms function_space_subset_Pow_rel unfolding seqspace_def
+  by auto
+
+lemma seqspace_imp_M:
+  assumes "x \<in> B\<^bsup><\<omega>\<^esup>" "M(B)"
+  shows "M(x)"
+  using assms seqspace_subset_Pow_rel
+  by (auto dest:transM)
+
+lemma seqspace_eq_Collect:
+  assumes "M(B)"
+  shows "B\<^bsup><\<omega>\<^esup> = {z \<in> Pow\<^bsup>M\<^esup>(\<Union>(\<omega>\<rightarrow>\<^bsup>M\<^esup>B)). \<exists>x[M]. \<exists>n[M]. n \<in> \<omega> \<and> z \<in> x \<and> x = n \<rightarrow>\<^bsup>M\<^esup> B}"
+  using assms seqspace_subset_Pow_rel nat_into_M seqspace_imp_M
+    transM[OF _ finite_funspace_closed, of _ _ B] function_space_rel_char
+  by (intro equalityI) (auto dest:transM dest!:seqspaceD)
+
+end \<comment> \<open>\<^locale>\<open>M_pre_seqspace\<close>\<close>
+
+locale M_seqspace =  M_pre_seqspace +
   assumes
-    seqspace_replacement: "M(B) \<Longrightarrow> strong_replacement(M,\<lambda>n z. n\<in>nat \<and> is_funspace(M,n,B,z))"
+    seqspace_separation: "M(B) \<Longrightarrow> separation(M,\<lambda>z. \<exists>x[M]. \<exists>n[M]. n \<in> \<omega> \<and> z \<in> x \<and> x = n \<rightarrow>\<^bsup>M\<^esup> B)"
 begin
 
 lemma seqspace_closed:
   "M(B) \<Longrightarrow> M(B\<^bsup><\<omega>\<^esup>)"
-  unfolding seqspace_def using seqspace_replacement[of B] RepFun_closed2
+  using seqspace_eq_Collect using seqspace_separation
   by simp
-end
+
+end \<comment> \<open>\<^locale>\<open>M_seqspace\<close>\<close>
 
 subsection\<open>Representation of finite functions\<close>
 
 text\<open>A function $f\in A\to_{\mathit{fin}}B$ can be represented by a function
 $g\in |f| \to A\times B$. It is clear that $f$ can be represented by
 any $g' = g \cdot \pi$, where $\pi$ is a permutation $\pi\in dom(g)\to dom(g)$.
 We use this representation of $A\to_{\mathit{fin}}B$ to prove that our model is
 closed under $\_\to_{\mathit{fin}}\_$.\<close>
 
 text\<open>A function $g\in n\to A\times B$ that is functional in the first components.\<close>
 definition cons_like :: "i \<Rightarrow> o" where
   "cons_like(f) \<equiv> \<forall> i\<in>domain(f) . \<forall>j\<in>i . fst(f`i) \<noteq> fst(f`j)"
 
-relativize "cons_like" "cons_like_rel"
-
-lemma (in M_seqspace) cons_like_abs:
-  "M(f) \<Longrightarrow> cons_like(f) \<longleftrightarrow> cons_like_rel(M,f)"
-  unfolding cons_like_def cons_like_rel_def
-  using fst_abs
-  by simp
-
 definition FiniteFun_iso :: "[i,i,i,i,i] \<Rightarrow> o" where
   "FiniteFun_iso(A,B,n,g,f) \<equiv>  (\<forall> i\<in>n . g`i \<in> f) \<and> (\<forall> ab\<in>f. (\<exists> i\<in>n. g`i=ab))"
 
 text\<open>From a function $g\in n \to A\times B$ we obtain a finite function in \<^term>\<open>A-||>B\<close>.\<close>
 
 definition to_FiniteFun :: "i \<Rightarrow> i" where
   "to_FiniteFun(f) \<equiv> {f`i. i\<in>domain(f)}"
 
 definition FiniteFun_Repr :: "[i,i] \<Rightarrow> i" where
   "FiniteFun_Repr(A,B) \<equiv> {f \<in> (A\<times>B)\<^bsup><\<omega>\<^esup> . cons_like(f) }"
 
 locale M_FiniteFun =  M_seqspace +
   assumes
-    cons_like_separation : "separation(M,\<lambda>f. cons_like_rel(M,f))"
-    and
     separation_is_function : "separation(M, is_function(M))"
 begin
 
+lemma cons_like_separation : "separation(M,\<lambda>f. cons_like(f))"
+  unfolding cons_like_def
+  using lam_replacement_identity lam_replacement_domain lam_replacement_snd
+    lam_replacement_hcomp[OF _ lam_replacement_snd ]
+    lam_replacement_hcomp[OF _ lam_replacement_fst]
+    separation_eq lam_replacement_apply2[THEN [5] lam_replacement_hcomp2] separation_neg
+  by(rule_tac separation_all,auto,rule_tac separation_all,auto)
+
 lemma supset_separation: "separation(M, \<lambda> x. \<exists>a. \<exists>b. x = \<langle>a,b\<rangle> \<and> b \<subseteq> a)"
-  using separation_pair separation_subset lam_replacement_fst lam_replacement_snd
+  using separation_Pair separation_subset lam_replacement_fst lam_replacement_snd
   by simp
 
 lemma to_finiteFun_replacement: "strong_replacement(M, \<lambda>x y. y = range(x))"
   using lam_replacement_range lam_replacement_imp_strong_replacement
   by simp
 
 lemma fun_range_eq: "f\<in>A\<rightarrow>B \<Longrightarrow> {f`i . i\<in>domain(f) } = range(f)"
   using ZF_Library.range_eq_image[of f] domain_of_fun image_fun func.apply_rangeI
   by simp
 
 lemma FiniteFun_fst_type:
   assumes "h\<in>A-||>B" "p\<in>h"
   shows  "fst(p)\<in>domain(h)"
   using assms
   by(induct h, auto)
 
 lemma FinFun_closed:
   "M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(\<Union>{n\<rightarrow>A\<times>B . n\<in>\<omega>})"
   using cartprod_closed seqspace_closed
   unfolding seqspace_def by simp
 
 lemma cons_like_lt :
   assumes "n\<in>\<omega>" "f\<in>succ(n)\<rightarrow>A\<times>B" "cons_like(f)"
   shows "restrict(f,n)\<in>n\<rightarrow>A\<times>B" "cons_like(restrict(f,n))"
   using assms
 proof (auto simp add: le_imp_subset restrict_type2)
   from \<open>f\<in>_\<close>
   have D:"domain(restrict(f,n)) = n" "domain(f) = succ(n)"
     using domain_of_fun domain_restrict by auto
   {
     fix i j
     assume "i\<in>domain(restrict(f,n))" (is "i\<in>?D") "j\<in>i"
     with \<open>n\<in>_\<close> D
     have "j\<in>?D" "i\<in>n" "j\<in>n" using Ord_trans[of j] by simp_all
     with D \<open>cons_like(f)\<close>  \<open>j\<in>n\<close> \<open>i\<in>n\<close> \<open>j\<in>i\<close>
     have "fst(restrict(f,n)`i) \<noteq> fst(restrict(f,n)`j)"
       using restrict_if unfolding cons_like_def by auto
   }
   then show "cons_like(restrict(f,n))"
     unfolding cons_like_def by auto
 qed
 
 text\<open>A finite function \<^term>\<open>f \<in> A -||> B\<close> can be represented by a
 function $g \in n \to A \times B$, with $n=|f|$.\<close>
 lemma FiniteFun_iso_intro1:
   assumes "f \<in> (A -||> B)"
   shows "\<exists>n\<in>\<omega> . \<exists>g\<in>n\<rightarrow>A\<times>B. FiniteFun_iso(A,B,n,g,f) \<and> cons_like(g)"
   using assms
 proof(induct f,force simp add:emptyI FiniteFun_iso_def cons_like_def)
   case (consI a b h)
   then obtain n g where
     HI: "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "FiniteFun_iso(A,B,n,g,h)" "cons_like(g)" by auto
   let ?G="\<lambda> i \<in> succ(n) . if i=n then <a,b> else g`i"
   from HI \<open>a\<in>_\<close> \<open>b\<in>_\<close>
   have G: "?G \<in> succ(n)\<rightarrow>A\<times>B"
     by (auto intro:lam_type)
   have "FiniteFun_iso(A,B,succ(n),?G,cons(<a,b>,h))"
     unfolding FiniteFun_iso_def
   proof(intro conjI)
     {
       fix i
       assume "i\<in>succ(n)"
       then consider "i=n" | "i\<in>n\<and>i\<noteq>n" by auto
       then have "?G ` i \<in> cons(<a,b>,h)"
         using HI
         by(cases,simp;auto simp add:HI FiniteFun_iso_def)
     }
     then show "\<forall>i\<in>succ(n). ?G ` i \<in> cons(\<langle>a, b\<rangle>, h)" ..
   next
     { fix ab'
       assume "ab' \<in> cons(<a,b>,h)"
       then
       consider  "ab' = <a,b>" | "ab' \<in> h" using cons_iff by auto
       then
       have "\<exists>i \<in> succ(n) . ?G`i = ab'" unfolding FiniteFun_iso_def
       proof(cases,simp)
         case 2
         with HI obtain i
           where "i\<in>n" "g`i=ab'" unfolding FiniteFun_iso_def by auto
         with HI show ?thesis using  ltI[OF \<open>i\<in>_\<close>] by auto
       qed
     }
     then
     show "\<forall>ab\<in>cons(\<langle>a, b\<rangle>, h). \<exists>i\<in>succ(n). ?G`i = ab"  ..
   qed
   with HI G
   have 1: "?G\<in>succ(n)\<rightarrow>A\<times>B" "FiniteFun_iso(A,B,succ(n),?G,cons(<a,b>,h))" "succ(n)\<in>\<omega>" by simp_all
   have "cons_like(?G)"
   proof -
     from \<open>?G\<in>_\<close> \<open>g\<in>_\<close>
     have "domain(g) = n" using domain_of_fun by simp
     {
       fix i j
       assume "i\<in>domain(?G)" "j\<in>i"
       with \<open>n\<in>_\<close>
       have "j\<in>n" using Ord_trans[of j _ n] by auto
       from \<open>i\<in>_\<close> consider (a) "i=n \<and> i\<notin>n" | (b) "i\<in>n" by auto
       then
       have " fst(?G`i) \<noteq> fst(?G`j)"
       proof(cases)
         case a
         with \<open>j\<in>n\<close> HI
         have "?G`i=<a,b>" "?G`j=g`j" "g`j\<in>h"
           unfolding FiniteFun_iso_def by auto
         with \<open>a\<notin>_\<close> \<open>h\<in>_\<close>
         show ?thesis using  FiniteFun_fst_type by auto
       next
         case b
         with \<open>i\<in>n\<close> \<open>j\<in>i\<close> \<open>j\<in>n\<close> HI \<open>domain(g) = n\<close>
         show ?thesis unfolding cons_like_def
           using mem_not_refl by auto
       qed
     }
     then show ?thesis unfolding cons_like_def by auto
   qed
   with 1 show ?case by auto
 qed
 
 text\<open>All the representations of \<^term>\<open>f\<in>A-||>B\<close> are equal.\<close>
 lemma FiniteFun_isoD :
   assumes "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "f\<in>A-||>B" "FiniteFun_iso(A,B,n,g,f)"
   shows "to_FiniteFun(g) = f"
 proof
   show "to_FiniteFun(g) \<subseteq> f"
   proof
     fix ab
     assume "ab\<in>to_FiniteFun(g)"
     moreover
     note assms
     moreover from calculation
     obtain i where "i\<in>n" "g`i=ab" "ab\<in>A\<times>B"
       unfolding to_FiniteFun_def using domain_of_fun by auto
     ultimately
     show "ab\<in>f" unfolding FiniteFun_iso_def by auto
   qed
 next
   show "f \<subseteq> to_FiniteFun(g)"
   proof
     fix ab
     assume "ab\<in>f"
     with assms
     obtain i where "i\<in>n" "g`i=ab" "ab\<in>A\<times>B"
       unfolding FiniteFun_iso_def by auto
     with assms
     show "ab \<in> to_FiniteFun(g)"
       unfolding to_FiniteFun_def
       using domain_of_fun by auto
   qed
 qed
 
 lemma to_FiniteFun_succ_eq :
   assumes "n\<in>\<omega>" "f\<in>succ(n) \<rightarrow> A"
   shows "to_FiniteFun(f) = cons(f`n,to_FiniteFun(restrict(f,n)))"
   using assms domain_restrict domain_of_fun
   unfolding to_FiniteFun_def by auto
 
 text\<open>If $g \in n\to A\times B$ is \<^term>\<open>cons_like\<close>, then it is a representation of
 \<^term>\<open>to_FiniteFun(g)\<close>.\<close>
 lemma FiniteFun_iso_intro_to:
   assumes "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "cons_like(g)"
   shows "to_FiniteFun(g) \<in> (A -||> B) \<and> FiniteFun_iso(A,B,n,g,to_FiniteFun(g))"
   using assms
 proof(induct n  arbitrary:g rule:nat_induct)
   case 0
   fix g
   assume "g\<in>0\<rightarrow>A\<times>B"
   then
   have "g=0" by simp
   then have "to_FiniteFun(g)=0" unfolding to_FiniteFun_def by simp
   then show "to_FiniteFun(g) \<in> (A -||> B) \<and> FiniteFun_iso(A,B,0,g,to_FiniteFun(g))"
     using emptyI unfolding FiniteFun_iso_def by simp
 next
   case (succ x)
   fix g
   let ?g'="restrict(g,x)"
   assume "g\<in>succ(x)\<rightarrow>A\<times>B" "cons_like(g)"
   with succ.hyps \<open>g\<in>_\<close>
   have "cons_like(?g')" "?g' \<in> x\<rightarrow>A\<times>B" "g`x\<in>A\<times>B" "domain(g) = succ(x)"
     using cons_like_lt succI1 apply_funtype domain_of_fun by simp_all
   with succ.hyps  \<open>?g'\<in>_\<close> \<open>x\<in>\<omega>\<close>
   have HI:
     "to_FiniteFun(?g') \<in> A -||> B" (is "(?h) \<in> _")
     "FiniteFun_iso(A,B,x,?g',to_FiniteFun(?g'))"
     by simp_all
   then
   have "fst(g`x) \<notin> domain(?h)"
   proof -
     {
       assume "fst(g`x) \<in> domain(?h)"
       with HI \<open>x\<in>_\<close>
       obtain i b
         where "i\<in>x" "<fst(?g'`i),b>\<in>?h" "i<x" "fst(g`x) = fst(?g'`i)"
         unfolding FiniteFun_iso_def using ltI by auto
       with \<open>cons_like(g)\<close> \<open>domain(g) = _\<close>
       have False
         unfolding cons_like_def by auto
     }
     then show ?thesis ..
   qed
   with HI assms \<open>g`x\<in>_\<close>
   have "cons(g`x,?h) \<in> A-||>B" (is "?h' \<in>_") using consI by auto
   have "FiniteFun_iso(A,B,succ(x),g,?h')"
     unfolding FiniteFun_iso_def
   proof
     { fix i
       assume "i\<in>succ(x)"
       with \<open>x\<in>_\<close> consider (a) "i=x"| (b) "i\<in>x\<and>i\<noteq>x" by auto
       then have "g`i\<in> ?h'"
       proof(cases,simp)
         case b
         with \<open>FiniteFun_iso(_,_,_,?g',?h)\<close>
         show ?thesis unfolding FiniteFun_iso_def by simp
       qed
     }
     then show "\<forall>i\<in>succ(x). g ` i \<in> cons(g ` x, ?h)" ..
   next
     {
       fix ab
       assume "ab\<in>?h'"
       then consider "ab=g`x" | "ab \<in> ?h" using cons_iff by auto
       then
       have "\<exists>i \<in> succ(x) . g`i = ab" unfolding FiniteFun_iso_def
       proof(cases,simp)
         case 2
         with HI obtain i
           where 2:"i\<in>x" "?g'`i=ab"  unfolding FiniteFun_iso_def by auto
         with \<open>x\<in>_\<close>
         have "i\<noteq>x" "i\<in>succ(x)" using  ltI[OF \<open>i\<in>_\<close>] by auto
         with 2 HI show ?thesis by auto
       qed
     } then show "\<forall>ab\<in>cons(g ` x, ?h). \<exists>i\<in>succ(x). g ` i = ab" ..
   qed
   with \<open>?h'\<in>_\<close>
   show "to_FiniteFun(g) \<in> A -||>B \<and> FiniteFun_iso(A,B,succ(x),g,to_FiniteFun(g))"
     using to_FiniteFun_succ_eq[OF \<open>x\<in>_\<close> \<open>g\<in>_\<close>,symmetric] by auto
 qed
 
 lemma FiniteFun_iso_intro2:
   assumes "n\<in>\<omega>" "f\<in>n\<rightarrow>A\<times>B" "cons_like(f)"
   shows "\<exists> g \<in> (A -||> B) . FiniteFun_iso(A,B,n,f,g)"
   using assms FiniteFun_iso_intro_to by blast
 
 lemma FiniteFun_eq_range_Repr :
   shows "{range(h) . h \<in> FiniteFun_Repr(A,B) } = {to_FiniteFun(h) . h \<in> FiniteFun_Repr(A,B) }"
   unfolding FiniteFun_Repr_def to_FiniteFun_def seqspace_def
   using fun_range_eq
   by(intro equalityI subsetI,auto)
 
 
 lemma FiniteFun_eq_to_FiniteFun_Repr :
   shows "A-||>B = {to_FiniteFun(h) . h \<in> FiniteFun_Repr(A,B) } "
     (is "?Y=?X")
 proof
   {
     fix f
     assume "f\<in>A-||>B"
     then obtain n g where
       1: "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "FiniteFun_iso(A,B,n,g,f)" "cons_like(g)"
       using FiniteFun_iso_intro1 by blast
     with \<open>f\<in>_\<close>
     have "cons_like(g)" "f=to_FiniteFun(g)" "domain(g) = n" "g\<in>FiniteFun_Repr(A,B)"
       using FiniteFun_isoD domain_of_fun
       unfolding FiniteFun_Repr_def
       by auto
     with 1 have "f\<in>?X"
       by auto
   } then show "?Y\<subseteq>?X" ..
 next
   {
     fix f
     assume "f\<in>?X"
     then obtain g where
       A:"g\<in>FiniteFun_Repr(A,B)" "f=to_FiniteFun(g)" "cons_like(g)"
       using RepFun_iff unfolding FiniteFun_Repr_def by auto
     then obtain n where "n\<in>\<omega>" "g\<in>n\<rightarrow>A\<times>B" "domain(g) = n"
       unfolding FiniteFun_Repr_def using domain_of_fun by force
     with A
     have "f\<in>?Y"
       using FiniteFun_iso_intro_to by simp
   } then show "?X\<subseteq>?Y" ..
 qed
 
 lemma FiniteFun_Repr_closed :
   assumes "M(A)" "M(B)"
   shows "M(FiniteFun_Repr(A,B))"
   unfolding FiniteFun_Repr_def
   using assms cartprod_closed
-    seqspace_closed separation_closed cons_like_abs cons_like_separation
+    seqspace_closed separation_closed cons_like_separation
   by simp
 
 lemma to_FiniteFun_closed:
   assumes "M(A)" "f\<in>A"
   shows "M(range(f))"
   using assms transM[of _ A] by simp
 
 lemma To_FiniteFun_Repr_closed :
   assumes "M(A)" "M(B)"
   shows "M({range(h) . h \<in> FiniteFun_Repr(A,B) })"
   using assms FiniteFun_Repr_closed
     RepFun_closed  to_finiteFun_replacement
     to_FiniteFun_closed[OF FiniteFun_Repr_closed]
   by simp
 
 lemma FiniteFun_closed[intro,simp] :
   assumes "M(A)" "M(B)"
   shows "M(A -||> B)"
   using assms To_FiniteFun_Repr_closed FiniteFun_eq_to_FiniteFun_Repr
     FiniteFun_eq_range_Repr
   by simp
 
 end \<comment> \<open>\<^locale>\<open>M_FiniteFun\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Internalizations.thy b/thys/Transitive_Models/Internalizations.thy
--- a/thys/Transitive_Models/Internalizations.thy
+++ b/thys/Transitive_Models/Internalizations.thy
@@ -1,277 +1,279 @@
 section\<open>Aids to internalize formulas\<close>
 
 theory Internalizations
   imports
     "ZF-Constructible.DPow_absolute"
     Synthetic_Definition
     Nat_Miscellanea
 begin
 
+hide_const (open) Order.pred
+
 definition
   infinity_ax :: "(i \<Rightarrow> o) \<Rightarrow> o" where
   "infinity_ax(M) \<equiv>
       (\<exists>I[M]. (\<exists>z[M]. empty(M,z) \<and> z\<in>I) \<and> (\<forall>y[M]. y\<in>I \<longrightarrow> (\<exists>sy[M]. successor(M,y,sy) \<and> sy\<in>I)))"
 
 definition
   wellfounded_trancl :: "[i=>o,i,i,i] => o" where
   "wellfounded_trancl(M,Z,r,p) \<equiv>
       \<exists>w[M]. \<exists>wx[M]. \<exists>rp[M].
                w \<in> Z & pair(M,w,p,wx) & tran_closure(M,r,rp) & wx \<in> rp"
 
 lemma empty_intf :
   "infinity_ax(M) \<Longrightarrow>
   (\<exists>z[M]. empty(M,z))"
   by (auto simp add: empty_def infinity_ax_def)
 
 lemma Transset_intf :
   "Transset(M) \<Longrightarrow>  y\<in>x \<Longrightarrow> x \<in> M \<Longrightarrow> y \<in> M"
   by (simp add: Transset_def,auto)
 
 definition
   choice_ax :: "(i\<Rightarrow>o) \<Rightarrow> o" where
   "choice_ax(M) \<equiv> \<forall>x[M]. \<exists>a[M]. \<exists>f[M]. ordinal(M,a) \<and> surjection(M,a,x,f)"
 
 lemma (in M_basic) choice_ax_abs :
   "choice_ax(M) \<longleftrightarrow> (\<forall>x[M]. \<exists>a[M]. \<exists>f[M]. Ord(a) \<and> f \<in> surj(a,x))"
   unfolding choice_ax_def
   by simp
 
 txt\<open>Setting up notation for internalized formulas\<close>
 
 abbreviation
   dec10  :: i   ("10") where "10 \<equiv> succ(9)"
 abbreviation
   dec11  :: i   ("11") where "11 \<equiv> succ(10)"
 abbreviation
   dec12  :: i   ("12") where "12 \<equiv> succ(11)"
 abbreviation
   dec13  :: i   ("13") where "13 \<equiv> succ(12)"
 abbreviation
   dec14  :: i   ("14") where "14 \<equiv> succ(13)"
 abbreviation
   dec15  :: i   ("15") where "15 \<equiv> succ(14)"
 abbreviation
   dec16  :: i   ("16") where "16 \<equiv> succ(15)"
 abbreviation
   dec17  :: i   ("17") where "17 \<equiv> succ(16)"
 abbreviation
   dec18  :: i   ("18") where "18 \<equiv> succ(17)"
 abbreviation
   dec19  :: i   ("19") where "19 \<equiv> succ(18)"
 abbreviation
   dec20  :: i   ("20") where "20 \<equiv> succ(19)"
 abbreviation
   dec21  :: i   ("21") where "21 \<equiv> succ(20)"
 abbreviation
   dec22  :: i   ("22") where "22 \<equiv> succ(21)"
 abbreviation
   dec23  :: i   ("23") where "23 \<equiv> succ(22)"
 abbreviation
   dec24  :: i   ("24") where "24 \<equiv> succ(23)"
 abbreviation
   dec25  :: i   ("25") where "25 \<equiv> succ(24)"
 abbreviation
   dec26  :: i   ("26") where "26 \<equiv> succ(25)"
 abbreviation
   dec27  :: i   ("27") where "27 \<equiv> succ(26)"
 abbreviation
   dec28  :: i   ("28") where "28 \<equiv> succ(27)"
 abbreviation
   dec29  :: i   ("29") where "29 \<equiv> succ(28)"
 
 notation Member (\<open>\<cdot>_ \<in>/ _\<cdot>\<close>)
 notation Equal (\<open>\<cdot>_ =/ _\<cdot>\<close>)
 notation Nand (\<open>\<cdot>\<not>'(_ \<and>/ _')\<cdot>\<close>)
 notation And (\<open>\<cdot>_ \<and>/ _\<cdot>\<close>)
 notation Or (\<open>\<cdot>_ \<or>/ _\<cdot>\<close>)
 notation Iff (\<open>\<cdot>_ \<leftrightarrow>/ _\<cdot>\<close>)
 notation Implies (\<open>\<cdot>_ \<rightarrow>/ _\<cdot>\<close>)
 notation Neg (\<open>\<cdot>\<not>_\<cdot>\<close>)
 notation Forall (\<open>'(\<cdot>\<forall>(/_)\<cdot>')\<close>)
 notation Exists (\<open>'(\<cdot>\<exists>(/_)\<cdot>')\<close>)
 
 notation subset_fm (\<open>\<cdot>_ \<subseteq>/ _\<cdot>\<close>)
 notation succ_fm (\<open>\<cdot>succ'(_') is _\<cdot>\<close>)
 notation empty_fm (\<open>\<cdot>_ is empty\<cdot>\<close>)
 notation fun_apply_fm (\<open>\<cdot>_`_ is _\<cdot>\<close>)
 notation big_union_fm (\<open>\<cdot>\<Union>_ is _\<cdot>\<close>)
 notation upair_fm (\<open>\<cdot>{_,_} is _ \<cdot>\<close>)
 notation ordinal_fm (\<open>\<cdot>_ is ordinal\<cdot>\<close>)
 
 
 notation pair_fm (\<open>\<cdot>\<langle>_,_\<rangle> is _ \<cdot>\<close>)
 notation composition_fm (\<open>\<cdot>_ \<circ> _ is _ \<cdot>\<close>)
 notation domain_fm (\<open>\<cdot>dom'(_') is _ \<cdot>\<close>)
 notation range_fm (\<open>\<cdot>ran'(_') is _ \<cdot>\<close>)
 notation union_fm (\<open>\<cdot>_ \<union> _ is _ \<cdot>\<close>)
 notation image_fm (\<open>\<cdot>_ `` _ is _ \<cdot>\<close>)
 notation pre_image_fm (\<open>\<cdot>_ -`` _ is _ \<cdot>\<close>)
 notation field_fm (\<open>\<cdot>fld'(_') is _ \<cdot>\<close>)
 notation cons_fm (\<open>\<cdot>cons'(_,_') is _ \<cdot>\<close>)
 notation number1_fm (\<open>\<cdot>_ is the number one\<cdot>\<close>)
 notation function_fm (\<open>\<cdot>_ is funct\<cdot>\<close>)
 notation relation_fm (\<open>\<cdot>_ is relat\<cdot>\<close>)
 notation restriction_fm (\<open>\<cdot>_ \<restriction> _ is _ \<cdot>\<close>)
 notation transset_fm (\<open>\<cdot>_ is transitive\<cdot>\<close>)
 notation limit_ordinal_fm (\<open>\<cdot>_ is limit\<cdot>\<close>)
 notation finite_ordinal_fm (\<open>\<cdot>_ is finite ord\<cdot>\<close>)
 notation omega_fm (\<open>\<cdot>_ is \<omega>\<cdot>\<close>)
 notation cartprod_fm (\<open>\<cdot>_ \<times> _ is _\<cdot>\<close>)
 notation Memrel_fm (\<open>\<cdot>Memrel'(_') is _\<cdot>\<close>)
 notation quasinat_fm (\<open>\<cdot>_ is qnat\<cdot>\<close>)
   (* notation rtran_closure_mem_fm (\<open>\<cdot>{_,_} is _ \<cdot>\<close>)
 notation rtran_closure_fm (\<open>\<cdot>{_,_} is _ \<cdot>\<close>)
 notation tran_closure_fm (\<open>\<cdot>_ is  \<cdot>\<close>)
 notation order_isomorphism_fm (\<open>\<cdot>{_,_} is _ \<cdot>\<close>) *)
 notation Inl_fm (\<open>\<cdot>Inl'(_') is _ \<cdot>\<close>)
 notation Inr_fm (\<open>\<cdot>Inr'(_') is _ \<cdot>\<close>)
 notation pred_set_fm (\<open>\<cdot>_-predecessors of _ are _\<cdot>\<close>)
 
 
 abbreviation
   fm_typedfun :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_ : _ \<rightarrow> _\<cdot>\<close>) where
   "fm_typedfun(f,A,B) \<equiv> typed_function_fm(A,B,f)"
 
 abbreviation
   fm_surjection :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_ surjects _ to _\<cdot>\<close>) where
   "fm_surjection(f,A,B) \<equiv> surjection_fm(A,B,f)"
 
 abbreviation
   fm_injection :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_ injects _ to _\<cdot>\<close>) where
   "fm_injection(f,A,B) \<equiv> injection_fm(A,B,f)"
 
 abbreviation
   fm_bijection :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_ bijects _ to _\<cdot>\<close>) where
   "fm_bijection(f,A,B) \<equiv> bijection_fm(A,B,f)"
 
 text\<open>We found it useful to have slightly different versions of some
 results in ZF-Constructible:\<close>
 lemma nth_closed :
   assumes "env\<in>list(A)" "0\<in>A"
   shows "nth(n,env)\<in>A"
   using assms unfolding nth_def by (induct env; simp)
 
 lemma conj_setclass_model_iff_sats [iff_sats]:
   "[| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
        P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) |]
        ==> (P \<and> (##A)(x)) \<longleftrightarrow> sats(A, p, env)"
   "[| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
        P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) |]
        ==> ((##A)(x) \<and> P) \<longleftrightarrow> sats(A, p, env)"
   using nth_closed[of env A i]
   by auto
 
 lemma conj_mem_model_iff_sats [iff_sats]:
   "[| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
        P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) |]
        ==> (P \<and> x \<in> A) \<longleftrightarrow> sats(A, p, env)"
   "[| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
        P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) |]
        ==> (x \<in> A \<and> P) \<longleftrightarrow> sats(A, p, env)"
   using nth_closed[of env A i]
   by auto
 
 (* lemma [iff_sats]:
       "[| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
        P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) |]
        ==> (x \<in> A \<longleftrightarrow> P) \<longleftrightarrow> sats(A, p, env)"
       "[| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
        P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) |]
        ==> (P \<longleftrightarrow> x \<in> A) \<longleftrightarrow> sats(A, p, env)"
 
       "[| 0 \<in> A; nth(i,env) = x; env \<in> list(A);
        P \<longleftrightarrow> sats(A,p,env); env \<in> list(A) |]
        ==> (x \<in> A \<longrightarrow> P) \<longleftrightarrow> sats(A, p, env)"
 
   using nth_closed[of env A i]
   by auto *)
 
 lemma mem_model_iff_sats [iff_sats]:
   "[| 0 \<in> A; nth(i,env) = x; env \<in> list(A)|]
        ==> (x\<in>A) \<longleftrightarrow> sats(A, Exists(Equal(0,0)), env)"
   using nth_closed[of env A i]
   by auto
 
 lemma subset_iff_sats[iff_sats]:
   "nth(i, env) = x \<Longrightarrow> nth(j, env) = y \<Longrightarrow> i\<in>nat \<Longrightarrow> j\<in>nat \<Longrightarrow>
    env \<in> list(A) \<Longrightarrow> subset(##A, x, y) \<longleftrightarrow> sats(A, subset_fm(i, j), env)"
   using sats_subset_fm' by simp
 
 lemma not_mem_model_iff_sats [iff_sats]:
   "[| 0 \<in> A; nth(i,env) = x; env \<in> list(A)|]
        ==> (\<forall> x . x \<notin> A) \<longleftrightarrow> sats(A, Neg(Exists(Equal(0,0))), env)"
   by auto
 
 lemma top_iff_sats [iff_sats]:
   "env \<in> list(A) \<Longrightarrow> 0 \<in> A \<Longrightarrow> sats(A, Exists(Equal(0,0)), env)"
   by auto
 
 lemma prefix1_iff_sats[iff_sats]:
   assumes
     "x \<in> nat" "env \<in> list(A)" "0 \<in> A" "a \<in> A"
   shows
     "a = nth(x,env) \<longleftrightarrow> sats(A, Equal(0,x+\<^sub>\<omega>1), Cons(a,env))"
     "nth(x,env) = a \<longleftrightarrow> sats(A, Equal(x+\<^sub>\<omega>1,0), Cons(a,env))"
     "a \<in> nth(x,env) \<longleftrightarrow> sats(A, Member(0,x+\<^sub>\<omega>1), Cons(a,env))"
     "nth(x,env) \<in> a \<longleftrightarrow> sats(A, Member(x+\<^sub>\<omega>1,0), Cons(a,env))"
   using assms nth_closed
   by simp_all
 
 lemma prefix2_iff_sats[iff_sats]:
   assumes
     "x \<in> nat" "env \<in> list(A)" "0 \<in> A" "a \<in> A" "b \<in> A"
   shows
     "b = nth(x,env) \<longleftrightarrow> sats(A, Equal(1,x+\<^sub>\<omega>2), Cons(a,Cons(b,env)))"
     "nth(x,env) = b \<longleftrightarrow> sats(A, Equal(x+\<^sub>\<omega>2,1), Cons(a,Cons(b,env)))"
     "b \<in> nth(x,env) \<longleftrightarrow> sats(A, Member(1,x+\<^sub>\<omega>2), Cons(a,Cons(b,env)))"
     "nth(x,env) \<in> b \<longleftrightarrow> sats(A, Member(x+\<^sub>\<omega>2,1), Cons(a,Cons(b,env)))"
   using assms nth_closed
   by simp_all
 
 lemma prefix3_iff_sats[iff_sats]:
   assumes
     "x \<in> nat" "env \<in> list(A)" "0 \<in> A" "a \<in> A" "b \<in> A" "c \<in> A"
   shows
     "c = nth(x,env) \<longleftrightarrow> sats(A, Equal(2,x+\<^sub>\<omega>3), Cons(a,Cons(b,Cons(c,env))))"
     "nth(x,env) = c \<longleftrightarrow> sats(A, Equal(x+\<^sub>\<omega>3,2), Cons(a,Cons(b,Cons(c,env))))"
     "c \<in> nth(x,env) \<longleftrightarrow> sats(A, Member(2,x+\<^sub>\<omega>3), Cons(a,Cons(b,Cons(c,env))))"
     "nth(x,env) \<in> c \<longleftrightarrow> sats(A, Member(x+\<^sub>\<omega>3,2), Cons(a,Cons(b,Cons(c,env))))"
   using assms nth_closed
   by simp_all
 
 lemmas FOL_sats_iff = sats_Nand_iff sats_Forall_iff sats_Neg_iff sats_And_iff
   sats_Or_iff sats_Implies_iff sats_Iff_iff sats_Exists_iff
 
 lemma nth_ConsI: "\<lbrakk>nth(n,l) = x; n \<in> nat\<rbrakk> \<Longrightarrow> nth(succ(n), Cons(a,l)) = x"
   by simp
 
 lemmas nth_rules = nth_0 nth_ConsI nat_0I nat_succI
 lemmas sep_rules = nth_0 nth_ConsI FOL_iff_sats function_iff_sats
   fun_plus_iff_sats successor_iff_sats
   omega_iff_sats FOL_sats_iff Replace_iff_sats
 
 text\<open>Also a different compilation of lemmas (term\<open>sep_rules\<close>) used in formula
  synthesis\<close>
 lemmas fm_defs =
   omega_fm_def limit_ordinal_fm_def empty_fm_def typed_function_fm_def
   pair_fm_def upair_fm_def domain_fm_def function_fm_def succ_fm_def
   cons_fm_def fun_apply_fm_def image_fm_def big_union_fm_def union_fm_def
   relation_fm_def composition_fm_def field_fm_def ordinal_fm_def range_fm_def
   transset_fm_def subset_fm_def Replace_fm_def
 
 lemmas formulas_def [fm_definitions] = fm_defs
   is_iterates_fm_def iterates_MH_fm_def is_wfrec_fm_def is_recfun_fm_def is_transrec_fm_def
   is_nat_case_fm_def quasinat_fm_def number1_fm_def ordinal_fm_def finite_ordinal_fm_def
   cartprod_fm_def sum_fm_def Inr_fm_def Inl_fm_def
   formula_functor_fm_def
   Memrel_fm_def transset_fm_def subset_fm_def pre_image_fm_def restriction_fm_def
   list_functor_fm_def tl_fm_def quasilist_fm_def Cons_fm_def Nil_fm_def
 
 lemmas sep_rules' [iff_sats]  = nth_0 nth_ConsI FOL_iff_sats function_iff_sats
   fun_plus_iff_sats omega_iff_sats
 
 lemmas  more_iff_sats [iff_sats] = rtran_closure_iff_sats tran_closure_iff_sats
   is_eclose_iff_sats Inl_iff_sats Inr_iff_sats fun_apply_iff_sats cartprod_iff_sats
   Collect_iff_sats
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Lambda_Replacement.thy b/thys/Transitive_Models/Lambda_Replacement.thy
--- a/thys/Transitive_Models/Lambda_Replacement.thy
+++ b/thys/Transitive_Models/Lambda_Replacement.thy
@@ -1,2128 +1,2361 @@
 section\<open>Replacements using Lambdas\<close>
 
 theory Lambda_Replacement
   imports
     Discipline_Function
 begin
 
 text\<open>In this theory we prove several instances of separation and replacement
 in @{locale M_basic}. Moreover we introduce a new locale assuming two instances
 of separation and twelve instances of lambda replacements (ie, replacement of
 the form $\lambda x y. y=\langle x, f(x) \rangle$) we prove a bunch of other
 instances.\<close>
 
 
 definition
   lam_replacement :: "[i\<Rightarrow>o,i\<Rightarrow>i] \<Rightarrow> o" where
   "lam_replacement(M,b) \<equiv> strong_replacement(M, \<lambda>x y. y = \<langle>x, b(x)\<rangle>)"
 
 lemma separation_univ :
   shows "separation(M,M)"
   unfolding separation_def by auto
 
+context M_trivial
+begin
+
+lemma lam_replacement_iff_lam_closed:
+  assumes "\<forall>x[M]. M(b(x))"
+  shows "lam_replacement(M, b) \<longleftrightarrow>  (\<forall>A[M]. M(\<lambda>x\<in>A. b(x)))"
+  using assms lam_closed lam_funtype[of _ b, THEN Pi_memberD]
+  unfolding lam_replacement_def strong_replacement_def
+  by (auto intro:lamI dest:transM)
+    (rule lam_closed, auto simp add:strong_replacement_def dest:transM)
+
+lemma lam_replacement_imp_lam_closed:
+  assumes "lam_replacement(M, b)" "M(A)" "\<forall>x\<in>A. M(b(x))"
+  shows "M(\<lambda>x\<in>A. b(x))"
+  using assms unfolding lam_replacement_def
+  by (rule_tac lam_closed, auto simp add:strong_replacement_def dest:transM)
+
+lemma lam_replacement_cong:
+  assumes "lam_replacement(M,f)" "\<forall>x[M]. f(x) = g(x)" "\<forall>x[M]. M(f(x))"
+  shows "lam_replacement(M,g)"
+proof -
+  note assms
+  moreover from this
+  have "\<forall>A[M]. M(\<lambda>x\<in>A. f(x))"
+    using lam_replacement_iff_lam_closed
+    by simp
+  moreover from calculation
+  have "(\<lambda>x\<in>A . f(x)) = (\<lambda>x\<in>A . g(x))" if "M(A)" for A
+    using lam_cong[OF refl,of A f g] transM[OF _ that]
+    by simp
+  ultimately
+  show ?thesis
+    using lam_replacement_iff_lam_closed
+    by simp
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
+
 context M_basic
 begin
 
 lemma separation_iff':
   assumes "separation(M,\<lambda>x . P(x))" "separation(M,\<lambda>x . Q(x))"
   shows "separation(M,\<lambda>x . P(x) \<longleftrightarrow> Q(x))"
   using assms separation_conj separation_imp iff_def
   by auto
 
 lemma separation_in_constant :
   assumes "M(a)"
   shows "separation(M,\<lambda>x . x\<in>a)"
 proof -
   have "{x\<in>A . x\<in>a} = A \<inter> a" for A by auto
   with \<open>M(a)\<close>
   show ?thesis using separation_iff Collect_abs
     by simp
 qed
 
 lemma separation_equal :
   shows "separation(M,\<lambda>x . x=a)"
 proof -
   have "{x\<in>A . x=a} = (if a\<in>A then {a} else 0)" for A
     by auto
   then
   have "M({x\<in>A . x=a})" if "M(A)" for A
     using transM[OF _ \<open>M(A)\<close>] by simp
   then
   show ?thesis using separation_iff Collect_abs
     by simp
 qed
 
 lemma (in M_basic) separation_in_rev:
   assumes "(M)(a)"
   shows "separation(M,\<lambda>x . a\<in>x)"
 proof -
   have eq: "{x\<in>A. a\<in>x} = Memrel(A\<union>{a}) `` {a}" for A
     unfolding ZF_Base.image_def
     by(intro equalityI,auto simp:mem_not_refl)
   moreover from assms
   have "M(Memrel(A\<union>{a}) `` {a})" if "M(A)" for A
     using that by simp
   ultimately
   show ?thesis
     using separation_iff Collect_abs
     by simp
 qed
 
-lemma lam_replacement_iff_lam_closed:
-  assumes "\<forall>x[M]. M(b(x))"
-  shows "lam_replacement(M, b) \<longleftrightarrow>  (\<forall>A[M]. M(\<lambda>x\<in>A. b(x)))"
-  using assms lam_closed lam_funtype[of _ b, THEN Pi_memberD]
-  unfolding lam_replacement_def strong_replacement_def
-  by (auto intro:lamI dest:transM)
-    (rule lam_closed, auto simp add:strong_replacement_def dest:transM)
-
-lemma lam_replacement_imp_lam_closed:
-  assumes "lam_replacement(M, b)" "M(A)" "\<forall>x\<in>A. M(b(x))"
-  shows "M(\<lambda>x\<in>A. b(x))"
-  using assms unfolding lam_replacement_def
-  by (rule_tac lam_closed, auto simp add:strong_replacement_def dest:transM)
-
-lemma lam_replacement_cong:
-  assumes "lam_replacement(M,f)" "\<forall>x[M]. f(x) = g(x)" "\<forall>x[M]. M(f(x))"
-  shows "lam_replacement(M,g)"
-proof -
-  note assms
-  moreover from this
-  have "\<forall>A[M]. M(\<lambda>x\<in>A. f(x))"
-    using lam_replacement_iff_lam_closed
-    by simp
-  moreover from calculation
-  have "(\<lambda>x\<in>A . f(x)) = (\<lambda>x\<in>A . g(x))" if "M(A)" for A
-    using lam_cong[OF refl,of A f g] transM[OF _ that]
-    by simp
-  ultimately
-  show ?thesis
-    using lam_replacement_iff_lam_closed
-    by simp
-qed
-
-lemma converse_subset : "converse(r) \<subseteq> {\<langle>snd(x),fst(x)\<rangle> . x\<in>r}"
-  unfolding converse_def
-proof(intro  subsetI, auto)
-  fix u v
-  assume "\<langle>u,v\<rangle>\<in>r" (is "?z\<in>r")
-  moreover
-  have "v=snd(?z)" "u=fst(?z)" by simp_all
-  ultimately
-  show "\<exists>z\<in>r. v=snd(z) \<and> u = fst(z)"
-    using rexI[where x="\<langle>u,v\<rangle>"] by force
-qed
-
-lemma converse_eq_aux :
-  assumes "<0,0>\<in>r"
-  shows "converse(r) = {\<langle>snd(x),fst(x)\<rangle> . x\<in>r}"
-  using converse_subset
-proof(intro equalityI subsetI,auto)
-  fix z
-  assume "z\<in>r"
-  then show "\<langle>fst(z),snd(z)\<rangle> \<in> r"
-  proof(cases "\<exists> a b . z =\<langle>a,b\<rangle>")
-    case True
-    with \<open>z\<in>r\<close>
-    show ?thesis by auto
-  next
-    case False
-    then
-    have "fst(z) = 0" "snd(z)=0"
-      unfolding fst_def snd_def by auto
-    with \<open>z\<in>r\<close> assms
-    show ?thesis by auto
-  qed
-qed
-
-lemma converse_eq_aux' :
-  assumes "<0,0>\<notin>r"
-  shows "converse(r) = {\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>}"
-  using converse_subset assms
-proof(intro equalityI subsetI,auto)
-  fix z
-  assume "z\<in>r" "snd(z)\<noteq>0"
-  then
-  obtain a b where "z = \<langle>a,b\<rangle>" unfolding snd_def by force
-  with \<open>z\<in>r\<close>
-  show "\<langle>fst(z),snd(z)\<rangle> \<in> r"
-    by auto
-next
-  fix z
-  assume "z\<in>r" "fst(z)\<noteq>0"
-  then
-  obtain a b where "z = \<langle>a,b\<rangle>" unfolding fst_def by force
-  with \<open>z\<in>r\<close>
-  show "\<langle>fst(z),snd(z)\<rangle> \<in> r"
-    by auto
-qed
-
-lemma diff_un : "b\<subseteq>a \<Longrightarrow> (a-b) \<union> b = a"
-  by auto
-
-lemma converse_eq: "converse(r) = ({\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>}) \<union> (r\<inter>{<0,0>})"
-proof(cases "<0,0>\<in>r")
-  case True
-  then
-  have "converse(r) = {\<langle>snd(x),fst(x)\<rangle> . x\<in>r}"
-    using converse_eq_aux  by auto
-  moreover
-  from True
-  have "r\<inter>{<0,0>} = {<0,0>}" "{<0,0>}\<subseteq>{\<langle>snd(x),fst(x)\<rangle> . x\<in>r}"
-    using converse_subset by auto
-  moreover from this True
-  have "{\<langle>snd(x),fst(x)\<rangle> . x\<in>r} = ({\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>}) \<union> ({<0,0>})"
-    using diff_un[of "{<0,0>}",symmetric] converse_eq_aux  by auto
-  ultimately
-  show ?thesis
-    by simp
-next
-  case False
-  then
-  have "r\<inter>{<0,0>} = 0" by auto
-  then
-  have "({\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>}) \<union> (r\<inter>{<0,0>}) = ({\<langle>snd(x),fst(x)\<rangle> . x\<in>r} - {<0,0>})"
-    by simp
-  with False
-  show ?thesis
-    using converse_eq_aux' by auto
-qed
-
-lemma range_subset : "range(r) \<subseteq> {snd(x). x\<in>r}"
-  unfolding range_def domain_def converse_def
-proof(intro  subsetI, auto)
-  fix u v
-  assume "\<langle>u,v\<rangle>\<in>r" (is "?z\<in>r")
-  moreover
-  have "v=snd(?z)" "u=fst(?z)" by simp_all
-  ultimately
-  show "\<exists>z\<in>r. v=snd(z)"
-    using rexI[where x="v"] by force
-qed
-
 lemma lam_replacement_imp_strong_replacement_aux:
   assumes "lam_replacement(M, b)" "\<forall>x[M]. M(b(x))"
   shows "strong_replacement(M, \<lambda>x y. y = b(x))"
 proof -
   {
     fix A
     note assms
     moreover
     assume "M(A)"
     moreover from calculation
     have "M(\<lambda>x\<in>A. b(x))" using lam_replacement_iff_lam_closed by auto
     ultimately
     have "M((\<lambda>x\<in>A. b(x))``A)" "\<forall>z[M]. z \<in> (\<lambda>x\<in>A. b(x))``A \<longleftrightarrow> (\<exists>x\<in>A. z = b(x))"
       by (auto simp:lam_def)
   }
   then
   show ?thesis unfolding strong_replacement_def
     by clarsimp (rule_tac x="(\<lambda>x\<in>A. b(x))``A" in rexI, auto)
 qed
 
 lemma lam_replacement_imp_RepFun_Lam:
   assumes "lam_replacement(M, f)" "M(A)"
   shows "M({y . x\<in>A , M(y) \<and> y=\<langle>x,f(x)\<rangle>})"
 proof -
   from assms
   obtain Y where 1:"M(Y)" "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,f(x)\<rangle>)"
     unfolding lam_replacement_def strong_replacement_def
     by auto
   moreover from calculation
   have "Y = {y . x\<in>A , M(y) \<and> y = \<langle>x,f(x)\<rangle>}" (is "Y=?R")
   proof(intro equalityI subsetI)
     fix y
     assume "y\<in>Y"
     moreover from this 1
     obtain x where "x\<in>A" "y=\<langle>x,f(x)\<rangle>" "M(y)"
       using transM[OF _ \<open>M(Y)\<close>] by auto
     ultimately
     show "y\<in>?R"
       by auto
   next
     fix z
     assume "z\<in>?R"
     moreover from this
     obtain a where "a\<in>A" "z=\<langle>a,f(a)\<rangle>" "M(a)" "M(f(a))"
       using transM[OF _ \<open>M(A)\<close>]
       by auto
     ultimately
     show "z\<in>Y" using 1 by simp
   qed
   ultimately
   show ?thesis by auto
 qed
 
 lemma lam_closed_imp_closed:
   assumes "\<forall>A[M]. M(\<lambda>x\<in>A. f(x))"
   shows "\<forall>x[M]. M(f(x))"
 proof
   fix x
   assume "M(x)"
   moreover from this and assms
   have "M(\<lambda>x\<in>{x}. f(x))" by simp
   ultimately
   show "M(f(x))"
     using image_lam[of "{x}" "{x}" f]
       image_closed[of "{x}" "(\<lambda>x\<in>{x}. f(x))"] by (auto dest:transM)
 qed
 
 lemma lam_replacement_if:
   assumes "lam_replacement(M,f)" "lam_replacement(M,g)" "separation(M,b)"
     "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
   shows "lam_replacement(M, \<lambda>x. if b(x) then f(x) else g(x))"
 proof -
   let ?G="\<lambda>x. if b(x) then f(x) else g(x)"
   let ?b="\<lambda>A . {x\<in>A. b(x)}" and ?b'="\<lambda>A . {x\<in>A. \<not>b(x)}"
   have eq:"(\<lambda>x\<in>A . ?G(x)) = (\<lambda>x\<in>?b(A) . f(x)) \<union> (\<lambda>x\<in>?b'(A).g(x))" for A
     unfolding lam_def by auto
   have "?b'(A) = A - ?b(A)" for A by auto
   moreover
   have "M(?b(A))" if "M(A)" for A using assms that by simp
   moreover from calculation
   have "M(?b'(A))" if "M(A)" for A using that by simp
   moreover from calculation assms
   have "M(\<lambda>x\<in>?b(A). f(x))" "M(\<lambda>x\<in>?b'(A) . g(x))" if "M(A)" for A
     using lam_replacement_iff_lam_closed that
     by simp_all
   moreover from this
   have "M((\<lambda>x\<in>?b(A) . f(x)) \<union> (\<lambda>x\<in>?b'(A).g(x)))" if "M(A)" for A
     using that by simp
   ultimately
   have "M(\<lambda>x\<in>A. if b(x) then f(x) else g(x))" if "M(A)" for A
     using that eq by simp
   with assms
   show ?thesis using lam_replacement_iff_lam_closed by simp
 qed
 
 lemma lam_replacement_constant: "M(b) \<Longrightarrow> lam_replacement(M,\<lambda>_. b)"
   unfolding lam_replacement_def strong_replacement_def
   by safe (rule_tac x="_\<times>{b}" in rexI; blast)
 
 subsection\<open>Replacement instances obtained through Powerset\<close>
 
 txt\<open>The next few lemmas provide bounds for certain constructions.\<close>
 
 lemma not_functional_Replace_0:
   assumes "\<not>(\<forall>y y'. P(y) \<and> P(y') \<longrightarrow> y=y')"
   shows "{y . x \<in> A, P(y)} = 0"
   using assms by (blast elim!: ReplaceE)
 
 lemma Replace_in_Pow_rel:
   assumes "\<And>x b. x \<in> A \<Longrightarrow> P(x,b) \<Longrightarrow> b \<in> U" "\<forall>x\<in>A. \<forall>y y'. P(x,y) \<and> P(x,y') \<longrightarrow> y=y'"
     "separation(M, \<lambda>y. \<exists>x[M]. x \<in> A \<and> P(x, y))"
     "M(U)" "M(A)"
   shows "{y . x \<in> A, P(x, y)} \<in> Pow\<^bsup>M\<^esup>(U)"
 proof -
   from assms
   have "{y . x \<in> A, P(x, y)} \<subseteq> U"
     "z \<in> {y . x \<in> A, P(x, y)} \<Longrightarrow> M(z)" for z
     by (auto dest:transM)
   with assms
   have "{y . x \<in> A, P(x, y)} = {y\<in>U . \<exists>x[M]. x\<in>A \<and> P(x,y)}"
     by (intro equalityI) (auto, blast)
   with assms
   have "M({y . x \<in> A, P(x, y)})"
     by simp
   with assms
   show ?thesis
     using mem_Pow_rel_abs by auto
 qed
 
 lemma Replace_sing_0_in_Pow_rel:
   assumes "\<And>b. P(b) \<Longrightarrow> b \<in> U"
     "separation(M, \<lambda>y. P(y))" "M(U)"
   shows "{y . x \<in> {0}, P(y)} \<in> Pow\<^bsup>M\<^esup>(U)"
 proof (cases "\<forall>y y'. P(y) \<and> P(y') \<longrightarrow> y=y'")
   case True
   with assms
   show ?thesis by (rule_tac Replace_in_Pow_rel) auto
 next
   case False
   with assms
   show ?thesis
     using nonempty not_functional_Replace_0[of P "{0}"] Pow_rel_char by auto
 qed
 
 lemma The_in_Pow_rel_Union:
   assumes "\<And>b. P(b) \<Longrightarrow> b \<in> U" "separation(M, \<lambda>y. P(y))" "M(U)"
   shows "(THE i. P(i)) \<in> Pow\<^bsup>M\<^esup>(\<Union>U)"
 proof -
   note assms
   moreover from this
   have "(THE i. P(i)) \<in> Pow(\<Union>U)"
     unfolding the_def by auto
   moreover from assms
   have "M(THE i. P(i))"
     using Replace_sing_0_in_Pow_rel[of P U] unfolding the_def
     by (auto dest:transM)
   ultimately
   show ?thesis
     using Pow_rel_char by auto
 qed
 
 lemma separation_least: "separation(M, \<lambda>y. Ord(y) \<and> P(y) \<and> (\<forall>j. j < y \<longrightarrow> \<not> P(j)))"
   unfolding separation_def
 proof
   fix z
   assume "M(z)"
   have "M({x \<in> z . x \<in> z \<and> Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))})"
     (is "M(?y)")
   proof (cases "\<exists>x\<in>z. Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))")
     case True
     with \<open>M(z)\<close>
     have "\<exists>x[M]. ?y = {x}"
       by (safe, rename_tac x, rule_tac x=x in rexI)
         (auto dest:transM, intro equalityI, auto elim:Ord_linear_lt)
     then
     show ?thesis
       by auto
   next
     case False
     then
     have "{x \<in> z . x \<in> z \<and> Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))} = 0"
       by auto
     then
     show ?thesis by auto
   qed
   moreover from this
   have "\<forall>x[M]. x \<in> ?y \<longleftrightarrow> x \<in> z \<and> Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))" by simp
   ultimately
   show "\<exists>y[M]. \<forall>x[M]. x \<in> y \<longleftrightarrow> x \<in> z \<and> Ord(x) \<and> P(x) \<and> (\<forall>j. j < x \<longrightarrow> \<not> P(j))"
     by blast
 qed
 
 lemma Least_in_Pow_rel_Union:
   assumes "\<And>b. P(b) \<Longrightarrow> b \<in> U"
     "M(U)"
   shows "(\<mu> i. P(i)) \<in> Pow\<^bsup>M\<^esup>(\<Union>U)"
   using assms separation_least unfolding Least_def
   by (rule_tac The_in_Pow_rel_Union) simp
 
 lemma bounded_lam_replacement:
   fixes U
   assumes "\<forall>X[M]. \<forall>x\<in>X. f(x) \<in> U(X)"
     and separation_f:"\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, f(x)\<rangle>)"
     and U_closed [intro,simp]: "\<And>X. M(X) \<Longrightarrow> M(U(X))"
   shows "lam_replacement(M, f)"
 proof -
   have "M(\<lambda>x\<in>A. f(x))" if "M(A)" for A
   proof -
     have "(\<lambda>x\<in>A. f(x)) = {y\<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \<union> U(A))). \<exists>x[M]. x\<in>A \<and> y = \<langle>x, f(x)\<rangle>}"
       using \<open>M(A)\<close> unfolding lam_def
     proof (intro equalityI, auto)
       fix x
       assume "x\<in>A"
       moreover
       note \<open>M(A)\<close>
       moreover from calculation assms
       have "f(x) \<in> U(A)" by simp
       moreover from calculation
       have "{x, f(x)} \<in> Pow\<^bsup>M\<^esup>(A \<union> U(A))" "{x,x} \<in> Pow\<^bsup>M\<^esup>(A \<union> U(A))"
         using Pow_rel_char[of "A \<union> U(A)"] by (auto dest:transM)
       ultimately
       show "\<langle>x, f(x)\<rangle> \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \<union> U(A)))"
         using Pow_rel_char[of "Pow\<^bsup>M\<^esup>(A \<union> U(A))"] unfolding Pair_def
         by (auto dest:transM)
     qed
     moreover from \<open>M(A)\<close>
     have "M({y\<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \<union> U(A))). \<exists>x[M]. x\<in>A \<and> y = \<langle>x, f(x)\<rangle>})"
       using separation_f
       by (rule_tac separation_closed) simp_all
     ultimately
     show ?thesis
       by simp
   qed
   moreover from this
   have "\<forall>x[M]. M(f(x))"
     using lam_closed_imp_closed by simp
   ultimately
   show ?thesis
     using assms
     by (rule_tac lam_replacement_iff_lam_closed[THEN iffD2]) simp_all
 qed
 
-lemma lam_replacement_domain':
-  assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, domain(x)\<rangle>)"
-  shows "lam_replacement(M,domain)"
+lemma fst_in_double_Union:
+  assumes "x\<in>X" "M(X)"
+  shows "fst(x) \<in> {0} \<union> \<Union>\<Union>X"
 proof -
-  have "\<forall>x\<in>X. domain(x) \<in> Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>X)" if "M(X)" for X
-  proof
-    fix x
-    assume "x\<in>X"
-    moreover
-    note \<open>M(X)\<close>
-    moreover from calculation
-    have "M(x)" by (auto dest:transM)
+  have "fst(x) \<in> {0} \<union> \<Union>x" for x
+    unfolding fst_def
+    using the_0 fst_conv
+    by(cases "\<exists>!a.\<exists>b. x = \<langle>a,b\<rangle>", auto, simp add:Pair_def)
+  with assms
+  show ?thesis by auto
+qed
+
+lemma snd_in_double_Union:
+  assumes "x\<in>X" "M(X)"
+  shows "snd(x) \<in> {0} \<union> \<Union>\<Union>X"
+proof -
+  have "snd(x) \<in> {0} \<union> \<Union>x" for x
+    unfolding snd_def
+    using the_0 snd_conv
+    by(cases "\<exists>!a.\<exists>b. x = \<langle>a,b\<rangle>", auto, simp add:Pair_def)
+  with assms
+  show ?thesis by auto
+qed
+
+lemma bounded_lam_replacement_binary:
+  fixes U
+  assumes "\<forall>X[M]. \<forall>x\<in>X. \<forall>y\<in>X. f(x,y) \<in> U(X)"
+    and separation_f:"\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, f(fst(x),snd(x))\<rangle>)"
+    and U_closed [intro,simp]: "\<And>X. M(X) \<Longrightarrow> M(U(X))"
+  shows "lam_replacement(M, \<lambda>r . f(fst(r),snd(r)))"
+proof -
+  have "M(\<lambda>x\<in>A. f(fst(x),snd(x)))" if "M(A)" for A
+  proof -
+    have "(\<lambda>x\<in>A. f(fst(x),snd(x))) =
+      {y\<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \<union> U({0} \<union> \<Union>\<Union>A))). \<exists>x[M]. x\<in>A \<and> y = \<langle>x, f(fst(x),snd(x))\<rangle>}"
+      using \<open>M(A)\<close> unfolding lam_def
+    proof (intro equalityI, auto)
+      fix x
+      assume "x\<in>A"
+      moreover
+      note \<open>M(A)\<close>
+      moreover from calculation assms
+      have "f(fst(x),snd(x)) \<in> U({0} \<union> \<Union>\<Union>A)"
+        using fst_in_double_Union snd_in_double_Union by simp
+      moreover from calculation
+      have "{x, f(fst(x),snd(x))} \<in> Pow\<^bsup>M\<^esup>(A \<union> U({0} \<union> \<Union>\<Union>A))"
+        "{x,x} \<in> Pow\<^bsup>M\<^esup>(A \<union> U({0} \<union> \<Union>\<Union>A))"
+        using Pow_rel_char[of "A \<union> U({0} \<union> \<Union>\<Union>A)"] by (auto dest:transM)
+      ultimately
+      show "\<langle>x, f(fst(x),snd(x))\<rangle> \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \<union> U({0} \<union> \<Union>\<Union>A)))"
+        using Pow_rel_char[of "Pow\<^bsup>M\<^esup>(A \<union> U({0} \<union> \<Union>\<Union>A))"] unfolding Pair_def
+        by (auto dest:transM)
+    qed
+    moreover from \<open>M(A)\<close>
+    have "M({y\<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A \<union> U({0} \<union> \<Union>\<Union>A))). \<exists>x[M]. x\<in>A \<and> y = \<langle>x, f(fst(x),snd(x))\<rangle>})"
+      using separation_f
+      by (rule_tac separation_closed) simp_all
     ultimately
-    show "domain(x) \<in> Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>X)"
-      by(rule_tac mem_Pow_rel_abs[of "domain(x)" "\<Union>\<Union>\<Union>X",THEN iffD2],auto simp:Pair_def,force)
+    show ?thesis
+      by simp
   qed
-  with assms
+  moreover from this
+  have "\<forall>x[M]. M(f(fst(x),snd(x)))"
+    using lam_closed_imp_closed[of "\<lambda>x. f(fst(x),snd(x))"] by simp
+  ultimately
   show ?thesis
-    using bounded_lam_replacement[of domain "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>X)"] by simp
+    using assms
+    by (rule_tac lam_replacement_iff_lam_closed[THEN iffD2]) simp_all
 qed
 
 \<comment> \<open>Below we assume the replacement instance for @{term fst}. Alternatively it follows from the
 instance of separation assumed in this lemma.\<close>
 lemma lam_replacement_fst':
-  assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, fst(x)\<rangle>)"
+  assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, fst(x)\<rangle>)"
   shows "lam_replacement(M,fst)"
-proof -
-  have "\<forall>x\<in>X. fst(x) \<in> {0} \<union> \<Union>\<Union>X" if "M(X)" for X
-  proof
-    fix x
-    assume "x\<in>X"
-    moreover
-    note \<open>M(X)\<close>
-    moreover from calculation
-    have "M(x)" by (auto dest:transM)
-    ultimately
-    show "fst(x) \<in> {0} \<union> \<Union>\<Union>X" unfolding fst_def Pair_def
-      by (auto, rule_tac [1] the_0) force\<comment> \<open>tricky! And slow. It doesn't work for \<^term>\<open>snd\<close>\<close>
-  qed
-  with assms
-  show ?thesis
-    using bounded_lam_replacement[of fst "\<lambda>X. {0} \<union> \<Union>\<Union>X"] by simp
-qed
+  using fst_in_double_Union assms
+    bounded_lam_replacement[of fst "\<lambda>X. {0} \<union> \<Union>\<Union>X"] by simp
+
+lemma lam_replacement_snd':
+  assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, snd(x)\<rangle>)"
+  shows "lam_replacement(M,snd)"
+  using snd_in_double_Union assms
+    bounded_lam_replacement[of snd "\<lambda>X. {0} \<union> \<Union>\<Union>X"] by simp
 
 lemma lam_replacement_restrict:
-  assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, restrict(x,B)\<rangle>)"  "M(B)"
+  assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, restrict(x,B)\<rangle>)"  "M(B)"
   shows "lam_replacement(M, \<lambda>r . restrict(r,B))"
 proof -
-  have "\<forall>r\<in>R. restrict(r,B)\<in>Pow\<^bsup>M\<^esup>(\<Union>R)" if "M(R)" for R
-  proof -
-    {
-      fix r
-      assume "r\<in>R"
-      with \<open>M(B)\<close>
-      have "restrict(r,B)\<in>Pow(\<Union>R)" "M(restrict(r,B))"
-        using Union_upper subset_Pow_Union subset_trans[OF restrict_subset]
-          transM[OF _ \<open>M(R)\<close>]
-        by simp_all
-    } then show ?thesis
-      using Pow_rel_char that by simp
-  qed
+  from assms
+  have "restrict(r,B)\<in>Pow\<^bsup>M\<^esup>(\<Union>R)" if "M(R)" "r\<in>R" for r R
+    using Union_upper subset_Pow_Union subset_trans[OF restrict_subset]
+      Pow_rel_char that transM[of _ R]
+    by auto
   with assms
   show ?thesis
     using bounded_lam_replacement[of "\<lambda>r . restrict(r,B)" "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>X)"]
     by simp
 qed
 
+lemma domain_sub_Union3:
+  assumes "r\<in>R" shows "domain(r) \<subseteq> (\<Union>\<Union>\<Union>R)"
+  using assms
+  unfolding domain_def Pair_def
+  by auto
+
+lemma range_sub_Union3:
+  assumes "r\<in>R" shows "range(r) \<subseteq> (\<Union>\<Union>\<Union>R)"
+  unfolding range_def converse_def domain_def
+  by (clarsimp, auto simp add:Pair_def,rule_tac x="r" in rev_bexI,auto simp add:assms)
+
+lemma lam_replacement_converse':
+  assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, converse(x)\<rangle>)"
+  shows "lam_replacement(M, \<lambda>r . converse(r))"
+proof -
+  have "converse(r) \<subseteq> range(r) \<times> domain(r)" for r
+    unfolding range_def domain_def converse_def
+    by auto
+  moreover from this
+  have "converse(r) \<in> Pow(\<Union>\<Union>\<Union>R \<times> \<Union>\<Union>\<Union>R)" if "r\<in>R" for r R
+    using that domain_sub_Union3 range_sub_Union3
+      subset_trans[OF \<open>converse(_)\<subseteq>_\<close>] Sigma_mono
+    by auto
+  ultimately
+  have "converse(r) \<in> Pow\<^bsup>M\<^esup>((\<Union>\<Union>\<Union>R \<times> \<Union>\<Union>\<Union>R))" if "M(R)" "r\<in>R" for r R
+    using that Pow_rel_char transM[of _ R] by auto
+  with assms
+  show ?thesis
+    using bounded_lam_replacement[of "\<lambda>r . converse(r)" "\<lambda>X. Pow\<^bsup>M\<^esup>((\<Union>\<Union>\<Union>X \<times> \<Union>\<Union>\<Union>X))"]
+    by simp
+qed
+
+lemma lam_replacement_domain' :
+  assumes  "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x \<in> A \<and> y = \<langle>x, domain(x)\<rangle>)"
+  shows "lam_replacement(M,domain)"
+proof -
+  have "domain(x) \<in> Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>A)" if "M(A)" "x\<in>A" for x A
+    using that domain_sub_Union3 transM[of x A] Pow_rel_char
+    by auto
+  with assms
+  show ?thesis
+    using bounded_lam_replacement[where U="\<lambda>A . Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>A)"]
+    by auto
+qed
+
+lemma lam_replacement_Union' :
+  assumes  "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x \<in> A \<and> y = \<langle>x, \<Union>x\<rangle>)"
+  shows "lam_replacement(M,Union)"
+proof -
+  have "\<Union>x \<in> Pow(\<Union>\<Union>A)" if "x\<in>A" for x A
+    using that by auto
+  then
+  have "\<Union>x \<in> Pow\<^bsup>M\<^esup>(\<Union>\<Union>A)" if "M(A)" "x\<in>A" for x A
+    using that transM[of x A] Pow_rel_char
+    by auto
+  with assms
+  show ?thesis
+    using bounded_lam_replacement[where U="\<lambda>A . Pow\<^bsup>M\<^esup>(\<Union>\<Union>A)"]
+    by auto
+qed
+
+lemma Upair_in_Pow_rel:
+  assumes "x\<in>X" "y\<in>X" "M(X)"
+  shows "Upair(x,y) \<in> Pow\<^bsup>M\<^esup>(X)"
+  using assms transM[of _  X] mem_Pow_rel_abs
+  by auto
+
+lemma lam_replacement_Upair':
+  assumes
+    "\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, Upair(fst(x),snd(x))\<rangle>)"
+  shows
+    "lam_replacement(M, \<lambda>r . Upair(fst(r),snd(r)))"
+  using assms Upair_in_Pow_rel
+  by (rule_tac bounded_lam_replacement_binary[of _ "\<lambda>X. Pow\<^bsup>M\<^esup>(X)"]) auto
+
+lemma Diff_in_Pow_rel_Union:
+  assumes "x\<in>X" "y\<in>X" "M(X)"
+  shows "Diff(x,y) \<in> Pow\<^bsup>M\<^esup>(\<Union>X)"
+  using assms transM[of _  X] mem_Pow_rel_abs
+  by auto
+
+lemma lam_replacement_Diff'':
+  assumes
+    "\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, Diff(fst(x),snd(x))\<rangle>)"
+  shows
+    "lam_replacement(M, \<lambda>r . Diff(fst(r),snd(r)))"
+  using assms Diff_in_Pow_rel_Union
+  by (rule_tac bounded_lam_replacement_binary[of _ "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>X)"]) auto
+
+lemma Image_in_Pow_rel_Union3:
+  assumes "x\<in>X" "y\<in>X" "M(X)"
+  shows "Image(x,y) \<in> Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>X)"
+proof -
+  from assms
+  have "\<langle>a, b\<rangle> \<in> x \<Longrightarrow> b \<in> \<Union>\<Union>x" for a b
+    unfolding Pair_def by (auto dest:transM)
+  moreover from this and assms
+  have "\<langle>a, b\<rangle> \<in> x \<Longrightarrow> M(b)" for a b
+    using transM[of _  X] transM[of _  x]
+    by auto
+  ultimately
+  show ?thesis
+    using assms transM[of _  X] transM[of _  x] mem_Pow_rel_abs
+    by auto fast
+qed
+
+lemma lam_replacement_Image':
+  assumes
+    "\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, Image(fst(x),snd(x))\<rangle>)"
+  shows
+    "lam_replacement(M, \<lambda>r . Image(fst(r),snd(r)))"
+  using assms Image_in_Pow_rel_Union3
+  by (rule_tac bounded_lam_replacement_binary[of _ "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>\<Union>\<Union>X)"]) auto
+
+lemma comp_in_Pow_rel:
+  assumes "x\<in>X" "y\<in>X" "M(X)"
+  shows "comp(x,y) \<in> Pow\<^bsup>M\<^esup>((\<Union>\<Union>\<Union>X \<times> \<Union>\<Union>\<Union>X))"
+proof -
+  have "comp(x,y) \<subseteq> domain(y) \<times> range(x)"
+    using M_comp_iff by auto
+  moreover
+  note assms
+  moreover from this
+  have "comp(x,y) \<in> Pow(\<Union>\<Union>\<Union>X \<times> \<Union>\<Union>\<Union>X)"
+    using domain_sub_Union3 range_sub_Union3
+      subset_trans[OF \<open>comp(_,_)\<subseteq>_\<close>] Sigma_mono
+    by auto
+  ultimately
+  show "comp(x,y) \<in> Pow\<^bsup>M\<^esup>((\<Union>\<Union>\<Union>X \<times> \<Union>\<Union>\<Union>X))"
+    using Pow_rel_char transM[of _ X] by auto
+qed
+
+lemma lam_replacement_comp'':
+  assumes
+    "\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, comp(fst(x),snd(x))\<rangle>)"
+  shows
+    "lam_replacement(M, \<lambda>r . comp(fst(r),snd(r)))"
+  using assms comp_in_Pow_rel
+  by (rule_tac bounded_lam_replacement_binary[of _ "\<lambda>X. Pow\<^bsup>M\<^esup>((\<Union>\<Union>\<Union>X \<times> \<Union>\<Union>\<Union>X))"]) auto
+
+lemma minimum_in_Union:
+  assumes "x\<in>X" "y\<in>X" "M(X)"
+  shows "minimum(x,y) \<in> {0} \<union> \<Union>X"
+  using assms minimum_in'
+  by auto
+
+lemma lam_replacement_minimum':
+  assumes
+    "\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, minimum(fst(x),snd(x))\<rangle>)"
+  shows
+    "lam_replacement(M, \<lambda>r . minimum(fst(r),snd(r)))"
+  using assms minimum_in_Union
+  by (rule_tac bounded_lam_replacement_binary[of _ "\<lambda>X. {0} \<union> \<Union>X"]) auto
+
+lemma lam_replacement_Pow_rel:
+  assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x \<in> A \<and> y = \<langle>x, Pow_rel(M,x)\<rangle>)"
+  shows "lam_replacement(M,Pow_rel(M))"
+proof -
+  have "Pow_rel(M,x) \<in> Pow(Pow(\<Union>A))" if "x\<in>A" "M(A)" for x A
+    using that transM[of x A] def_Pow_rel[of _ x] by (auto dest:transM)
+  then
+  have "Pow_rel(M,x) \<in> Pow(Pow\<^bsup>M\<^esup>(\<Union>A))" if "M(A)" "x\<in>A" for x A
+    using that transM[of x A] Pow_rel_char
+    by auto
+  then
+  have "Pow_rel(M,x) \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>A))" if "M(A)" "x\<in>A" for x A
+    using that transM[of x A] Pow_rel_char[of "Pow\<^bsup>M\<^esup>(\<Union>A)"]
+    by auto
+  with assms
+  show ?thesis
+    using bounded_lam_replacement[where U="\<lambda>A. Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>A))"]
+    by auto
+qed
+
 end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
 
+definition
+  middle_del :: "i\<Rightarrow>i\<Rightarrow>i" where
+  "middle_del(x,y) \<equiv> \<langle>fst(x),snd(y)\<rangle>"
+
+relativize functional "middle_del" "middle_del_rel"
+relationalize "middle_del_rel" "is_middle_del"
+synthesize "is_middle_del" from_definition
+arity_theorem for "is_middle_del_fm"
+
+context M_basic
+begin
+
+lemma middle_del_in_cartprod:
+  assumes "x\<in>X" "y\<in>X" "M(X)"
+  shows "middle_del(x,y) \<in> ({0} \<union> \<Union>\<Union>X) \<times> ({0} \<union> \<Union>\<Union>X)"
+  using assms Pow_rel_char transM[of _ X] fst_in_double_Union snd_in_double_Union
+  unfolding middle_del_def by auto
+
+lemma lam_replacement_middle_del':
+  assumes
+    "\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, middle_del(fst(x),snd(x))\<rangle>)"
+  shows
+    "lam_replacement(M, \<lambda>r . middle_del(fst(r),snd(r)))"
+  using assms middle_del_in_cartprod
+  by (rule_tac bounded_lam_replacement_binary[of _ "\<lambda>X. ({0} \<union> \<Union>\<Union>X) \<times> ({0} \<union> \<Union>\<Union>X)"]) auto
+
+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
+
+definition
+  prodRepl :: "i\<Rightarrow>i\<Rightarrow>i" where
+  "prodRepl(x,y) \<equiv> \<langle>snd(x),\<langle>fst(x),snd(y)\<rangle>\<rangle>"
+
+relativize functional "prodRepl" "prodRepl_rel"
+relationalize "prodRepl_rel" "is_prodRepl"
+synthesize "is_prodRepl" from_definition
+arity_theorem for "is_prodRepl_fm"
+
+context M_basic
+begin
+
+lemma prodRepl_in_cartprod:
+  assumes "x\<in>X" "y\<in>X" "M(X)"
+  shows "prodRepl(x,y) \<in> ({0} \<union> \<Union>\<Union>X) \<times> ({0} \<union> \<Union>\<Union>X) \<times> ({0} \<union> \<Union>\<Union>X)"
+  using assms Pow_rel_char transM[of _ X] fst_in_double_Union snd_in_double_Union
+  unfolding prodRepl_def by auto
+
+lemma lam_replacement_prodRepl':
+  assumes
+    "\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, prodRepl(fst(x),snd(x))\<rangle>)"
+  shows
+    "lam_replacement(M, \<lambda>r . prodRepl(fst(r),snd(r)))"
+  using assms prodRepl_in_cartprod
+  by (rule_tac bounded_lam_replacement_binary[of _
+        "\<lambda>X. ({0} \<union> \<Union>\<Union>X) \<times> ({0} \<union> \<Union>\<Union>X) \<times> ({0} \<union> \<Union>\<Union>X)"]) auto
+
+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
+
+context M_Perm
+begin
+
+lemma inj_rel_in_Pow_rel_Pow_rel:
+  assumes "x\<in>X" "y\<in>X" "M(X)"
+  shows "inj\<^bsup>M\<^esup>(x,y) \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>X \<times> \<Union>X))"
+  using assms transM[of _  X] mem_Pow_rel_abs inj_def Pi_def
+  by clarsimp (use inj_rel_char in auto)
+
+lemma lam_replacement_inj_rel':
+  assumes
+    "\<forall>A[M]. separation(M,\<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, inj\<^bsup>M\<^esup>(fst(x),snd(x))\<rangle>)"
+  shows
+    "lam_replacement(M, \<lambda>r . inj\<^bsup>M\<^esup>(fst(r),snd(r)))"
+  using assms inj_rel_in_Pow_rel_Pow_rel
+  by (rule_tac bounded_lam_replacement_binary[of _ "\<lambda>X. Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>X \<times> \<Union>X))"]) auto
+
+end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
+
 locale M_replacement = M_basic +
   assumes
     lam_replacement_domain: "lam_replacement(M,domain)"
     and
     lam_replacement_fst: "lam_replacement(M,fst)"
     and
     lam_replacement_snd: "lam_replacement(M,snd)"
     and
     lam_replacement_Union: "lam_replacement(M,Union)"
     and
-    middle_del_replacement: "strong_replacement(M, \<lambda>x y. y=\<langle>fst(fst(x)),snd(snd(x))\<rangle>)"
+    lam_replacement_middle_del: "lam_replacement(M, \<lambda>r. middle_del(fst(r),snd(r)))"
     and
-    product_replacement:
-    "strong_replacement(M, \<lambda>x y. y=\<langle>snd(fst(x)),\<langle>fst(fst(x)),snd(snd(x))\<rangle>\<rangle>)"
+    lam_replacement_prodRepl: "lam_replacement(M, \<lambda>r. prodRepl(fst(r),snd(r)))"
     and
     lam_replacement_Upair:"lam_replacement(M, \<lambda>p. Upair(fst(p),snd(p)))"
     and
     lam_replacement_Diff:"lam_replacement(M, \<lambda>p. fst(p) - snd(p))"
     and
     lam_replacement_Image:"lam_replacement(M, \<lambda>p. fst(p) `` snd(p))"
     and
     middle_separation: "separation(M, \<lambda>x. snd(fst(x))=fst(snd(x)))"
     and
     separation_fst_in_snd: "separation(M, \<lambda>y. fst(snd(y)) \<in> snd(snd(y)))"
     and
     lam_replacement_converse : "lam_replacement(M,converse)"
     and
     lam_replacement_comp: "lam_replacement(M, \<lambda>x. fst(x) O snd(x))"
 begin
 
 lemma lam_replacement_imp_strong_replacement:
   assumes "lam_replacement(M, f)"
   shows "strong_replacement(M, \<lambda>x y. y = f(x))"
 proof -
   {
     fix A
     assume "M(A)"
     moreover from calculation assms
     obtain Y where 1:"M(Y)" "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,f(x)\<rangle>)"
       unfolding lam_replacement_def strong_replacement_def
       by auto
     moreover from this
     have "M({snd(b) . b \<in> Y})"
       using transM[OF _ \<open>M(Y)\<close>] lam_replacement_snd lam_replacement_imp_strong_replacement_aux
         RepFun_closed by simp
     moreover
     have "{snd(b) . b \<in> Y} = {y . x\<in>A , M(f(x)) \<and> y=f(x)}" (is "?L=?R")
     proof(intro equalityI subsetI)
       fix x
       assume "x\<in>?L"
       moreover from this
       obtain b where "b\<in>Y" "x=snd(b)" "M(b)"
         using transM[OF _ \<open>M(Y)\<close>] by auto
       moreover from this 1
       obtain a where "a\<in>A" "b=\<langle>a,f(a)\<rangle>" by auto
       moreover from calculation
       have "x=f(a)" by simp
       ultimately show "x\<in>?R"
         by auto
     next
       fix z
       assume "z\<in>?R"
       moreover from this
       obtain a where "a\<in>A" "z=f(a)" "M(a)" "M(f(a))"
         using transM[OF _ \<open>M(A)\<close>]
         by auto
       moreover from calculation this 1
       have "z=snd(\<langle>a,f(a)\<rangle>)" "\<langle>a,f(a)\<rangle> \<in> Y" by auto
       ultimately
       show "z\<in>?L" by force
     qed
     ultimately
     have "\<exists>Z[M]. \<forall>z[M]. z\<in>Z \<longleftrightarrow> (\<exists>a[M]. a\<in>A \<and> z=f(a))"
       by (rule_tac rexI[where x="{snd(b) . b \<in> Y}"],auto)
   }
   then
   show ?thesis unfolding strong_replacement_def by simp
 qed
 
 lemma Collect_middle: "{p \<in> (\<lambda>x\<in>A. f(x)) \<times> (\<lambda>x\<in>{f(x) . x\<in>A}. g(x)) . snd(fst(p))=fst(snd(p))}
      = { \<langle>\<langle>x,f(x)\<rangle>,\<langle>f(x),g(f(x))\<rangle>\<rangle> . x\<in>A }"
   by (intro equalityI; auto simp:lam_def)
 
 lemma RepFun_middle_del: "{ \<langle>fst(fst(p)),snd(snd(p))\<rangle> . p \<in> { \<langle>\<langle>x,f(x)\<rangle>,\<langle>f(x),g(f(x))\<rangle>\<rangle> . x\<in>A }}
         =  { \<langle>x,g(f(x))\<rangle> . x\<in>A }"
   by auto
 
 lemma lam_replacement_imp_RepFun:
   assumes "lam_replacement(M, f)" "M(A)"
   shows "M({y . x\<in>A , M(y) \<and> y=f(x)})"
 proof -
   from assms
   obtain Y where 1:"M(Y)" "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,f(x)\<rangle>)"
     unfolding lam_replacement_def strong_replacement_def
     by auto
   moreover from this
   have "M({snd(b) . b \<in> Y})"
     using transM[OF _ \<open>M(Y)\<close>] lam_replacement_snd lam_replacement_imp_strong_replacement_aux
       RepFun_closed by simp
   moreover
   have "{snd(b) . b \<in> Y} = {y . x\<in>A , M(y) \<and> y=f(x)}" (is "?L=?R")
   proof(intro equalityI subsetI)
     fix x
     assume "x\<in>?L"
     moreover from this
     obtain b where "b\<in>Y" "x=snd(b)" "M(b)"
       using transM[OF _ \<open>M(Y)\<close>] by auto
     moreover from this 1
     obtain a where "a\<in>A" "b=\<langle>a,f(a)\<rangle>" by auto
     moreover from calculation
     have "x=f(a)" by simp
     ultimately show "x\<in>?R"
       by auto
   next
     fix z
     assume "z\<in>?R"
     moreover from this
     obtain a where "a\<in>A" "z=f(a)" "M(a)" "M(f(a))"
       using transM[OF _ \<open>M(A)\<close>]
       by auto
     moreover from calculation this 1
     have "z=snd(\<langle>a,f(a)\<rangle>)" "\<langle>a,f(a)\<rangle> \<in> Y" by auto
     ultimately
     show "z\<in>?L" by force
   qed
   ultimately
   show ?thesis by simp
 qed
 
 lemma lam_replacement_product:
   assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
   shows "lam_replacement(M, \<lambda>x. \<langle>f(x),g(x)\<rangle>)"
 proof -
   {
     fix A
     let ?Y="{y . x\<in>A , M(y) \<and> y=f(x)}"
     let ?Y'="{y . x\<in>A ,M(y) \<and>  y=\<langle>x,f(x)\<rangle>}"
     let ?Z="{y . x\<in>A , M(y) \<and> y=g(x)}"
     let ?Z'="{y . x\<in>A ,M(y) \<and>  y=\<langle>x,g(x)\<rangle>}"
     have "x\<in>C \<Longrightarrow> y\<in>C \<Longrightarrow> fst(x) = fst(y) \<longrightarrow> M(fst(y)) \<and> M(snd(x)) \<and> M(snd(y))" if "M(C)" for C y x
       using transM[OF _ that] by auto
     moreover
     note assms
     moreover
     assume "M(A)"
     moreover from \<open>M(A)\<close> assms(1)
     have "M(converse(?Y'))" "M(?Y)"
       using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun by auto
     moreover from calculation
     have "M(?Z)" "M(?Z')"
       using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun by auto
     moreover from calculation
     have "M(converse(?Y')\<times>?Z')"
       by simp
     moreover from this
     have "M({p \<in> converse(?Y')\<times>?Z' . snd(fst(p))=fst(snd(p))})" (is "M(?P)")
       using middle_separation by simp
     moreover from calculation
     have "M({ \<langle>snd(fst(p)),\<langle>fst(fst(p)),snd(snd(p))\<rangle>\<rangle> . p\<in>?P })" (is "M(?R)")
-      using RepFun_closed[OF product_replacement \<open>M(?P)\<close> ] by simp
+      using RepFun_closed[OF lam_replacement_prodRepl[THEN
+            lam_replacement_imp_strong_replacement] \<open>M(?P)\<close> ]
+      unfolding prodRepl_def by simp
     ultimately
     have "b \<in> ?R \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,\<langle>f(x),g(x)\<rangle>\<rangle>)" if "M(b)" for b
       using that
-      apply(intro iffI)apply(auto)[1]
+      apply(intro iffI) apply(auto)[1]
     proof -
       assume " \<exists>x[M]. x \<in> A \<and> b = \<langle>x, f(x), g(x)\<rangle>"
       moreover from this
       obtain x where "M(x)" "x\<in>A" "b= \<langle>x, \<langle>f(x), g(x)\<rangle>\<rangle>"
         by auto
       moreover from calculation that
       have "M(\<langle>x,f(x)\<rangle>)" "M(\<langle>x,g(x)\<rangle>)" by auto
       moreover from calculation
       have "\<langle>f(x),x\<rangle> \<in> converse(?Y')" "\<langle>x,g(x)\<rangle> \<in> ?Z'" by auto
       moreover from calculation
       have "\<langle>\<langle>f(x),x\<rangle>,\<langle>x,g(x)\<rangle>\<rangle>\<in>converse(?Y')\<times>?Z'" by auto
       moreover from calculation
       have "\<langle>\<langle>f(x),x\<rangle>,\<langle>x,g(x)\<rangle>\<rangle> \<in> ?P"
         (is "?p\<in>?P")
         by auto
       moreover from calculation
       have "b = \<langle>snd(fst(?p)),\<langle>fst(fst(?p)),snd(snd(?p))\<rangle>\<rangle>" by auto
       moreover from calculation
       have "\<langle>snd(fst(?p)),\<langle>fst(fst(?p)),snd(snd(?p))\<rangle>\<rangle>\<in>?R"
         by(rule_tac RepFunI[of ?p ?P], simp)
       ultimately show "b\<in>?R" by simp
     qed
     with \<open>M(?R)\<close>
     have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,\<langle>f(x),g(x)\<rangle>\<rangle>)"
       by (rule_tac rexI[where x="?R"],simp_all)
   }
   with assms
   show ?thesis using lam_replacement_def strong_replacement_def by simp
 qed
 
 lemma lam_replacement_hcomp:
   assumes "lam_replacement(M,f)" "lam_replacement(M,g)" "\<forall>x[M]. M(f(x))"
   shows "lam_replacement(M, \<lambda>x. g(f(x)))"
 proof -
   {
     fix A
     let ?Y="{y . x\<in>A , y=f(x)}"
     let ?Y'="{y . x\<in>A , y=\<langle>x,f(x)\<rangle>}"
     have "\<forall>x\<in>C. M(\<langle>fst(fst(x)),snd(snd(x))\<rangle>)" if "M(C)" for C
       using transM[OF _ that] by auto
     moreover
     note assms
     moreover
     assume "M(A)"
     moreover from assms
     have eq:"?Y = {y . x\<in>A ,M(y) \<and> y=f(x)}"  "?Y' = {y . x\<in>A ,M(y) \<and> y=\<langle>x,f(x)\<rangle>}"
       using transM[OF _ \<open>M(A)\<close>] by auto
     moreover from \<open>M(A)\<close> assms(1)
     have "M(?Y')" "M(?Y)"
       using lam_replacement_imp_RepFun_Lam lam_replacement_imp_RepFun eq by auto
     moreover from calculation
     have "M({z . y\<in>?Y , M(z) \<and> z=\<langle>y,g(y)\<rangle>})" (is "M(?Z)")
       using lam_replacement_imp_RepFun_Lam by auto
     moreover from calculation
     have "M(?Y'\<times>?Z)"
       by simp
     moreover from this
     have "M({p \<in> ?Y'\<times>?Z . snd(fst(p))=fst(snd(p))})" (is "M(?P)")
       using middle_separation by simp
     moreover from calculation
     have "M({ \<langle>fst(fst(p)),snd(snd(p))\<rangle> . p\<in>?P })" (is "M(?R)")
-      using RepFun_closed[OF middle_del_replacement \<open>M(?P)\<close>] by simp
+      using RepFun_closed[OF lam_replacement_middle_del[THEN
+            lam_replacement_imp_strong_replacement] \<open>M(?P)\<close>]
+      unfolding middle_del_def by simp
     ultimately
     have "b \<in> ?R \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,g(f(x))\<rangle>)" if "M(b)" for b
       using that assms(3)
       apply(intro iffI) apply(auto)[1]
     proof -
       assume "\<exists>x[M]. x \<in> A \<and> b = \<langle>x, g(f(x))\<rangle>"
       moreover from this
       obtain x where "M(x)" "x\<in>A" "b= \<langle>x, g(f(x))\<rangle>"
         by auto
       moreover from calculation that assms(3)
       have "M(f(x))" "M(g(f(x)))" by auto
       moreover from calculation
       have "\<langle>x,f(x)\<rangle> \<in> ?Y'" by auto
       moreover from calculation
       have "\<langle>f(x),g(f(x))\<rangle>\<in>?Z" by auto
       moreover from calculation
       have "\<langle>\<langle>x,f(x)\<rangle>,\<langle>f(x),g(f(x))\<rangle>\<rangle> \<in> ?P"
         (is "?p\<in>?P")
         by auto
       moreover from calculation
       have "b = \<langle>fst(fst(?p)),snd(snd(?p))\<rangle>" by auto
       moreover from calculation
       have "\<langle>fst(fst(?p)),snd(snd(?p))\<rangle>\<in>?R"
         by(rule_tac RepFunI[of ?p ?P], simp)
       ultimately show "b\<in>?R" by simp
     qed
     with \<open>M(?R)\<close>
     have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> b = \<langle>x,g(f(x))\<rangle>)"
       by (rule_tac rexI[where x="?R"],simp_all)
   }
   with assms
   show ?thesis using lam_replacement_def strong_replacement_def by simp
 qed
 
 lemma lam_replacement_Collect :
   assumes "M(A)" "\<forall>x[M]. separation(M,F(x))"
     "separation(M,\<lambda>p . \<forall>x\<in>A. x\<in>snd(p) \<longleftrightarrow> F(fst(p),x))"
   shows "lam_replacement(M,\<lambda>x. {y\<in>A . F(x,y)})"
 proof -
   {
     fix Z
     let ?Y="\<lambda>z.{x\<in>A . F(z,x)}"
     assume "M(Z)"
     moreover from this
     have "M(?Y(z))" if "z\<in>Z" for z
       using assms that transM[of _ Z] by simp
     moreover from this
     have "?Y(z)\<in>Pow\<^bsup>M\<^esup>(A)" if "z\<in>Z" for z
       using Pow_rel_char that assms by auto
     moreover from calculation \<open>M(A)\<close>
     have "M(Z\<times>Pow\<^bsup>M\<^esup>(A))" by simp
     moreover from this
     have "M({p \<in> Z\<times>Pow\<^bsup>M\<^esup>(A) . \<forall>x\<in>A. x\<in>snd(p) \<longleftrightarrow> F(fst(p),x)})" (is "M(?P)")
       using assms by simp
     ultimately
     have "b \<in> ?P \<longleftrightarrow> (\<exists>z[M]. z\<in>Z \<and> b=\<langle>z,?Y(z)\<rangle>)" if "M(b)" for b
       using  assms(1) Pow_rel_char[OF \<open>M(A)\<close>] that
       by(intro iffI,auto,intro equalityI,auto)
     with \<open>M(?P)\<close>
     have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>z[M]. z \<in> Z \<and> b = \<langle>z,?Y(z)\<rangle>)"
       by (rule_tac rexI[where x="?P"],simp_all)
   }
   then
   show ?thesis
     unfolding lam_replacement_def strong_replacement_def
     by simp
 qed
 
 lemma lam_replacement_hcomp2:
   assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
     "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
     "lam_replacement(M, \<lambda>p. h(fst(p),snd(p)))"
     "\<forall>x[M]. \<forall>y[M]. M(h(x,y))"
   shows "lam_replacement(M, \<lambda>x. h(f(x),g(x)))"
   using assms lam_replacement_product[of f g]
     lam_replacement_hcomp[of "\<lambda>x. \<langle>f(x), g(x)\<rangle>" "\<lambda>\<langle>x,y\<rangle>. h(x,y)"]
   unfolding split_def by simp
 
 lemma lam_replacement_identity: "lam_replacement(M,\<lambda>x. x)"
 proof -
   {
     fix A
     assume "M(A)"
     moreover from this
     have "id(A) = {\<langle>snd(fst(z)),fst(snd(z))\<rangle> . z\<in> {z\<in> (A\<times>A)\<times>(A\<times>A). snd(fst(z)) = fst(snd(z))}}"
       unfolding id_def lam_def
       by(intro equalityI subsetI,simp_all,auto)
     moreover from calculation
     have "M({z\<in> (A\<times>A)\<times>(A\<times>A). snd(fst(z)) = fst(snd(z))})" (is "M(?A')")
       using middle_separation by simp
     moreover from calculation
     have "M({\<langle>snd(fst(z)),fst(snd(z))\<rangle> . z\<in> ?A'})"
       using transM[of _ A]
         lam_replacement_product lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
         lam_replacement_imp_strong_replacement[THEN RepFun_closed]
       by simp_all
     ultimately
     have "M(id(A))" by simp
   }
   then
   show ?thesis using lam_replacement_iff_lam_closed
     unfolding id_def by simp
 qed
 
-lemma lam_replacement_vimage :
-  shows "lam_replacement(M, \<lambda>x. fst(x)-``snd(x))"
-  unfolding vimage_def using
-    lam_replacement_hcomp2[OF
-      lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_converse] lam_replacement_snd
-      _ _ lam_replacement_Image]
-  by auto
-
 lemma strong_replacement_separation_aux :
   assumes "strong_replacement(M,\<lambda> x y . y=f(x))" "separation(M,P)"
   shows "strong_replacement(M, \<lambda>x y . P(x) \<and> y=f(x))"
 proof -
   {
     fix A
     let ?Q="\<lambda>X. \<forall>b[M]. b \<in> X \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> P(x) \<and> b = f(x))"
     assume "M(A)"
     moreover from this
     have "M({x\<in>A . P(x)})" (is "M(?B)") using assms by simp
     moreover from calculation assms
     obtain Y where "M(Y)" "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> ?B \<and> b = f(x))"
       unfolding strong_replacement_def by auto
     then
     have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> P(x) \<and> b = f(x))"
       using rexI[of ?Q _ M] by simp
   }
   then
   show ?thesis
     unfolding strong_replacement_def by simp
 qed
 
 lemma separation_in:
   assumes "\<forall>x[M]. M(f(x))" "lam_replacement(M,f)"
     "\<forall>x[M]. M(g(x))" "lam_replacement(M,g)"
   shows "separation(M,\<lambda>x . f(x)\<in>g(x))"
 proof -
   let ?Z="\<lambda>A. {\<langle>x,\<langle>f(x),g(x)\<rangle>\<rangle>. x\<in>A}"
   have "M(?Z(A))" if "M(A)" for A
     using assms lam_replacement_iff_lam_closed that
       lam_replacement_product[of f g]
     unfolding lam_def
     by auto
   then
   have "M({u\<in>?Z(A) . fst(snd(u)) \<in>snd(snd(u))})" (is "M(?W(A))") if "M(A)" for A
     using that separation_fst_in_snd assms
     by auto
   then
   have "M({fst(u) . u \<in> ?W(A)})" if "M(A)" for A
     using that lam_replacement_imp_strong_replacement[OF lam_replacement_fst,THEN
         RepFun_closed] fst_closed[OF transM]
     by auto
   moreover
   have "{x\<in>A. f(x)\<in>g(x)} = {fst(u) . u\<in>?W(A)}" for A
     by auto
   ultimately
   show ?thesis
     using separation_iff
     by auto
 qed
 
 lemma lam_replacement_swap: "lam_replacement(M, \<lambda>x. \<langle>snd(x),fst(x)\<rangle>)"
   using lam_replacement_fst lam_replacement_snd
     lam_replacement_product[of "snd" "fst"] by simp
 
 lemma lam_replacement_range : "lam_replacement(M,range)"
   unfolding range_def
   using lam_replacement_hcomp[OF lam_replacement_converse lam_replacement_domain]
   by auto
 
 lemma separation_in_range : "M(a) \<Longrightarrow> separation(M, \<lambda>x. a\<in>range(x))"
   using lam_replacement_range lam_replacement_constant separation_in
   by auto
 
 lemma separation_in_domain : "M(a) \<Longrightarrow> separation(M, \<lambda>x. a\<in>domain(x))"
   using lam_replacement_domain lam_replacement_constant separation_in
   by auto
 
 lemma lam_replacement_separation :
   assumes "lam_replacement(M,f)" "separation(M,P)"
   shows "strong_replacement(M, \<lambda>x y . P(x) \<and> y=\<langle>x,f(x)\<rangle>)"
   using strong_replacement_separation_aux assms
   unfolding lam_replacement_def
   by simp
 
 lemmas strong_replacement_separation =
   strong_replacement_separation_aux[OF lam_replacement_imp_strong_replacement]
 
 lemma id_closed: "M(A) \<Longrightarrow> M(id(A))"
   using lam_replacement_identity lam_replacement_iff_lam_closed
   unfolding id_def by simp
 
 lemma relation_separation: "separation(M, \<lambda>z. \<exists>x y. z = \<langle>x, y\<rangle>)"
   unfolding separation_def
 proof (clarify)
   fix A
   assume "M(A)"
   moreover from this
   have "{z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle>} = {z\<in>A. \<exists>x\<in>domain(A). \<exists>y\<in>range(A). pair(M, x, y, z)}"
     (is "?rel = _")
     by (intro equalityI, auto dest:transM)
       (intro bexI, auto dest:transM simp:Pair_def)
   moreover from calculation
   have "M(?rel)"
     using cartprod_separation[THEN separation_closed, of "domain(A)" "range(A)" A]
     by simp
   ultimately
   show "\<exists>y[M]. \<forall>x[M]. x \<in> y \<longleftrightarrow> x \<in> A \<and> (\<exists>w y. x = \<langle>w, y\<rangle>)"
     by (rule_tac x="{z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle>}" in rexI) auto
 qed
 
-lemma separation_pair:
+lemma separation_Pair:
   assumes "separation(M, \<lambda>y . P(fst(y), snd(y)))"
   shows "separation(M, \<lambda>y. \<exists> u v . y=\<langle>u,v\<rangle> \<and> P(u,v))"
   unfolding separation_def
 proof(clarify)
   fix A
   assume "M(A)"
   moreover from this
   have "M({z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle>})" (is "M(?P)")
     using relation_separation by simp
   moreover from this assms
   have "M({z\<in>?P . P(fst(z),snd(z))})"
     by(rule_tac separation_closed,simp_all)
   moreover
   have "{y\<in>A . \<exists> u v . y=\<langle>u,v\<rangle> \<and> P(u,v) } = {z\<in>?P . P(fst(z),snd(z))}"
     by(rule equalityI subsetI,auto)
   moreover from calculation
   have "M({y\<in>A . \<exists> u v . y=\<langle>u,v\<rangle> \<and> P(u,v) })"
     by simp
   ultimately
   show "\<exists>y[M]. \<forall>x[M]. x \<in> y \<longleftrightarrow> x \<in> A \<and> (\<exists>w y. x = \<langle>w, y\<rangle> \<and> P(w,y))"
     by (rule_tac x="{z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle> \<and> P(x,y)}" in rexI) auto
 qed
 
 lemma lam_replacement_Pair:
   shows "lam_replacement(M, \<lambda>x. \<langle>fst(x), snd(x)\<rangle>)"
   unfolding lam_replacement_def strong_replacement_def
 proof (clarsimp)
   fix A
   assume "M(A)"
   then
   show "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x\<in>A. b = \<langle>x, fst(x), snd(x)\<rangle>)"
     unfolding lam_replacement_def strong_replacement_def
   proof (cases "relation(A)")
     case True
     with \<open>M(A)\<close>
     show ?thesis
       using id_closed unfolding relation_def
       by (rule_tac x="id(A)" in rexI) auto
   next
     case False
     moreover
     note \<open>M(A)\<close>
     moreover from this
     have "M({z\<in>A. \<exists>x y. z = \<langle>x, y\<rangle>})" (is "M(?rel)")
       using relation_separation by auto
     moreover
     have "z = \<langle>fst(z), snd(z)\<rangle>" if "fst(z) \<noteq> 0 \<or> snd(z) \<noteq> 0" for z
       using that
       by (cases "\<exists>a b. z=\<langle>a,b\<rangle>") (auto simp add: the_0 fst_def snd_def)
     ultimately
     show ?thesis
       using id_closed unfolding relation_def
       by (rule_tac x="id(?rel) \<union> (A-?rel)\<times>{0}\<times>{0}" in rexI)
         (force simp:fst_def snd_def)+
   qed
 qed
 
 lemma lam_replacement_Un: "lam_replacement(M, \<lambda>p. fst(p) \<union> snd(p))"
   using lam_replacement_Upair lam_replacement_Union
     lam_replacement_hcomp[where g=Union and f="\<lambda>p. Upair(fst(p),snd(p))"]
   unfolding Un_def by simp
 
 lemma lam_replacement_cons: "lam_replacement(M, \<lambda>p. cons(fst(p),snd(p)))"
   using  lam_replacement_Upair
     lam_replacement_hcomp2[of _ _ "(\<union>)"]
     lam_replacement_hcomp2[of fst fst "Upair"]
     lam_replacement_Un lam_replacement_fst lam_replacement_snd
   unfolding cons_def
   by auto
 
-lemma lam_replacement_sing: "lam_replacement(M, \<lambda>x. {x})"
+lemma lam_replacement_sing_fun:
+  assumes "lam_replacement(M, f)" "\<forall>x[M]. M(f(x))"
+  shows "lam_replacement(M, \<lambda>x. {f(x)})"
   using lam_replacement_constant lam_replacement_cons
-    lam_replacement_hcomp2[of "\<lambda>x. x" "\<lambda>_. 0" cons]
-  by (force intro: lam_replacement_identity)
+    lam_replacement_hcomp2[of "f" "\<lambda>_. 0" cons] assms
+  by auto
+
+lemma lam_replacement_sing: "lam_replacement(M, \<lambda>x. {x})"
+  using lam_replacement_sing_fun lam_replacement_identity
+  by simp
+
+
+lemma lam_replacement_CartProd:
+  assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
+    "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
+  shows "lam_replacement(M, \<lambda>x. f(x) \<times> g(x))"
+proof -
+  note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed]
+  {
+    fix A
+    assume "M(A)"
+    moreover
+    note transM[OF _ \<open>M(A)\<close>]
+    moreover from calculation assms
+    have "M({\<langle>x,\<langle>f(x),g(x)\<rangle>\<rangle> . x\<in>A})" (is "M(?A')")
+      using lam_replacement_product[THEN lam_replacement_imp_lam_closed[unfolded lam_def]]
+      by simp
+    moreover from calculation
+    have "M(\<Union>{f(x) . x\<in>A})" (is "M(?F)")
+      using rep_closed[OF assms(1)] assms(3)
+      by simp
+    moreover from calculation
+    have "M(\<Union>{g(x) . x\<in>A})" (is "M(?G)")
+      using rep_closed[OF assms(2)] assms(4)
+      by simp
+    moreover from calculation
+    have "M(?A' \<times> (?F \<times> ?G))" (is "M(?T)")
+      by simp
+    moreover from this
+    have "M({t \<in> ?T . fst(snd(t)) \<in> fst(snd(fst(t))) \<and> snd(snd(t)) \<in> snd(snd(fst(t)))})" (is "M(?Q)")
+      using
+        lam_replacement_hcomp[OF lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] _ ]
+        lam_replacement_hcomp lam_replacement_identity  lam_replacement_fst lam_replacement_snd
+        separation_in separation_conj
+      by simp
+    moreover from this
+    have "M({\<langle>fst(fst(t)),snd(t)\<rangle> . t\<in>?Q})" (is "M(?R)")
+      using rep_closed lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+        lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst] lam_replacement_snd
+        transM[of _ ?Q]
+      by simp
+    moreover from calculation
+    have "M({\<langle>x,?R``{x}\<rangle> . x\<in>A})"
+      using lam_replacement_imp_lam_closed[unfolded lam_def] lam_replacement_sing
+        lam_replacement_Image[THEN [5] lam_replacement_hcomp2] lam_replacement_constant[of ?R]
+      by simp
+    moreover
+    have "?R``{x} = f(x)\<times>g(x)" if "x\<in>A" for x
+      by(rule equalityI subsetI,force,rule subsetI,rule_tac a="x" in imageI)
+        (auto simp:that,(rule_tac rev_bexI[of x],simp_all add:that)+)
+    ultimately
+    have "M({\<langle>x,f(x) \<times> g(x)\<rangle> . x\<in>A})" by auto
+  }
+  with assms
+  show ?thesis using lam_replacement_iff_lam_closed[THEN iffD2,unfolded lam_def]
+    by simp
+qed
+
+lemma lam_replacement_RepFun :
+  assumes "lam_replacement(M,\<lambda>x . f(fst(x),snd(x)))" "lam_replacement(M,g)"
+    "\<forall>x[M].\<forall>y[M].M(f(x,y))" "\<forall>x[M].M(g(x))"
+  shows "lam_replacement(M,\<lambda>x .  {f(x,z) . z\<in>g(x)})"
+proof -
+  from assms
+  have "lam_replacement(M,\<lambda>x.{x}\<times>g(x))"
+    using lam_replacement_CartProd lam_replacement_sing
+    by auto
+  moreover from assms
+  have "M({f(x,z) . z \<in> g(x)})" if "M(x)" for x
+    using that transM[of _ "g(_)"]
+      lam_replacement_imp_strong_replacement
+      lam_replacement_product[OF lam_replacement_fst]
+      lam_replacement_snd lam_replacement_identity
+      assms(1)[THEN [5] lam_replacement_hcomp2] lam_replacement_constant[of x]
+    by(rule_tac RepFun_closed,simp_all)
+  moreover
+  have "M(\<lambda>z\<in>A.{f(z,u) . u \<in> g(z)})" if "M(A)" for A
+  proof -
+    from that assms calculation
+    have "M(\<Union>{{x}\<times>g(x) . x\<in>A})" (is "M(?C)")
+      using lam_replacement_imp_strong_replacement transM[of _ A] RepFun_closed
+      by simp
+    with assms \<open>M(A)\<close>
+    have "M({\<langle>fst(x),f(fst(x),snd(x))\<rangle> . x \<in>?C})" (is "M(?B)")
+      using singleton_closed transM[of _ A] lam_replacement_imp_strong_replacement
+        lam_replacement_product[OF lam_replacement_fst]
+        lam_replacement_hcomp[OF lam_replacement_snd]
+        transM[of _ "g(_)"] RepFun_closed
+      by simp
+    with \<open>M(A)\<close>
+    have "M({\<langle>x,?B``{x}\<rangle> . x\<in>A})"
+      using transM[of _ A]
+        lam_replacement_product[OF lam_replacement_identity]
+        lam_replacement_Image[THEN [5] lam_replacement_hcomp2]
+        lam_replacement_constant lam_replacement_sing RepFun_closed[OF lam_replacement_imp_strong_replacement]
+      by simp
+    moreover
+    have "?B``{z} = {f(z,u) . u \<in> g(z)}" if "z\<in>A" for z
+      using that
+      by(intro equalityI subsetI,auto simp:imageI)
+    moreover from this
+    have "{\<langle>x,?B``{x}\<rangle> . x\<in>A} = {\<langle>z,{f(z,u) . u \<in> g(z)}\<rangle> . z\<in>A}"
+      by auto
+    ultimately
+    show ?thesis
+      unfolding lam_def by auto
+  qed
+  ultimately
+  show ?thesis
+    using lam_replacement_iff_lam_closed[THEN iffD2]
+    by simp
+qed
 
 lemmas tag_replacement = lam_replacement_constant[unfolded lam_replacement_def]
 
 lemma lam_replacement_id2: "lam_replacement(M, \<lambda>x. \<langle>x, x\<rangle>)"
   using lam_replacement_identity lam_replacement_product[of "\<lambda>x. x" "\<lambda>x. x"]
   by simp
 
 lemmas id_replacement = lam_replacement_id2[unfolded lam_replacement_def]
 
 lemma lam_replacement_apply2:"lam_replacement(M, \<lambda>p. fst(p) ` snd(p))"
-  using lam_replacement_sing lam_replacement_fst lam_replacement_snd
+  using lam_replacement_fst lam_replacement_sing_fun[OF lam_replacement_snd]
     lam_replacement_Image lam_replacement_Union
+    lam_replacement_hcomp[of _ Union] lam_replacement_hcomp2[of _ _ "(``)"]
   unfolding apply_def
-  by (rule_tac lam_replacement_hcomp[of _ Union],
-      rule_tac lam_replacement_hcomp2[of _ _ "(``)"])
-    (force intro:lam_replacement_hcomp)+
-
-definition map_snd where
-  "map_snd(X) = {snd(z) . z\<in>X}"
-
-lemma map_sndE: "y\<in>map_snd(X) \<Longrightarrow> \<exists>p\<in>X. y=snd(p)"
-  unfolding map_snd_def by auto
-
-lemma map_sndI : "\<exists>p\<in>X. y=snd(p) \<Longrightarrow> y\<in>map_snd(X)"
-  unfolding map_snd_def by auto
-
-lemma map_snd_closed: "M(x) \<Longrightarrow> M(map_snd(x))"
-  unfolding map_snd_def
-  using lam_replacement_imp_strong_replacement[OF lam_replacement_snd]
-    RepFun_closed snd_closed[OF transM[of _ x]]
   by simp
 
-lemma lam_replacement_imp_lam_replacement_RepFun:
-  assumes "lam_replacement(M, f)" "\<forall>x[M]. M(f(x))"
-    "separation(M, \<lambda>x. ((\<forall>y\<in>snd(x). fst(y) \<in> fst(x)) \<and> (\<forall>y\<in>fst(x). \<exists>u\<in>snd(x). y=fst(u))))"
-    and
-    lam_replacement_RepFun_snd:"lam_replacement(M,map_snd)"
-  shows "lam_replacement(M, \<lambda>x. {f(y) . y\<in>x})"
-proof -
-  have f_closed:"M(\<langle>fst(z),map_snd(snd(z))\<rangle>)" if "M(z)" for z
-    using pair_in_M_iff fst_closed snd_closed map_snd_closed that
-    by simp
-  have p_closed:"M(\<langle>x,{f(y) . y\<in>x}\<rangle>)" if "M(x)" for x
-    using pair_in_M_iff RepFun_closed lam_replacement_imp_strong_replacement
-      transM[OF _ that] that assms by auto
-  {
-    fix A
-    assume "M(A)"
-    then
-    have "M({\<langle>y,f(y)\<rangle> . y\<in>x})" if "x\<in>A" for x
-      using lam_replacement_iff_lam_closed assms that transM[of _ A]
-      unfolding lam_def by simp
-    from assms \<open>M(A)\<close>
-    have "\<forall>x\<in>\<Union>A. M(f(x))"
-      using transM[of _ "\<Union>A"] by auto
-    with assms \<open>M(A)\<close>
-    have "M({\<langle>y,f(y)\<rangle> . y \<in> \<Union>A})" (is "M(?fUnA)")
-      using lam_replacement_iff_lam_closed[THEN iffD1,OF assms(2) assms(1)]
-      unfolding lam_def
-      by simp
-    with \<open>M(A)\<close>
-    have "M(Pow_rel(M,?fUnA))" by simp
-    with \<open>M(A)\<close>
-    have "M({z\<in>A\<times>Pow_rel(M,?fUnA) . ((\<forall>y\<in>snd(z). fst(y) \<in> fst(z)) \<and> (\<forall>y\<in>fst(z). \<exists>u\<in>snd(z). y=fst(u)))})" (is "M(?T)")
-      using assms(3) by simp
-    then
-    have 1:"M({\<langle>fst(z),map_snd(snd(z))\<rangle> . z\<in>?T})" (is "M(?Y)")
-      using lam_replacement_product[OF lam_replacement_fst
-          lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_RepFun_snd]]
-        RepFun_closed lam_replacement_imp_strong_replacement
-        f_closed[OF transM[OF _ \<open>M(?T)\<close>]]
-      by simp
-    have 2:"?Y = {\<langle>x,{f(y) . y\<in>x}\<rangle> . x\<in>A}" (is "_ = ?R")
-    proof(intro equalityI subsetI)
-      fix p
-      assume "p\<in>?R"
-      with \<open>M(A)\<close>
-      obtain x where "x\<in>A" "p=\<langle>x,{f(y) . y \<in> x}\<rangle>" "M(x)"
-        using transM[OF _ \<open>M(A)\<close>]
-        by auto
-      moreover from calculation
-      have "M({\<langle>y,f(y)\<rangle> . y\<in>x})" (is "M(?Ux)")
-        using lam_replacement_iff_lam_closed assms
-        unfolding lam_def by auto
-      moreover from calculation
-      have "?Ux \<subseteq> ?fUnA"
-        by auto
-      moreover from calculation
-      have "?Ux \<in> Pow_rel(M,?fUnA)"
-        using Pow_rel_char[OF \<open>M(?fUnA)\<close>] by simp
-      moreover from calculation
-      have "\<forall>u\<in>x. \<exists>w\<in>?Ux. u=fst(w)"
-        by force
-      moreover from calculation
-      have "\<langle>x,?Ux\<rangle> \<in> ?T" by auto
-      moreover from calculation
-      have "{f(y).y\<in>x} = map_snd(?Ux)"
-        unfolding map_snd_def
-        by(intro equalityI,auto)
-      ultimately
-      show "p\<in>?Y"
-        by (auto,rule_tac bexI[where x=x],simp_all,rule_tac bexI[where x="?Ux"],simp_all)
-    next
-      fix u
-      assume "u\<in>?Y"
-      moreover from this
-      obtain z where "z\<in>?T" "u=\<langle>fst(z),map_snd(snd(z))\<rangle>"
-        by blast
-      moreover from calculation
-      obtain x U where
-        1:"x\<in>A" "U\<in>Pow_rel(M,?fUnA)" "(\<forall>u\<in>U. fst(u) \<in> x) \<and> (\<forall>w\<in>x. \<exists>v\<in>U. w=fst(v))" "z=\<langle>x,U\<rangle>"
-        by force
-      moreover from this
-      have "fst(u)\<in>\<Union>A" "snd(u) = f(fst(u))" if "u\<in>U" for u
-        using that Pow_rel_char[OF \<open>M(?fUnA)\<close>]
-        by auto
-      moreover from calculation
-      have "map_snd(U) = {f(y) . y\<in>x}"
-        unfolding map_snd_def
-        by(intro equalityI subsetI,auto)
-      moreover from calculation
-      have "u=\<langle>x,map_snd(U)\<rangle>"
-        by simp
-      ultimately
-      show "u\<in>?R"
-        by (auto)
-    qed
-    from 1 2
-    have "M({\<langle>x,{f(y) . y\<in>x}\<rangle> . x\<in>A})"
-      by simp
-  }
-  then
-  have "\<forall>A[M]. M(\<lambda>x\<in>A. {f(y) . y\<in>x})"
-    unfolding lam_def by auto
-  then
-  show ?thesis
-    using lam_replacement_iff_lam_closed[THEN iffD2] p_closed
-    by simp
-qed
-
-
 lemma lam_replacement_apply:"M(S) \<Longrightarrow> lam_replacement(M, \<lambda>x.  S ` x)"
-  using lam_replacement_Union lam_replacement_constant lam_replacement_identity
-    lam_replacement_Image lam_replacement_cons
-    lam_replacement_hcomp2[of _ _ Image] lam_replacement_hcomp2[of "\<lambda>x. x" "\<lambda>_. 0" cons]
-  unfolding apply_def
-  by (rule_tac lam_replacement_hcomp[of _ Union]) (force intro:lam_replacement_hcomp)+
+  using lam_replacement_constant[of S] lam_replacement_identity
+    lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
+  by simp
 
 lemma apply_replacement:"M(S) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = S ` x)"
   using lam_replacement_apply lam_replacement_imp_strong_replacement by simp
 
 lemma lam_replacement_id_const: "M(b) \<Longrightarrow> lam_replacement(M, \<lambda>x. \<langle>x, b\<rangle>)"
   using lam_replacement_identity lam_replacement_constant
     lam_replacement_product[of "\<lambda>x. x" "\<lambda>x. b"] by simp
 
 lemmas pospend_replacement = lam_replacement_id_const[unfolded lam_replacement_def]
 
 lemma lam_replacement_const_id: "M(b) \<Longrightarrow> lam_replacement(M, \<lambda>z. \<langle>b, z\<rangle>)"
   using lam_replacement_identity lam_replacement_constant
     lam_replacement_product[of "\<lambda>x. b" "\<lambda>x. x"] by simp
 
 lemmas prepend_replacement = lam_replacement_const_id[unfolded lam_replacement_def]
 
 lemma lam_replacement_apply_const_id: "M(f) \<Longrightarrow> M(z) \<Longrightarrow>
       lam_replacement(M, \<lambda>x. f ` \<langle>z, x\<rangle>)"
-  using lam_replacement_const_id[of z] lam_replacement_apply[of f]
-    lam_replacement_hcomp[of "\<lambda>x. \<langle>z, x\<rangle>" "\<lambda>x. f`x"] by simp
+  using lam_replacement_const_id[of z] lam_replacement_apply
+    lam_replacement_hcomp[of "\<lambda>x. \<langle>z, x\<rangle>"] by simp
 
 lemmas apply_replacement2 = lam_replacement_apply_const_id[unfolded lam_replacement_def]
 
 lemma lam_replacement_Inl: "lam_replacement(M, Inl)"
   using lam_replacement_identity lam_replacement_constant
     lam_replacement_product[of "\<lambda>x. 0" "\<lambda>x. x"]
   unfolding Inl_def by simp
 
 lemma lam_replacement_Inr: "lam_replacement(M, Inr)"
   using lam_replacement_identity lam_replacement_constant
     lam_replacement_product[of "\<lambda>x. 1" "\<lambda>x. x"]
   unfolding Inr_def by simp
 
 lemmas Inl_replacement1 = lam_replacement_Inl[unfolded lam_replacement_def]
 
 lemma lam_replacement_Diff': "M(X) \<Longrightarrow> lam_replacement(M, \<lambda>x. x - X)"
-  using lam_replacement_Diff
-  by (force intro: lam_replacement_hcomp2 lam_replacement_constant
-      lam_replacement_identity)+
+  using lam_replacement_Diff[THEN [5] lam_replacement_hcomp2]
+    lam_replacement_constant lam_replacement_identity
+  by simp
 
 lemmas Pair_diff_replacement = lam_replacement_Diff'[unfolded lam_replacement_def]
 
 lemma diff_Pair_replacement: "M(p) \<Longrightarrow> strong_replacement(M, \<lambda>x y . y=\<langle>x,x-{p}\<rangle>)"
   using Pair_diff_replacement by simp
 
 lemma swap_replacement:"strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>x,y\<rangle>. \<langle>y, x\<rangle>)(x)\<rangle>)"
   using lam_replacement_swap unfolding lam_replacement_def split_def by simp
 
 lemma lam_replacement_Un_const:"M(b) \<Longrightarrow> lam_replacement(M, \<lambda>x. x \<union> b)"
   using lam_replacement_Un lam_replacement_hcomp2[of _ _ "(\<union>)"]
     lam_replacement_constant[of b] lam_replacement_identity by simp
 
 lemmas tag_union_replacement = lam_replacement_Un_const[unfolded lam_replacement_def]
 
 lemma lam_replacement_csquare: "lam_replacement(M,\<lambda>p. \<langle>fst(p) \<union> snd(p), fst(p), snd(p)\<rangle>)"
   using lam_replacement_Un lam_replacement_fst lam_replacement_snd
   by (fast intro: lam_replacement_product lam_replacement_hcomp2)
 
 lemma csquare_lam_replacement:"strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>x,y\<rangle>. \<langle>x \<union> y, x, y\<rangle>)(x)\<rangle>)"
   using lam_replacement_csquare unfolding split_def lam_replacement_def .
 
 lemma lam_replacement_assoc:"lam_replacement(M,\<lambda>x. \<langle>fst(fst(x)), snd(fst(x)), snd(x)\<rangle>)"
   using lam_replacement_fst lam_replacement_snd
   by (force intro: lam_replacement_product lam_replacement_hcomp)
 
 lemma assoc_replacement:"strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>. \<langle>x, y, z\<rangle>)(x)\<rangle>)"
   using lam_replacement_assoc unfolding split_def lam_replacement_def .
 
 lemma lam_replacement_prod_fun: "M(f) \<Longrightarrow> M(g) \<Longrightarrow> lam_replacement(M,\<lambda>x. \<langle>f ` fst(x), g ` snd(x)\<rangle>)"
   using lam_replacement_fst lam_replacement_snd
   by (force intro: lam_replacement_product lam_replacement_hcomp lam_replacement_apply)
 
 lemma prod_fun_replacement:"M(f) \<Longrightarrow> M(g) \<Longrightarrow>
   strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>w,y\<rangle>. \<langle>f ` w, g ` y\<rangle>)(x)\<rangle>)"
   using lam_replacement_prod_fun unfolding split_def lam_replacement_def .
 
-lemma lam_replacement_vimage_sing: "lam_replacement(M, \<lambda>p. fst(p) -`` {snd(p)})"
-  using lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_sing]
-    lam_replacement_hcomp2[OF lam_replacement_fst  _ _ _ lam_replacement_vimage]
-  by simp
-
-lemma lam_replacement_vimage_sing_fun: "M(f) \<Longrightarrow> lam_replacement(M, \<lambda>x. f -`` {x})"
-  using lam_replacement_hcomp2[OF lam_replacement_constant[of f]
-      lam_replacement_identity _ _ lam_replacement_vimage_sing]
-  by simp
-lemma lam_replacement_image_sing_fun: "M(f) \<Longrightarrow> lam_replacement(M, \<lambda>x. f `` {x})"
-  using lam_replacement_hcomp2[OF lam_replacement_constant[of f]
-      lam_replacement_hcomp[OF lam_replacement_identity lam_replacement_sing]
-      _ _ lam_replacement_Image]
-  by simp
-
-lemma converse_apply_projs: "\<forall>x[M]. \<Union> (fst(x) -`` {snd(x)}) = converse(fst(x)) ` (snd(x))"
-  using converse_apply_eq by auto
-
-lemma lam_replacement_converse_app: "lam_replacement(M, \<lambda>p. converse(fst(p)) ` snd(p))"
-  using lam_replacement_cong[OF _ converse_apply_projs]
-    lam_replacement_hcomp[OF lam_replacement_vimage_sing lam_replacement_Union]
-  by simp
-
-lemmas cardinal_lib_assms4 = lam_replacement_vimage_sing_fun[unfolded lam_replacement_def]
-
-lemma lam_replacement_sing_const_id:
-  "M(x) \<Longrightarrow> lam_replacement(M, \<lambda>y. {\<langle>x, y\<rangle>})"
-  using lam_replacement_hcomp[OF lam_replacement_const_id[of x]]
-    lam_replacement_sing pair_in_M_iff
-  by simp
-
-lemma tag_singleton_closed: "M(x) \<Longrightarrow> M(z) \<Longrightarrow> M({{\<langle>z, y\<rangle>} . y \<in> x})"
-  using RepFun_closed[where A=x and f="\<lambda> u. {\<langle>z,u\<rangle>}"]
-    lam_replacement_imp_strong_replacement lam_replacement_sing_const_id
-    transM[of _ x]
-  by simp
-
 lemma separation_eq:
   assumes "\<forall>x[M]. M(f(x))" "lam_replacement(M,f)"
     "\<forall>x[M]. M(g(x))" "lam_replacement(M,g)"
   shows "separation(M,\<lambda>x . f(x) = g(x))"
 proof -
   let ?Z="\<lambda>A. {\<langle>x,\<langle>f(x),\<langle>g(x),x\<rangle>\<rangle>\<rangle>. x\<in>A}"
   let ?Y="\<lambda>A. {\<langle>\<langle>x,f(x)\<rangle>,\<langle>g(x),x\<rangle>\<rangle>. x\<in>A}"
   note sndsnd = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_snd]
   note fstsnd = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_fst]
   note sndfst = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]
   have "M(?Z(A))" if "M(A)" for A
     using assms lam_replacement_iff_lam_closed that
       lam_replacement_product[OF assms(2)
         lam_replacement_product[OF assms(4) lam_replacement_identity]]
     unfolding lam_def
     by auto
   moreover
   have "?Y(A) = {\<langle>\<langle>fst(x), fst(snd(x))\<rangle>, fst(snd(snd(x))), snd(snd(snd(x)))\<rangle> . x \<in> ?Z(A)}" for A
     by auto
   moreover from calculation
   have "M(?Y(A))" if "M(A)" for A
     using
       lam_replacement_imp_strong_replacement[OF
         lam_replacement_product[OF
           lam_replacement_product[OF lam_replacement_fst fstsnd]
           lam_replacement_product[OF
             lam_replacement_hcomp[OF sndsnd lam_replacement_fst]
             lam_replacement_hcomp[OF lam_replacement_snd sndsnd]
             ]
           ], THEN RepFun_closed,simplified,of "?Z(A)"]
       fst_closed[OF transM] snd_closed[OF transM] that
     by auto
   then
   have "M({u\<in>?Y(A) . snd(fst(u)) = fst(snd(u))})" (is "M(?W(A))") if "M(A)" for A
     using that middle_separation assms
     by auto
   then
   have "M({fst(fst(u)) . u \<in> ?W(A)})" if "M(A)" for A
     using that lam_replacement_imp_strong_replacement[OF
         lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst], THEN RepFun_closed]
       fst_closed[OF transM]
     by auto
   moreover
   have "{x\<in>A. f(x) = g(x)} = {fst(fst(u)) . u\<in>?W(A)}" for A
     by auto
   ultimately
   show ?thesis
     using separation_iff by auto
 qed
 
 lemma separation_subset:
   assumes "\<forall>x[M]. M(f(x))" "lam_replacement(M,f)"
     "\<forall>x[M]. M(g(x))" "lam_replacement(M,g)"
   shows "separation(M,\<lambda>x . f(x) \<subseteq> g(x))"
 proof -
   have "f(x) \<subseteq> g(x) \<longleftrightarrow> f(x)\<union>g(x) = g(x)" for x
     using subset_Un_iff by simp
   moreover from assms
   have "separation(M,\<lambda>x . f(x)\<union>g(x) = g(x))"
     using separation_eq lam_replacement_Un lam_replacement_hcomp2
     by simp
   ultimately
   show ?thesis
     using separation_cong[THEN iffD1] by auto
 qed
 
+lemma lam_replacement_twist: "lam_replacement(M,\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>. \<langle>x,y,z\<rangle>)"
+  using lam_replacement_fst lam_replacement_snd
+    lam_replacement_Pair[THEN [5] lam_replacement_hcomp2,
+      of "\<lambda>x. snd(fst(x))" "\<lambda>x. snd(x)", THEN [2] lam_replacement_Pair[
+        THEN [5] lam_replacement_hcomp2, of "\<lambda>x. fst(fst(x))"]]
+    lam_replacement_hcomp unfolding split_def by simp
+
+lemma twist_closed[intro,simp]: "M(x) \<Longrightarrow> M((\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>. \<langle>x,y,z\<rangle>)(x))"
+  unfolding split_def by simp
+
+lemma lam_replacement_vimage :
+  shows "lam_replacement(M, \<lambda>x. fst(x)-``snd(x))"
+  unfolding vimage_def using
+    lam_replacement_Image[THEN [5] lam_replacement_hcomp2]
+      lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_converse] lam_replacement_snd
+  by simp
+
+lemma lam_replacement_vimage_sing: "lam_replacement(M, \<lambda>p. fst(p) -`` {snd(p)})"
+  using lam_replacement_snd lam_replacement_sing_fun
+    lam_replacement_vimage[THEN [5] lam_replacement_hcomp2] lam_replacement_fst
+  by simp
+
+lemma lam_replacement_vimage_sing_fun: "M(f) \<Longrightarrow> lam_replacement(M, \<lambda>x. f -`` {x})"
+  using lam_replacement_vimage_sing[THEN [5] lam_replacement_hcomp2] lam_replacement_constant[of f]
+      lam_replacement_identity
+  by simp
+
+lemma lam_replacement_image_sing_fun: "M(f) \<Longrightarrow> lam_replacement(M, \<lambda>x. f `` {x})"
+  using lam_replacement_Image[THEN [5] lam_replacement_hcomp2] lam_replacement_constant[of f]
+      lam_replacement_sing
+  by simp
+
+lemma converse_apply_projs: "\<forall>x[M]. \<Union> (fst(x) -`` {snd(x)}) = converse(fst(x)) ` (snd(x))"
+  using converse_apply_eq by auto
+
+lemma lam_replacement_converse_app: "lam_replacement(M, \<lambda>p. converse(fst(p)) ` snd(p))"
+  using lam_replacement_cong[OF _ converse_apply_projs]
+    lam_replacement_hcomp[OF lam_replacement_vimage_sing lam_replacement_Union]
+  by simp
+
+lemmas cardinal_lib_assms4 = lam_replacement_vimage_sing_fun[unfolded lam_replacement_def]
+
+lemma lam_replacement_sing_const_id:
+  "M(x) \<Longrightarrow> lam_replacement(M, \<lambda>y. {\<langle>x, y\<rangle>})"
+  using lam_replacement_const_id[of x] lam_replacement_sing_fun
+  by simp
+
+lemma tag_singleton_closed: "M(x) \<Longrightarrow> M(z) \<Longrightarrow> M({{\<langle>z, y\<rangle>} . y \<in> x})"
+  using RepFun_closed lam_replacement_imp_strong_replacement lam_replacement_sing_const_id
+    transM[of _ x]
+  by simp
+
 lemma separation_ball:
   assumes "separation(M, \<lambda>y. f(fst(y),snd(y)))" "M(X)"
   shows "separation(M, \<lambda>y. \<forall>u\<in>X. f(y,u))"
   unfolding separation_def
 proof(clarify)
   fix A
   assume "M(A)"
   moreover
   note \<open>M(X)\<close>
   moreover from calculation
   have "M(A\<times>X)"
     by simp
   then
   have "M({p \<in> A\<times>X . f(fst(p),snd(p))})" (is "M(?P)")
     using assms(1)
     by auto
   moreover from calculation
   have "M({a\<in>A . ?P``{a} = X})" (is "M(?A')")
     using separation_eq lam_replacement_image_sing_fun[of "?P"] lam_replacement_constant
     by simp
   moreover
   have "f(a,x)" if "a\<in>?A'" and "x\<in>X" for a x
   proof -
     from that
     have "a\<in>A" "?P``{a}=X"
       by auto
     then
     have "x\<in>?P``{a}"
       using that by simp
     then
     show ?thesis using image_singleton_iff by simp
   qed
   moreover from this
   have "\<forall>a[M]. a \<in> ?A' \<longleftrightarrow> a \<in> A \<and> (\<forall>x\<in>X. f(a, x))"
     using image_singleton_iff
     by auto
   with \<open>M(?A')\<close>
   show "\<exists>y[M]. \<forall>a[M]. a \<in> y \<longleftrightarrow> a \<in> A \<and> (\<forall>x\<in>X. f(a, x))"
     by (rule_tac x="?A'" in rexI,simp_all)
 qed
 
-lemma lam_replacement_twist: "lam_replacement(M,\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>. \<langle>x,y,z\<rangle>)"
-  using lam_replacement_fst lam_replacement_snd
-    lam_replacement_Pair[THEN [5] lam_replacement_hcomp2,
-      of "\<lambda>x. snd(fst(x))" "\<lambda>x. snd(x)", THEN [2] lam_replacement_Pair[
-        THEN [5] lam_replacement_hcomp2, of "\<lambda>x. fst(fst(x))"]]
-    lam_replacement_hcomp unfolding split_def by simp
-
-lemma twist_closed[intro,simp]: "M(x) \<Longrightarrow> M((\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>. \<langle>x,y,z\<rangle>)(x))"
-  unfolding split_def by simp
+lemma separation_bex:
+  assumes "separation(M, \<lambda>y. f(fst(y),snd(y)))" "M(X)"
+  shows "separation(M, \<lambda>y. \<exists>u\<in>X. f(y,u))"
+  unfolding separation_def
+proof(clarify)
+  fix A
+  assume "M(A)"
+  moreover
+  note \<open>M(X)\<close>
+  moreover from calculation
+  have "M(A\<times>X)"
+    by simp
+  then
+  have "M({p \<in> A\<times>X . f(fst(p),snd(p))})" (is "M(?P)")
+    using assms(1)
+    by auto
+  moreover from calculation
+  have "M({a\<in>A . ?P``{a} \<noteq> 0})" (is "M(?A')")
+    using separation_eq lam_replacement_image_sing_fun[of "?P"] lam_replacement_constant
+      separation_neg
+    by simp
+  moreover from this
+  have "\<forall>a[M]. a \<in> ?A' \<longleftrightarrow> a \<in> A \<and> (\<exists>x\<in>X. f(a, x))"
+    using image_singleton_iff
+    by auto
+  with \<open>M(?A')\<close>
+  show "\<exists>y[M]. \<forall>a[M]. a \<in> y \<longleftrightarrow> a \<in> A \<and> (\<exists>x\<in>X. f(a, x))"
+    by (rule_tac x="?A'" in rexI,simp_all)
+qed
 
 lemma lam_replacement_Lambda:
   assumes "lam_replacement(M, \<lambda>y. b(fst(y), snd(y)))"
     "\<forall>w[M]. \<forall>y[M]. M(b(w, y))" "M(W)"
   shows "lam_replacement(M, \<lambda>x. \<lambda>w\<in>W. b(x, w))"
-proof (intro lam_replacement_iff_lam_closed[THEN iffD2]; clarify)
-  have aux_sep: "\<forall>x[M]. separation(M,\<lambda>y. \<langle>fst(x), y\<rangle> \<in> A)"
-    if "M(X)" "M(A)" for X A
-    using separation_in lam_replacement_hcomp2[OF lam_replacement_hcomp[OF  lam_replacement_constant lam_replacement_fst]
-        lam_replacement_identity _ _ lam_replacement_Pair]
-      lam_replacement_constant[of A]
-      that
-    by simp
-  have aux_closed: "\<forall>x[M]. M({y \<in> X . \<langle>fst(x), y\<rangle> \<in> A})" if "M(X)" "M(A)" for X A
-    using aux_sep that by simp
-  have aux_lemma: "lam_replacement(M,\<lambda>p . {y \<in> X . \<langle>fst(p), y\<rangle> \<in> A})"
-    if "M(X)" "M(A)" for X A
-  proof -
-    note lr = lam_replacement_Collect[OF \<open>M(X)\<close>]
-    note fst3 = lam_replacement_hcomp[OF lam_replacement_fst
-        lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]]
-    then show ?thesis
-      using lam_replacement_Collect[OF \<open>M(X)\<close> aux_sep separation_ball[OF separation_iff']]
-        separation_in[OF _ lam_replacement_snd _ lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]]
-        separation_in[OF _ lam_replacement_hcomp2[OF fst3 lam_replacement_snd _ _  lam_replacement_Pair] _
-          lam_replacement_constant[of A]] that
-      by auto
-  qed
-  from assms
-  show lbc:"M(x) \<Longrightarrow> M(\<lambda>w\<in>W. b(x, w))" for x
-    using lam_replacement_constant lam_replacement_identity
-      lam_replacement_hcomp2[where h=b]
-    by (intro lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
-      simp_all
-  fix A
-  assume "M(A)"
-  moreover from this assms
-  have "M({b(fst(x),snd(x)). x \<in> A\<times>W})" (is "M(?RFb)")\<comment> \<open>\<^term>\<open>RepFun\<close> \<^term>\<open>b\<close>\<close>
-    using lam_replacement_imp_strong_replacement transM[of _ "A\<times>W"]
-    by (rule_tac RepFun_closed) auto
-  moreover
-  have "{\<langle>\<langle>x,y\<rangle>,z\<rangle> \<in> (A\<times>W)\<times>?RFb. z = b(x,y)} = (\<lambda>\<langle>x,y\<rangle>\<in>A\<times>W. b(x,y)) \<inter> (A\<times>W)\<times>?RFb"
-    (is "{\<langle>\<langle>x,y\<rangle>,z\<rangle> \<in> (A\<times>W)\<times>?B. _ } = ?lam")
-    unfolding lam_def by auto
-  moreover from calculation and assms
-  have "M(?lam)"
-    using lam_replacement_iff_lam_closed unfolding split_def by simp
-  moreover
-  have "{\<langle>\<langle>x,y\<rangle>,z\<rangle> \<in> (X \<times> Y) \<times> Z . P(x, y, z)} \<subseteq> (X \<times> Y) \<times> Z" for X Y Z P
-    by auto
-  then
-  have "{\<langle>x,y,z\<rangle> \<in> X\<times>Y\<times>Z. P(x,y,z) }= (\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>\<in>(X\<times>Y)\<times>Z. \<langle>x,y,z\<rangle>) ``
-        {\<langle>\<langle>x,y\<rangle>,z\<rangle> \<in> (X\<times>Y)\<times>Z. P(x,y,z) }" (is "?C' = Lambda(?A,?f) `` ?C")
-    for X Y Z P
-    using image_lam[of ?C ?A ?f]
-    by (intro equalityI) (auto)
-  with calculation
-  have "{\<langle>x,y,z\<rangle> \<in> A\<times>W\<times>?RFb. z = b(x,y) } =
-        (\<lambda>\<langle>\<langle>x,y\<rangle>,z\<rangle>\<in>(A\<times>W)\<times>?RFb. \<langle>x,y,z\<rangle>) `` ?lam" (is "?H = ?G ")
-    by simp
-  with \<open>M(A)\<close> \<open>M(W)\<close> \<open>M(?lam)\<close> \<open>M(?RFb)\<close>
-  have "M(?H)"
-    using lam_replacement_iff_lam_closed[THEN iffD1, rule_format, OF _ lam_replacement_twist]
-    by simp
-  moreover from this and \<open>M(A)\<close>
-  have "(\<lambda>x\<in>A. \<lambda>w\<in>W. b(x, w)) =
-    {\<langle>x,Z\<rangle> \<in> A \<times> Pow\<^bsup>M\<^esup>(range(?H)). Z = {y \<in> W\<times>?RFb . \<langle>x, y\<rangle> \<in> ?H}}"
-    unfolding lam_def
-    by (intro equalityI; subst Pow_rel_char[of "range(?H)"])
-      (auto dest:transM simp: lbc[unfolded lam_def], force+)
-  moreover from calculation and \<open>M(A)\<close> and \<open>M(W)\<close>
-  have "M(A\<times>Pow\<^bsup>M\<^esup>(range(?H)))" "M(W\<times>?RFb)"
-    by auto
-  moreover
-  note \<open>M(W)\<close>
-  moreover from calculation
-  have "M({\<langle>x,Z\<rangle> \<in> A \<times> Pow\<^bsup>M\<^esup>(range(?H)). Z = {y \<in> W\<times>?RFb . \<langle>x, y\<rangle> \<in> ?H}})"
-    using separation_eq[OF _ lam_replacement_snd
-        aux_closed[OF \<open>M(W\<times>?RFb)\<close> \<open>M(?H)\<close>]
-        aux_lemma[OF \<open>M(W\<times>?RFb)\<close> \<open>M(?H)\<close>]]
-      \<open>M(A\<times>Pow\<^bsup>M\<^esup>(_))\<close> assms
-    unfolding split_def
-    by auto
-  ultimately
-  show "M(\<lambda>x\<in>A. \<lambda>w\<in>W. b(x, w))" by simp
-qed
+  using assms lam_replacement_constant lam_replacement_product lam_replacement_snd
+    lam_replacement_RepFun
+  unfolding lam_def
+  by simp
 
 lemma lam_replacement_apply_Pair:
   assumes "M(y)"
   shows "lam_replacement(M, \<lambda>x. y ` \<langle>fst(x), snd(x)\<rangle>)"
   using assms lam_replacement_constant lam_replacement_Pair
     lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
   by auto
 
 lemma lam_replacement_apply_fst_snd:
   shows "lam_replacement(M, \<lambda>w. fst(w) ` fst(snd(w)) ` snd(snd(w)))"
   using lam_replacement_fst lam_replacement_snd lam_replacement_hcomp
     lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
   by auto
 
+lemma lam_replacement_RepFun_apply :
+  assumes "M(f)"
+  shows "lam_replacement(M, \<lambda>x . {f`y . y \<in> x})"
+  using assms  lam_replacement_identity lam_replacement_RepFun
+    lam_replacement_hcomp lam_replacement_snd lam_replacement_apply
+  by simp
+
 lemma separation_snd_in_fst: "separation(M, \<lambda>x. snd(x) \<in> fst(x))"
   using separation_in lam_replacement_fst lam_replacement_snd
   by auto
 
 lemma lam_replacement_if_mem:
   "lam_replacement(M, \<lambda>x. if snd(x) \<in> fst(x) then 1 else 0)"
   using separation_snd_in_fst
     lam_replacement_constant lam_replacement_if
   by auto
 
 lemma lam_replacement_Lambda_apply_fst_snd:
   assumes "M(X)"
   shows "lam_replacement(M, \<lambda>x. \<lambda>w\<in>X. x ` fst(w) ` snd(w))"
   using assms lam_replacement_apply_fst_snd lam_replacement_Lambda
   by simp
 
 lemma lam_replacement_Lambda_apply_Pair:
   assumes "M(X)" "M(y)"
   shows "lam_replacement(M, \<lambda>x. \<lambda>w\<in>X. y ` \<langle>x, w\<rangle>)"
   using assms lam_replacement_apply_Pair lam_replacement_Lambda
   by simp
 
 lemma lam_replacement_Lambda_if_mem:
   assumes "M(X)"
   shows "lam_replacement(M, \<lambda>x. \<lambda>xa\<in>X. if xa \<in> x then 1 else 0)"
   using assms lam_replacement_if_mem lam_replacement_Lambda
   by simp
 
 lemma lam_replacement_comp':
   "M(f) \<Longrightarrow> M(g) \<Longrightarrow> lam_replacement(M, \<lambda>x . f O x O g)"
   using lam_replacement_comp[THEN [5] lam_replacement_hcomp2,
       OF lam_replacement_constant lam_replacement_comp,
       THEN [5] lam_replacement_hcomp2] lam_replacement_constant
     lam_replacement_identity by simp
 
-lemma separation_bex:
-  assumes "separation(M, \<lambda>y. f(fst(y),snd(y)))" "M(X)"
-  shows "separation(M, \<lambda>y. \<exists>u\<in>X. f(y,u))"
-  unfolding separation_def
-proof(clarify)
-  fix A
-  assume "M(A)"
-  moreover
-  note \<open>M(X)\<close>
-  moreover from calculation
-  have "M(A\<times>X)"
-    by simp
-  then
-  have "M({p \<in> A\<times>X . f(fst(p),snd(p))})" (is "M(?P)")
-    using assms(1)
-    by auto
-  moreover from calculation
-  have "M({a\<in>A . ?P``{a} \<noteq> 0})" (is "M(?A')")
-    using separation_eq lam_replacement_image_sing_fun[of "?P"] lam_replacement_constant
-      separation_neg
-    by simp
-  moreover from this
-  have "\<forall>a[M]. a \<in> ?A' \<longleftrightarrow> a \<in> A \<and> (\<exists>x\<in>X. f(a, x))"
-    using image_singleton_iff
-    by auto
-  with \<open>M(?A')\<close>
-  show "\<exists>y[M]. \<forall>a[M]. a \<in> y \<longleftrightarrow> a \<in> A \<and> (\<exists>x\<in>X. f(a, x))"
-    by (rule_tac x="?A'" in rexI,simp_all)
-qed
-
 lemma case_closed :
   assumes "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
   shows "\<forall>x[M]. M(case(f,g,x))"
   unfolding case_def split_def cond_def
   using assms by simp
 
 lemma separation_fst_equal : "M(a) \<Longrightarrow> separation(M,\<lambda>x . fst(x)=a)"
   using separation_eq lam_replacement_fst lam_replacement_constant
   by auto
 
 lemma lam_replacement_case :
   assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
     "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
   shows "lam_replacement(M, \<lambda>x . case(f,g,x))"
   unfolding case_def split_def cond_def
   using lam_replacement_if separation_fst_equal
     lam_replacement_hcomp[of "snd" g]
     lam_replacement_hcomp[of "snd" f]
     lam_replacement_snd assms
   by simp
 
 lemma Pi_replacement1: "M(x) \<Longrightarrow> M(y) \<Longrightarrow>  strong_replacement(M, \<lambda>ya z. ya \<in> y \<and> z = {\<langle>x, ya\<rangle>})"
   using lam_replacement_imp_strong_replacement
     strong_replacement_separation[OF lam_replacement_sing_const_id[of x],where P="\<lambda>x . x \<in>y"]
     separation_in_constant
   by simp
 
 lemma surj_imp_inj_replacement1:
   "M(f) \<Longrightarrow> M(x) \<Longrightarrow> strong_replacement(M, \<lambda>y z. y \<in> f -`` {x} \<and> z = {\<langle>x, y\<rangle>})"
   using Pi_replacement1 vimage_closed singleton_closed
   by simp
 
 lemmas domain_replacement = lam_replacement_domain[unfolded lam_replacement_def]
 
 lemma domain_replacement_simp: "strong_replacement(M, \<lambda>x y. y=domain(x))"
   using lam_replacement_domain lam_replacement_imp_strong_replacement by simp
 
 lemma un_Pair_replacement: "M(p) \<Longrightarrow> strong_replacement(M, \<lambda>x y . y = x\<union>{p})"
   using lam_replacement_Un_const[THEN lam_replacement_imp_strong_replacement] by simp
 
 lemma diff_replacement: "M(X) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = x - X)"
   using lam_replacement_Diff'[THEN lam_replacement_imp_strong_replacement] by simp
 
 lemma lam_replacement_succ:
   "lam_replacement(M,\<lambda>z . succ(z))"
   unfolding succ_def
   using lam_replacement_hcomp2[of "\<lambda>x. x" "\<lambda>x. x" cons]
     lam_replacement_cons lam_replacement_identity
   by simp
 
 lemma lam_replacement_hcomp_Least:
   assumes "lam_replacement(M, g)" "lam_replacement(M,\<lambda>x. \<mu> i. x\<in>F(i,x))"
     "\<forall>x[M]. M(g(x))" "\<And>x i. M(x) \<Longrightarrow> i \<in> F(i, x) \<Longrightarrow> M(i)"
   shows "lam_replacement(M,\<lambda>x. \<mu> i. g(x)\<in>F(i,g(x)))"
   using assms
   by (rule_tac lam_replacement_hcomp[of _ "\<lambda>x. \<mu> i. x\<in>F(i,x)"])
     (auto intro:Least_closed')
 
 lemma domain_mem_separation: "M(A) \<Longrightarrow> separation(M, \<lambda>x . domain(x)\<in>A)"
   using separation_in lam_replacement_constant lam_replacement_domain
   by auto
 
 lemma domain_eq_separation: "M(p) \<Longrightarrow> separation(M, \<lambda>x . domain(x) = p)"
   using separation_eq lam_replacement_domain lam_replacement_constant
   by auto
 
 lemma lam_replacement_Int:
   shows "lam_replacement(M, \<lambda>x. fst(x) \<inter> snd(x))"
 proof -
   have "A\<inter>B = (A\<union>B) - ((A- B) \<union> (B-A))" (is "_=?f(A,B)")for A B
     by auto
   then
   show ?thesis
     using lam_replacement_cong
       lam_replacement_Diff[THEN[5] lam_replacement_hcomp2]
       lam_replacement_Un[THEN[5] lam_replacement_hcomp2]
       lam_replacement_fst lam_replacement_snd
     by simp
 qed
 
-lemma lam_replacement_CartProd:
-  assumes "lam_replacement(M,f)" "lam_replacement(M,g)"
-    "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
-  shows "lam_replacement(M, \<lambda>x. f(x) \<times> g(x))"
-proof -
-  note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed]
-  {
-    fix A
-    assume "M(A)"
-    moreover
-    note transM[OF _ \<open>M(A)\<close>]
-    moreover from calculation assms
-    have "M({\<langle>x,\<langle>f(x),g(x)\<rangle>\<rangle> . x\<in>A})" (is "M(?A')")
-      using lam_replacement_product[THEN lam_replacement_imp_lam_closed[unfolded lam_def]]
-      by simp
-    moreover from calculation
-    have "M(\<Union>{f(x) . x\<in>A})" (is "M(?F)")
-      using rep_closed[OF assms(1)] assms(3)
-      by simp
-    moreover from calculation
-    have "M(\<Union>{g(x) . x\<in>A})" (is "M(?G)")
-      using rep_closed[OF assms(2)] assms(4)
-      by simp
-    moreover from calculation
-    have "M(?A' \<times> (?F \<times> ?G))" (is "M(?T)")
-      by simp
-    moreover from this
-    have "M({t \<in> ?T . fst(snd(t)) \<in> fst(snd(fst(t))) \<and> snd(snd(t)) \<in> snd(snd(fst(t)))})" (is "M(?Q)")
-      using
-        lam_replacement_hcomp[OF lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] _ ]
-        lam_replacement_hcomp lam_replacement_identity  lam_replacement_fst lam_replacement_snd
-        separation_in separation_conj
-      by simp
-    moreover from this
-    have "M({\<langle>fst(fst(t)),snd(t)\<rangle> . t\<in>?Q})" (is "M(?R)")
-      using rep_closed lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
-        lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst] lam_replacement_snd
-        transM[of _ ?Q]
-      by simp
-    moreover from calculation
-    have "M({\<langle>x,?R``{x}\<rangle> . x\<in>A})"
-      using lam_replacement_imp_lam_closed[unfolded lam_def] lam_replacement_sing
-        lam_replacement_Image[THEN [5] lam_replacement_hcomp2] lam_replacement_constant[of ?R]
-      by simp
-    moreover
-    have "?R``{x} = f(x)\<times>g(x)" if "x\<in>A" for x
-      by(rule equalityI subsetI,force,rule subsetI,rule_tac a="x" in imageI)
-        (auto simp:that,(rule_tac rev_bexI[of x],simp_all add:that)+)
-    ultimately
-    have "M({\<langle>x,f(x) \<times> g(x)\<rangle> . x\<in>A})" by auto
-  }
-  with assms
-  show ?thesis using lam_replacement_iff_lam_closed[THEN iffD2,unfolded lam_def]
-    by simp
-qed
-
-lemma restrict_eq_separation': "M(B) \<Longrightarrow> \<forall>A[M]. separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, restrict(x, B)\<rangle>)"
+lemma restrict_eq_separation': "M(B) \<Longrightarrow> \<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, restrict(x, B)\<rangle>)"
 proof(clarify)
   fix A
   have "restrict(r,B) = r \<inter> (B \<times> range(r))" for r
     unfolding restrict_def by(rule equalityI subsetI,auto)
   moreover
   assume "M(A)" "M(B)"
   moreover from this
   have "separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, x \<inter> (B \<times> range(x))\<rangle>)"
     using lam_replacement_Int[THEN[5] lam_replacement_hcomp2]
       lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
     using lam_replacement_fst lam_replacement_snd lam_replacement_constant
       lam_replacement_hcomp lam_replacement_range lam_replacement_identity
       lam_replacement_CartProd separation_bex separation_eq
     by simp_all
   ultimately
-  show "separation(M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, restrict(x, B)\<rangle>)"
+  show "separation(M, \<lambda>y. \<exists>x[M]. x\<in>A \<and> y = \<langle>x, restrict(x, B)\<rangle>)"
     by simp
 qed
 
 lemmas lam_replacement_restrict' = lam_replacement_restrict[OF restrict_eq_separation']
 
 lemma restrict_strong_replacement: "M(A) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y=restrict(x,A))"
   using lam_replacement_restrict restrict_eq_separation'
     lam_replacement_imp_strong_replacement
   by simp
 
 lemma restrict_eq_separation: "M(r) \<Longrightarrow> M(p) \<Longrightarrow> separation(M, \<lambda>x . restrict(x,r) = p)"
   using separation_eq lam_replacement_restrict' lam_replacement_constant
   by auto
 
 lemma separation_equal_fst2 : "M(a) \<Longrightarrow> separation(M,\<lambda>x . fst(fst(x))=a)"
   using separation_eq lam_replacement_hcomp lam_replacement_fst lam_replacement_constant
   by auto
 
 lemma separation_equal_apply: "M(f) \<Longrightarrow> M(a) \<Longrightarrow> separation(M,\<lambda>x. f`x=a)"
   using separation_eq lam_replacement_apply[of f] lam_replacement_constant
   by auto
 
 lemma lam_apply_replacement: "M(A) \<Longrightarrow> M(f) \<Longrightarrow> lam_replacement(M, \<lambda>x . \<lambda>n\<in>A. f ` \<langle>x, n\<rangle>)"
   using lam_replacement_Lambda lam_replacement_hcomp[OF _ lam_replacement_apply[of f]] lam_replacement_Pair
   by simp
 
 lemma separation_all:
-  assumes "separation(M, \<lambda>x  .P(fst(x),snd(x)))"
-  shows "separation(M, \<lambda>z. \<forall>x\<in>z. P(z,x))"
+  assumes "separation(M, \<lambda>x . P(fst(fst(x)),snd(x)))"
+    "lam_replacement(M,f)" "lam_replacement(M,g)"
+    "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
+  shows "separation(M, \<lambda>z. \<forall>x\<in>f(z). P(g(z),x))"
   unfolding separation_def
 proof(clarify)
+  note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed]
+  note lr_fs = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]
   fix A
   assume "M(A)"
-  let ?B="\<Union>A"
-  let ?C="A\<times>?B"
-  note \<open>M(A)\<close>
+  with assms
+  have "M({f(x) . x\<in>A})" (is "M(?F)") "M({<g(x),f(x)> . x\<in>A})" (is "M(?G)")
+    using rep_closed transM[of _ A]
+      lam_replacement_product lam_replacement_imp_lam_closed
+    unfolding lam_def
+    by auto
+  let ?B="\<Union>?F"
+  let ?C="?G\<times>?B"
+  note \<open>M(A)\<close> \<open>M(?F)\<close> \<open>M(?G)\<close>
   moreover from calculation
   have "M(?C)"
     by simp
   moreover from calculation
-  have "M({p\<in>?C . P(fst(p),snd(p)) \<and> snd(p)\<in>fst(p)})" (is "M(?Prod)")
+  have "M({p\<in>?C . P(fst(fst(p)),snd(p)) \<and> snd(p)\<in>snd(fst(p))})" (is "M(?Prod)")
     using assms separation_conj separation_in lam_replacement_fst lam_replacement_snd
+      lam_replacement_hcomp
     by simp
   moreover from calculation
-  have "M({z\<in>A . z=?Prod``{z}})" (is "M(?L)")
-    using separation_eq lam_replacement_identity
-      lam_replacement_constant[of ?Prod] lam_replacement_image_sing_fun
+  have "M({z\<in>?G . snd(z)=?Prod``{z}})" (is "M(?L)")
+    using separation_eq
+      lam_replacement_constant[of ?Prod] lam_replacement_constant[of 0]
+      lam_replacement_hcomp[OF _ lam_replacement_sing]
+      lam_replacement_Image[THEN [5] lam_replacement_hcomp2]
+      lam_replacement_identity lam_replacement_snd
     by simp
-  moreover
-  have "?L = {z\<in>A . \<forall>x\<in>z. P(z,x)}"
+  moreover from calculation assms
+  have "M({x\<in>A . <g(x),f(x)> \<in> ?L})" (is "M(?N)")
+    using lam_replacement_product lam_replacement_constant
+    by (rule_tac separation_closed,rule_tac separation_in,auto)
+  moreover from calculation
+  have "?N = {z\<in>A . \<forall>x\<in>f(z). P(g(z),x)}"
   proof -
-    have "P(z,x)" if "z\<in>A" "x\<in>z" "x\<in>?Prod``{z}" for z x
+    have "P(g(z),x)" if "z\<in>A" "x\<in>f(z)" "f(z) = ?Prod``{<g(z),f(z)>}" for z x
       using that
-      by auto
+      by(rule_tac imageE[of x ?Prod "{<g(z),f(z)>}"],simp_all)
     moreover
-    have "z = ?Prod `` {z}" if "z\<in>A" "\<forall>x\<in>z. P(z, x)" for z
+    have "f(z) = ?Prod `` {<g(z),f(z)>}" if "z\<in>A" "\<forall>x\<in>f(z). P(g(z), x)" for z
       using that
-      by(intro equalityI subsetI,auto)
+      by force
     ultimately
     show ?thesis
-      by(intro equalityI subsetI,auto)
+      by auto
   qed
   ultimately
-  show " \<exists>y[M]. \<forall>z[M]. z \<in> y \<longleftrightarrow> z \<in> A \<and> (\<forall>x\<in>z . P(z,x))"
-    by (rule_tac x="?L" in rexI,simp_all)
+  show " \<exists>y[M]. \<forall>z[M]. z \<in> y \<longleftrightarrow> z \<in> A \<and> (\<forall>x\<in>f(z) . P(g(z),x))"
+    by (rule_tac x="?N" in rexI,simp_all)
 qed
 
-lemma separation_Transset: "separation(M,Transset)"
-  unfolding Transset_def
-  using separation_all separation_subset lam_replacement_fst lam_replacement_snd
-  by auto
+lemma separation_ex:
+  assumes "separation(M, \<lambda>x . P(fst(fst(x)),snd(x)))"
+    "lam_replacement(M,f)" "lam_replacement(M,g)"
+    "\<forall>x[M]. M(f(x))" "\<forall>x[M]. M(g(x))"
+  shows "separation(M, \<lambda>z. \<exists>x\<in>f(z). P(g(z),x))"
+  unfolding separation_def
+proof(clarify)
+  note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed]
+  note lr_fs = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]
+  fix A
+  assume "M(A)"
+  with assms
+  have "M({f(x) . x\<in>A})" (is "M(?F)") "M({<g(x),f(x)> . x\<in>A})" (is "M(?G)")
+    using rep_closed transM[of _ A]
+      lam_replacement_product lam_replacement_imp_lam_closed
+    unfolding lam_def
+    by auto
+  let ?B="\<Union>?F"
+  let ?C="?G\<times>?B"
+  note \<open>M(A)\<close> \<open>M(?F)\<close> \<open>M(?G)\<close>
+  moreover from calculation
+  have "M(?C)"
+    by simp
+  moreover from calculation
+  have "M({p\<in>?C . P(fst(fst(p)),snd(p)) \<and> snd(p)\<in>snd(fst(p))})" (is "M(?Prod)")
+    using assms separation_conj separation_in lam_replacement_fst lam_replacement_snd
+      lam_replacement_hcomp
+    by simp
+  moreover from calculation
+  have "M({z\<in>?G . 0\<noteq>?Prod``{z}})" (is "M(?L)")
+    using separation_eq  separation_neg
+      lam_replacement_constant[of ?Prod] lam_replacement_constant[of 0]
+      lam_replacement_hcomp[OF _ lam_replacement_sing]
+      lam_replacement_Image[THEN [5] lam_replacement_hcomp2]
+      lam_replacement_identity
+    by simp
+  moreover from calculation assms
+  have "M({x\<in>A . <g(x),f(x)> \<in> ?L})" (is "M(?N)")
+    using lam_replacement_product lam_replacement_constant
+    by (rule_tac separation_closed,rule_tac separation_in,auto)
+  moreover from calculation
+  have "?N = {z\<in>A . \<exists>x\<in>f(z). P(g(z),x)}"
+    by(intro equalityI subsetI,simp_all,force) (rule ccontr,force)
+  ultimately
+  show " \<exists>y[M]. \<forall>z[M]. z \<in> y \<longleftrightarrow> z \<in> A \<and> (\<exists>x\<in>f(z) . P(g(z),x))"
+    by (rule_tac x="?N" in rexI,simp_all)
+qed
+
+lemma RepFun_SigFun_closed: "M(x)\<Longrightarrow> M(z) \<Longrightarrow> M({{\<langle>z, u\<rangle>} . u \<in> x})"
+  using lam_replacement_sing_const_id lam_replacement_imp_strong_replacement RepFun_closed
+    transM[of _ x] singleton_in_M_iff pair_in_M_iff
+  by simp
 
 lemma separation_comp :
   assumes "separation(M,P)" "lam_replacement(M,f)" "\<forall>x[M]. M(f(x))"
   shows "separation(M,\<lambda>x. P(f(x)))"
   unfolding separation_def
 proof(clarify)
   fix A
   assume "M(A)"
   let ?B="{f(a) . a \<in> A}"
   let ?C="A\<times>{b\<in>?B . P(b)}"
   note \<open>M(A)\<close>
   moreover from calculation
   have "M(?C)"
     using lam_replacement_imp_strong_replacement assms RepFun_closed transM[of _ A]
     by simp
   moreover from calculation
   have "M({p\<in>?C . f(fst(p)) = snd(p)})" (is "M(?Prod)")
     using assms separation_eq lam_replacement_fst lam_replacement_snd
       lam_replacement_hcomp
     by simp
   moreover from calculation
   have "M({fst(p) . p\<in>?Prod})" (is "M(?L)")
     using lam_replacement_imp_strong_replacement lam_replacement_fst RepFun_closed
       transM[of _ ?Prod]
     by simp
   moreover
   have "?L = {z\<in>A . P(f(z))}"
     by(intro equalityI subsetI,auto)
   ultimately
   show " \<exists>y[M]. \<forall>z[M]. z \<in> y \<longleftrightarrow> z \<in> A \<and> P(f(z))"
     by (rule_tac x="?L" in rexI,simp_all)
 qed
 
+(* Gives the orthogonal of x with respect Q *)
+lemma separation_orthogonal: "M(x) \<Longrightarrow> M(Q) \<Longrightarrow> separation(M, \<lambda>a .  \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q)"
+  using separation_in[OF _
+      lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair] _
+      lam_replacement_constant]
+    separation_ball lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
+  by simp_all
+
+lemma separation_Transset: "separation(M,Transset)"
+  unfolding Transset_def
+  using separation_subset lam_replacement_fst lam_replacement_snd
+    lam_replacement_hcomp lam_replacement_identity
+  by(rule_tac separation_all,auto)
+
+
 lemma separation_Ord: "separation(M,Ord)"
   unfolding Ord_def
-  using separation_conj separation_Transset separation_all
-    separation_comp separation_Transset lam_replacement_snd
+  using  separation_Transset
+    separation_comp separation_Transset lam_replacement_snd lam_replacement_identity
+  by(rule_tac separation_conj,auto,rule_tac separation_all,auto)
+
+lemma ord_iso_separation: "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow>
+      separation(M, \<lambda>f. \<forall>x\<in>A. \<forall>y\<in>A. \<langle>x, y\<rangle> \<in> r \<longleftrightarrow> \<langle>f ` x, f ` y\<rangle> \<in> s)"
+  using
+    lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
+    lam_replacement_apply2[THEN[5] lam_replacement_hcomp2]
+    lam_replacement_hcomp lam_replacement_fst lam_replacement_snd
+    lam_replacement_identity lam_replacement_constant
+    separation_in separation_ball[of _ A] separation_iff'
+  by simp
+
+lemma separation_dist: "separation(M, \<lambda> x . \<exists>a. \<exists>b . x=\<langle>a,b\<rangle> \<and> a\<noteq>b)"
+  using separation_Pair separation_neg separation_eq lam_replacement_fst lam_replacement_snd
+  by simp
+
+lemma separation_imp_lam_closed:
+  assumes "\<forall>x\<in>A. F(x) \<in> B" "separation(M, \<lambda>\<langle>x,y\<rangle>. F(x) = y)"
+    "M(A)" "M(B)"
+  shows "M(\<lambda>x\<in>A. F(x))"
+proof -
+  from \<open>\<forall>x\<in>A. F(x) \<in> B\<close>
+  have "(\<lambda>x\<in>A. F(x)) \<subseteq> A\<times>B"
+    using times_subset_iff fun_is_rel[OF lam_funtype, of A F]
+    by auto
+  moreover from this
+  have "(\<lambda>x\<in>A. F(x)) = {\<langle>x,y\<rangle> \<in> A \<times> B. F(x) = y}"
+    unfolding lam_def by force
+  moreover
+  note \<open>M(A)\<close> \<open>M(B)\<close> \<open>separation(M, \<lambda>\<langle>x,y\<rangle>. F(x) = y)\<close>
+  moreover from this
+  have "M({\<langle>x,y\<rangle> \<in> A \<times> B. F(x) = y})"
+    by simp
+  ultimately
+  show ?thesis
+    unfolding lam_def
+    by auto
+qed
+
+lemma curry_closed :
+  assumes "M(f)" "M(A)" "M(B)"
+  shows "M(curry(A,B,f))"
+  using assms lam_replacement_apply_const_id
+    lam_apply_replacement lam_replacement_iff_lam_closed
+  unfolding curry_def
   by auto
 
 end \<comment> \<open>\<^locale>\<open>M_replacement\<close>\<close>
 
-locale M_replacement_extra = M_replacement +
-  assumes
-    lam_replacement_minimum:"lam_replacement(M, \<lambda>p. minimum(fst(p),snd(p)))"
-    and
-    lam_replacement_RepFun_cons:"lam_replacement(M, \<lambda>p. RepFun(fst(p), \<lambda>x. {\<langle>snd(p),x\<rangle>}))"
-    \<comment> \<open>This one is too particular: It is for \<^term>\<open>Sigfun\<close>.
-        I would like greater modularity here.\<close>
+definition
+  RepFun_cons :: "i\<Rightarrow>i\<Rightarrow>i" where
+  "RepFun_cons(x,y) \<equiv> RepFun(x, \<lambda>z. {\<langle>y,z\<rangle>})"
 
+context M_replacement
 begin
+
+lemma lam_replacement_RepFun_cons'':
+  shows "lam_replacement(M, \<lambda>x . RepFun_cons(fst(x),snd(x)))"
+  unfolding RepFun_cons_def
+  using lam_replacement_fst fst_closed snd_closed
+lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+lam_replacement_snd lam_replacement_hcomp lam_replacement_sing_fun
+  lam_replacement_RepFun[of "\<lambda> x z . {<snd(x),z>}" "fst"]
+  by(simp_all)
+
+lemma RepFun_cons_replacement: "lam_replacement(M, \<lambda>p. RepFun(fst(p), \<lambda>x. {\<langle>snd(p),x\<rangle>}))"
+  using lam_replacement_RepFun_cons''
+  unfolding RepFun_cons_def
+  by simp
+
 lemma lam_replacement_Sigfun:
   assumes "lam_replacement(M,f)" "\<forall>y[M]. M(f(y))"
   shows "lam_replacement(M, \<lambda>x. Sigfun(x,f))"
-  using lam_replacement_Union lam_replacement_identity
-    lam_replacement_sing[THEN lam_replacement_imp_strong_replacement]
-    lam_replacement_hcomp[of _ Union] assms tag_singleton_closed
-    lam_replacement_RepFun_cons[THEN [5] lam_replacement_hcomp2]
+  using assms lam_replacement_Union lam_replacement_sing_fun lam_replacement_Pair
+      lam_replacement_hcomp[of _ Union] tag_singleton_closed lam_replacement_RepFun
   unfolding Sigfun_def
-  by (rule_tac lam_replacement_hcomp[of _ Union],simp_all)
+  by simp
 
-subsection\<open>Particular instances\<close>
+lemma phrank_repl:
+  assumes
+    "M(f)"
+  shows
+    "strong_replacement(M, \<lambda>x y. y = succ(f`x))"
+  using assms lam_replacement_succ lam_replacement_apply
+    lam_replacement_imp_strong_replacement lam_replacement_hcomp
+  by auto
+
+lemma lam_replacement_Powapply_rel:
+  assumes "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x \<in> A \<and> y = \<langle>x, Pow_rel(M,x)\<rangle>)"
+    "M(f)"
+  shows
+    "lam_replacement(M, Powapply_rel(M,f))"
+  using assms lam_replacement_Pow_rel lam_replacement_apply[THEN lam_replacement_hcomp]
+  unfolding Powapply_rel_def
+  by auto
+
+lemmas Powapply_rel_replacement = lam_replacement_Powapply_rel[THEN
+    lam_replacement_imp_strong_replacement]
 
 lemma surj_imp_inj_replacement2:
   "M(f) \<Longrightarrow> strong_replacement(M, \<lambda>x z. z = Sigfun(x, \<lambda>y. f -`` {y}))"
   using lam_replacement_imp_strong_replacement lam_replacement_Sigfun
     lam_replacement_vimage_sing_fun
   by simp
 
-lemma lam_replacement_minimum_vimage:
-  "M(f) \<Longrightarrow> M(r) \<Longrightarrow> lam_replacement(M, \<lambda>x. minimum(r, f -`` {x}))"
-  using lam_replacement_minimum lam_replacement_vimage_sing_fun lam_replacement_constant
-  by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
-    (force intro: lam_replacement_identity)+
-
-lemmas surj_imp_inj_replacement4 = lam_replacement_minimum_vimage[unfolded lam_replacement_def]
-
 lemma lam_replacement_Pi: "M(y) \<Longrightarrow> lam_replacement(M, \<lambda>x. \<Union>xa\<in>y. {\<langle>x, xa\<rangle>})"
-  using lam_replacement_Union lam_replacement_identity lam_replacement_constant
-    lam_replacement_RepFun_cons[THEN [5] lam_replacement_hcomp2] tag_singleton_closed
-  by (rule_tac lam_replacement_hcomp[of _ Union],simp_all)
+  using  lam_replacement_constant lam_replacement_Sigfun[unfolded Sigfun_def,of "\<lambda>x. y"]
+  by (simp)
 
 lemma Pi_replacement2: "M(y) \<Longrightarrow> strong_replacement(M, \<lambda>x z. z = (\<Union>xa\<in>y. {\<langle>x, xa\<rangle>}))"
   using lam_replacement_Pi[THEN lam_replacement_imp_strong_replacement, of y]
-proof -
-  assume "M(y)"
-  then
-  have "M(x) \<Longrightarrow> M(\<Union>xa\<in>y. {\<langle>x, xa\<rangle>})" for x
-    using tag_singleton_closed
-    by (rule_tac Union_closed RepFun_closed)
-  with \<open>M(y)\<close>
-  show ?thesis
-    using lam_replacement_Pi[THEN lam_replacement_imp_strong_replacement, of y]
-    by blast
-qed
+  by simp
 
 lemma if_then_Inj_replacement:
   shows "M(A) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, if x \<in> A then Inl(x) else Inr(x)\<rangle>)"
   using lam_replacement_if lam_replacement_Inl lam_replacement_Inr separation_in_constant
   unfolding lam_replacement_def
   by simp
 
 lemma lam_if_then_replacement:
   "M(b) \<Longrightarrow>
     M(a) \<Longrightarrow> M(f) \<Longrightarrow> strong_replacement(M, \<lambda>y ya. ya = \<langle>y, if y = a then b else f ` y\<rangle>)"
   using lam_replacement_if lam_replacement_apply lam_replacement_constant
     separation_equal
   unfolding lam_replacement_def
   by simp
 
 lemma if_then_replacement:
   "M(A) \<Longrightarrow> M(f) \<Longrightarrow> M(g) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, if x \<in> A then f ` x else g ` x\<rangle>)"
   using lam_replacement_if lam_replacement_apply[of f] lam_replacement_apply[of g]
     separation_in_constant
   unfolding lam_replacement_def
   by simp
 
 lemma ifx_replacement:
   "M(f) \<Longrightarrow>
     M(b) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, if x \<in> range(f) then converse(f) ` x else b\<rangle>)"
   using lam_replacement_if lam_replacement_apply lam_replacement_constant
     separation_in_constant
   unfolding lam_replacement_def
   by simp
 
 lemma if_then_range_replacement2:
   "M(A) \<Longrightarrow> M(C) \<Longrightarrow> strong_replacement(M, \<lambda>x y. y = \<langle>x, if x = Inl(A) then C else x\<rangle>)"
   using lam_replacement_if lam_replacement_constant lam_replacement_identity
     separation_equal
   unfolding lam_replacement_def
   by simp
 
 lemma if_then_range_replacement:
   "M(u) \<Longrightarrow>
     M(f) \<Longrightarrow>
     strong_replacement
      (M,
       \<lambda>z y. y = \<langle>z, if z = u then f ` 0 else if z \<in> range(f) then f ` succ(converse(f) ` z) else z\<rangle>)"
   using lam_replacement_if separation_equal separation_in_constant
     lam_replacement_constant lam_replacement_identity
     lam_replacement_succ lam_replacement_apply
     lam_replacement_hcomp[of "\<lambda>x. converse(f)`x" "succ"]
     lam_replacement_hcomp[of "\<lambda>x. succ(converse(f)`x)" "\<lambda>x . f`x"]
   unfolding lam_replacement_def
   by simp
 
 lemma Inl_replacement2:
   "M(A) \<Longrightarrow>
     strong_replacement(M, \<lambda>x y. y = \<langle>x, if fst(x) = A then Inl(snd(x)) else Inr(x)\<rangle>)"
   using lam_replacement_if separation_fst_equal
     lam_replacement_hcomp[of "snd" "Inl"]
     lam_replacement_Inl lam_replacement_Inr lam_replacement_snd
   unfolding lam_replacement_def
   by simp
 
 lemma case_replacement1:
   "strong_replacement(M, \<lambda>z y. y = \<langle>z, case(Inr, Inl, z)\<rangle>)"
   using lam_replacement_case lam_replacement_Inl lam_replacement_Inr
   unfolding lam_replacement_def
   by simp
 
 lemma case_replacement2:
   "strong_replacement(M, \<lambda>z y. y = \<langle>z, case(case(Inl, \<lambda>y. Inr(Inl(y))), \<lambda>y. Inr(Inr(y)), z)\<rangle>)"
   using lam_replacement_case lam_replacement_hcomp
     case_closed[of Inl "\<lambda>x. Inr(Inl(x))"]
     lam_replacement_Inl lam_replacement_Inr
   unfolding lam_replacement_def
   by simp
 
 lemma case_replacement4:
   "M(f) \<Longrightarrow> M(g) \<Longrightarrow> strong_replacement(M, \<lambda>z y. y = \<langle>z, case(\<lambda>w. Inl(f ` w), \<lambda>y. Inr(g ` y), z)\<rangle>)"
   using lam_replacement_case lam_replacement_hcomp
     lam_replacement_Inl lam_replacement_Inr lam_replacement_apply
   unfolding lam_replacement_def
   by simp
 
 lemma case_replacement5:
   "strong_replacement(M, \<lambda>x y. y = \<langle>x, (\<lambda>\<langle>x,z\<rangle>. case(\<lambda>y. Inl(\<langle>y, z\<rangle>), \<lambda>y. Inr(\<langle>y, z\<rangle>), x))(x)\<rangle>)"
   unfolding split_def case_def cond_def
   using lam_replacement_if separation_equal_fst2
     lam_replacement_snd lam_replacement_Inl lam_replacement_Inr
     lam_replacement_hcomp[OF
       lam_replacement_product[OF
         lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]]]
   unfolding lam_replacement_def
   by simp
 
-end \<comment> \<open>\<^locale>\<open>M_replacement_extra\<close>\<close>
+end \<comment> \<open>\<^locale>\<open>M_replacement\<close>\<close>
+
+locale M_Pi_replacement = M_Pi + M_replacement
+
+begin
+lemma curry_rel_exp :
+  assumes "M(f)" "M(A)" "M(B)" "M(C)" "f \<in> A \<times> B \<rightarrow> C"
+  shows "curry(A,B,f) \<in> A \<rightarrow>\<^bsup>M\<^esup> (B \<rightarrow>\<^bsup>M\<^esup> C)"
+  using assms transM[of _ A] lam_closed[OF apply_replacement2]
+    lam_replacement_apply_const_id
+    lam_apply_replacement lam_replacement_iff_lam_closed
+  unfolding curry_def
+  by (intro lam_type mem_function_space_rel_abs[THEN iffD2],auto)
+
+end \<comment> \<open>\<^locale>\<open>M_Pi_replacement\<close>\<close>
 
 \<comment> \<open>To be used in the relativized treatment of Cohen posets\<close>
 definition
   \<comment> \<open>"domain collect F"\<close>
   dC_F :: "i \<Rightarrow> i \<Rightarrow> i" where
   "dC_F(A,d) \<equiv> {p \<in> A. domain(p) = d }"
 
 definition
   \<comment> \<open>"domain restrict SepReplace Y"\<close>
   drSR_Y :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
   "drSR_Y(B,D,A,x) \<equiv> {y . r\<in>A , restrict(r,B) = x \<and> y = domain(r) \<and> domain(r) \<in> D}"
 
 lemma drSR_Y_equality: "drSR_Y(B,D,A,x) = { dr\<in>D . (\<exists>r\<in>A . restrict(r,B) = x \<and> dr=domain(r)) }"
   unfolding drSR_Y_def by auto
 
-context M_replacement_extra
+context M_replacement
 begin
 
 lemma separation_restrict_eq_dom_eq:"\<forall>x[M].separation(M, \<lambda>dr. \<exists>r\<in>A . restrict(r,B) = x \<and> dr=domain(r))"
   if "M(A)" and "M(B)" for A B
   using that
     separation_eq[OF _
       lam_replacement_fst _
       lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_domain ]]
     separation_eq[OF _
       lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict'] _
       lam_replacement_constant]
   by(clarify,rule_tac separation_bex[OF _ \<open>M(A)\<close>],rule_tac separation_conj,simp_all)
 
 
 lemma separation_is_insnd_restrict_eq_dom : "separation(M, \<lambda>p. \<forall>x\<in>D. x \<in> snd(p) \<longleftrightarrow> (\<exists>r\<in>A. restrict(r, B) = fst(p) \<and> x = domain(r)))"
   if "M(B)" "M(D)" "M(A)" for A B D
   using that lam_replacement_fst lam_replacement_hcomp lam_replacement_snd separation_in
     separation_eq[OF _
       lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd] _
       lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_domain]]
     separation_eq separation_restrict_eq_dom_eq
     lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict']
     lam_replacement_hcomp[OF lam_replacement_fst
       lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]]
   by(rule_tac separation_ball,rule_tac separation_iff',simp_all,
       rule_tac separation_bex[OF _ \<open>M(A)\<close>],rule_tac separation_conj,simp_all)
 
 lemma lam_replacement_drSR_Y:
   assumes
     "M(B)" "M(D)" "M(A)"
   shows "lam_replacement(M, drSR_Y(B,D,A))"
   using lam_replacement_cong lam_replacement_Collect[OF \<open>M(D)\<close> separation_restrict_eq_dom_eq[of A B]]
     assms drSR_Y_equality separation_is_insnd_restrict_eq_dom separation_restrict_eq_dom_eq
   by simp
 
 lemma drSR_Y_closed:
   assumes
     "M(B)" "M(D)" "M(A)" "M(f)"
   shows "M(drSR_Y(B,D,A,f))"
   using assms drSR_Y_equality lam_replacement_Collect[OF \<open>M(D)\<close> separation_restrict_eq_dom_eq[of A B]]
     assms drSR_Y_equality separation_is_insnd_restrict_eq_dom separation_restrict_eq_dom_eq
   by simp
 
 lemma lam_if_then_apply_replacement: "M(f) \<Longrightarrow> M(v) \<Longrightarrow> M(u) \<Longrightarrow>
      lam_replacement(M, \<lambda>x. if f ` x = v then f ` u else f ` x)"
   using lam_replacement_if separation_equal_apply lam_replacement_constant lam_replacement_apply
   by simp
 
 lemma  lam_if_then_apply_replacement2: "M(f) \<Longrightarrow> M(m) \<Longrightarrow> M(y) \<Longrightarrow>
      lam_replacement(M, \<lambda>z . if f ` z = m then y else f ` z)"
   using lam_replacement_if separation_equal_apply lam_replacement_constant lam_replacement_apply
   by simp
 
 lemma lam_if_then_replacement2: "M(A) \<Longrightarrow> M(f) \<Longrightarrow>
      lam_replacement(M, \<lambda>x . if x \<in> A then f ` x else x)"
   using lam_replacement_if separation_in_constant lam_replacement_identity lam_replacement_apply
   by simp
 
 lemma lam_if_then_replacement_apply: "M(G) \<Longrightarrow> lam_replacement(M, \<lambda>x. if M(x) then G ` x else 0)"
   using lam_replacement_if separation_in_constant lam_replacement_identity lam_replacement_apply
     lam_replacement_constant[of 0] separation_univ
   by simp
 
 lemma lam_replacement_dC_F:
   assumes "M(A)"
   shows "lam_replacement(M, dC_F(A))"
 proof -
   have "separation(M, \<lambda>p. \<forall>x\<in>A. x \<in> snd(p) \<longleftrightarrow> domain(x) = fst(p))" if "M(A)" for A
     using separation_ball separation_iff'
       lam_replacement_hcomp lam_replacement_fst lam_replacement_snd lam_replacement_domain
       separation_in separation_eq that
     by simp_all
   then
   show ?thesis
     unfolding dC_F_def
     using assms lam_replacement_Collect[of A "\<lambda> d x . domain(x) = d"]
       separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant]
     by simp
 qed
 
 lemma dCF_closed:
   assumes "M(A)" "M(f)"
   shows "M(dC_F(A,f))"
   unfolding dC_F_def
   using assms lam_replacement_Collect[of A "\<lambda> d x . domain(x) = d"]
     separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant]
   by simp
 
-lemma lam_replacement_min: "M(f) \<Longrightarrow> M(r) \<Longrightarrow> lam_replacement(M, \<lambda>x . minimum(r, f -`` {x}))"
-  using lam_replacement_hcomp2[OF lam_replacement_constant[of r] lam_replacement_vimage_sing_fun]
-    lam_replacement_minimum
-  by simp
-
 lemma lam_replacement_Collect_ball_Pair:
   assumes "separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> Q))" "M(G)" "M(Q)"
   shows "lam_replacement(M, \<lambda>x . {a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q})"
 proof -
   have 1:"\<forall>x[M]. separation(M, \<lambda>a .  \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q)" if "M(Q)" for Q
     using separation_in lam_replacement_hcomp2[OF _ _ _ _ lam_replacement_Pair]
       lam_replacement_constant separation_ball
       lam_replacement_hcomp lam_replacement_fst lam_replacement_snd that
     by simp
   then
   show ?thesis
     using assms lam_replacement_Collect
     by simp_all
 qed
 
 lemma surj_imp_inj_replacement3:
   "(\<And>x. M(x) \<Longrightarrow> separation(M, \<lambda>y. \<forall>s\<in>x. \<langle>s, y\<rangle> \<in> Q)) \<Longrightarrow> M(G) \<Longrightarrow> M(Q) \<Longrightarrow> M(x) \<Longrightarrow>
   strong_replacement(M, \<lambda>y z. y \<in> {a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q} \<and> z = {\<langle>x, y\<rangle>})"
   using lam_replacement_imp_strong_replacement
   using lam_replacement_sing_const_id[THEN lam_replacement_imp_strong_replacement, of x]
   unfolding strong_replacement_def
   by (simp, safe, drule_tac x="A \<inter> {a \<in> G . \<forall>s\<in>x. \<langle>s, a\<rangle> \<in> Q}" in rspec,
       simp, erule_tac rexE, rule_tac x=Y in rexI) auto
 
 lemmas replacements = Pair_diff_replacement id_replacement tag_replacement
   pospend_replacement prepend_replacement
   Inl_replacement1  diff_Pair_replacement
   swap_replacement tag_union_replacement csquare_lam_replacement
   assoc_replacement prod_fun_replacement
   cardinal_lib_assms4  domain_replacement
   apply_replacement
   un_Pair_replacement restrict_strong_replacement diff_replacement
   if_then_Inj_replacement lam_if_then_replacement if_then_replacement
   ifx_replacement if_then_range_replacement2 if_then_range_replacement
   Inl_replacement2
   case_replacement1 case_replacement2 case_replacement4 case_replacement5
 
-end \<comment> \<open>\<^locale>\<open>M_replacement_extra\<close>\<close>
+end \<comment> \<open>\<^locale>\<open>M_replacement\<close>\<close>
+
+subsection\<open>Some basic replacement lemmas\<close>
+
+lemma (in M_trans) strong_replacement_conj:
+  assumes "\<And>A. M(A) \<Longrightarrow> univalent(M,A,P)" "strong_replacement(M,P)"
+    "separation(M, \<lambda>x. \<exists>b[M]. Q(x,b) \<and> P(x,b))"
+  shows "strong_replacement(M, \<lambda>x z. Q(x,z) \<and> P(x,z))"
+proof -
+  {
+    fix A
+    assume "M(A)"
+    with \<open>separation(M, \<lambda>x. \<exists>b[M]. Q(x,b) \<and> P(x,b))\<close>
+    have "M({x\<in>A. \<exists>b[M]. Q(x,b) \<and> P(x,b)})"
+      by simp
+    with \<open>M(_) \<Longrightarrow> univalent(M,{x\<in>A. \<exists>b[M]. Q(x,b) \<and> P(x,b)}, P)\<close> \<open>strong_replacement(M, P)\<close>
+    have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> {x\<in>A. \<exists>b[M]. Q(x,b) \<and> P(x,b)} \<and> P(x, b))"
+      unfolding strong_replacement_def by blast
+    then
+    obtain Y where "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> {x\<in>A. \<exists>b[M]. Q(x,b) \<and> P(x,b)} \<and> P(x, b))" "M(Y)"
+      by blast
+    with \<open>M(A)\<close> \<open>M(A) \<Longrightarrow> univalent(M,A,P)\<close>
+    have "\<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> Q(x, b) \<and> P(x, b))"
+      unfolding univalent_def by auto
+    with \<open>M(Y)\<close>
+    have "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> Q(x, b) \<and> P(x, b))"
+      by auto
+  }
+  then
+  show ?thesis
+    unfolding strong_replacement_def by simp
+qed
+
+lemma strong_replacement_iff_bounded_M:
+  "strong_replacement(M,P) \<longleftrightarrow> strong_replacement(M,\<lambda> x z . M(z) \<and> M(x) \<and> P(x,z))"
+  unfolding strong_replacement_def by auto
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Nat_Miscellanea.thy b/thys/Transitive_Models/Nat_Miscellanea.thy
--- a/thys/Transitive_Models/Nat_Miscellanea.thy
+++ b/thys/Transitive_Models/Nat_Miscellanea.thy
@@ -1,282 +1,281 @@
 section\<open>Auxiliary results on arithmetic\<close>
 
 theory Nat_Miscellanea
   imports
     Delta_System_Lemma.ZF_Library
 begin
 
-(* no_notation add (infixl \<open>#+\<close> 65)
-no_notation diff (infixl \<open>#-\<close> 65) *)
+hide_const (open) Order.pred
 notation add (infixl \<open>+\<^sub>\<omega>\<close> 65)
 notation diff (infixl \<open>-\<^sub>\<omega>\<close> 65)
 
 text\<open>Most of these results will get used at some point for the
 calculation of arities.\<close>
 
 lemmas nat_succI =  Ord_succ_mem_iff [THEN iffD2,OF nat_into_Ord]
 
 lemma nat_succD : "m \<in> nat \<Longrightarrow>  succ(n) \<in> succ(m) \<Longrightarrow> n \<in> m"
   by (drule_tac j="succ(m)" in ltI,auto elim:ltD)
 
 lemmas zero_in_succ = ltD [OF nat_0_le]
 
 lemma in_n_in_nat :  "m \<in> nat \<Longrightarrow> n \<in> m \<Longrightarrow> n \<in> nat"
   by(drule ltI[of "n"],auto simp add: lt_nat_in_nat)
 
 lemma ltI_neg : "x \<in> nat \<Longrightarrow> j \<le> x \<Longrightarrow> j \<noteq> x \<Longrightarrow> j < x"
   by (simp add: le_iff)
 
 lemma succ_pred_eq  :  "m \<in> nat \<Longrightarrow> m \<noteq> 0  \<Longrightarrow> succ(pred(m)) = m"
   by (auto elim: natE)
 
 lemma succ_ltI : "succ(j) < n \<Longrightarrow> j < n"
   by (simp add: succ_leE[OF leI])
 
 lemmas succ_leD = succ_leE[OF leI]
 
 lemma succpred_leI : "n \<in> nat \<Longrightarrow>  n \<le> succ(pred(n))"
   by (auto elim: natE)
 
 lemma succpred_n0 : "succ(n) \<in> p \<Longrightarrow> p\<noteq>0"
   by (auto)
 
 lemmas natEin = natE [OF lt_nat_in_nat]
 
 lemmas Un_least_lt_iffn =  Un_least_lt_iff [OF nat_into_Ord nat_into_Ord]
 
 lemma pred_type : "m \<in> nat \<Longrightarrow> n \<le> m \<Longrightarrow> n\<in>nat"
   by (rule leE,auto simp:in_n_in_nat ltD)
 
 lemma pred_le : "m \<in> nat \<Longrightarrow> n \<le> succ(m) \<Longrightarrow> pred(n) \<le> m"
   by(rule_tac n="n" in natE,auto simp add:pred_type[of "succ(m)"])
 
 lemma pred_le2 : "n\<in> nat \<Longrightarrow> m \<in> nat \<Longrightarrow> pred(n) \<le> m \<Longrightarrow> n \<le> succ(m)"
   by(subgoal_tac "n\<in>nat",rule_tac n="n" in natE,auto)
 
 lemma Un_leD1 : "Ord(i)\<Longrightarrow> Ord(j)\<Longrightarrow> Ord(k)\<Longrightarrow>  i \<union> j \<le> k \<Longrightarrow> i \<le> k"
   by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct1]],simp_all)
 
 lemma Un_leD2 : "Ord(i)\<Longrightarrow> Ord(j)\<Longrightarrow> Ord(k)\<Longrightarrow>  i \<union> j \<le>k \<Longrightarrow> j \<le> k"
   by (rule Un_least_lt_iff[THEN iffD1[THEN conjunct2]],simp_all)
 
 lemma gt1 : "n \<in> nat \<Longrightarrow> i \<in> n \<Longrightarrow> i \<noteq> 0 \<Longrightarrow> i \<noteq> 1 \<Longrightarrow> 1<i"
   by(rule_tac n="i" in natE,erule in_n_in_nat,auto intro: Ord_0_lt)
 
 lemma pred_mono : "m \<in> nat \<Longrightarrow> n \<le> m \<Longrightarrow> pred(n) \<le> pred(m)"
   by(rule_tac n="n" in natE,auto simp add:le_in_nat,erule_tac n="m" in natE,auto)
 
 lemma succ_mono : "m \<in> nat \<Longrightarrow> n \<le> m \<Longrightarrow> succ(n) \<le> succ(m)"
   by auto
 
 lemma union_abs1 :
   "\<lbrakk> i \<le> j \<rbrakk> \<Longrightarrow> i \<union> j = j"
   by (rule Un_absorb1,erule le_imp_subset)
 
 lemma union_abs2 :
   "\<lbrakk> i \<le> j \<rbrakk> \<Longrightarrow> j \<union> i = j"
   by (rule Un_absorb2,erule le_imp_subset)
 
 lemma ord_un_max : "Ord(i) \<Longrightarrow> Ord(j) \<Longrightarrow> i \<union> j = max(i,j)"
   using max_def union_abs1 not_lt_iff_le leI union_abs2
   by auto
 
 lemma ord_max_ty : "Ord(i) \<Longrightarrow>Ord(j) \<Longrightarrow> Ord(max(i,j))"
   unfolding max_def by simp
 
 lemmas ord_simp_union = ord_un_max ord_max_ty max_def
 
 lemma le_succ : "x\<in>nat \<Longrightarrow> x\<le>succ(x)" by simp
 
 lemma le_pred : "x\<in>nat \<Longrightarrow> pred(x)\<le>x"
   using pred_le[OF _ le_succ] pred_succ_eq
   by simp
 
 lemma not_le_anti_sym : "x\<in>nat \<Longrightarrow> y \<in> nat \<Longrightarrow> \<not> x\<le>y \<Longrightarrow> \<not>y\<le>x \<Longrightarrow> y=x"
   using Ord_linear not_le_iff_lt ltD lt_trans
   by auto
 
 lemma Un_le_compat : "o \<le> p \<Longrightarrow> q \<le> r \<Longrightarrow> Ord(o) \<Longrightarrow> Ord(p) \<Longrightarrow> Ord(q) \<Longrightarrow> Ord(r) \<Longrightarrow> o \<union> q \<le> p \<union> r"
   using le_trans[of q r "p\<union>r",OF _ Un_upper2_le] le_trans[of o p "p\<union>r",OF _ Un_upper1_le]
     ord_simp_union
   by auto
 
 lemma Un_le : "p \<le> r \<Longrightarrow> q \<le> r \<Longrightarrow>
                Ord(p) \<Longrightarrow> Ord(q) \<Longrightarrow> Ord(r) \<Longrightarrow>
                 p \<union> q \<le> r"
   using ord_simp_union by auto
 
 lemma Un_leI3 : "o \<le> r \<Longrightarrow> p \<le> r \<Longrightarrow> q \<le> r \<Longrightarrow>
                 Ord(o) \<Longrightarrow> Ord(p) \<Longrightarrow> Ord(q) \<Longrightarrow> Ord(r) \<Longrightarrow>
                 o \<union> p \<union> q \<le> r"
   using ord_simp_union by auto
 
 lemma diff_mono :
   assumes "m \<in> nat" "n\<in>nat" "p \<in> nat" "m < n" "p\<le>m"
   shows "m#-p < n#-p"
 proof -
   from assms
   have "m#-p \<in> nat" "m#-p +\<^sub>\<omega>p = m"
     using add_diff_inverse2 by simp_all
   with assms
   show ?thesis
     using less_diff_conv[of n p "m #- p",THEN iffD2] by simp
 qed
 
 lemma pred_Un:
   "x \<in> nat \<Longrightarrow> y \<in> nat \<Longrightarrow> pred(succ(x) \<union> y) = x \<union> pred(y)"
   "x \<in> nat \<Longrightarrow> y \<in> nat \<Longrightarrow> pred(x \<union> succ(y)) = pred(x) \<union> y"
   using pred_Un_distrib pred_succ_eq by simp_all
 
 lemma le_natI : "j \<le> n \<Longrightarrow> n \<in> nat \<Longrightarrow> j\<in>nat"
   by(drule ltD,rule in_n_in_nat,rule nat_succ_iff[THEN iffD2,of n],simp_all)
 
 lemma le_natE : "n\<in>nat \<Longrightarrow> j < n \<Longrightarrow>  j\<in>n"
   by(rule ltE[of j n],simp+)
 
 lemma leD : assumes "n\<in>nat" "j \<le> n"
   shows "j < n | j = n"
   using leE[OF \<open>j\<le>n\<close>,of "j<n | j = n"] by auto
 
 lemma pred_nat_eq :
   assumes "n\<in>nat"
   shows "pred(n) = \<Union> n"
   using assms
 proof(induct)
   case 0
   then show ?case by simp
 next
   case (succ x)
   then show ?case using pred_succ_eq Ord_Union_succ_eq
     by simp
 qed
 
 subsection\<open>Some results in ordinal arithmetic\<close>
 text\<open>The following results are auxiliary to the proof of
 wellfoundedness of the relation \<^term>\<open>frecR\<close>\<close>
 
 lemma max_cong :
   assumes "x \<le> y" "Ord(y)" "Ord(z)"
   shows "max(x,y) \<le> max(y,z)"
 proof (cases "y \<le> z")
   case True
   then show ?thesis
     unfolding max_def using assms by simp
 next
   case False
   then have "z \<le> y"  using assms not_le_iff_lt leI by simp
   then show ?thesis
     unfolding max_def using assms by simp
 qed
 
 lemma max_commutes :
   assumes "Ord(x)" "Ord(y)"
   shows "max(x,y) = max(y,x)"
   using assms Un_commute ord_simp_union(1) ord_simp_union(1)[symmetric] by auto
 
 lemma max_cong2 :
   assumes "x \<le> y" "Ord(y)" "Ord(z)" "Ord(x)"
   shows "max(x,z) \<le> max(y,z)"
 proof -
   from assms
   have " x \<union> z \<le> y \<union> z"
     using lt_Ord Ord_Un Un_mono[OF  le_imp_subset[OF \<open>x\<le>y\<close>]]  subset_imp_le by auto
   then show ?thesis
     using  ord_simp_union \<open>Ord(x)\<close> \<open>Ord(z)\<close> \<open>Ord(y)\<close> by simp
 qed
 
 lemma max_D1 :
   assumes "x = y" "w < z"  "Ord(x)"  "Ord(w)" "Ord(z)" "max(x,w) = max(y,z)"
   shows "z\<le>y"
 proof -
   from assms
   have "w <  x \<union> w" using Un_upper2_lt[OF \<open>w<z\<close>] assms ord_simp_union by simp
   then
   have "w < x" using assms lt_Un_iff[of x w w] lt_not_refl by auto
   then
   have "y = y \<union> z" using assms max_commutes ord_simp_union assms leI by simp
   then
   show ?thesis using Un_leD2 assms by simp
 qed
 
 lemma max_D2 :
   assumes "w = y \<or> w = z" "x < y"  "Ord(x)"  "Ord(w)" "Ord(y)" "Ord(z)" "max(x,w) = max(y,z)"
   shows "x<w"
 proof -
   from assms
   have "x < z \<union> y" using Un_upper2_lt[OF \<open>x<y\<close>] by simp
   then
   consider (a) "x < y" | (b) "x < w"
     using assms ord_simp_union by simp
   then show ?thesis proof (cases)
     case a
     consider (c) "w = y" | (d) "w = z"
       using assms by auto
     then show ?thesis proof (cases)
       case c
       with a show ?thesis by simp
     next
       case d
       with a
       show ?thesis
       proof (cases "y <w")
         case True
         then show ?thesis using lt_trans[OF \<open>x<y\<close>] by simp
       next
         case False
         then
         have "w \<le> y"
           using not_lt_iff_le[OF assms(5) assms(4)] by simp
         with \<open>w=z\<close>
         have "max(z,y) = y"  unfolding max_def using assms by simp
         with assms
         have "... = x \<union> w" using ord_simp_union max_commutes  by simp
         then show ?thesis using le_Un_iff assms by blast
       qed
     qed
   next
     case b
     then show ?thesis .
   qed
 qed
 
 lemma oadd_lt_mono2 :
   assumes  "Ord(n)" "Ord(\<alpha>)" "Ord(\<beta>)" "\<alpha> < \<beta>" "x < n" "y < n" "0 <n"
   shows "n ** \<alpha> + x < n **\<beta> + y"
 proof -
   consider (0) "\<beta>=0" | (s) \<gamma> where  "Ord(\<gamma>)" "\<beta> = succ(\<gamma>)" | (l) "Limit(\<beta>)"
     using Ord_cases[OF \<open>Ord(\<beta>)\<close>,of ?thesis] by force
   then show ?thesis
   proof cases
     case 0
     then show ?thesis using \<open>\<alpha><\<beta>\<close> by auto
   next
     case s
     then
     have "\<alpha>\<le>\<gamma>" using \<open>\<alpha><\<beta>\<close> using leI by auto
     then
     have "n ** \<alpha> \<le> n ** \<gamma>" using omult_le_mono[OF _ \<open>\<alpha>\<le>\<gamma>\<close>] \<open>Ord(n)\<close> by simp
     then
     have "n ** \<alpha> + x < n ** \<gamma> + n" using oadd_lt_mono[OF _ \<open>x<n\<close>] by simp
     also
     have "... = n ** \<beta>" using \<open>\<beta>=succ(_)\<close> omult_succ \<open>Ord(\<beta>)\<close> \<open>Ord(n)\<close> by simp
     finally
     have "n ** \<alpha> + x < n ** \<beta>" by auto
     then
     show ?thesis using oadd_le_self \<open>Ord(\<beta>)\<close> lt_trans2 \<open>Ord(n)\<close> by auto
   next
     case l
     have "Ord(x)" using \<open>x<n\<close> lt_Ord by simp
     with l
     have "succ(\<alpha>) < \<beta>" using Limit_has_succ \<open>\<alpha><\<beta>\<close> by simp
     have "n ** \<alpha> + x < n ** \<alpha> + n"
       using oadd_lt_mono[OF le_refl[OF Ord_omult[OF _ \<open>Ord(\<alpha>)\<close>]] \<open>x<n\<close>] \<open>Ord(n)\<close> by simp
     also
     have "... = n ** succ(\<alpha>)" using omult_succ \<open>Ord(\<alpha>)\<close> \<open>Ord(n)\<close> by simp
     finally
     have "n ** \<alpha> + x < n ** succ(\<alpha>)" by simp
     with \<open>succ(\<alpha>) < \<beta>\<close>
     have "n ** \<alpha> + x < n ** \<beta>" using lt_trans omult_lt_mono \<open>Ord(n)\<close> \<open>0<n\<close>  by auto
     then show ?thesis using oadd_le_self \<open>Ord(\<beta>)\<close> lt_trans2 \<open>Ord(n)\<close> by auto
   qed
 qed
 end
diff --git a/thys/Transitive_Models/Partial_Functions_Relative.thy b/thys/Transitive_Models/Partial_Functions_Relative.thy
--- a/thys/Transitive_Models/Partial_Functions_Relative.thy
+++ b/thys/Transitive_Models/Partial_Functions_Relative.thy
@@ -1,702 +1,947 @@
 section\<open>Cohen forcing notions\<close>
 
 theory Partial_Functions_Relative
   imports
     Cardinal_Library_Relative
 begin
 
 text\<open>In this theory we introduce bounded partial functions and its relative
 version; for historical reasons the relative version is based on a proper
 definition of partial functions.
 
 We note that finite partial functions are easier and are used to prove
 some lemmas about finite sets in the theory
 \<^theory>\<open>Transitive_Models.ZF_Library_Relative\<close>.\<close>
 
 definition
   Fn :: "[i,i,i] \<Rightarrow> i" where
   "Fn(\<kappa>,I,J) \<equiv> \<Union>{y . d \<in> Pow(I), y=(d\<rightarrow>J) \<and> d\<prec>\<kappa>}"
 
 lemma domain_function_lepoll :
   assumes "function(r)"
   shows "domain(r) \<lesssim> r"
 proof -
-  let ?f="\<lambda>x\<in>domain(r) . <x,THE y . <x,y> \<in> r>"
-  have 1:"\<And>x. x \<in> domain(r) \<Longrightarrow> \<exists>!y. <x,y> \<in> r"
-    using assms unfolding domain_def function_def by auto
+  let ?f="\<lambda>x\<in>domain(r) . \<langle>x,r`x\<rangle>"
+  have "\<langle>x, r ` x\<rangle> \<in> r" if "\<langle>x, y\<rangle> \<in> r" for x y
+  proof -
+    have "x\<in>domain(r)" using that by auto
+    with assms
+    show ?thesis using function_apply_Pair by auto
+  qed
   then
   have "?f \<in> inj(domain(r), r)"
-    using theI[OF 1]
     by(rule_tac lam_injective,auto)
   then
   show ?thesis unfolding lepoll_def
     by force
 qed
 
 lemma function_lepoll:
   assumes "r:d\<rightarrow>J"
   shows "r \<lesssim> d"
 proof -
   let ?f="\<lambda>x\<in>r . fst(x)"
   note assms Pi_iff[THEN iffD1,OF assms]
-  moreover from this
-  have 1:"\<And>x. x \<in> domain(r) \<Longrightarrow> \<exists>!y. <x,y> \<in> r"
-    unfolding function_def by auto
   moreover from calculation
-  have "(THE u . <fst(x),u> \<in> r) = snd(x)" if "x\<in>r" for x
-    using that subsetD[of r "d\<times>J" x] theI[OF 1]
-    by(auto,rule_tac the_equality2[OF 1],auto)
-  moreover from calculation
-  have "\<And>x. x \<in>r \<Longrightarrow> <fst(x),THE y . <fst(x),y> \<in> r> = x"
+  have "r`fst(x) = snd(x)" if "x\<in>r" for x
+    using that apply_equality
     by auto
   ultimately
   have "?f\<in>inj(r,d)"
-    by(rule_tac d= "\<lambda>u . <u,THE y . <u,y> \<in> r>" in lam_injective,force,simp)
+    by(rule_tac d= "\<lambda>u . \<langle>u, r`u\<rangle>" in lam_injective,auto)
   then
   show ?thesis
     unfolding lepoll_def
     by auto
 qed
 
 lemma function_eqpoll :
   assumes "r:d\<rightarrow>J"
   shows "r \<approx> d"
   using assms domain_of_fun domain_function_lepoll Pi_iff[THEN iffD1,OF assms]
     eqpollI[OF function_lepoll[OF assms]] subset_imp_lepoll
   by force
 
 lemma Fn_char : "Fn(\<kappa>,I,J) = {f \<in> Pow(I\<times>J) . function(f) \<and> f \<prec> \<kappa>}" (is "?L=?R")
 proof (intro equalityI subsetI)
   fix x
   assume "x \<in> ?R"
   moreover from this
   have "domain(x) \<in> Pow(I)" "domain(x) \<lesssim> x" "x\<prec> \<kappa>"
     using domain_function_lepoll
     by auto
   ultimately
   show "x \<in> ?L"
     unfolding Fn_def
     using lesspoll_trans1 Pi_iff
     by (auto,rule_tac rev_bexI[of "domain(x) \<rightarrow> J"],auto)
 next
   fix x
   assume "x \<in> ?L"
   then
   obtain d where "x:d\<rightarrow>J" "d \<in> Pow(I)" "d\<prec>\<kappa>"
     unfolding Fn_def
     by auto
   moreover from this
   have "x\<prec>\<kappa>"
     using function_lepoll[THEN lesspoll_trans1] by auto
   moreover from calculation
   have "x \<in> Pow(I\<times>J)" "function(x)"
     using Pi_iff by auto
   ultimately
   show "x \<in> ?R" by simp
 qed
 
 lemma zero_in_Fn:
   assumes "0 < \<kappa>"
   shows "0 \<in> Fn(\<kappa>, I, J)"
   using lt_Card_imp_lesspoll assms zero_lesspoll
   unfolding Fn_def
   by (simp,rule_tac x="0\<rightarrow>J" in bexI,simp)
     (rule ReplaceI[of _ 0],simp_all)
 
 lemma Fn_nat_eq_FiniteFun: "Fn(nat,I,J) = I -||> J"
 proof (intro equalityI subsetI)
   fix x
   assume "x \<in> I -||> J"
   then
   show "x \<in> Fn(nat,I,J)"
   proof (induct)
     case emptyI
     then
     show ?case
       using zero_in_Fn ltI
       by simp
   next
     case (consI a b h)
     then
     obtain d where "h:d\<rightarrow>J" "d\<prec>nat" "d\<subseteq>I"
       unfolding Fn_def by auto
     moreover from this
     have "Finite(d)"
       using lesspoll_nat_is_Finite by simp
     ultimately
     have "h : d -||> J"
       using fun_FiniteFunI Finite_into_Fin by blast
     note \<open>h:d\<rightarrow>J\<close>
     moreover from this
     have "domain(cons(\<langle>a, b\<rangle>, h)) = cons(a,d)" (is "domain(?h) = ?d")
       and "domain(h) = d"
       using domain_of_fun by simp_all
     moreover
     note consI
     moreover from calculation
     have "cons(\<langle>a, b\<rangle>, h) \<in> cons(a,d) \<rightarrow> J"
       using fun_extend3 by simp
     moreover from \<open>Finite(d)\<close>
     have "Finite(cons(a,d))" by simp
     moreover from this
     have "cons(a,d) \<prec> nat" using Finite_imp_lesspoll_nat by simp
     ultimately
     show ?case
       unfolding Fn_def
       by (simp,rule_tac x="?d\<rightarrow>J" in bexI)
         (force dest:app_fun)+
   qed
 next
   fix x
   assume "x \<in> Fn(nat,I,J)"
   then
   obtain d where "x:d\<rightarrow>J" "d \<in> Pow(I)" "d\<prec>nat"
     unfolding Fn_def
     by auto
   moreover from this
   have "Finite(d)"
     using lesspoll_nat_is_Finite by simp
   moreover from calculation
   have "d \<in> Fin(I)"
     using Finite_into_Fin[of d] Fin_mono by auto
   ultimately
   show "x \<in> I -||> J" using fun_FiniteFunI FiniteFun_mono by blast
 qed
 
 lemma Fn_nat_subset_Pow: "Fn(\<kappa>,I,J) \<subseteq> Pow(I\<times>J)"
   using Fn_char by auto
 
 lemma FnI:
   assumes "p : d \<rightarrow> J" "d \<subseteq> I" "d \<prec> \<kappa>"
   shows "p \<in> Fn(\<kappa>,I,J)"
   using assms
   unfolding Fn_def by auto
 
 lemma FnD[dest]:
   assumes "p \<in> Fn(\<kappa>,I,J)"
   shows "\<exists>d. p : d \<rightarrow> J \<and> d \<subseteq> I \<and> d \<prec> \<kappa>"
   using assms
   unfolding Fn_def by auto
 
 lemma Fn_is_function: "p \<in> Fn(\<kappa>,I,J) \<Longrightarrow> function(p)"
   unfolding Fn_def using fun_is_function by auto
 
 lemma Fn_csucc:
   assumes "Ord(\<kappa>)"
   shows "Fn(csucc(\<kappa>),I,J) = \<Union>{y . d \<in> Pow(I), y=(d\<rightarrow>J) \<and> d\<lesssim>\<kappa>}"
   using assms
   unfolding Fn_def using lesspoll_csucc by (simp)
 
 definition
   FnleR :: "i \<Rightarrow> i \<Rightarrow> o" (infixl \<open>\<supseteq>\<close> 50) where
   "f \<supseteq> g \<equiv> g \<subseteq> f"
 
 lemma FnleR_iff_subset [iff]: "f \<supseteq> g \<longleftrightarrow> g \<subseteq> f"
   unfolding FnleR_def ..
 
 definition
   Fnlerel :: "i \<Rightarrow> i" where
   "Fnlerel(A) \<equiv> Rrel(\<lambda>x y. x \<supseteq> y,A)"
 
 definition
   Fnle :: "[i,i,i] \<Rightarrow> i" where
   "Fnle(\<kappa>,I,J) \<equiv> Fnlerel(Fn(\<kappa>,I,J))"
 
 lemma FnleI[intro]:
   assumes "p \<in> Fn(\<kappa>,I,J)" "q \<in> Fn(\<kappa>,I,J)" "p \<supseteq> q"
   shows "\<langle>p,q\<rangle> \<in> Fnle(\<kappa>,I,J)"
   using assms unfolding Fnlerel_def Fnle_def FnleR_def Rrel_def
   by auto
 
 lemma FnleD[dest]:
   assumes "\<langle>p,q\<rangle> \<in> Fnle(\<kappa>,I,J)"
   shows "p \<in> Fn(\<kappa>,I,J)" "q \<in> Fn(\<kappa>,I,J)" "p \<supseteq> q"
   using assms unfolding Fnlerel_def Fnle_def FnleR_def Rrel_def
   by auto
 
 definition PFun_Space_Rel :: "[i,i\<Rightarrow>o, i] \<Rightarrow> i"  ("_\<rightharpoonup>\<^bsup>_\<^esup>_")
   where "A \<rightharpoonup>\<^bsup>M\<^esup> B \<equiv> {f \<in> Pow(A\<times>B) . M(f) \<and> function(f)}"
 
 lemma (in M_library) PFun_Space_subset_Powrel :
   assumes "M(A)" "M(B)"
   shows "A \<rightharpoonup>\<^bsup>M\<^esup> B = {f \<in> Pow\<^bsup>M\<^esup>(A\<times>B) . function(f)}"
   using Pow_rel_char assms
   unfolding PFun_Space_Rel_def
   by auto
 
 lemma (in M_library) PFun_Space_closed :
   assumes "M(A)" "M(B)"
   shows "M(A \<rightharpoonup>\<^bsup>M\<^esup> B)"
   using assms PFun_Space_subset_Powrel separation_is_function
   by auto
 
+lemma pfun_is_function :
+  "f \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B \<Longrightarrow> function(f)"
+  unfolding PFun_Space_Rel_def by simp
+
+lemma pfun_range :
+  "f \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B \<Longrightarrow> range(f) \<subseteq> B"
+  unfolding PFun_Space_Rel_def by auto
+
+lemma pfun_domain :
+  "f \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B \<Longrightarrow> domain(f) \<subseteq> A"
+  unfolding PFun_Space_Rel_def by auto
+
 lemma Un_filter_fun_space_closed:
   assumes "G \<subseteq> I \<rightarrow> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>I\<rightarrow> J . d \<supseteq> f \<and> d \<supseteq> g"
   shows "\<Union>G \<in> Pow(I\<times>J)" "function(\<Union>G)"
 proof -
   from assms
   show "\<Union>G \<in> Pow(I\<times>J)"
     using Union_Pow_iff
     unfolding Pi_def
     by auto
 next
   show "function(\<Union>G)"
     unfolding function_def
   proof(auto)
     fix B B' x y y'
     assume "B \<in> G" "\<langle>x, y\<rangle> \<in> B" "B' \<in> G" "\<langle>x, y'\<rangle> \<in> B'"
     moreover from assms this
     have "B \<in> I \<rightarrow> J" "B' \<in> I \<rightarrow> J"
       by auto
     moreover from calculation assms(2)[of B B']
     obtain d where "d \<supseteq> B"  "d \<supseteq> B'" "d\<in>I \<rightarrow> J"  "\<langle>x, y\<rangle> \<in> d" "\<langle>x, y'\<rangle> \<in> d"
       using subsetD[OF \<open>G\<subseteq>_\<close>]
       by auto
     then
     show "y=y'"
       using fun_is_function[OF \<open>d\<in>_\<close>]
       unfolding function_def
       by force
   qed
 qed
 
 lemma Un_filter_is_fun :
   assumes "G \<subseteq> I \<rightarrow> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>I\<rightarrow> J . d\<supseteq>f \<and> d\<supseteq>g" "G\<noteq>0"
   shows "\<Union>G \<in> I \<rightarrow> J"
   using assms Un_filter_fun_space_closed Pi_iff
 proof(simp_all)
   show "I\<subseteq>domain(\<Union>G)"
   proof -
     from \<open>G\<noteq>0\<close>
     obtain f where "f\<subseteq>\<Union>G" "f\<in>G"
       by auto
     with \<open>G\<subseteq>_\<close>
     have "f\<in>I\<rightarrow>J" by auto
     then
     show ?thesis
       using subset_trans[OF _ domain_mono[OF \<open>f\<subseteq>\<Union>G\<close>],of I]
       unfolding Pi_def by auto
   qed
 qed
 
-context M_cardinals
+context M_Pi
 begin
 
 lemma mem_function_space_relD:
   assumes "f \<in> function_space_rel(M,A,y)" "M(A)" "M(y)"
   shows "f \<in> A \<rightarrow> y" and "M(f)"
   using assms function_space_rel_char by simp_all
 
 lemma pfunI :
   assumes "C\<subseteq>A" "f \<in> C \<rightarrow>\<^bsup>M\<^esup> B" "M(C)" "M(B)"
   shows "f\<in> A \<rightharpoonup>\<^bsup>M\<^esup> B"
 proof -
   from assms
   have "f \<in> C\<rightarrow>B" "M(f)"
     using mem_function_space_relD
     by simp_all
   with assms
   show ?thesis
     using Pi_iff
     unfolding PFun_Space_Rel_def
     by auto
 qed
 
 lemma zero_in_PFun_rel:
   assumes "M(I)" "M(J)"
   shows "0 \<in> I \<rightharpoonup>\<^bsup>M\<^esup> J"
   using pfunI[of 0] nonempty mem_function_space_rel_abs assms
   by simp
 
 lemma pfun_subsetI :
   assumes "f \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B" "g\<subseteq>f" "M(g)"
   shows "g\<in> A \<rightharpoonup>\<^bsup>M\<^esup> B"
   using assms function_subset
   unfolding PFun_Space_Rel_def
   by auto
 
-lemma pfun_is_function :
-  "f \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B \<Longrightarrow> function(f)"
-  unfolding PFun_Space_Rel_def by simp
-
 lemma pfun_Un_filter_closed:
   assumes "G \<subseteq>I\<rightharpoonup>\<^bsup>M\<^esup> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>I\<rightharpoonup>\<^bsup>M\<^esup> J . d\<supseteq>f \<and> d\<supseteq>g"
   shows "\<Union>G \<in> Pow(I\<times>J)" "function(\<Union>G)"
 proof -
   from assms
   show "\<Union>G \<in> Pow(I\<times>J)"
     using Union_Pow_iff
     unfolding PFun_Space_Rel_def
     by auto
 next
   show "function(\<Union>G)"
     unfolding function_def
   proof(auto)
     fix B B' x y y'
     assume "B \<in> G" "\<langle>x, y\<rangle> \<in> B" "B' \<in> G" "\<langle>x, y'\<rangle> \<in> B'"
     moreover from calculation assms
     obtain d where "d \<in> I \<rightharpoonup>\<^bsup>M\<^esup> J" "function(d)" "\<langle>x, y\<rangle> \<in> d"  "\<langle>x, y'\<rangle> \<in> d"
       using pfun_is_function
       by force
     ultimately
     show "y=y'"
       unfolding function_def
       by auto
   qed
 qed
 
 lemma pfun_Un_filter_closed'':
   assumes "G \<subseteq>I\<rightharpoonup>\<^bsup>M\<^esup> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>G . d\<supseteq>f \<and> d\<supseteq>g"
   shows "\<Union>G \<in> Pow(I\<times>J)" "function(\<Union>G)"
 proof -
   from assms
   have "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>I\<rightharpoonup>\<^bsup>M\<^esup> J . d\<supseteq>f \<and> d\<supseteq>g"
     using subsetD[OF assms(1),THEN [2] bexI]
     by force
   then
   show "\<Union>G \<in> Pow(I\<times>J)"  "function(\<Union>G)"
     using assms pfun_Un_filter_closed
     unfolding PFun_Space_Rel_def
     by auto
 qed
 
 lemma pfun_Un_filter_closed':
   assumes "G \<subseteq>I\<rightharpoonup>\<^bsup>M\<^esup> J" "\<And> f g . f\<in>G \<Longrightarrow> g\<in>G \<Longrightarrow> \<exists>d\<in>G . d\<supseteq>f \<and> d\<supseteq>g" "M(G)"
   shows "\<Union>G \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J"
   using assms pfun_Un_filter_closed''
   unfolding PFun_Space_Rel_def
   by auto
 
 lemma pfunD :
   assumes "f \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B"
   shows "\<exists>C[M]. C\<subseteq>A \<and> f \<in> C\<rightarrow>B"
 proof -
   note assms
   moreover from this
   have "f\<in>Pow(A\<times>B)" "function(f)" "M(f)"
     unfolding PFun_Space_Rel_def
     by simp_all
   moreover from this
   have "domain(f) \<subseteq> A" "f \<in> domain(f) \<rightarrow> B" "M(domain(f))"
     using assms Pow_iff[of f "A\<times>B"] domain_subset Pi_iff
     by auto
   ultimately
   show ?thesis by auto
 qed
 
 lemma pfunD_closed :
   assumes "f \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B"
   shows "M(f)"
   using assms
   unfolding PFun_Space_Rel_def by simp
 
 lemma pfun_singletonI :
   assumes "x \<in> A" "b \<in> B" "M(A)" "M(B)"
   shows "{\<langle>x,b\<rangle>} \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B"
   using assms transM[of x A] transM[of b B]
   unfolding PFun_Space_Rel_def function_def
   by auto
 
 lemma pfun_unionI :
   assumes "f \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B" "g \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B" "domain(f)\<inter>domain(g)=0"
   shows "f\<union>g \<in> A\<rightharpoonup>\<^bsup>M\<^esup> B"
   using assms
   unfolding PFun_Space_Rel_def function_def
   by blast
 
 lemma (in M_library) pfun_restrict_eq_imp_compat:
   assumes "f \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J" "g \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J" "M(J)"
     "restrict(f, domain(f) \<inter> domain(g)) = restrict(g, domain(f) \<inter> domain(g))"
   shows "f \<union> g \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J"
 proof -
   note assms
   moreover from this
   obtain C D where "f : C \<rightarrow> J" "C \<subseteq> I" "D \<subseteq> I" "M(C)" "M(D)" "g : D \<rightarrow> J"
     using pfunD[of f] pfunD[of g] by force
   moreover from calculation
   have "f\<union>g \<in> C\<union>D \<rightarrow> J"
     using restrict_eq_imp_Un_into_Pi'[OF \<open>f\<in>C\<rightarrow>_\<close> \<open>g\<in>D\<rightarrow>_\<close>]
     by auto
   ultimately
   show ?thesis
     using pfunI[of "C\<union>D" _ "f\<union>g"] Un_subset_iff pfunD_closed function_space_rel_char
     by auto
 qed
 
 lemma FiniteFun_pfunI :
   assumes "f \<in> A-||> B" "M(A)" "M(B)"
   shows "f \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B"
   using assms(1)
 proof(induct)
   case emptyI
   then
   show ?case
     using assms nonempty mem_function_space_rel_abs pfunI[OF empty_subsetI, of 0]
     by simp
 next
   case (consI a b h)
   note consI
   moreover from this
   have "M(a)" "M(b)" "M(h)" "domain(h) \<subseteq> A"
     using transM[OF _ \<open>M(A)\<close>] transM[OF _ \<open>M(B)\<close>]
       FinD
       FiniteFun_domain_Fin
       pfunD_closed
     by simp_all
   moreover from calculation
   have "{a}\<union>domain(h)\<subseteq>A" "M({a}\<union>domain(h))" "M(cons(<a,b>,h))" "domain(cons(<a,b>,h)) = {a}\<union>domain(h)"
     by auto
   moreover from calculation
   have "cons(<a,b>,h) \<in> {a}\<union>domain(h) \<rightarrow> B"
     using FiniteFun_is_fun[OF FiniteFun.consI, of a A b B h]
     by auto
   ultimately
   show "cons(<a,b>,h) \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B"
     using assms  mem_function_space_rel_abs pfunI
     by simp_all
 qed
 
 lemma PFun_FiniteFunI :
   assumes "f \<in> A \<rightharpoonup>\<^bsup>M\<^esup> B" "Finite(f)"
   shows  "f \<in> A-||> B"
 proof -
   from assms
   have "f\<in>Fin(A\<times>B)" "function(f)"
     using Finite_Fin Pow_iff
     unfolding PFun_Space_Rel_def
     by auto
   then
   show ?thesis
     using FiniteFunI by simp
 qed
 
-end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
+end \<comment> \<open>\<^locale>\<open>M_Pi\<close>\<close>
 
 (* Fn_rel should be the relativization *)
 definition
   Fn_rel :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> i" (\<open>Fn\<^bsup>_\<^esup>'(_,_,_')\<close>) where
   "Fn_rel(M,\<kappa>,I,J) \<equiv> {f \<in> I\<rightharpoonup>\<^bsup>M\<^esup> J . f \<prec>\<^bsup>M\<^esup> \<kappa>}"
 
 context  M_library
 begin
 
 lemma Fn_rel_subset_PFun_rel : "Fn\<^bsup>M\<^esup>(\<kappa>,I,J) \<subseteq> I\<rightharpoonup>\<^bsup>M\<^esup> J"
   unfolding Fn_rel_def by auto
 
 lemma Fn_relI[intro]:
   assumes "f : d \<rightarrow> J" "d \<subseteq> I" "f \<prec>\<^bsup>M\<^esup> \<kappa>" "M(d)" "M(J)" "M(f)"
   shows "f \<in> Fn_rel(M,\<kappa>,I,J)"
   using assms pfunI mem_function_space_rel_abs
   unfolding Fn_rel_def
   by auto
 
 lemma Fn_relD[dest]:
   assumes "p \<in> Fn_rel(M,\<kappa>,I,J)"
   shows "\<exists>C[M]. C\<subseteq>I \<and> p : C \<rightarrow> J \<and> p \<prec>\<^bsup>M\<^esup> \<kappa>"
   using assms pfunD
   unfolding Fn_rel_def
   by simp
 
 lemma Fn_rel_is_function:
   assumes "p \<in> Fn_rel(M,\<kappa>,I,J)"
   shows "function(p)" "M(p)" "p \<prec>\<^bsup>M\<^esup> \<kappa>" "p\<in> I\<rightharpoonup>\<^bsup>M\<^esup> J"
   using assms
   unfolding Fn_rel_def PFun_Space_Rel_def by simp_all
 
 lemma Fn_rel_mono:
   assumes "p \<in> Fn_rel(M,\<kappa>,I,J)" "\<kappa> \<prec>\<^bsup>M\<^esup> \<kappa>'" "M(\<kappa>)" "M(\<kappa>')"
   shows "p \<in> Fn_rel(M,\<kappa>',I,J)"
   using assms lesspoll_rel_trans[OF _ assms(2)] cardinal_rel_closed
     Fn_rel_is_function(2)[OF assms(1)]
   unfolding Fn_rel_def
   by simp
 
 lemma Fn_rel_mono':
   assumes "p \<in> Fn_rel(M,\<kappa>,I,J)" "\<kappa> \<lesssim>\<^bsup>M\<^esup> \<kappa>'" "M(\<kappa>)" "M(\<kappa>')"
   shows "p \<in> Fn_rel(M,\<kappa>',I,J)"
 proof -
   note assms
   then
   consider "\<kappa> \<prec>\<^bsup>M\<^esup> \<kappa>'"  | "\<kappa> \<approx>\<^bsup>M\<^esup> \<kappa>'"
     using lepoll_rel_iff_leqpoll_rel
     by auto
   then
   show ?thesis
   proof(cases)
     case 1
     with assms show ?thesis using Fn_rel_mono by simp
   next
     case 2
     then show ?thesis
       using assms cardinal_rel_closed Fn_rel_is_function[OF assms(1)]
         lesspoll_rel_eq_trans
       unfolding Fn_rel_def
       by simp
   qed
 qed
 
 lemma Fn_csucc:
   assumes "Ord(\<kappa>)" "M(\<kappa>)"
   shows "Fn_rel(M,(\<kappa>\<^sup>+)\<^bsup>M\<^esup>,I,J) = {p\<in> I\<rightharpoonup>\<^bsup>M\<^esup> J . p  \<lesssim>\<^bsup>M\<^esup> \<kappa>}"   (is "?L=?R")
   using assms
 proof(intro equalityI)
   show "?L \<subseteq> ?R"
   proof(intro subsetI)
     fix p
     assume "p\<in>?L"
     then
     have "p \<prec>\<^bsup>M\<^esup> csucc_rel(M,\<kappa>)" "M(p)" "p\<in> I\<rightharpoonup>\<^bsup>M\<^esup> J"
       using Fn_rel_is_function by simp_all
     then
     show "p\<in>?R"
       using  assms lesspoll_rel_csucc_rel by simp
   qed
 next
   show "?R\<subseteq>?L"
   proof(intro subsetI)
     fix p
     assume "p\<in>?R"
     then
     have  "p\<in> I\<rightharpoonup>\<^bsup>M\<^esup> J" "p \<lesssim>\<^bsup>M\<^esup> \<kappa>"
       using assms lesspoll_rel_csucc_rel by simp_all
     then
     show "p\<in>?L"
       using  assms lesspoll_rel_csucc_rel pfunD_closed
       unfolding Fn_rel_def
       by simp
   qed
 qed
 
 lemma Finite_imp_lesspoll_nat:
   assumes "Finite(A)"
   shows "A \<prec> nat"
   using assms subset_imp_lepoll[OF naturals_subset_nat] eq_lepoll_trans
     n_lesspoll_nat eq_lesspoll_trans
   unfolding Finite_def lesspoll_def by auto
 
 lemma FinD_Finite :
   assumes "a\<in>Fin(A)"
   shows "Finite(a)"
   using assms
   by(induct,simp_all)
 
 lemma Fn_rel_nat_eq_FiniteFun:
   assumes "M(I)" "M(J)"
   shows "I -||> J = Fn_rel(M,\<omega>,I,J)"
 proof(intro equalityI subsetI)
   fix p
   assume "p\<in>I -||> J"
   with assms
   have "p\<in> I \<rightharpoonup>\<^bsup>M\<^esup> J" "Finite(p)"
     using FiniteFun_pfunI FinD_Finite[OF subsetD[OF FiniteFun.dom_subset,OF \<open>p\<in>_\<close>]]
     by auto
   moreover from this
   have "p \<prec>\<^bsup>M\<^esup> \<omega>"
     using Finite_lesspoll_rel_nat pfunD_closed[of p] n_lesspoll_rel_nat
     by simp
   ultimately
   show "p\<in> Fn_rel(M,\<omega>,I,J)"
     unfolding Fn_rel_def by simp
 next
   fix p
   assume "p\<in> Fn_rel(M,\<omega>,I,J)"
   then
   have "p\<in> I \<rightharpoonup>\<^bsup>M\<^esup> J"  "p \<prec>\<^bsup>M\<^esup> \<omega>"
     unfolding Fn_rel_def by simp_all
   moreover from this
   have "Finite(p)"
     using Finite_cardinal_rel_Finite lesspoll_rel_nat_is_Finite_rel pfunD_closed
       cardinal_rel_closed[of p]  Finite_cardinal_rel_iff'[THEN iffD1]
     by simp
   ultimately
   show "p\<in>I -||> J"
     using PFun_FiniteFunI
     by simp
 qed
 
 lemma Fn_nat_abs:
   assumes "M(I)" "M(J)"
   shows "Fn(nat,I,J) = Fn_rel(M,\<omega>,I,J)"
   using assms Fn_rel_nat_eq_FiniteFun Fn_nat_eq_FiniteFun
   by simp
 
 lemma Fn_rel_singletonI:
   assumes "x \<in> I" "j \<in> J" "1 \<prec>\<^bsup>M\<^esup> \<kappa>" "M(\<kappa>)" "M(I)" "M(J)"
   shows "{\<langle>x,j\<rangle>} \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
   using pfun_singletonI transM[of x] transM[of j] assms
     eq_lesspoll_rel_trans[OF singleton_eqpoll_rel_1]
   unfolding Fn_rel_def
   by auto
 
 end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
 
 definition
   Fnle_rel :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> i" (\<open>Fnle\<^bsup>_\<^esup>'(_,_,_')\<close>) where
   "Fnle_rel(M,\<kappa>,I,J) \<equiv> Fnlerel(Fn\<^bsup>M\<^esup>(\<kappa>,I,J))"
 
 abbreviation
   Fn_r_set ::  "[i,i,i,i] \<Rightarrow> i" (\<open>Fn\<^bsup>_\<^esup>'(_,_,_')\<close>) where
   "Fn_r_set(M) \<equiv> Fn_rel(##M)"
 
 abbreviation
   Fnle_r_set ::  "[i,i,i,i] \<Rightarrow> i" (\<open>Fnle\<^bsup>_\<^esup>'(_,_,_')\<close>) where
   "Fnle_r_set(M) \<equiv> Fnle_rel(##M)"
 
 
 context M_library
 begin
 
 lemma Fnle_relI[intro]:
   assumes "p \<in> Fn_rel(M,\<kappa>,I,J)" "q \<in> Fn_rel(M,\<kappa>,I,J)" "p \<supseteq> q"
-  shows "<p,q> \<in> Fnle_rel(M,\<kappa>,I,J)"
+  shows "\<langle>p, q\<rangle> \<in> Fnle_rel(M,\<kappa>,I,J)"
   using assms unfolding Fnlerel_def Fnle_rel_def FnleR_def Rrel_def
   by auto
 
 lemma Fnle_relD[dest]:
-  assumes "<p,q> \<in> Fnle_rel(M,\<kappa>,I,J)"
+  assumes "\<langle>p, q\<rangle> \<in> Fnle_rel(M,\<kappa>,I,J)"
   shows "p \<in> Fn_rel(M,\<kappa>,I,J)" "q \<in> Fn_rel(M,\<kappa>,I,J)" "p \<supseteq> q"
   using assms unfolding Fnlerel_def Fnle_rel_def FnleR_def Rrel_def
   by auto
 
 lemma Fn_rel_closed[intro,simp]:
   assumes "M(\<kappa>)" "M(I)" "M(J)"
   shows "M(Fn\<^bsup>M\<^esup>(\<kappa>,I,J))"
   using assms separation_cardinal_rel_lesspoll_rel PFun_Space_closed
   unfolding Fn_rel_def
   by auto
 
 lemma Fn_rel_subset_Pow:
   assumes "M(\<kappa>)" "M(I)" "M(J)"
   shows "Fn\<^bsup>M\<^esup>(\<kappa>,I,J) \<subseteq> Pow(I\<times>J)"
   unfolding Fn_rel_def PFun_Space_Rel_def
   by auto
 
 lemma Fnle_rel_closed[intro,simp]:
   assumes "M(\<kappa>)" "M(I)" "M(J)"
   shows "M(Fnle\<^bsup>M\<^esup>(\<kappa>,I,J))"
   unfolding Fnle_rel_def Fnlerel_def Rrel_def FnleR_def
   using assms supset_separation Fn_rel_closed
   by auto
 
 lemma zero_in_Fn_rel:
   assumes "0<\<kappa>" "M(\<kappa>)" "M(I)" "M(J)"
   shows "0 \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)"
   unfolding Fn_rel_def
   using zero_in_PFun_rel zero_lesspoll_rel assms
   by simp
 
 lemma zero_top_Fn_rel:
   assumes "p\<in>Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "0<\<kappa>" "M(\<kappa>)" "M(I)" "M(J)"
   shows "\<langle>p, 0\<rangle> \<in> Fnle\<^bsup>M\<^esup>(\<kappa>, I, J)"
   using assms zero_in_Fn_rel unfolding preorder_on_def refl_def trans_on_def
   by auto
 
 lemma preorder_on_Fnle_rel:
   assumes "M(\<kappa>)" "M(I)" "M(J)"
   shows "preorder_on(Fn\<^bsup>M\<^esup>(\<kappa>, I, J), Fnle\<^bsup>M\<^esup>(\<kappa>, I, J))"
   unfolding preorder_on_def refl_def trans_on_def
   by blast
 
-end \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
+end  \<comment> \<open>\<^locale>\<open>M_library\<close>\<close>
 
-end
\ No newline at end of file
+context M_cardinal_library
+begin
+
+lemma lesspoll_nat_imp_lesspoll_rel:
+  assumes "A \<prec> \<omega>" "M(A)"
+  shows "A \<prec>\<^bsup>M\<^esup> \<omega>"
+proof -
+  note assms
+  moreover from this
+  obtain f n where "f\<in>bij\<^bsup>M\<^esup>(A,n)" "n\<in>\<omega>" "A \<approx>\<^bsup>M\<^esup> n"
+    using lesspoll_nat_is_Finite Finite_rel_def[of M A]
+    by auto
+  moreover from calculation
+  have "A \<lesssim>\<^bsup>M\<^esup> \<omega>"
+    using lesspoll_nat_is_Finite Infinite_imp_nats_lepoll_rel[of \<omega> n]
+      nat_not_Finite eq_lepoll_rel_trans[of A n \<omega>]
+    by auto
+  moreover from calculation
+  have "\<not> g \<in> bij\<^bsup>M\<^esup>(A,\<omega>)" for g
+    using mem_bij_rel unfolding lesspoll_def by auto
+  ultimately
+  show ?thesis
+    unfolding lesspoll_rel_def
+    by auto
+qed
+
+lemma Finite_imp_lesspoll_rel_nat:
+  assumes "Finite(A)" "M(A)"
+  shows "A \<prec>\<^bsup>M\<^esup> \<omega>"
+  using Finite_imp_lesspoll_nat assms lesspoll_nat_imp_lesspoll_rel
+  by auto
+
+end \<comment> \<open>\<^locale>\<open>M_cardinal_library\<close>\<close>
+
+context M_cardinal_library_extra
+begin
+
+lemma InfCard_rel_lesspoll_rel_Un:
+  includes Ord_dests
+  assumes "InfCard_rel(M,\<kappa>)" "A \<prec>\<^bsup>M\<^esup> \<kappa>" "B \<prec>\<^bsup>M\<^esup> \<kappa>"
+    and types: "M(\<kappa>)" "M(A)" "M(B)"
+  shows "A \<union> B \<prec>\<^bsup>M\<^esup> \<kappa>"
+proof -
+  from assms
+  have "|A|\<^bsup>M\<^esup> < \<kappa>" "|B|\<^bsup>M\<^esup> < \<kappa>"
+    using lesspoll_rel_cardinal_rel_lt InfCard_rel_is_Card_rel
+    by auto
+  show ?thesis
+  proof (cases "Finite(A) \<and> Finite(B)")
+    case True
+    with assms
+    show ?thesis
+      using lesspoll_rel_trans2[OF _ le_imp_lepoll_rel, of _ nat \<kappa>]
+        Finite_imp_lesspoll_rel_nat[OF Finite_Un]
+      unfolding InfCard_rel_def
+      by simp
+  next
+    case False
+    with types
+    have "InfCard_rel(M,max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>))"
+      using Infinite_InfCard_rel_cardinal_rel InfCard_rel_is_Card_rel
+        le_trans[of nat] not_le_iff_lt[THEN iffD1, THEN leI, of "|A|\<^bsup>M\<^esup>" "|B|\<^bsup>M\<^esup>"]
+      unfolding max_def InfCard_rel_def
+      by auto
+    with \<open>M(A)\<close> \<open>M(B)\<close>
+    have "|A \<union> B|\<^bsup>M\<^esup> \<le> max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>)"
+      using cardinal_rel_Un_le[of "max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>)" A B]
+        not_le_iff_lt[THEN iffD1, THEN leI, of "|A|\<^bsup>M\<^esup>" "|B|\<^bsup>M\<^esup>" ]
+      unfolding max_def
+      by simp
+    moreover from \<open>|A|\<^bsup>M\<^esup> < \<kappa>\<close> \<open>|B|\<^bsup>M\<^esup> < \<kappa>\<close>
+    have "max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>) < \<kappa>"
+      unfolding max_def
+      by simp
+    ultimately
+    have "|A \<union> B|\<^bsup>M\<^esup> <  \<kappa>"
+      using lt_trans1
+      by blast
+    moreover
+    note \<open>InfCard_rel(M,\<kappa>)\<close>
+    moreover from calculation types
+    have "|A \<union> B|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<kappa>"
+      using lt_Card_rel_imp_lesspoll_rel InfCard_rel_is_Card_rel
+      by simp
+    ultimately
+    show ?thesis
+      using cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[of "A \<union> B" "|A \<union> B|\<^bsup>M\<^esup>" \<kappa>]
+        eqpoll_rel_sym types
+      by simp
+  qed
+qed
+
+lemma Fn_rel_unionI:
+  assumes "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "q\<in>Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
+    "M(\<kappa>)" "M(I)" "M(J)" "domain(p) \<inter> domain(q) = 0"
+  shows "p\<union>q \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
+proof -
+  note assms
+  moreover from calculation
+  have "p \<prec>\<^bsup>M\<^esup> \<kappa>" "q \<prec>\<^bsup>M\<^esup> \<kappa>" "M(p)" "M(q)"
+    using Fn_rel_is_function by simp_all
+  moreover from calculation
+  have "p\<union>q \<prec>\<^bsup>M\<^esup> \<kappa>"
+    using eqpoll_rel_sym cardinal_rel_eqpoll_rel InfCard_rel_lesspoll_rel_Un
+    by simp_all
+  ultimately
+  show ?thesis
+    unfolding Fn_rel_def
+    using pfun_unionI cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[OF _ \<open>p\<union>q \<prec>\<^bsup>M\<^esup> _\<close>]
+    by auto
+qed
+
+lemma restrict_eq_imp_compat_rel:
+  assumes "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "q \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(J)" "M(\<kappa>)"
+    "restrict(p, domain(p) \<inter> domain(q)) = restrict(q, domain(p) \<inter> domain(q))"
+  shows "p \<union> q \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)"
+proof -
+  note assms
+  moreover from calculation
+  have "p \<prec>\<^bsup>M\<^esup> \<kappa>" "q \<prec>\<^bsup>M\<^esup> \<kappa>" "M(p)" "M(q)"
+    using Fn_rel_is_function by simp_all
+  moreover from calculation
+  have "p\<union>q \<prec>\<^bsup>M\<^esup> \<kappa>"
+    using InfCard_rel_lesspoll_rel_Un cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym]
+    by auto
+  ultimately
+  show ?thesis
+    unfolding Fn_rel_def
+    using pfun_restrict_eq_imp_compat cardinal_rel_eqpoll_rel
+      eq_lesspoll_rel_trans[OF _ \<open>p\<union>q \<prec>\<^bsup>M\<^esup> _\<close>]
+    by auto
+qed
+
+lemma InfCard_rel_imp_n_lesspoll_rel :
+  assumes "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(\<kappa>)" "n\<in>\<omega>"
+  shows "n \<prec>\<^bsup>M\<^esup> \<kappa>"
+proof -
+  note assms
+  moreover from this
+  have "n \<prec>\<^bsup>M\<^esup> \<omega>"
+    using n_lesspoll_rel_nat by simp
+  ultimately
+  show ?thesis
+    using lesspoll_rel_trans2 Infinite_iff_lepoll_rel_nat InfCard_rel_imp_Infinite nat_into_M
+    by simp
+qed
+
+lemma cons_in_Fn_rel:
+  assumes "x \<notin> domain(p)" "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "x \<in> I" "j \<in> J" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
+    "M(\<kappa>)" "M(I)" "M(J)"
+  shows "cons(\<langle>x,j\<rangle>, p) \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
+  using assms cons_eq Fn_rel_unionI[OF Fn_rel_singletonI[of x I j J] \<open>p\<in>_\<close>]
+    InfCard_rel_imp_n_lesspoll_rel
+  by auto
+
+lemma dense_dom_dense:
+  assumes "x \<in> I" "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(I)" "M(J)" "z\<in>J" "M(\<kappa>)" "p\<in>Fn\<^bsup>M\<^esup>(\<kappa>, I, J)"
+  shows "\<exists>d\<in>{ p \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J) . x \<in> domain(p) }. \<langle>d,p\<rangle> \<in> Fnle\<^bsup>M\<^esup>(\<kappa>, I, J)"
+proof (cases "x \<in> domain(p)")
+  case True
+  with \<open>x \<in> I\<close> \<open>p \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)\<close>
+  show ?thesis by auto
+next
+  case False
+  note \<open>p \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)\<close>
+  moreover from this and False and assms
+  have "cons(\<langle>x,z\<rangle>, p) \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "M(x)"
+    using cons_in_Fn_rel by (auto dest:transM)
+  ultimately
+  show ?thesis using Fn_relD by blast
+qed
+
+lemma (in M_cardinal_library) domain_lepoll_rel :
+  assumes "function(r)" "M(r)"
+  shows "domain(r) \<lesssim>\<^bsup>M\<^esup> r"
+proof -
+  let ?f="\<lambda>x\<in>domain(r) . \<langle>x,r`x\<rangle>"
+  have "\<langle>x, r ` x\<rangle> \<in> r" if "\<langle>x, y\<rangle> \<in> r" for x y
+  proof -
+    have "x\<in>domain(r)" using that by auto
+    with assms
+    show ?thesis using function_apply_Pair by auto
+  qed
+  then
+  have "?f \<in> inj(domain(r), r)"
+    by(rule_tac lam_injective,auto)
+  moreover note assms
+  moreover from calculation
+  have "M(?f)"
+    using lam_replacement_constant[of r] lam_replacement_identity assms
+      lam_replacement_apply lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+    by(rule_tac lam_replacement_imp_lam_closed,auto dest:transM[of _ r])
+  ultimately
+  have "?f \<in> inj\<^bsup>M\<^esup>(domain(r),r)" using inj_rel_char
+    by auto
+  with \<open>M(?f)\<close>
+  show ?thesis
+    using lepoll_relI by simp
+qed
+
+lemma dense_surj_dense:
+  assumes "x \<in> J" "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(I)" "M(J)" "M(\<kappa>)" "p\<in>Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "\<kappa> \<lesssim>\<^bsup>M\<^esup> I"
+  shows "\<exists>d\<in>{ p \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J) . x \<in> range(p) }. \<langle>d,p\<rangle> \<in> Fnle\<^bsup>M\<^esup>(\<kappa>, I, J)"
+proof -
+  from \<open>p \<in> _\<close> \<open>M(J)\<close> \<open>x\<in>_\<close> lesspoll_rel_def
+  have "domain(p) \<subseteq> I" "M(p)" "p \<prec>\<^bsup>M\<^esup> \<kappa>" "M(x)" "function(p)"
+    using pfun_domain[OF Fn_rel_is_function(4)] Fn_rel_is_function transM[of x J]
+    by simp_all
+  moreover from calculation assms
+  have 1:"domain(p) \<prec>\<^bsup>M\<^esup> \<kappa>" "M(domain(p))" "domain(p) \<prec>\<^bsup>M\<^esup> I"
+    using domain_lepoll_rel lesspoll_rel_trans1[of "domain(p)" p \<kappa>] lesspoll_rel_trans2
+    by auto
+  with calculation \<open>\<kappa> \<lesssim>\<^bsup>M\<^esup> I\<close> \<open>M(I)\<close> \<open>M(\<kappa>)\<close>
+  have "domain(p) \<noteq> I"
+  proof -
+    {assume "domain(p) = I"
+      with 1
+      have "domain(p) \<prec>\<^bsup>M\<^esup> domain(p)"
+        by auto
+      with \<open>M(domain(p))\<close>
+      have False
+        using lesspoll_rel_irrefl[of "domain(p)"] by simp
+    }
+    then show ?thesis by auto
+  qed
+  ultimately
+  obtain \<alpha> where "\<alpha> \<notin> domain(p)" "\<alpha>\<in>I"
+    by force
+  moreover note assms
+  moreover from calculation
+  have "cons(\<langle>\<alpha>,x\<rangle>, p) \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)"
+    using InfCard_rel_Aleph_rel cons_in_Fn_rel[of \<alpha> p \<kappa> I J x]
+    by auto
+  ultimately
+  show ?thesis
+    using Fnle_relI by blast
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_cardinal_library_extra\<close>\<close>
+
+end
diff --git a/thys/Transitive_Models/Pointed_DC_Relative.thy b/thys/Transitive_Models/Pointed_DC_Relative.thy
--- a/thys/Transitive_Models/Pointed_DC_Relative.thy
+++ b/thys/Transitive_Models/Pointed_DC_Relative.thy
@@ -1,477 +1,469 @@
 section\<open>Relative DC\<close>
 
 theory Pointed_DC_Relative
   imports
     Cardinal_Library_Relative
 
 begin
 
 consts dc_witness :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i"
 primrec
   wit0   : "dc_witness(0,A,a,s,R) = a"
   witrec : "dc_witness(succ(n),A,a,s,R) = s`{x\<in>A. \<langle>dc_witness(n,A,a,s,R),x\<rangle>\<in>R}"
 
 lemmas dc_witness_def = dc_witness_nat_def
 
 relativize functional "dc_witness" "dc_witness_rel"
 relationalize "dc_witness_rel" "is_dc_witness"
   (* definition
   is_dc_witness_fm where
   "is_dc_witness_fm(na, A, a, s, R, e) \<equiv> is_transrec_fm
                   (is_nat_case_fm
                     (a +\<^sub>\<omega> 8, (\<cdot>\<exists>\<cdot>\<cdot>4`2 is 0\<cdot> \<and> (\<cdot>\<exists>\<cdot>\<cdot>s +\<^sub>\<omega> 12`0 is 2\<cdot> \<and> Collect_fm(A +\<^sub>\<omega> 12, \<cdot>(\<cdot>\<exists>\<cdot>0 = 0\<cdot>\<cdot>) \<and> (\<cdot>\<exists>\<cdot>\<cdot>0 \<in> R +\<^sub>\<omega> 14\<cdot> \<and> pair_fm(3, 1, 0) \<cdot>\<cdot>)\<cdot>, 0) \<cdot>\<cdot>)\<cdot>\<cdot>), 2,
                      0), na, e)"
  *)
 schematic_goal sats_is_dc_witness_fm_auto:
   assumes "na < length(env)" "e < length(env)"
   shows
     "   na \<in> \<omega> \<Longrightarrow>
     A \<in> \<omega> \<Longrightarrow>
     a \<in> \<omega> \<Longrightarrow>
     s \<in> \<omega> \<Longrightarrow>
     R \<in> \<omega> \<Longrightarrow>
     e \<in> \<omega> \<Longrightarrow>
     env \<in> list(Aa) \<Longrightarrow>
     0 \<in> Aa \<Longrightarrow>
     is_dc_witness(##Aa, nth(na, env), nth(A, env), nth(a, env), nth(s, env), nth(R, env), nth(e, env)) \<longleftrightarrow>
     Aa, env \<Turnstile> ?fm(nat, A, a, s, R, e)"
   unfolding is_dc_witness_def is_recursor_def
   by (rule is_transrec_iff_sats | simp_all)
     (rule iff_sats is_nat_case_iff_sats is_eclose_iff_sats sep_rules | simp add:assms)+
 
 synthesize "is_dc_witness" from_schematic
 
 manual_arity for "is_dc_witness_fm"
   unfolding is_dc_witness_fm_def apply (subst arity_transrec_fm)
        apply (simp add:arity) defer 3
       apply (simp add:arity) defer
      apply (subst arity_is_nat_case_fm)
            apply (simp add:arity del:arity_transrec_fm) prefer 5
   by (simp add:arity del:arity_transrec_fm)+
 
 definition dcwit_body :: "[i,i,i,i,i] \<Rightarrow> o" where
   "dcwit_body(A,a,g,R) \<equiv> \<lambda>p. snd(p) = dc_witness(fst(p), A, a, g, R)"
 
 relativize functional "dcwit_body" "dcwit_body_rel"
 relationalize "dcwit_body_rel" "is_dcwit_body"
 
 synthesize "is_dcwit_body" from_definition assuming "nonempty"
 arity_theorem for "is_dcwit_body_fm"
 
 context M_replacement
 begin
 
 lemma dc_witness_closed[intro,simp]:
   assumes "M(n)" "M(A)" "M(a)" "M(s)" "M(R)" "n\<in>nat"
   shows "M(dc_witness(n,A,a,s,R))"
   using \<open>n\<in>nat\<close>
 proof(induct)
   case 0
   with \<open>M(a)\<close>
   show ?case
     unfolding dc_witness_def by simp
 next
   case (succ x)
   with assms
   have "M(dc_witness(x,A,a,s,R))" (is "M(?b)")
     by simp
   moreover from this assms
   have "M(({?b}\<times>A)\<inter>R)" (is "M(?X)") by auto
   moreover
   have "{x\<in>A. \<langle>?b,x\<rangle>\<in>R} = {snd(y) . y\<in>?X}" (is "_ = ?Y")
     by(intro equalityI subsetI,force,auto)
   moreover from calculation
   have "M(?Y)"
     using lam_replacement_snd lam_replacement_imp_strong_replacement RepFun_closed
       snd_closed[OF transM]
     by auto
   ultimately
   show ?case
     using \<open>M(s)\<close> apply_closed
     unfolding dc_witness_def by simp
 qed
 
 lemma dc_witness_rel_char:
   assumes "M(A)"
   shows "dc_witness_rel(M,n,A,a,s,R) = dc_witness(n,A,a,s,R)"
 proof -
   from assms
   have "{x \<in> A . \<langle>rec, x\<rangle> \<in> R} =  {x \<in> A . M(x) \<and> \<langle>rec, x\<rangle> \<in> R}" for rec
     by (auto dest:transM)
   then
   show ?thesis
     unfolding dc_witness_def dc_witness_rel_def by simp
 qed
 
 lemma (in M_basic) first_section_closed:
   assumes
     "M(A)" "M(a)" "M(R)"
   shows "M({x \<in> A . \<langle>a, x\<rangle> \<in> R})"
 proof -
   have "{x \<in> A . \<langle>a, x\<rangle> \<in> R} = range({a} \<times> range(R) \<inter> R) \<inter> A"
     by (intro equalityI) auto
   with assms
   show ?thesis
     by simp
 qed
 
 lemma witness_into_A [TC]:
   assumes "a\<in>A"
     "\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X\<in>A"
     "\<forall>y\<in>A. {x\<in>A. \<langle>y,x\<rangle>\<in>R } \<noteq> 0" "n\<in>nat"
     "M(A)" "M(a)" "M(s)" "M(R)"
   shows "dc_witness(n, A, a, s, R)\<in>A"
   using \<open>n\<in>nat\<close>
 proof(induct n)
   case 0
   then show ?case using \<open>a\<in>A\<close> by simp
 next
   case (succ x)
   with succ assms(1,3-)
   show ?case
     using nat_into_M first_section_closed
     by (simp, rule_tac rev_subsetD, rule_tac assms(2)[rule_format])
       auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_replacement\<close>\<close>
 
 locale M_DC = M_trancl + M_replacement + M_eclose +
   assumes
     separation_is_dcwit_body:
     "M(A) \<Longrightarrow> M(a) \<Longrightarrow> M(g) \<Longrightarrow> M(R) \<Longrightarrow> separation(M,is_dcwit_body(M, A, a, g, R))"
     and
     dcwit_replacement:"Ord(na) \<Longrightarrow>
     M(na) \<Longrightarrow>
     M(A) \<Longrightarrow>
     M(a) \<Longrightarrow>
     M(s) \<Longrightarrow>
     M(R) \<Longrightarrow>
     transrec_replacement
      (M, \<lambda>n f ntc.
             is_nat_case
              (M, a,
               \<lambda>m bmfm.
                  \<exists>fm[M]. \<exists>cp[M].
                     is_apply(M, f, m, fm) \<and>
                     is_Collect(M, A, \<lambda>x. \<exists>fmx[M]. (M(x) \<and> fmx \<in> R) \<and> pair(M, fm, x, fmx), cp) \<and>
                     is_apply(M, s, cp, bmfm),
               n, ntc),na)"
 begin
 
 lemma is_dc_witness_iff:
   assumes "Ord(na)" "M(na)" "M(A)" "M(a)" "M(s)" "M(R)" "M(res)"
   shows "is_dc_witness(M, na, A, a, s, R, res) \<longleftrightarrow> res = dc_witness_rel(M, na, A, a, s, R)"
 proof -
   note assms
   moreover from this
   have "{x \<in> A . M(x) \<and> \<langle>f, x\<rangle> \<in> R} = {x \<in> A . \<langle>f, x\<rangle> \<in> R}" for f
     by (auto dest:transM)
   moreover from calculation
   have "M(fm) \<Longrightarrow> M({x \<in> A . M(x) \<and> \<langle>fm, x\<rangle> \<in> R})" for fm
     using first_section_closed by (auto dest:transM)
   moreover from calculation
   have "M(x) \<Longrightarrow> M(z) \<Longrightarrow> M(mesa) \<Longrightarrow>
     (\<exists>ya[M]. pair(M, x, ya, z) \<and>
       is_wfrec(M, \<lambda>n f. is_nat_case(M, a, \<lambda>m bmfm. \<exists>fm[M]. is_apply(M, f, m, fm) \<and>
         is_apply(M, s, {x \<in> A . \<langle>fm, x\<rangle> \<in> R}, bmfm), n), mesa, x, ya))
     \<longleftrightarrow>
     (\<exists>y[M]. pair(M, x, y, z) \<and>
       is_wfrec(M, \<lambda>n f. is_nat_case(M, a,
         \<lambda>m bmfm.
           \<exists>fm[M]. \<exists>cp[M]. is_apply(M, f, m, fm) \<and>
             is_Collect(M, A, \<lambda>x. M(x) \<and> \<langle>fm, x\<rangle> \<in> R, cp) \<and>  is_apply(M, s, cp, bmfm),n),
         mesa, x, y))" for x z mesa by simp
   moreover from calculation
   show ?thesis
     using assms dcwit_replacement[of na A a s R]
     unfolding is_dc_witness_def dc_witness_rel_def
     by (rule_tac recursor_abs) (auto dest:transM)
 qed
 
 lemma dcwit_body_abs:
   "fst(x) \<in> \<omega> \<Longrightarrow> M(A) \<Longrightarrow> M(a) \<Longrightarrow> M(g) \<Longrightarrow> M(R) \<Longrightarrow> M(x) \<Longrightarrow>
    is_dcwit_body(M,A,a,g,R,x) \<longleftrightarrow> dcwit_body(A,a,g,R,x)"
   using pair_in_M_iff apply_closed transM[of _ A]
     is_dc_witness_iff[of "fst(x)" "A" "a" "g" "R" "snd(x)"]
     fst_snd_closed dc_witness_closed
   unfolding dcwit_body_def is_dcwit_body_def
   by (auto dest:transM simp:absolut dc_witness_rel_char del:bexI intro!:bexI)
 
-lemma separation_eq_dc_witness:
-  "M(A) \<Longrightarrow>
-    M(a) \<Longrightarrow>
-    M(g) \<Longrightarrow>
-    M(R) \<Longrightarrow>  separation(M,\<lambda>p. fst(p)\<in>\<omega> \<longrightarrow> snd(p) = dc_witness(fst(p), A, a, g, R))"
-  using separation_is_dcwit_body dcwit_body_abs unfolding is_dcwit_body_def
-  oops
-
 lemma Lambda_dc_witness_closed:
   assumes "g \<in> Pow\<^bsup>M\<^esup>(A)-{0} \<rightarrow> A" "a\<in>A" "\<forall>y\<in>A. {x \<in> A . \<langle>y, x\<rangle> \<in> R} \<noteq> 0"
     "M(g)" "M(A)" "M(a)" "M(R)"
   shows "M(\<lambda>n\<in>nat. dc_witness(n,A,a,g,R))"
 proof -
   from assms
   have "(\<lambda>n\<in>nat. dc_witness(n,A,a,g,R)) = {p \<in> \<omega> \<times> A . is_dcwit_body(M,A,a,g,R,p)}"
     using witness_into_A[of a A g R]
       Pow_rel_char apply_type[of g "{x \<in> Pow(A) . M(x)}-{0}" "\<lambda>_.A"]
     unfolding lam_def split_def
     apply (intro equalityI subsetI)
      apply (auto) (* slow *)
     by (subst dcwit_body_abs, simp_all add:transM[of _ \<omega>] dcwit_body_def,
         subst (asm) dcwit_body_abs, auto dest:transM simp:dcwit_body_def)
       (* by (intro equalityI subsetI, auto) (* Extremely slow *)
     (subst dcwit_body_abs, simp_all add:transM[of _ \<omega>] dcwit_body_def,
       subst (asm) dcwit_body_abs, auto dest:transM simp:dcwit_body_def) *)
   with assms
   show ?thesis
     using separation_is_dcwit_body dc_witness_rel_char unfolding split_def by simp
 qed
 
 lemma witness_related:
   assumes "a\<in>A"
     "\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X\<in>X"
     "\<forall>y\<in>A. {x\<in>A. \<langle>y,x\<rangle>\<in>R } \<noteq> 0" "n\<in>nat"
     "M(a)" "M(A)" "M(s)" "M(R)" "M(n)"
   shows "\<langle>dc_witness(n, A, a, s, R),dc_witness(succ(n), A, a, s, R)\<rangle>\<in>R"
 proof -
   note assms
   moreover from this
   have "(\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X\<in>A)" by auto
   moreover from calculation
   have "dc_witness(n, A, a, s, R)\<in>A" (is "?x \<in> A")
     using witness_into_A[of _ _ s R n] by simp
   moreover from assms
   have "M({x \<in> A . \<langle>dc_witness(n, A, a, s, R), x\<rangle> \<in> R})"
     using first_section_closed[of A "dc_witness(n, A, a, s, R)"]
     by simp
   ultimately
   show ?thesis by auto
 qed
 
 lemma witness_funtype:
   assumes "a\<in>A"
     "\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X \<in> A"
     "\<forall>y\<in>A. {x\<in>A. \<langle>y,x\<rangle>\<in>R} \<noteq> 0"
     "M(A)" "M(a)" "M(s)" "M(R)"
   shows "(\<lambda>n\<in>nat. dc_witness(n, A, a, s, R)) \<in> nat \<rightarrow> A" (is "?f \<in> _ \<rightarrow> _")
 proof -
   have "?f \<in> nat \<rightarrow> {dc_witness(n, A, a, s, R). n\<in>nat}" (is "_ \<in> _ \<rightarrow> ?B")
     using lam_funtype assms by simp
   then
   have "?B \<subseteq> A"
     using witness_into_A assms by auto
   with \<open>?f \<in> _\<close>
   show ?thesis
     using fun_weaken_type
     by simp
 qed
 
 lemma witness_to_fun:
   assumes "a\<in>A"
     "\<forall>X[M]. X\<noteq>0 \<and> X\<subseteq>A \<longrightarrow> s`X\<in>A"
     "\<forall>y\<in>A. {x\<in>A. \<langle>y,x\<rangle>\<in>R } \<noteq> 0"
     "M(A)" "M(a)" "M(s)" "M(R)"
   shows "\<exists>f \<in> nat\<rightarrow>A. \<forall>n\<in>nat. f`n =dc_witness(n,A,a,s,R)"
   using assms bexI[of _ "\<lambda>n\<in>nat. dc_witness(n,A,a,s,R)"] witness_funtype
   by simp
 
 end \<comment> \<open>\<^locale>\<open>M_DC\<close>\<close>
 
 locale M_library_DC = M_library + M_DC
 begin
 
 (* Should port the whole AC theory, including the absolute version
   of the following theorem *)
 lemma AC_M_func:
   assumes "\<And>x. x \<in> A \<Longrightarrow> (\<exists>y. y \<in> x)" "M(A)"
   shows "\<exists>f \<in> A \<rightarrow>\<^bsup>M\<^esup> \<Union>(A). \<forall>x \<in> A. f`x \<in> x"
 proof -
   from \<open>M(A)\<close>
   interpret mpiA:M_Pi_assumptions _ A "\<lambda>x. x"
     using Pi_replacement Pi_separation lam_replacement_identity
       lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement]
     by unfold_locales (simp_all add:transM[of _ A])
   from \<open>M(A)\<close>
   interpret mpic_A:M_Pi_assumptions_choice _ A "\<lambda>x. x"
     apply unfold_locales
     using lam_replacement_constant lam_replacement_identity
       lam_replacement_identity[THEN lam_replacement_imp_strong_replacement]
       lam_replacement_minimum[THEN [5] lam_replacement_hcomp2]
     unfolding lam_replacement_def[symmetric]
     by auto
   from \<open>M(A)\<close>
   interpret mpi2:M_Pi_assumptions2 _ A "\<lambda>_. \<Union>A" "\<lambda>x. x"
     using Pi_replacement Pi_separation lam_replacement_constant
       lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement,
         of  "\<lambda>_. \<Union>A"] Pi_replacement1[of _  "\<Union>A"] transM[of _  "A"]
     by unfold_locales auto
   from assms
   show ?thesis
     using mpi2.Pi_rel_type apply_type mpiA.mem_Pi_rel_abs mpi2.mem_Pi_rel_abs
       function_space_rel_char
     by (rule_tac mpic_A.AC_Pi_rel[THEN rexE], simp, rule_tac x=x in bexI)
       (auto, rule_tac C="\<lambda>x. x" in Pi_type, auto)
 qed
 
 lemma non_empty_family: "[| 0 \<notin> A;  x \<in> A |] ==> \<exists>y. y \<in> x"
   by (subgoal_tac "x \<noteq> 0", blast+)
 
 lemma AC_M_func0: "0 \<notin> A \<Longrightarrow> M(A) \<Longrightarrow> \<exists>f \<in> A \<rightarrow>\<^bsup>M\<^esup> \<Union>(A). \<forall>x \<in> A. f`x \<in> x"
   by (rule AC_M_func) (simp_all add: non_empty_family)
 
 lemma AC_M_func_Pow_rel:
   assumes "M(C)"
   shows "\<exists>f \<in> (Pow\<^bsup>M\<^esup>(C)-{0}) \<rightarrow>\<^bsup>M\<^esup> C. \<forall>x \<in> Pow\<^bsup>M\<^esup>(C)-{0}. f`x \<in> x"
 proof -
   have "0\<notin>Pow\<^bsup>M\<^esup>(C)-{0}" by simp
   with assms
   obtain f where "f \<in> (Pow\<^bsup>M\<^esup>(C)-{0}) \<rightarrow>\<^bsup>M\<^esup> \<Union>(Pow\<^bsup>M\<^esup>(C)-{0})" "\<forall>x \<in> Pow\<^bsup>M\<^esup>(C)-{0}. f`x \<in> x"
     using AC_M_func0[OF \<open>0\<notin>_\<close>] by auto
   moreover
   have "x\<subseteq>C" if "x \<in> Pow\<^bsup>M\<^esup>(C) - {0}" for x
     using that Pow_rel_char assms
     by auto
   moreover
   have "\<Union>(Pow\<^bsup>M\<^esup>(C) - {0}) \<subseteq> C"
     using assms Pow_rel_char by auto
   ultimately
   show ?thesis
     using assms function_space_rel_char
     by (rule_tac bexI,auto,rule_tac Pi_weaken_type,simp_all)
 qed
 
 theorem pointed_DC:
   assumes "\<forall>x\<in>A. \<exists>y\<in>A. \<langle>x,y\<rangle>\<in> R" "M(A)" "M(R)"
   shows "\<forall>a\<in>A. \<exists>f \<in> nat\<rightarrow>\<^bsup>M\<^esup> A. f`0 = a \<and> (\<forall>n \<in> nat. \<langle>f`n,f`succ(n)\<rangle>\<in>R)"
 proof -
   have 0:"\<forall>y\<in>A. {x \<in> A . \<langle>y, x\<rangle> \<in> R} \<noteq> 0"
     using assms by auto
   from \<open>M(A)\<close>
   obtain g where 1: "g \<in> Pow\<^bsup>M\<^esup>(A)-{0} \<rightarrow> A" "\<forall>X[M]. X \<noteq> 0 \<and> X \<subseteq> A \<longrightarrow> g ` X \<in> X"
     "M(g)"
     using AC_M_func_Pow_rel[of A] mem_Pow_rel_abs
       function_space_rel_char[of "Pow\<^bsup>M\<^esup>(A)-{0}" A] by auto
   then
   have 2:"\<forall>X[M]. X \<noteq> 0 \<and> X \<subseteq> A \<longrightarrow> g ` X \<in> A" by auto
   {
     fix a
     assume "a\<in>A"
     let ?f ="\<lambda>n\<in>nat. dc_witness(n,A,a,g,R)"
     note \<open>a\<in>A\<close>
     moreover from this
     have f0: "?f`0 = a" by simp
     moreover
     note \<open>a\<in>A\<close> \<open>M(g)\<close> \<open>M(A)\<close> \<open>M(R)\<close>
     moreover from calculation
     have "\<langle>?f ` n, ?f ` succ(n)\<rangle> \<in> R" if "n\<in>nat" for n
       using witness_related[OF \<open>a\<in>A\<close> _ 0, of g n] 1 that
       by (auto dest:transM)
     ultimately
     have "\<exists>f[M]. f\<in>nat \<rightarrow> A \<and> f ` 0 = a \<and> (\<forall>n\<in>nat. \<langle>f ` n, f ` succ(n)\<rangle> \<in> R)"
       using 0 1 \<open>a\<in>_\<close>
       by (rule_tac x="(\<lambda>n\<in>\<omega>. dc_witness(n, A, a, g, R))" in rexI)
         (simp_all, rule_tac witness_funtype,
           auto intro!: Lambda_dc_witness_closed dest:transM)
   }
   with \<open>M(A)\<close>
   show ?thesis using function_space_rel_char by auto
 qed
 
 lemma aux_DC_on_AxNat2 : "\<forall>x\<in>A\<times>nat. \<exists>y\<in>A. \<langle>x,\<langle>y,succ(snd(x))\<rangle>\<rangle> \<in> R \<Longrightarrow>
                   \<forall>x\<in>A\<times>nat. \<exists>y\<in>A\<times>nat. \<langle>x,y\<rangle> \<in> {\<langle>a,b\<rangle>\<in>R. snd(b) = succ(snd(a))}"
   by (rule ballI, erule_tac x="x" in ballE, simp_all)
 
 lemma infer_snd : "c\<in> A\<times>B \<Longrightarrow> snd(c) = k \<Longrightarrow> c=\<langle>fst(c),k\<rangle>"
   by auto
 
 corollary DC_on_A_x_nat :
   assumes "(\<forall>x\<in>A\<times>nat. \<exists>y\<in>A. \<langle>x,\<langle>y,succ(snd(x))\<rangle>\<rangle> \<in> R)" "a\<in>A" "M(A)" "M(R)"
   shows "\<exists>f \<in> nat\<rightarrow>\<^bsup>M\<^esup>A. f`0 = a \<and> (\<forall>n \<in> nat. \<langle>\<langle>f`n,n\<rangle>,\<langle>f`succ(n),succ(n)\<rangle>\<rangle>\<in>R)" (is "\<exists>x\<in>_.?P(x)")
 proof -
   let ?R'="{\<langle>a,b\<rangle>\<in>R. snd(b) = succ(snd(a))}"
   from assms(1)
   have "\<forall>x\<in>A\<times>nat. \<exists>y\<in>A\<times>nat. \<langle>x,y\<rangle> \<in> ?R'"
     using aux_DC_on_AxNat2 by simp
   moreover
   note \<open>a\<in>_\<close> \<open>M(A)\<close>
   moreover from this
   have "M(A \<times> \<omega>)" by simp
   have "lam_replacement(M, \<lambda>x. succ(snd(fst(x))))"
     using lam_replacement_fst lam_replacement_snd lam_replacement_hcomp
       lam_replacement_hcomp[of _ "\<lambda>x. succ(snd(x))"]
       lam_replacement_succ by simp
   with \<open>M(R)\<close>
   have "M(?R')"
     using separation_eq lam_replacement_fst lam_replacement_snd
       lam_replacement_succ lam_replacement_hcomp lam_replacement_identity
     unfolding split_def by simp
   ultimately
   obtain f where
     F:"f\<in>nat\<rightarrow>\<^bsup>M\<^esup> A\<times>\<omega>" "f ` 0 = \<langle>a,0\<rangle>"  "\<forall>n\<in>nat. \<langle>f ` n, f ` succ(n)\<rangle> \<in> ?R'"
     using pointed_DC[of "A\<times>nat" ?R'] by blast
   with \<open>M(A)\<close>
   have "M(f)" using function_space_rel_char by simp
   then
   have "M(\<lambda>x\<in>nat. fst(f`x))" (is "M(?f)")
     using lam_replacement_fst lam_replacement_hcomp
       lam_replacement_constant lam_replacement_identity
       lam_replacement_apply
     by (rule_tac lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
       auto
   with F \<open>M(A)\<close>
   have "?f\<in>nat\<rightarrow>\<^bsup>M\<^esup> A" "?f ` 0 = a" using function_space_rel_char by auto
   have 1:"n\<in> nat \<Longrightarrow> f`n= \<langle>?f`n, n\<rangle>" for n
   proof(induct n set:nat)
     case 0
     then show ?case using F by simp
   next
     case (succ x)
     with \<open>M(A)\<close>
     have "\<langle>f`x, f`succ(x)\<rangle> \<in> ?R'" "f`x \<in> A\<times>nat" "f`succ(x)\<in>A\<times>nat"
       using F function_space_rel_char[of \<omega> "A\<times>\<omega>"] by auto
     then
     have "snd(f`succ(x)) = succ(snd(f`x))" by simp
     with succ \<open>f`x\<in>_\<close>
     show ?case using infer_snd[OF \<open>f`succ(_)\<in>_\<close>] by auto
   qed
   have "\<langle>\<langle>?f`n,n\<rangle>,\<langle>?f`succ(n),succ(n)\<rangle>\<rangle> \<in> R" if "n\<in>nat" for n
     using that 1[of "succ(n)"] 1[OF \<open>n\<in>_\<close>] F(3) by simp
   with \<open>f`0=\<langle>a,0\<rangle>\<close>
   show ?thesis
     using rev_bexI[OF \<open>?f\<in>_\<close>] by simp
 qed
 
 lemma aux_sequence_DC :
   assumes "\<forall>x\<in>A. \<forall>n\<in>nat. \<exists>y\<in>A. \<langle>x,y\<rangle> \<in> S`n"
     "R={\<langle>\<langle>x,n\<rangle>,\<langle>y,m\<rangle>\<rangle> \<in> (A\<times>nat)\<times>(A\<times>nat). \<langle>x,y\<rangle>\<in>S`m }"
   shows "\<forall> x\<in>A\<times>nat . \<exists>y\<in>A. \<langle>x,\<langle>y,succ(snd(x))\<rangle>\<rangle> \<in> R"
   using assms Pair_fst_snd_eq by auto
 
 lemma aux_sequence_DC2 : "\<forall>x\<in>A. \<forall>n\<in>nat. \<exists>y\<in>A. \<langle>x,y\<rangle> \<in> S`n \<Longrightarrow>
         \<forall>x\<in>A\<times>nat. \<exists>y\<in>A. \<langle>x,\<langle>y,succ(snd(x))\<rangle>\<rangle> \<in> {\<langle>\<langle>x,n\<rangle>,\<langle>y,m\<rangle>\<rangle>\<in>(A\<times>nat)\<times>(A\<times>nat). \<langle>x,y\<rangle>\<in>S`m }"
   by auto
 
 lemma sequence_DC:
   assumes "\<forall>x\<in>A. \<forall>n\<in>nat. \<exists>y\<in>A. \<langle>x,y\<rangle> \<in> S`n" "M(A)" "M(S)"
   shows "\<forall>a\<in>A. (\<exists>f \<in> nat\<rightarrow>\<^bsup>M\<^esup> A. f`0 = a \<and> (\<forall>n \<in> nat. \<langle>f`n,f`succ(n)\<rangle>\<in>S`succ(n)))"
 proof -
   from \<open>M(S)\<close>
   have "lam_replacement(M, \<lambda>x. S ` snd(snd(x)))"
     using lam_replacement_snd lam_replacement_hcomp
       lam_replacement_hcomp[of _ "\<lambda>x. S`snd(x)"] lam_replacement_apply by simp
   with assms
   have "M({x \<in> (A \<times> \<omega>) \<times> A \<times> \<omega> . (\<lambda>\<langle>\<langle>x,n\<rangle>,y,m\<rangle>. \<langle>x, y\<rangle> \<in> S ` m)(x)})"
     using lam_replacement_fst lam_replacement_snd
       lam_replacement_Pair[THEN [5] lam_replacement_hcomp2,
         of "\<lambda>x. fst(fst(x))" "\<lambda>x. fst(snd(x))", THEN [2] separation_in,
         of "\<lambda>x. S ` snd(snd(x))"] lam_replacement_apply[of S]
       lam_replacement_hcomp unfolding split_def by simp
   with assms
   show ?thesis
     by (rule_tac ballI) (drule aux_sequence_DC2, drule DC_on_A_x_nat, auto)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_library_DC\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Recursion_Thms.thy b/thys/Transitive_Models/Recursion_Thms.thy
--- a/thys/Transitive_Models/Recursion_Thms.thy
+++ b/thys/Transitive_Models/Recursion_Thms.thy
@@ -1,362 +1,364 @@
 section\<open>Some enhanced theorems on recursion\<close>
 
 theory Recursion_Thms
   imports "ZF-Constructible.Datatype_absolute"
 
 begin
 
+hide_const (open) Order.pred
+
 \<comment> \<open>Removing arities from inherited simpset\<close>
 declare arity_And [simp del] arity_Or[simp del] arity_Implies[simp del]
   arity_Exists[simp del] arity_Iff[simp del]
   arity_subset_fm [simp del] arity_ordinal_fm[simp del] arity_transset_fm[simp del]
 
 text\<open>We prove results concerning definitions by well-founded
 recursion on some relation \<^term>\<open>R\<close> and its transitive closure
 \<^term>\<open>R^*\<close>\<close>
   (* Restrict the relation r to the field A*A *)
 
 lemma fld_restrict_eq : "a \<in> A \<Longrightarrow> (r \<inter> A\<times>A)-``{a} = (r-``{a} \<inter> A)"
   by(force)
 
 lemma fld_restrict_mono : "relation(r) \<Longrightarrow> A \<subseteq> B \<Longrightarrow> r \<inter> A\<times>A \<subseteq> r \<inter> B\<times>B"
   by(auto)
 
 lemma fld_restrict_dom :
   assumes "relation(r)" "domain(r) \<subseteq> A" "range(r)\<subseteq> A"
   shows "r\<inter> A\<times>A = r"
 proof (rule equalityI,blast,rule subsetI)
   { fix x
     assume xr: "x \<in> r"
     from xr assms have "\<exists> a b . x = \<langle>a,b\<rangle>" by (simp add: relation_def)
     then obtain a b where "\<langle>a,b\<rangle> \<in> r" "\<langle>a,b\<rangle> \<in> r\<inter>A\<times>A" "x \<in> r\<inter>A\<times>A"
       using assms xr
       by force
     then have "x\<in> r \<inter> A\<times>A" by simp
   }
   then show "x \<in> r \<Longrightarrow> x\<in> r\<inter>A\<times>A" for x .
 qed
 
 definition tr_down :: "[i,i] \<Rightarrow> i"
   where "tr_down(r,a) = (r^+)-``{a}"
 
 lemma tr_downD : "x \<in> tr_down(r,a) \<Longrightarrow> \<langle>x,a\<rangle> \<in> r^+"
   by (simp add: tr_down_def vimage_singleton_iff)
 
 lemma pred_down : "relation(r) \<Longrightarrow> r-``{a} \<subseteq> tr_down(r,a)"
   by(simp add: tr_down_def vimage_mono r_subset_trancl)
 
 lemma tr_down_mono : "relation(r) \<Longrightarrow> x \<in> r-``{a} \<Longrightarrow> tr_down(r,x) \<subseteq> tr_down(r,a)"
   by(rule subsetI,simp add:tr_down_def,auto dest: underD,force simp add: underI r_into_trancl trancl_trans)
 
 lemma rest_eq :
   assumes "relation(r)" and "r-``{a} \<subseteq> B" and "a \<in> B"
   shows "r-``{a} = (r\<inter>B\<times>B)-``{a}"
 proof (intro equalityI subsetI)
   fix x
   assume "x \<in> r-``{a}"
   then
   have "x \<in> B" using assms by (simp add: subsetD)
   from \<open>x\<in> r-``{a}\<close>
   have "\<langle>x,a\<rangle> \<in> r" using underD by simp
   then
   show "x \<in> (r\<inter>B\<times>B)-``{a}" using \<open>x\<in>B\<close> \<open>a\<in>B\<close> underI by simp
 next
   from assms
   show "x \<in> r -`` {a}" if  "x \<in> (r \<inter> B\<times>B) -`` {a}" for x
     using vimage_mono that by auto
 qed
 
 lemma wfrec_restr_eq : "r' = r \<inter> A\<times>A \<Longrightarrow> wfrec[A](r,a,H) = wfrec(r',a,H)"
   by(simp add:wfrec_on_def)
 
 lemma wfrec_restr :
   assumes rr: "relation(r)" and wfr:"wf(r)"
   shows  "a \<in> A \<Longrightarrow> tr_down(r,a) \<subseteq> A \<Longrightarrow> wfrec(r,a,H) = wfrec[A](r,a,H)"
 proof (induct a arbitrary:A rule:wf_induct_raw[OF wfr] )
   case (1 a)
   have wfRa : "wf[A](r)"
     using wf_subset wfr wf_on_def Int_lower1 by simp
   from pred_down rr
   have "r -`` {a} \<subseteq> tr_down(r, a)" .
   with 1
   have "r-``{a} \<subseteq> A" by (force simp add: subset_trans)
   {
     fix x
     assume x_a : "x \<in> r-``{a}"
     with \<open>r-``{a} \<subseteq> A\<close>
     have "x \<in> A" ..
     from pred_down rr
     have b : "r -``{x} \<subseteq> tr_down(r,x)" .
     then
     have "tr_down(r,x) \<subseteq> tr_down(r,a)"
       using tr_down_mono x_a rr by simp
     with 1
     have "tr_down(r,x) \<subseteq> A" using subset_trans by force
     have "\<langle>x,a\<rangle> \<in> r" using x_a  underD by simp
     with 1 \<open>tr_down(r,x) \<subseteq> A\<close> \<open>x \<in> A\<close>
     have "wfrec(r,x,H) = wfrec[A](r,x,H)" by simp
   }
   then
   have "x\<in> r-``{a} \<Longrightarrow> wfrec(r,x,H) =  wfrec[A](r,x,H)" for x  .
   then
   have Eq1 :"(\<lambda> x \<in> r-``{a} . wfrec(r,x,H)) = (\<lambda> x \<in> r-``{a} . wfrec[A](r,x,H))"
     using lam_cong by simp
 
   from assms
   have "wfrec(r,a,H) = H(a,\<lambda> x \<in> r-``{a} . wfrec(r,x,H))" by (simp add:wfrec)
   also
   have "... = H(a,\<lambda> x \<in> r-``{a} . wfrec[A](r,x,H))"
     using assms Eq1 by simp
   also from 1 \<open>r-``{a} \<subseteq> A\<close>
   have "... = H(a,\<lambda> x \<in> (r\<inter>A\<times>A)-``{a} . wfrec[A](r,x,H))"
     using assms rest_eq  by simp
   also from \<open>a\<in>A\<close>
   have "... = H(a,\<lambda> x \<in> (r-``{a})\<inter>A . wfrec[A](r,x,H))"
     using fld_restrict_eq by simp
   also from \<open>a\<in>A\<close> \<open>wf[A](r)\<close>
   have "... = wfrec[A](r,a,H)" using wfrec_on by simp
   finally show ?case .
 qed
 
 lemmas wfrec_tr_down = wfrec_restr[OF _ _ _ subset_refl]
 
 lemma wfrec_trans_restr : "relation(r) \<Longrightarrow> wf(r) \<Longrightarrow> trans(r) \<Longrightarrow> r-``{a}\<subseteq>A \<Longrightarrow> a \<in> A \<Longrightarrow>
   wfrec(r, a, H) = wfrec[A](r, a, H)"
   by(subgoal_tac "tr_down(r,a) \<subseteq> A",auto simp add : wfrec_restr tr_down_def trancl_eq_r)
 
 
 lemma field_trancl : "field(r^+) = field(r)"
   by (blast intro: r_into_trancl dest!: trancl_type [THEN subsetD])
 
 definition
   Rrel :: "[i\<Rightarrow>i\<Rightarrow>o,i] \<Rightarrow> i" where
   "Rrel(R,A) \<equiv> {z\<in>A\<times>A. \<exists>x y. z = \<langle>x, y\<rangle> \<and> R(x,y)}"
 
 lemma RrelI : "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> R(x,y) \<Longrightarrow> \<langle>x,y\<rangle> \<in> Rrel(R,A)"
   unfolding Rrel_def by simp
 
 lemma Rrel_mem: "Rrel(mem,x) = Memrel(x)"
   unfolding Rrel_def Memrel_def ..
 
 lemma relation_Rrel: "relation(Rrel(R,d))"
   unfolding Rrel_def relation_def by simp
 
 lemma field_Rrel: "field(Rrel(R,d)) \<subseteq>  d"
   unfolding Rrel_def by auto
 
 lemma Rrel_mono : "A \<subseteq> B \<Longrightarrow> Rrel(R,A) \<subseteq> Rrel(R,B)"
   unfolding Rrel_def by blast
 
 lemma Rrel_restr_eq : "Rrel(R,A) \<inter> B\<times>B = Rrel(R,A\<inter>B)"
   unfolding Rrel_def by blast
 
 (* now a consequence of the previous lemmas *)
 lemma field_Memrel : "field(Memrel(A)) \<subseteq> A"
   (* unfolding field_def using Ordinal.Memrel_type by blast *)
   using Rrel_mem field_Rrel by blast
 
 lemma restrict_trancl_Rrel:
   assumes "R(w,y)"
   shows "restrict(f,Rrel(R,d)-``{y})`w
        = restrict(f,(Rrel(R,d)^+)-``{y})`w"
 proof (cases "y\<in>d")
   let ?r="Rrel(R,d)" and ?s="(Rrel(R,d))^+"
   case True
   show ?thesis
   proof (cases "w\<in>d")
     case True
     with \<open>y\<in>d\<close> assms
     have "\<langle>w,y\<rangle>\<in>?r"
       unfolding Rrel_def by blast
     then
     have "\<langle>w,y\<rangle>\<in>?s"
       using r_subset_trancl[of ?r] relation_Rrel[of R d] by blast
     with \<open>\<langle>w,y\<rangle>\<in>?r\<close>
     have "w\<in>?r-``{y}" "w\<in>?s-``{y}"
       using vimage_singleton_iff by simp_all
     then
     show ?thesis by simp
   next
     case False
     then
     have "w\<notin>domain(restrict(f,?r-``{y}))"
       using subsetD[OF field_Rrel[of R d]] by auto
     moreover from \<open>w\<notin>d\<close>
     have "w\<notin>domain(restrict(f,?s-``{y}))"
       using subsetD[OF field_Rrel[of R d], of w] field_trancl[of ?r]
         fieldI1[of w y ?s] by auto
     ultimately
     have "restrict(f,?r-``{y})`w = 0" "restrict(f,?s-``{y})`w = 0"
       unfolding apply_def by auto
     then show ?thesis by simp
   qed
 next
   let ?r="Rrel(R,d)"
   let ?s="?r^+"
   case False
   then
   have "?r-``{y}=0"
     unfolding Rrel_def by blast
   then
   have "w\<notin>?r-``{y}" by simp
   with \<open>y\<notin>d\<close> assms
   have "y\<notin>field(?s)"
     using field_trancl subsetD[OF field_Rrel[of R d]] by force
   then
   have "w\<notin>?s-``{y}"
     using vimage_singleton_iff by blast
   with \<open>w\<notin>?r-``{y}\<close>
   show ?thesis by simp
 qed
 
 lemma restrict_trans_eq:
   assumes "w \<in> y"
   shows "restrict(f,Memrel(eclose({x}))-``{y})`w
        = restrict(f,(Memrel(eclose({x}))^+)-``{y})`w"
   using assms restrict_trancl_Rrel[of mem ] Rrel_mem by (simp)
 
 lemma wf_eq_trancl:
   assumes "\<And> f y . H(y,restrict(f,R-``{y})) = H(y,restrict(f,R^+-``{y}))"
   shows  "wfrec(R, x, H) = wfrec(R^+, x, H)" (is "wfrec(?r,_,_) = wfrec(?r',_,_)")
 proof -
   have "wfrec(R, x, H) = wftrec(?r^+, x, \<lambda>y f. H(y, restrict(f,?r-``{y})))"
     unfolding wfrec_def ..
   also
   have " ... = wftrec(?r^+, x, \<lambda>y f. H(y, restrict(f,(?r^+)-``{y})))"
     using assms by simp
   also
   have " ... =  wfrec(?r^+, x, H)"
     unfolding wfrec_def using trancl_eq_r[OF relation_trancl trans_trancl] by simp
   finally
   show ?thesis .
 qed
 
 lemma transrec_equal_on_Ord:
   assumes
     "\<And>x f . Ord(x) \<Longrightarrow> foo(x,f) = bar(x,f)"
     "Ord(\<alpha>)"
   shows
     "transrec(\<alpha>, foo) = transrec(\<alpha>, bar)"
 proof -
   have "transrec(\<beta>,foo) = transrec(\<beta>,bar)" if "Ord(\<beta>)" for \<beta>
     using that
   proof (induct rule:trans_induct)
     case (step \<beta>)
     have "transrec(\<beta>, foo) = foo(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, foo))"
       using def_transrec[of "\<lambda>x. transrec(x, foo)" foo] by blast
     also from assms and step
     have " \<dots> = bar(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, foo))"
       by simp
     also from step
     have " \<dots> = bar(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, bar))"
       by (auto)
     also
     have " \<dots> = transrec(\<beta>, bar)"
       using def_transrec[of "\<lambda>x. transrec(x, bar)" bar, symmetric]
       by blast
     finally
     show "transrec(\<beta>, foo) = transrec(\<beta>, bar)" .
   qed
   with assms
   show ?thesis by simp
 qed
 
 \<comment> \<open>Next theorem is very similar to @{thm transrec_equal_on_Ord}\<close>
 lemma (in M_eclose) transrec_equal_on_M:
   assumes
     "\<And>x f . M(x) \<Longrightarrow> M(f) \<Longrightarrow> foo(x,f) = bar(x,f)"
     "\<And>\<beta>. M(\<beta>) \<Longrightarrow> transrec_replacement(M,is_foo,\<beta>)" "relation2(M,is_foo,foo)"
     "strong_replacement(M, \<lambda>x y. y = \<langle>x, transrec(x, foo)\<rangle>)"
     "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(foo(x,g))"
     "M(\<alpha>)" "Ord(\<alpha>)"
   shows
     "transrec(\<alpha>, foo) = transrec(\<alpha>, bar)"
 proof -
   have "M(transrec(x, foo))" if "Ord(x)" and "M(x)" for x
     using that assms transrec_closed[of is_foo]
     by simp
   have "transrec(\<beta>,foo) = transrec(\<beta>,bar)" "M(transrec(\<beta>,foo))" if "Ord(\<beta>)" "M(\<beta>)" for \<beta>
     using that
   proof (induct rule:trans_induct)
     case (step \<beta>)
     moreover
     assume "M(\<beta>)"
     moreover
     note \<open>Ord(\<beta>)\<Longrightarrow> M(\<beta>) \<Longrightarrow> M(transrec(\<beta>, foo))\<close>
     ultimately
     show "M(transrec(\<beta>, foo))" by blast
     with step \<open>M(\<beta>)\<close> \<open>\<And>x. Ord(x)\<Longrightarrow> M(x) \<Longrightarrow> M(transrec(x, foo))\<close>
       \<open>strong_replacement(M, \<lambda>x y. y = \<langle>x, transrec(x, foo)\<rangle>)\<close>
     have "M(\<lambda>x\<in>\<beta>. transrec(x, foo))"
       using Ord_in_Ord transM[of _ \<beta>]
       by (rule_tac lam_closed) auto
     have "transrec(\<beta>, foo) = foo(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, foo))"
       using def_transrec[of "\<lambda>x. transrec(x, foo)" foo] by blast
     also from assms and \<open>M(\<lambda>x\<in>\<beta>. transrec(x, foo))\<close> \<open>M(\<beta>)\<close>
     have " \<dots> = bar(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, foo))"
       by simp
     also from step and \<open>M(\<beta>)\<close>
     have " \<dots> = bar(\<beta>, \<lambda>x\<in>\<beta>. transrec(x, bar))"
       using transM[of _ \<beta>] by (auto)
     also
     have " \<dots> = transrec(\<beta>, bar)"
       using def_transrec[of "\<lambda>x. transrec(x, bar)" bar, symmetric]
       by blast
     finally
     show "transrec(\<beta>, foo) = transrec(\<beta>, bar)" .
   qed
   with assms
   show ?thesis by simp
 qed
 
 
 lemma ordermap_restr_eq:
   assumes "well_ord(X,r)"
   shows "ordermap(X, r) = ordermap(X, r \<inter> X\<times>X)"
 proof -
   let ?A="\<lambda>x . Order.pred(X, x, r)"
   let ?B="\<lambda>x . Order.pred(X, x, r \<inter> X \<times> X)"
   let ?F="\<lambda>x f. f `` ?A(x)"
   let ?G="\<lambda>x f. f `` ?B(x)"
   let ?P="\<lambda> z. z\<in>X \<longrightarrow> wfrec(r \<inter> X \<times> X,z,\<lambda>x f. f `` ?A(x)) = wfrec(r \<inter> X \<times> X,z,\<lambda>x f. f `` ?B(x))"
   have pred_eq:
     "Order.pred(X, x, r \<inter> X \<times> X) = Order.pred(X, x, r)" if "x\<in>X" for x
     unfolding Order.pred_def using that by auto
   from assms
   have wf_onX:"wf(r \<inter> X \<times> X)" unfolding well_ord_def wf_on_def by simp
   {
     have "?P(z)" for z
     proof(induct rule:wf_induct[where P="?P",OF wf_onX])
       case (1 x)
       {
         assume "x\<in>X"
         from 1
         have lam_eq:
           "(\<lambda>w\<in>(r \<inter> X \<times> X) -`` {x}. wfrec(r \<inter> X \<times> X, w, ?F)) =
              (\<lambda>w\<in>(r \<inter> X \<times> X) -`` {x}. wfrec(r \<inter> X \<times> X, w, ?G))" (is "?L=?R")
         proof -
           have "wfrec(r \<inter> X \<times> X, w, ?F) = wfrec(r \<inter> X \<times> X, w, ?G)" if "w\<in>(r\<inter>X\<times>X)-``{x}" for w
             using 1 that by auto
           then show ?thesis using lam_cong[OF refl] by simp
         qed
         then
         have "wfrec(r \<inter> X \<times> X, x, ?F) = ?L `` ?A(x)"
           using wfrec[OF wf_onX,of x ?F] by simp
         also have "... =  ?R `` ?B(x)"
           using lam_eq pred_eq[OF \<open>x\<in>_\<close>] by simp
         also
         have "... = wfrec(r \<inter> X \<times> X, x, ?G)"
           using wfrec[OF wf_onX,of x ?G] by simp
         finally
         have "wfrec(r \<inter> X \<times> X, x, ?F) = wfrec(r \<inter> X \<times> X, x, ?G)" by simp
       }
       then
       show ?case by simp
     qed
   }
   then
   show ?thesis
     unfolding ordermap_def wfrec_on_def using Int_ac by simp
 qed
 
 end
diff --git a/thys/Transitive_Models/Renaming.thy b/thys/Transitive_Models/Renaming.thy
--- a/thys/Transitive_Models/Renaming.thy
+++ b/thys/Transitive_Models/Renaming.thy
@@ -1,572 +1,572 @@
 section\<open>Renaming of variables in internalized formulas\<close>
 
 theory Renaming
   imports
+    "ZF-Constructible.Formula"
     ZF_Miscellanea
-    "ZF-Constructible.Formula"
 begin
 
 subsection\<open>Renaming of free variables\<close>
 
 definition
   union_fun :: "[i,i,i,i] \<Rightarrow> i" where
   "union_fun(f,g,m,p) \<equiv> \<lambda>j \<in> m \<union> p  . if j\<in>m then f`j else g`j"
 
 lemma union_fun_type:
   assumes "f \<in> m \<rightarrow> n"
     "g \<in> p \<rightarrow> q"
   shows "union_fun(f,g,m,p) \<in> m \<union> p \<rightarrow> n \<union> q"
 proof -
   let ?h="union_fun(f,g,m,p)"
   have
     D: "?h`x \<in> n \<union> q" if "x \<in> m \<union> p" for x
   proof (cases "x \<in> m")
     case True
     then have
       "x \<in> m \<union> p" by simp
     with \<open>x\<in>m\<close>
     have "?h`x = f`x"
       unfolding union_fun_def  beta by simp
     with \<open>f \<in> m \<rightarrow> n\<close> \<open>x\<in>m\<close>
     have "?h`x \<in> n" by simp
     then show ?thesis ..
   next
     case False
     with \<open>x \<in> m \<union> p\<close>
     have "x \<in> p"
       by auto
     with \<open>x\<notin>m\<close>
     have "?h`x = g`x"
       unfolding union_fun_def using beta by simp
     with \<open>g \<in> p \<rightarrow> q\<close> \<open>x\<in>p\<close>
     have "?h`x \<in> q" by simp
     then show ?thesis ..
   qed
   have A:"function(?h)" unfolding union_fun_def using function_lam by simp
   have " x\<in> (m \<union> p) \<times> (n \<union> q)" if "x\<in> ?h" for x
     using that lamE[of x "m \<union> p" _ "x \<in> (m \<union> p) \<times> (n \<union> q)"] D unfolding union_fun_def
     by auto
   then have B:"?h \<subseteq> (m \<union> p) \<times> (n \<union> q)" ..
   have "m \<union> p \<subseteq> domain(?h)"
     unfolding union_fun_def using domain_lam by simp
   with A B
   show ?thesis using  Pi_iff [THEN iffD2] by simp
 qed
 
 lemma union_fun_action :
   assumes
     "env \<in> list(M)"
     "env' \<in> list(M)"
     "length(env) = m \<union> p"
     "\<forall> i . i \<in> m \<longrightarrow>  nth(f`i,env') = nth(i,env)"
     "\<forall> j . j \<in> p \<longrightarrow> nth(g`j,env') = nth(j,env)"
   shows "\<forall> i . i \<in> m \<union> p \<longrightarrow>
           nth(i,env) = nth(union_fun(f,g,m,p)`i,env')"
 proof -
   let ?h = "union_fun(f,g,m,p)"
   have "nth(x, env) = nth(?h`x,env')" if "x \<in> m \<union> p" for x
     using that
   proof (cases "x\<in>m")
     case True
     with \<open>x\<in>m\<close>
     have "?h`x = f`x"
       unfolding union_fun_def  beta by simp
     with assms \<open>x\<in>m\<close>
     have "nth(x,env) = nth(?h`x,env')" by simp
     then show ?thesis .
   next
     case False
     with \<open>x \<in> m \<union> p\<close>
     have
       "x \<in> p" "x\<notin>m"  by auto
     then
     have "?h`x = g`x"
       unfolding union_fun_def beta by simp
     with assms \<open>x\<in>p\<close>
     have "nth(x,env) = nth(?h`x,env')" by simp
     then show ?thesis .
   qed
   then show ?thesis by simp
 qed
 
 
 lemma id_fn_type :
   assumes "n \<in> nat"
   shows "id(n) \<in> n \<rightarrow> n"
   unfolding id_def using \<open>n\<in>nat\<close> by simp
 
 lemma id_fn_action:
   assumes "n \<in> nat" "env\<in>list(M)"
   shows "\<And> j . j < n \<Longrightarrow> nth(j,env) = nth(id(n)`j,env)"
 proof -
   show "nth(j,env) = nth(id(n)`j,env)" if "j < n" for j using that \<open>n\<in>nat\<close> ltD by simp
 qed
 
 
 definition
   rsum :: "[i,i,i,i,i] \<Rightarrow> i" where
   "rsum(f,g,m,n,p) \<equiv> \<lambda>j \<in> m+\<^sub>\<omega>p  . if j<m then f`j else (g`(j#-m))+\<^sub>\<omega>n"
 
 lemma sum_inl:
   assumes "m \<in> nat" "n\<in>nat"
     "f \<in> m\<rightarrow>n" "x \<in> m"
   shows "rsum(f,g,m,n,p)`x = f`x"
 proof -
   from \<open>m\<in>nat\<close>
   have "m\<le>m+\<^sub>\<omega>p"
     using add_le_self[of m] by simp
   with assms
   have "x\<in>m+\<^sub>\<omega>p"
     using ltI[of x m] lt_trans2[of x m "m+\<^sub>\<omega>p"] ltD by simp
   from assms
   have "x<m"
     using ltI by simp
   with \<open>x\<in>m+\<^sub>\<omega>p\<close>
   show ?thesis unfolding rsum_def by simp
 qed
 
 lemma sum_inr:
   assumes "m \<in> nat" "n\<in>nat" "p\<in>nat"
     "g\<in>p\<rightarrow>q" "m \<le> x" "x < m+\<^sub>\<omega>p"
   shows "rsum(f,g,m,n,p)`x = g`(x#-m)+\<^sub>\<omega>n"
 proof -
   from assms
   have "x\<in>nat"
     using in_n_in_nat[of "m+\<^sub>\<omega>p"] ltD
     by simp
   with assms
   have "\<not> x<m"
     using not_lt_iff_le[THEN iffD2] by simp
   from assms
   have "x\<in>m+\<^sub>\<omega>p"
     using ltD by simp
   with \<open>\<not> x<m\<close>
   show ?thesis unfolding rsum_def by simp
 qed
 
 
 lemma sum_action :
   assumes "m \<in> nat" "n\<in>nat" "p\<in>nat" "q\<in>nat"
     "f \<in> m\<rightarrow>n" "g\<in>p\<rightarrow>q"
     "env \<in> list(M)"
     "env' \<in> list(M)"
     "env1 \<in> list(M)"
     "env2 \<in> list(M)"
     "length(env) = m"
     "length(env1) = p"
     "length(env') = n"
     "\<And> i . i < m \<Longrightarrow> nth(i,env) = nth(f`i,env')"
     "\<And> j. j < p \<Longrightarrow> nth(j,env1) = nth(g`j,env2)"
   shows "\<forall> i . i < m+\<^sub>\<omega>p \<longrightarrow>
           nth(i,env@env1) = nth(rsum(f,g,m,n,p)`i,env'@env2)"
 proof -
   let ?h = "rsum(f,g,m,n,p)"
   from \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> \<open>q\<in>nat\<close>
   have "m\<le>m+\<^sub>\<omega>p" "n\<le>n+\<^sub>\<omega>q" "q\<le>n+\<^sub>\<omega>q"
     using add_le_self[of m]  add_le_self2[of n q] by simp_all
   from \<open>p\<in>nat\<close>
   have "p = (m+\<^sub>\<omega>p)#-m" using diff_add_inverse2 by simp
   have "nth(x, env @ env1) = nth(?h`x,env'@env2)" if "x<m+\<^sub>\<omega>p" for x
   proof (cases "x<m")
     case True
     then
     have 2: "?h`x= f`x" "x\<in>m" "f`x \<in> n" "x\<in>nat"
       using assms sum_inl ltD apply_type[of f m _ x] in_n_in_nat by simp_all
     with \<open>x<m\<close> assms
     have "f`x < n" "f`x<length(env')"  "f`x\<in>nat"
       using ltI in_n_in_nat by simp_all
     with 2 \<open>x<m\<close> assms
     have "nth(x,env@env1) = nth(x,env)"
       using nth_append[OF \<open>env\<in>list(M)\<close>] \<open>x\<in>nat\<close> by simp
     also
     have
       "... = nth(f`x,env')"
       using 2 \<open>x<m\<close> assms by simp
     also
     have "... = nth(f`x,env'@env2)"
       using nth_append[OF \<open>env'\<in>list(M)\<close>] \<open>f`x<length(env')\<close> \<open>f`x \<in>nat\<close> by simp
     also
     have "... = nth(?h`x,env'@env2)"
       using 2 by simp
     finally
     have "nth(x, env @ env1) = nth(?h`x,env'@env2)" .
     then show ?thesis .
   next
     case False
     have "x\<in>nat"
       using that in_n_in_nat[of "m+\<^sub>\<omega>p" x] ltD \<open>p\<in>nat\<close> \<open>m\<in>nat\<close> by simp
     with \<open>length(env) = m\<close>
     have "m\<le>x" "length(env) \<le> x"
       using not_lt_iff_le \<open>m\<in>nat\<close> \<open>\<not>x<m\<close> by simp_all
     with \<open>\<not>x<m\<close> \<open>length(env) = m\<close>
     have 2 : "?h`x= g`(x#-m)+\<^sub>\<omega>n"  "\<not> x <length(env)"
       unfolding rsum_def
       using  sum_inr that beta ltD by simp_all
     from assms \<open>x\<in>nat\<close> \<open>p=m+\<^sub>\<omega>p#-m\<close>
     have "x#-m < p"
       using diff_mono[OF _ _ _ \<open>x<m+\<^sub>\<omega>p\<close> \<open>m\<le>x\<close>] by simp
     then have "x#-m\<in>p" using ltD by simp
     with \<open>g\<in>p\<rightarrow>q\<close>
     have "g`(x#-m) \<in> q"  by simp
     with \<open>q\<in>nat\<close> \<open>length(env') = n\<close>
     have "g`(x#-m) < q" "g`(x#-m)\<in>nat" using ltI in_n_in_nat by simp_all
     with \<open>q\<in>nat\<close> \<open>n\<in>nat\<close>
     have "(g`(x#-m))+\<^sub>\<omega>n <n+\<^sub>\<omega>q" "n \<le> g`(x#-m)+\<^sub>\<omega>n" "\<not> g`(x#-m)+\<^sub>\<omega>n < length(env')"
       using add_lt_mono1[of "g`(x#-m)" _ n,OF _ \<open>q\<in>nat\<close>]
         add_le_self2[of n] \<open>length(env') = n\<close>
       by simp_all
     from assms \<open>\<not> x < length(env)\<close> \<open>length(env) = m\<close>
     have "nth(x,env @ env1) = nth(x#-m,env1)"
       using nth_append[OF \<open>env\<in>list(M)\<close> \<open>x\<in>nat\<close>] by simp
     also
     have "... = nth(g`(x#-m),env2)"
       using assms \<open>x#-m < p\<close> by simp
     also
     have "... = nth((g`(x#-m)+\<^sub>\<omega>n)#-length(env'),env2)"
       using  \<open>length(env') = n\<close>
         diff_add_inverse2 \<open>g`(x#-m)\<in>nat\<close>
       by simp
     also
     have "... = nth((g`(x#-m)+\<^sub>\<omega>n),env'@env2)"
       using  nth_append[OF \<open>env'\<in>list(M)\<close>] \<open>n\<in>nat\<close> \<open>\<not> g`(x#-m)+\<^sub>\<omega>n < length(env')\<close>
       by simp
     also
     have "... = nth(?h`x,env'@env2)"
       using 2 by simp
     finally
     have "nth(x, env @ env1) = nth(?h`x,env'@env2)" .
     then show ?thesis .
   qed
   then show ?thesis by simp
 qed
 
 lemma sum_type  :
   assumes "m \<in> nat" "n\<in>nat" "p\<in>nat" "q\<in>nat"
     "f \<in> m\<rightarrow>n" "g\<in>p\<rightarrow>q"
   shows "rsum(f,g,m,n,p) \<in> (m+\<^sub>\<omega>p) \<rightarrow> (n+\<^sub>\<omega>q)"
 proof -
   let ?h = "rsum(f,g,m,n,p)"
   from \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> \<open>q\<in>nat\<close>
   have "m\<le>m+\<^sub>\<omega>p" "n\<le>n+\<^sub>\<omega>q" "q\<le>n+\<^sub>\<omega>q"
     using add_le_self[of m]  add_le_self2[of n q] by simp_all
   from \<open>p\<in>nat\<close>
   have "p = (m+\<^sub>\<omega>p)#-m" using diff_add_inverse2 by simp
   {fix x
     assume 1: "x\<in>m+\<^sub>\<omega>p" "x<m"
     with 1 have "?h`x= f`x" "x\<in>m"
       using assms sum_inl ltD by simp_all
     with \<open>f\<in>m\<rightarrow>n\<close>
     have "?h`x \<in> n" by simp
     with \<open>n\<in>nat\<close> have "?h`x < n" using ltI by simp
     with \<open>n\<le>n+\<^sub>\<omega>q\<close>
     have "?h`x < n+\<^sub>\<omega>q" using lt_trans2 by simp
     then
     have "?h`x \<in> n+\<^sub>\<omega>q"  using ltD by simp
   }
   then have 1:"?h`x \<in> n+\<^sub>\<omega>q" if "x\<in>m+\<^sub>\<omega>p" "x<m" for x using that .
   {fix x
     assume 1: "x\<in>m+\<^sub>\<omega>p" "m\<le>x"
     then have "x<m+\<^sub>\<omega>p" "x\<in>nat" using ltI in_n_in_nat[of "m+\<^sub>\<omega>p"] ltD by simp_all
     with 1
     have 2 : "?h`x= g`(x#-m)+\<^sub>\<omega>n"
       using assms sum_inr ltD by simp_all
     from assms \<open>x\<in>nat\<close> \<open>p=m+\<^sub>\<omega>p#-m\<close>
     have "x#-m < p" using diff_mono[OF _ _ _ \<open>x<m+\<^sub>\<omega>p\<close> \<open>m\<le>x\<close>] by simp
     then have "x#-m\<in>p" using ltD by simp
     with \<open>g\<in>p\<rightarrow>q\<close>
     have "g`(x#-m) \<in> q"  by simp
     with \<open>q\<in>nat\<close> have "g`(x#-m) < q" using ltI by simp
     with \<open>q\<in>nat\<close>
     have "(g`(x#-m))+\<^sub>\<omega>n <n+\<^sub>\<omega>q" using add_lt_mono1[of "g`(x#-m)" _ n,OF _ \<open>q\<in>nat\<close>] by simp
     with 2
     have "?h`x \<in> n+\<^sub>\<omega>q"  using ltD by simp
   }
   then have 2:"?h`x \<in> n+\<^sub>\<omega>q" if "x\<in>m+\<^sub>\<omega>p" "m\<le>x" for x using that .
   have
     D: "?h`x \<in> n+\<^sub>\<omega>q" if "x\<in>m+\<^sub>\<omega>p" for x
     using that
   proof (cases "x<m")
     case True
     then show ?thesis using 1 that by simp
   next
     case False
     with \<open>m\<in>nat\<close> have "m\<le>x" using not_lt_iff_le that in_n_in_nat[of "m+\<^sub>\<omega>p"] by simp
     then show ?thesis using 2 that by simp
   qed
   have A:"function(?h)" unfolding rsum_def using function_lam by simp
   have " x\<in> (m +\<^sub>\<omega> p) \<times> (n +\<^sub>\<omega> q)" if "x\<in> ?h" for x
     using that lamE[of x "m+\<^sub>\<omega>p" _ "x \<in> (m +\<^sub>\<omega> p) \<times> (n +\<^sub>\<omega> q)"] D unfolding rsum_def
     by auto
   then have B:"?h \<subseteq> (m +\<^sub>\<omega> p) \<times> (n +\<^sub>\<omega> q)" ..
   have "m +\<^sub>\<omega> p \<subseteq> domain(?h)"
     unfolding rsum_def using domain_lam by simp
   with A B
   show ?thesis using  Pi_iff [THEN iffD2] by simp
 qed
 
 lemma sum_type_id :
   assumes
     "f \<in> length(env)\<rightarrow>length(env')"
     "env \<in> list(M)"
     "env' \<in> list(M)"
     "env1 \<in> list(M)"
   shows
     "rsum(f,id(length(env1)),length(env),length(env'),length(env1)) \<in>
         (length(env)+\<^sub>\<omega>length(env1)) \<rightarrow> (length(env')+\<^sub>\<omega>length(env1))"
   using assms length_type id_fn_type sum_type
   by simp
 
 lemma sum_type_id_aux2 :
   assumes
     "f \<in> m\<rightarrow>n"
     "m \<in> nat" "n \<in> nat"
     "env1 \<in> list(M)"
   shows
     "rsum(f,id(length(env1)),m,n,length(env1)) \<in>
         (m+\<^sub>\<omega>length(env1)) \<rightarrow> (n+\<^sub>\<omega>length(env1))"
   using assms id_fn_type sum_type
   by auto
 
 lemma sum_action_id :
   assumes
     "env \<in> list(M)"
     "env' \<in> list(M)"
     "f \<in> length(env)\<rightarrow>length(env')"
     "env1 \<in> list(M)"
     "\<And> i . i < length(env) \<Longrightarrow> nth(i,env) = nth(f`i,env')"
   shows "\<And> i . i < length(env)+\<^sub>\<omega>length(env1) \<Longrightarrow>
           nth(i,env@env1) = nth(rsum(f,id(length(env1)),length(env),length(env'),length(env1))`i,env'@env1)"
 proof -
   from assms
   have "length(env)\<in>nat" (is "?m \<in> _") by simp
   from assms have "length(env')\<in>nat" (is "?n \<in> _") by simp
   from assms have "length(env1)\<in>nat" (is "?p \<in> _") by simp
   note lenv = id_fn_action[OF \<open>?p\<in>nat\<close> \<open>env1\<in>list(M)\<close>]
   note lenv_ty = id_fn_type[OF \<open>?p\<in>nat\<close>]
   {
     fix i
     assume "i < length(env)+\<^sub>\<omega>length(env1)"
     have "nth(i,env@env1) = nth(rsum(f,id(length(env1)),?m,?n,?p)`i,env'@env1)"
       using sum_action[OF \<open>?m\<in>nat\<close> \<open>?n\<in>nat\<close> \<open>?p\<in>nat\<close> \<open>?p\<in>nat\<close> \<open>f\<in>?m\<rightarrow>?n\<close>
           lenv_ty \<open>env\<in>list(M)\<close> \<open>env'\<in>list(M)\<close>
           \<open>env1\<in>list(M)\<close> \<open>env1\<in>list(M)\<close> _
           _ _  assms(5) lenv
           ] \<open>i<?m+\<^sub>\<omega>length(env1)\<close> by simp
   }
   then show "\<And> i . i < ?m+\<^sub>\<omega>length(env1) \<Longrightarrow>
           nth(i,env@env1) = nth(rsum(f,id(?p),?m,?n,?p)`i,env'@env1)" by simp
 qed
 
 lemma sum_action_id_aux :
   assumes
     "f \<in> m\<rightarrow>n"
     "env \<in> list(M)"
     "env' \<in> list(M)"
     "env1 \<in> list(M)"
     "length(env) = m"
     "length(env') = n"
     "length(env1) = p"
     "\<And> i . i < m \<Longrightarrow> nth(i,env) = nth(f`i,env')"
   shows "\<And> i . i < m+\<^sub>\<omega>length(env1) \<Longrightarrow>
           nth(i,env@env1) = nth(rsum(f,id(length(env1)),m,n,length(env1))`i,env'@env1)"
   using assms length_type id_fn_type sum_action_id
   by auto
 
 
 definition
   sum_id :: "[i,i] \<Rightarrow> i" where
   "sum_id(m,f) \<equiv> rsum(\<lambda>x\<in>1.x,f,1,1,m)"
 
 lemma sum_id0 : "m\<in>nat\<Longrightarrow>sum_id(m,f)`0 = 0"
   by(unfold sum_id_def,subst sum_inl,auto)
 
 lemma sum_idS : "p\<in>nat \<Longrightarrow> q\<in>nat \<Longrightarrow> f\<in>p\<rightarrow>q \<Longrightarrow> x \<in> p \<Longrightarrow> sum_id(p,f)`(succ(x)) = succ(f`x)"
   by(subgoal_tac "x\<in>nat",unfold sum_id_def,subst sum_inr,
       simp_all add:ltI,simp_all add: app_nm in_n_in_nat)
 
 lemma sum_id_tc_aux :
   "p \<in> nat \<Longrightarrow>  q \<in> nat \<Longrightarrow> f \<in> p \<rightarrow> q \<Longrightarrow> sum_id(p,f) \<in> 1+\<^sub>\<omega>p \<rightarrow> 1+\<^sub>\<omega>q"
   by (unfold sum_id_def,rule sum_type,simp_all)
 
 lemma sum_id_tc :
   "n \<in> nat \<Longrightarrow> m \<in> nat \<Longrightarrow> f \<in> n \<rightarrow> m \<Longrightarrow> sum_id(n,f) \<in> succ(n) \<rightarrow> succ(m)"
   by(rule ssubst[of  "succ(n) \<rightarrow> succ(m)" "1+\<^sub>\<omega>n \<rightarrow> 1+\<^sub>\<omega>m"],
       simp,rule sum_id_tc_aux,simp_all)
 
 subsection\<open>Renaming of formulas\<close>
 
 consts   ren :: "i\<Rightarrow>i"
 primrec
   "ren(Member(x,y)) =
       (\<lambda> n \<in> nat . \<lambda> m \<in> nat. \<lambda>f \<in> n \<rightarrow> m. Member (f`x, f`y))"
 
 "ren(Equal(x,y)) =
       (\<lambda> n \<in> nat . \<lambda> m \<in> nat. \<lambda>f \<in> n \<rightarrow> m. Equal (f`x, f`y))"
 
 "ren(Nand(p,q)) =
       (\<lambda> n \<in> nat . \<lambda> m \<in> nat. \<lambda>f \<in> n \<rightarrow> m. Nand (ren(p)`n`m`f, ren(q)`n`m`f))"
 
 "ren(Forall(p)) =
       (\<lambda> n \<in> nat . \<lambda> m \<in> nat. \<lambda>f \<in> n \<rightarrow> m. Forall (ren(p)`succ(n)`succ(m)`sum_id(n,f)))"
 
 lemma arity_meml : "l \<in> nat \<Longrightarrow> Member(x,y) \<in> formula \<Longrightarrow> arity(Member(x,y)) \<le> l \<Longrightarrow> x \<in> l"
   by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
 lemma arity_memr : "l \<in> nat \<Longrightarrow> Member(x,y) \<in> formula \<Longrightarrow> arity(Member(x,y)) \<le> l \<Longrightarrow> y \<in> l"
   by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
 lemma arity_eql : "l \<in> nat \<Longrightarrow> Equal(x,y) \<in> formula \<Longrightarrow> arity(Equal(x,y)) \<le> l \<Longrightarrow> x \<in> l"
   by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
 lemma arity_eqr : "l \<in> nat \<Longrightarrow> Equal(x,y) \<in> formula \<Longrightarrow> arity(Equal(x,y)) \<le> l \<Longrightarrow> y \<in> l"
   by(simp,rule subsetD,rule le_imp_subset,assumption,simp)
 lemma  nand_ar1 : "p \<in> formula \<Longrightarrow> q\<in>formula \<Longrightarrow>arity(p) \<le> arity(Nand(p,q))"
   by (simp,rule Un_upper1_le,simp+)
 lemma nand_ar2 : "p \<in> formula \<Longrightarrow> q\<in>formula \<Longrightarrow>arity(q) \<le> arity(Nand(p,q))"
   by (simp,rule Un_upper2_le,simp+)
 
 lemma nand_ar1D : "p \<in> formula \<Longrightarrow> q\<in>formula \<Longrightarrow> arity(Nand(p,q)) \<le> n \<Longrightarrow> arity(p) \<le> n"
   by(auto simp add:  le_trans[OF Un_upper1_le[of "arity(p)" "arity(q)"]])
 lemma nand_ar2D : "p \<in> formula \<Longrightarrow> q\<in>formula \<Longrightarrow> arity(Nand(p,q)) \<le> n \<Longrightarrow> arity(q) \<le> n"
   by(auto simp add:  le_trans[OF Un_upper2_le[of "arity(p)" "arity(q)"]])
 
 
 lemma ren_tc : "p \<in> formula \<Longrightarrow>
   (\<And> n m f . n \<in> nat \<Longrightarrow> m \<in> nat \<Longrightarrow> f \<in> n\<rightarrow>m \<Longrightarrow>  ren(p)`n`m`f \<in> formula)"
   by (induct set:formula,auto simp add: app_nm sum_id_tc)
 
 
 lemma arity_ren :
   fixes "p"
   assumes "p \<in> formula"
   shows "\<And> n m f . n \<in> nat \<Longrightarrow> m \<in> nat \<Longrightarrow> f \<in> n\<rightarrow>m \<Longrightarrow> arity(p) \<le> n \<Longrightarrow> arity(ren(p)`n`m`f)\<le>m"
   using assms
 proof (induct set:formula)
   case (Member x y)
   then have "f`x \<in> m" "f`y \<in> m"
     using Member assms by (simp add: arity_meml apply_funtype,simp add:arity_memr apply_funtype)
   then show ?case using Member by (simp add: Un_least_lt ltI)
 next
   case (Equal x y)
   then have "f`x \<in> m" "f`y \<in> m"
     using Equal assms by (simp add: arity_eql apply_funtype,simp add:arity_eqr apply_funtype)
   then show ?case using Equal by (simp add: Un_least_lt ltI)
 next
   case (Nand p q)
   then have "arity(p)\<le>arity(Nand(p,q))"
     "arity(q)\<le>arity(Nand(p,q))"
     by (subst  nand_ar1,simp,simp,simp,subst nand_ar2,simp+)
   then have "arity(p)\<le>n"
     and "arity(q)\<le>n" using Nand
     by (rule_tac j="arity(Nand(p,q))" in le_trans,simp,simp)+
   then have "arity(ren(p)`n`m`f) \<le> m" and  "arity(ren(q)`n`m`f) \<le> m"
     using Nand by auto
   then show ?case using Nand by (simp add:Un_least_lt)
 next
   case (Forall p)
   from Forall have "succ(n)\<in>nat"  "succ(m)\<in>nat" by auto
   from Forall have 2: "sum_id(n,f) \<in> succ(n)\<rightarrow>succ(m)" by (simp add:sum_id_tc)
   from Forall have 3:"arity(p) \<le> succ(n)" by (rule_tac n="arity(p)" in natE,simp+)
   then have "arity(ren(p)`succ(n)`succ(m)`sum_id(n,f))\<le>succ(m)" using
       Forall \<open>succ(n)\<in>nat\<close> \<open>succ(m)\<in>nat\<close> 2 by force
   then show ?case using Forall 2 3 ren_tc arity_type pred_le by auto
 qed
 
 lemma arity_forallE : "p \<in> formula \<Longrightarrow> m \<in> nat \<Longrightarrow> arity(Forall(p)) \<le> m \<Longrightarrow> arity(p) \<le> succ(m)"
   by(rule_tac n="arity(p)" in natE,erule arity_type,simp+)
 
 lemma env_coincidence_sum_id :
   assumes "m \<in> nat" "n \<in> nat"
     "\<rho> \<in> list(A)" "\<rho>' \<in> list(A)"
     "f \<in> n \<rightarrow> m"
     "\<And> i . i < n \<Longrightarrow> nth(i,\<rho>) = nth(f`i,\<rho>')"
     "a \<in> A" "j \<in> succ(n)"
   shows "nth(j,Cons(a,\<rho>)) = nth(sum_id(n,f)`j,Cons(a,\<rho>'))"
 proof -
   let ?g="sum_id(n,f)"
   have "succ(n) \<in> nat" using \<open>n\<in>nat\<close> by simp
   then have "j \<in> nat" using \<open>j\<in>succ(n)\<close> in_n_in_nat by blast
   then have "nth(j,Cons(a,\<rho>)) = nth(?g`j,Cons(a,\<rho>'))"
   proof (cases rule:natE[OF \<open>j\<in>nat\<close>])
     case 1
     then show ?thesis using assms sum_id0 by simp
   next
     case (2 i)
     with \<open>j\<in>succ(n)\<close> have "succ(i)\<in>succ(n)" by simp
     with \<open>n\<in>nat\<close> have "i \<in> n" using nat_succD assms by simp
     have "f`i\<in>m" using \<open>f\<in>n\<rightarrow>m\<close> apply_type \<open>i\<in>n\<close> by simp
     then have "f`i \<in> nat" using in_n_in_nat \<open>m\<in>nat\<close> by simp
     have "nth(succ(i),Cons(a,\<rho>)) = nth(i,\<rho>)" using \<open>i\<in>nat\<close> by simp
     also have "... = nth(f`i,\<rho>')" using assms \<open>i\<in>n\<close> ltI by simp
     also have "... = nth(succ(f`i),Cons(a,\<rho>'))" using \<open>f`i\<in>nat\<close> by simp
     also have "... = nth(?g`succ(i),Cons(a,\<rho>'))"
       using assms sum_idS[OF \<open>n\<in>nat\<close> \<open>m\<in>nat\<close>  \<open>f\<in>n\<rightarrow>m\<close> \<open>i \<in> n\<close>] cases by simp
     finally have "nth(succ(i),Cons(a,\<rho>)) = nth(?g`succ(i),Cons(a,\<rho>'))" .
     then show ?thesis using \<open>j=succ(i)\<close> by simp
   qed
   then show ?thesis .
 qed
 
 lemma sats_iff_sats_ren :
   assumes "\<phi> \<in> formula"
   shows  "\<lbrakk>  n \<in> nat ; m \<in> nat ; \<rho> \<in> list(M) ; \<rho>' \<in> list(M) ; f \<in> n \<rightarrow> m ;
             arity(\<phi>) \<le> n ;
             \<And> i . i < n \<Longrightarrow> nth(i,\<rho>) = nth(f`i,\<rho>') \<rbrakk> \<Longrightarrow>
          sats(M,\<phi>,\<rho>) \<longleftrightarrow> sats(M,ren(\<phi>)`n`m`f,\<rho>')"
   using \<open>\<phi> \<in> formula\<close>
 proof(induct \<phi> arbitrary:n m \<rho> \<rho>' f)
   case (Member x y)
   have "ren(Member(x,y))`n`m`f = Member(f`x,f`y)" using Member assms arity_type by force
   moreover
   have "x \<in> n" using Member arity_meml by simp
   moreover
   have "y \<in> n" using Member arity_memr by simp
   ultimately
   show ?case using Member ltI by simp
 next
   case (Equal x y)
   have "ren(Equal(x,y))`n`m`f = Equal(f`x,f`y)" using Equal assms arity_type by force
   moreover
   have "x \<in> n" using Equal arity_eql by simp
   moreover
   have "y \<in> n" using Equal arity_eqr by simp
   ultimately show ?case using Equal ltI by simp
 next
   case (Nand p q)
   have "ren(Nand(p,q))`n`m`f = Nand(ren(p)`n`m`f,ren(q)`n`m`f)" using Nand by simp
   moreover
   have "arity(p) \<le> n" using Nand nand_ar1D by simp
   moreover from this
   have "i \<in> arity(p) \<Longrightarrow> i \<in> n" for i using subsetD[OF le_imp_subset[OF \<open>arity(p) \<le> n\<close>]] by simp
   moreover from this
   have "i \<in> arity(p) \<Longrightarrow> nth(i,\<rho>) = nth(f`i,\<rho>')" for i using Nand ltI by simp
   moreover from this
   have "sats(M,p,\<rho>) \<longleftrightarrow> sats(M,ren(p)`n`m`f,\<rho>')" using \<open>arity(p)\<le>n\<close> Nand by simp
   have "arity(q) \<le> n" using Nand nand_ar2D by simp
   moreover from this
   have "i \<in> arity(q) \<Longrightarrow> i \<in> n" for i using subsetD[OF le_imp_subset[OF \<open>arity(q) \<le> n\<close>]] by simp
   moreover from this
   have "i \<in> arity(q) \<Longrightarrow> nth(i,\<rho>) = nth(f`i,\<rho>')" for i using Nand ltI by simp
   moreover from this
   have "sats(M,q,\<rho>) \<longleftrightarrow> sats(M,ren(q)`n`m`f,\<rho>')" using assms \<open>arity(q)\<le>n\<close> Nand by simp
   ultimately
   show ?case using Nand by simp
 next
   case (Forall p)
   have 0:"ren(Forall(p))`n`m`f = Forall(ren(p)`succ(n)`succ(m)`sum_id(n,f))"
     using Forall by simp
   have 1:"sum_id(n,f) \<in> succ(n) \<rightarrow> succ(m)" (is "?g \<in> _") using sum_id_tc Forall by simp
   then have 2: "arity(p) \<le> succ(n)"
     using Forall le_trans[of _ "succ(pred(arity(p)))"] succpred_leI by simp
   have "succ(n)\<in>nat" "succ(m)\<in>nat" using Forall by auto
   then have A:"\<And> j .j < succ(n) \<Longrightarrow> nth(j, Cons(a, \<rho>)) = nth(?g`j, Cons(a, \<rho>'))" if "a\<in>M" for a
     using that env_coincidence_sum_id Forall ltD by force
   have
     "sats(M,p,Cons(a,\<rho>)) \<longleftrightarrow> sats(M,ren(p)`succ(n)`succ(m)`?g,Cons(a,\<rho>'))" if "a\<in>M" for a
   proof -
     have C:"Cons(a,\<rho>) \<in> list(M)" "Cons(a,\<rho>')\<in>list(M)" using Forall that by auto
     have "sats(M,p,Cons(a,\<rho>)) \<longleftrightarrow> sats(M,ren(p)`succ(n)`succ(m)`?g,Cons(a,\<rho>'))"
       using Forall(2)[OF \<open>succ(n)\<in>nat\<close> \<open>succ(m)\<in>nat\<close> C(1) C(2) 1 2 A[OF \<open>a\<in>M\<close>]] by simp
     then show ?thesis .
   qed
   then show ?case using Forall 0 1 2 by simp
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Renaming_Auto.thy b/thys/Transitive_Models/Renaming_Auto.thy
--- a/thys/Transitive_Models/Renaming_Auto.thy
+++ b/thys/Transitive_Models/Renaming_Auto.thy
@@ -1,54 +1,56 @@
 theory Renaming_Auto
   imports
+    Utils
     Renaming
-    Utils
 keywords
   "rename" :: thy_decl % "ML"
 and
   "simple_rename" :: thy_decl % "ML"
 and
   "src"
 and
   "tgt"
 abbrevs
   "simple_rename" = ""
 
 begin
 
+hide_const (open) Order.pred
+
 lemmas nat_succI = nat_succ_iff[THEN iffD2]
 ML_file\<open>Renaming_ML.ml\<close>
 ML\<open>
   open Renaming_ML
 
   fun renaming_def mk_ren name from to ctxt =
     let val to = to |> Syntax.read_term ctxt
         val from = from |> Syntax.read_term ctxt
         val (tc_lemma,action_lemma,fvs,r) = mk_ren from to ctxt
         val (tc_lemma,action_lemma) = (fix_vars tc_lemma fvs ctxt , fix_vars action_lemma fvs ctxt)
         val ren_fun_name = Binding.name (name ^ "_fn")
         val ren_fun_def =  Binding.name (name ^ "_fn_def")
         val ren_thm = Binding.name (name ^ "_thm")
     in
       Local_Theory.note   ((ren_thm, []), [tc_lemma,action_lemma]) ctxt |> snd |>
       Local_Theory.define ((ren_fun_name, NoSyn), ((ren_fun_def, []), r)) |> snd
   end;
 \<close>
 
 ML\<open>
 local
 
   val ren_parser = Parse.position (Parse.string --
       (Parse.$$$ "src" |-- Parse.string --| Parse.$$$ "tgt" -- Parse.string));
 
   val _ =
    Outer_Syntax.local_theory \<^command_keyword>\<open>rename\<close> "ML setup for synthetic definitions"
      (ren_parser >> (fn ((name,(from,to)),_) => renaming_def sum_rename name from to ))
 
   val _ =
    Outer_Syntax.local_theory \<^command_keyword>\<open>simple_rename\<close> "ML setup for synthetic definitions"
      (ren_parser >> (fn ((name,(from,to)),_) => renaming_def ren_thm name from to ))
 
 in
 end
 \<close>
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Replacement_Lepoll.thy b/thys/Transitive_Models/Replacement_Lepoll.thy
--- a/thys/Transitive_Models/Replacement_Lepoll.thy
+++ b/thys/Transitive_Models/Replacement_Lepoll.thy
@@ -1,485 +1,491 @@
 section\<open>Lambda-replacements required for cardinal inequalities\<close>
 
 theory Replacement_Lepoll
   imports
     ZF_Library_Relative
 begin
 
 definition
   lepoll_assumptions1 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions1(M,A,F,S,fa,K,x,f,r) \<equiv> \<forall>x\<in>S. strong_replacement(M, \<lambda>y z. y \<in> F(A, x) \<and> z = {\<langle>x, y\<rangle>})"
 
 definition
   lepoll_assumptions2 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions2(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x z. z = Sigfun(x, F(A)))"
 
 definition
   lepoll_assumptions3 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions3(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = F(A, x))"
 
 definition
   lepoll_assumptions4 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions4(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = \<langle>x, minimum(r, F(A, x))\<rangle>)"
 
 definition
   lepoll_assumptions5 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions5(M,A,F,S,fa,K,x,f,r) \<equiv>
 strong_replacement(M, \<lambda>x y. y = \<langle>x, \<mu> i. x \<in> F(A, i), f ` (\<mu> i. x \<in> F(A, i)) ` x\<rangle>)"
 
 definition
   lepoll_assumptions6 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions6(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>y z. y \<in> inj\<^bsup>M\<^esup>(F(A, x),S) \<and> z = {\<langle>x, y\<rangle>})"
 
 definition
   lepoll_assumptions7 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions7(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = inj\<^bsup>M\<^esup>(F(A, x),S))"
 
 definition
   lepoll_assumptions8 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions8(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x z. z = Sigfun(x, \<lambda>i. inj\<^bsup>M\<^esup>(F(A, i),S)))"
 
 definition
   lepoll_assumptions9 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions9(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = \<langle>x, minimum(r, inj\<^bsup>M\<^esup>(F(A, x),S))\<rangle>)"
 
 definition
   lepoll_assumptions10 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions10(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
            (M, \<lambda>x z. z = Sigfun(x, \<lambda>k. if k \<in> range(f) then F(A, converse(f) ` k) else 0))"
 
 definition
   lepoll_assumptions11 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions11(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = (if x \<in> range(f) then F(A, converse(f) ` x) else 0))"
 
 definition
   lepoll_assumptions12 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions12(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>y z. y \<in> F(A, converse(f) ` x) \<and> z = {\<langle>x, y\<rangle>})"
 
 definition
   lepoll_assumptions13 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions13(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
          (M, \<lambda>x y. y = \<langle>x, minimum(r, if x \<in> range(f) then F(A,converse(f) ` x) else 0)\<rangle>)"
 
 definition
   lepoll_assumptions14 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions14(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
          (M, \<lambda>x y. y = \<langle>x, \<mu> i. x \<in> (if i \<in> range(f) then F(A, converse(f) ` i) else 0),
                         fa ` (\<mu> i. x \<in> (if i \<in> range(f) then F(A, converse(f) ` i) else 0)) ` x\<rangle>)"
 
 definition
   lepoll_assumptions15 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions15(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
          (M, \<lambda>y z. y \<in> inj\<^bsup>M\<^esup>(if x \<in> range(f) then F(A, converse(f) ` x) else 0,K) \<and> z = {\<langle>x, y\<rangle>})"
 
 definition
   lepoll_assumptions16 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions16(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement(M, \<lambda>x y. y = inj\<^bsup>M\<^esup>(if x \<in> range(f) then F(A, converse(f) ` x) else 0,K))"
 
 definition
   lepoll_assumptions17 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions17(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
              (M, \<lambda>x z. z = Sigfun(x, \<lambda>i. inj\<^bsup>M\<^esup>(if i \<in> range(f) then F(A, converse(f) ` i) else 0,K)))"
 
 definition
   lepoll_assumptions18 :: "[i\<Rightarrow>o,i,[i,i]\<Rightarrow>i,i,i,i,i,i,i] \<Rightarrow> o" where
   "lepoll_assumptions18(M,A,F,S,fa,K,x,f,r) \<equiv> strong_replacement
          (M, \<lambda>x y. y = \<langle>x, minimum(r, inj\<^bsup>M\<^esup>(if x \<in> range(f) then F(A, converse(f) ` x) else 0,K))\<rangle>)"
 
 lemmas lepoll_assumptions_defs[simp] = lepoll_assumptions1_def
   lepoll_assumptions2_def lepoll_assumptions3_def lepoll_assumptions4_def
   lepoll_assumptions5_def lepoll_assumptions6_def lepoll_assumptions7_def
   lepoll_assumptions8_def lepoll_assumptions9_def lepoll_assumptions10_def
   lepoll_assumptions11_def lepoll_assumptions12_def lepoll_assumptions13_def
   lepoll_assumptions14_def lepoll_assumptions15_def lepoll_assumptions16_def
   lepoll_assumptions17_def lepoll_assumptions18_def
 
 definition if_range_F where
   [simp]: "if_range_F(H,f,i) \<equiv> if i \<in> range(f) then H(converse(f) ` i) else 0"
 
 definition if_range_F_else_F where
   "if_range_F_else_F(H,b,f,i) \<equiv> if b=0 then if_range_F(H,f,i) else H(i)"
 
 lemma (in M_basic) lam_Least_assumption_general:
   assumes
     separations:
     "\<forall>A'[M]. separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)\<rangle>)"
     and
     mem_F_bound:"\<And>x c. x\<in>F(A,c) \<Longrightarrow> c \<in> range(f) \<union> U(A)"
     and
     types:"M(A)" "M(b)" "M(f)" "M(U(A))"
   shows "lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
 proof -
   have "\<forall>x\<in>X. (\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)) \<in>
     Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> U(A)))" if "M(X)" for X
   proof
     fix x
     assume "x\<in>X"
     moreover
     note \<open>M(X)\<close>
     moreover from calculation
     have "M(x)" by (auto dest:transM)
     moreover
     note assms
     ultimately
     show "(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)) \<in>
         Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> U(A)))"
     proof (rule_tac Least_in_Pow_rel_Union, cases "b=0", simp_all)
       case True
       fix c
       assume asm:"x \<in> if_range_F_else_F(F(A), 0, f, c)"
       with mem_F_bound
       show "c\<in>X \<or> c \<in> range(f) \<or> c \<in> U(A)"
         unfolding if_range_F_else_F_def if_range_F_def by (cases "c\<in>range(f)") auto
     next
       case False
       fix c
       assume "x \<in> if_range_F_else_F(F(A), b, f, c)"
       with False mem_F_bound[of x c]
       show "c\<in>X \<or> c \<in> range(f) \<or> c\<in>U(A)"
         unfolding if_range_F_else_F_def if_range_F_def by auto
     qed
   qed
   with assms
   show ?thesis
     using bounded_lam_replacement[of "\<lambda>x.(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
         "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> U(A)))"] by simp
 qed
 
 lemma (in M_basic) lam_Least_assumption_ifM_b0:
   fixes F
   defines "F \<equiv> \<lambda>_ x. if M(x) then x else 0"
   assumes
     separations:
     "\<forall>A'[M]. separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(F(A),0,f,i)\<rangle>)"
     and
     types:"M(A)" "M(f)"
   shows "lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),0,f,i))"
     (is "lam_replacement(M,\<lambda>x . Least(?P(x)))")
 proof -
   {
     fix x X
     assume "M(X)" "x\<in>X" "(\<mu> i. ?P(x,i)) \<noteq> 0"
     moreover from this
     obtain m where "Ord(m)" "?P(x,m)"
       using Least_0[of "?P(_)"] by auto
     moreover
     note assms
     moreover
     have "?P(x,i) \<longleftrightarrow> (M(converse(f) ` i) \<and> i \<in> range(f) \<and> x \<in> converse(f) ` i)"  for i
       unfolding F_def if_range_F_else_F_def if_range_F_def by auto
     ultimately
     have "(\<mu> i. ?P(x,i)) \<in> range (f)"
       unfolding F_def if_range_F_else_F_def if_range_F_def
       by (rule_tac LeastI2) auto
   }
   with assms
   show ?thesis
     by (rule_tac bounded_lam_replacement[of _ "\<lambda>X. range(f) \<union> {0}"]) auto
 qed
 
-lemma (in M_replacement_extra) lam_Least_assumption_ifM_bnot0:
+lemma (in M_replacement) lam_Least_assumption_ifM_bnot0:
   fixes F
   defines "F \<equiv> \<lambda>_ x. if M(x) then x else 0"
   assumes
+    lam_replacement_minimum:"lam_replacement(M, \<lambda>p. minimum(fst(p),snd(p)))"
+    and
     separations:
     "\<forall>A'[M]. separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)\<rangle>)"
     "separation(M,Ord)"
     and
     types:"M(A)" "M(f)"
     and
     "b\<noteq>0"
   shows "lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
     (is "lam_replacement(M,\<lambda>x . Least(?P(x)))")
 proof -
   have "M(x) \<Longrightarrow>(\<mu> i. (M(i) \<longrightarrow> x \<in> i) \<and> M(i)) = (if Ord(x) then succ(x) else 0)" for x
     using Ord_in_Ord
     apply (auto intro:Least_0, rule_tac Least_equality, simp_all)
     by (frule lt_Ord) (auto dest:le_imp_not_lt[of _ x] intro:ltI[of x])
   moreover
   have "lam_replacement(M, \<lambda>x. if Ord(x) then succ(x) else 0)"
     using lam_replacement_if[OF _ _ separations(2)] lam_replacement_identity
       lam_replacement_constant lam_replacement_hcomp lam_replacement_succ
     by simp
   moreover
   note types \<open>b\<noteq>0\<close>
   ultimately
   show ?thesis
     using lam_replacement_cong
     unfolding F_def if_range_F_else_F_def if_range_F_def
     by auto
 qed
 
-lemma (in M_replacement_extra) lam_Least_assumption_drSR_Y:
+lemma (in M_replacement) lam_Least_assumption_drSR_Y:
   fixes F r' D
   defines "F \<equiv> drSR_Y(r',D)"
   assumes "\<forall>A'[M]. separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)\<rangle>)"
     "M(A)" "M(b)" "M(f)" "M(r')"
+    and
+    lam_replacement_minimum:"lam_replacement(M, \<lambda>p. minimum(fst(p),snd(p)))"
   shows "lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
 proof -
   from assms(2-)
   have [simp]: "M(X) \<Longrightarrow> M(X \<union> range(f) \<union> {domain(x) . x \<in> A})"
     "M(r') \<Longrightarrow> M(X) \<Longrightarrow> M({restrict(x,r') . x \<in> A})"
     for X r'
     using lam_replacement_domain[THEN lam_replacement_imp_strong_replacement,
         THEN RepFun_closed, of A]
       lam_replacement_restrict'[THEN lam_replacement_imp_strong_replacement,
         THEN RepFun_closed, of r' A] by (auto dest:transM)
   have "\<forall>x\<in>X. (\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)) \<in>
     Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> {domain(x). x\<in>A} \<union> {restrict(x,r'). x\<in>A} \<union> domain(A) \<union> range(A) \<union> \<Union>A))" if "M(X)" for X
   proof
     fix x
     assume "x\<in>X"
     moreover
     note \<open>M(X)\<close>
     moreover from calculation
     have "M(x)" by (auto dest:transM)
     moreover
     note assms(2-)
     ultimately
     show "(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i)) \<in>
         Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> {domain(x). x\<in>A} \<union> {restrict(x,r'). x\<in>A} \<union> domain(A) \<union> range(A) \<union> \<Union>A))"
       unfolding if_range_F_else_F_def if_range_F_def
     proof (rule_tac Least_in_Pow_rel_Union, simp_all,cases "b=0", simp_all)
       case True
       fix c
       assume asm:"x \<in> (if c \<in> range(f) then F(A, converse(f) ` c) else 0)"
       then
       show "c\<in>X \<or> c\<in>range(f) \<or> (\<exists>x\<in>A. c = domain(x)) \<or> (\<exists>x\<in>A. c = restrict(x,r')) \<or> c \<in> domain(A) \<or> c \<in> range(A) \<or> (\<exists>x\<in>A. c\<in>x)" by auto
     next
       case False
       fix c
       assume "x \<in> F(A, c)"
       then
       show "c\<in>X \<or> c\<in>range(f) \<or> (\<exists>x\<in>A. c = domain(x)) \<or> (\<exists>x\<in>A. c = restrict(x,r')) \<or> c \<in> domain(A) \<or> c \<in> range(A) \<or> (\<exists>x\<in>A. c\<in>x)"
         using apply_0
         by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
     qed
   qed
   with assms(2-)
   show ?thesis
     using bounded_lam_replacement[of "\<lambda>x.(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
         "\<lambda>X. Pow\<^bsup>M\<^esup>(\<Union>(X \<union> range(f) \<union> {domain(x). x\<in>A} \<union> {restrict(x,r'). x\<in>A} \<union> domain(A) \<union> range(A) \<union> \<Union>A))"] by simp
 qed
 
-locale M_replacement_lepoll = M_replacement_extra + M_inj +
+locale M_replacement_lepoll = M_replacement + M_inj +
   fixes F
   assumes
     F_type[simp]: "M(A) \<Longrightarrow> \<forall>x[M]. M(F(A,x))"
     and
     lam_lepoll_assumption_F:"M(A) \<Longrightarrow> lam_replacement(M,F(A))"
     and
     \<comment> \<open>Here b is a Boolean.\<close>
     lam_Least_assumption:"M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow>
         lam_replacement(M,\<lambda>x . \<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
     and
     F_args_closed: "M(A) \<Longrightarrow> M(x) \<Longrightarrow> x \<in> F(A,i) \<Longrightarrow> M(i)"
     and
     lam_replacement_inj_rel:"lam_replacement(M, \<lambda>p. inj\<^bsup>M\<^esup>(fst(p),snd(p)))"
+    and
+    lam_replacement_minimum:"lam_replacement(M, \<lambda>p. minimum(fst(p),snd(p)))"
 begin
 
 declare if_range_F_else_F_def[simp]
 
 lemma lepoll_assumptions1:
   assumes types[simp]:"M(A)" "M(S)"
   shows "lepoll_assumptions1(M,A,F,S,fa,K,x,f,r)"
   using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
     transM[of _ S]
   by simp
 
 lemma lepoll_assumptions2:
   assumes types[simp]:"M(A)" "M(S)"
   shows "lepoll_assumptions2(M,A,F,S,fa,K,x,f,r)"
   using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
     assms lam_lepoll_assumption_F
   by simp
 
 lemma lepoll_assumptions3:
   assumes types[simp]:"M(A)"
   shows "lepoll_assumptions3(M,A,F,S,fa,K,x,f,r)"
   using lam_lepoll_assumption_F[THEN lam_replacement_imp_strong_replacement]
   by simp
 
 lemma lepoll_assumptions4:
   assumes types[simp]:"M(A)" "M(r)"
   shows "lepoll_assumptions4(M,A,F,S,fa,K,x,f,r)"
   using lam_replacement_minimum lam_replacement_constant lam_lepoll_assumption_F
   unfolding lepoll_assumptions_defs
     lam_replacement_def[symmetric]
   by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
     (force intro: lam_replacement_identity)+
 
 lemma lam_Least_closed :
   assumes "M(A)" "M(b)" "M(f)"
   shows "\<forall>x[M]. M(\<mu> i. x \<in> if_range_F_else_F(F(A),b,f,i))"
 proof -
   have "x \<in> (if i \<in> range(f) then F(A, converse(f) ` i) else 0) \<Longrightarrow> M(i)" for x i
   proof (cases "i\<in>range(f)")
     case True
     with \<open>M(f)\<close>
     show ?thesis by (auto dest:transM)
   next
     case False
     moreover
     assume "x \<in> (if i \<in> range(f) then F(A, converse(f) ` i) else 0)"
     ultimately
     show ?thesis
       by auto
   qed
   with assms
   show ?thesis
     using F_args_closed[of A] unfolding if_range_F_else_F_def if_range_F_def
     by (clarify, rule_tac Least_closed', cases "b=0") simp_all
 qed
 
 lemma lepoll_assumptions5:
   assumes
     types[simp]:"M(A)" "M(f)"
   shows "lepoll_assumptions5(M,A,F,S,fa,K,x,f,r)"
   using
     lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
     lam_replacement_hcomp[OF _ lam_replacement_apply[of f]]
     lam_replacement_identity
     lam_replacement_product lam_Least_closed[where b=1]
     assms lam_Least_assumption[where b=1,OF \<open>M(A)\<close> _ \<open>M(f)\<close>]
   unfolding lepoll_assumptions_defs
     lam_replacement_def[symmetric]
   by simp
 
 lemma lepoll_assumptions6:
   assumes types[simp]:"M(A)" "M(S)" "M(x)"
   shows "lepoll_assumptions6(M,A,F,S,fa,K,x,f,r)"
   using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
     lam_replacement_inj_rel
   by simp
 
 lemma lepoll_assumptions7:
   assumes types[simp]:"M(A)" "M(S)" "M(x)"
   shows "lepoll_assumptions7(M,A,F,S,fa,K,x,f,r)"
   using lam_replacement_constant lam_lepoll_assumption_F lam_replacement_inj_rel
   unfolding lepoll_assumptions_defs
   by (rule_tac lam_replacement_imp_strong_replacement)
     (rule_tac lam_replacement_hcomp2[of _ _ "inj_rel(M)"], simp_all)
 
 lemma lepoll_assumptions8:
   assumes types[simp]:"M(A)" "M(S)"
   shows "lepoll_assumptions8(M,A,F,S,fa,K,x,f,r)"
   using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
     lam_replacement_inj_rel lam_replacement_constant
     lam_replacement_hcomp2[of _ _ "inj_rel(M)",OF lam_lepoll_assumption_F[of A]]
   by simp
 
 lemma lepoll_assumptions9:
   assumes types[simp]:"M(A)" "M(S)" "M(r)"
   shows "lepoll_assumptions9(M,A,F,S,fa,K,x,f,r)"
   using lam_replacement_minimum lam_replacement_constant lam_lepoll_assumption_F
     lam_replacement_hcomp2[of _ _ "inj_rel(M)"] lam_replacement_inj_rel lepoll_assumptions4
   unfolding lepoll_assumptions_defs lam_replacement_def[symmetric]
   by (rule_tac lam_replacement_hcomp2[of _ _ minimum])
     (force intro: lam_replacement_identity)+
 
 lemma lepoll_assumptions10:
   assumes types[simp]:"M(A)" "M(f)"
   shows "lepoll_assumptions10(M,A,F,S,fa,K,x,f,r)"
   using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
     lam_replacement_constant[OF nonempty]
     lam_replacement_if[OF _ _ separation_in_constant]
     lam_replacement_hcomp
     lam_replacement_apply[OF converse_closed[OF \<open>M(f)\<close>]]
     lam_lepoll_assumption_F[of A]
   by simp
 
 lemma lepoll_assumptions11:
   assumes types[simp]:"M(A)" "M(f)"
   shows "lepoll_assumptions11(M, A, F, S, fa, K, x, f, r)"
   using lam_replacement_imp_strong_replacement
     lam_replacement_if[OF _ _ separation_in_constant[of "range(f)"]]
     lam_replacement_constant
     lam_replacement_hcomp lam_replacement_apply
     lam_lepoll_assumption_F
   by simp
 
 lemma lepoll_assumptions12:
   assumes types[simp]:"M(A)" "M(x)" "M(f)"
   shows "lepoll_assumptions12(M,A,F,S,fa,K,x,f,r)"
   using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
   by simp
 
 lemma lepoll_assumptions13:
   assumes types[simp]:"M(A)" "M(r)" "M(f)"
   shows "lepoll_assumptions13(M,A,F,S,fa,K,x,f,r)"
   using  lam_replacement_constant[OF nonempty] lam_lepoll_assumption_F
     lam_replacement_hcomp lam_replacement_apply
     lam_replacement_hcomp2[OF lam_replacement_constant[OF \<open>M(r)\<close>]
       lam_replacement_if[OF _ _ separation_in_constant[of "range(f)"]] _ _
       lam_replacement_minimum] assms
   unfolding lepoll_assumptions_defs
     lam_replacement_def[symmetric]
   by simp
 
 lemma lepoll_assumptions14:
   assumes types[simp]:"M(A)" "M(f)" "M(fa)"
   shows "lepoll_assumptions14(M,A,F,S,fa,K,x,f,r)"
   using
     lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
     lam_replacement_hcomp[OF _ lam_replacement_apply[of fa]]
     lam_replacement_identity
     lam_replacement_product  lam_Least_closed[where b=0]
     assms lam_Least_assumption[where b=0,OF \<open>M(A)\<close> _ \<open>M(f)\<close>]
   unfolding lepoll_assumptions_defs
     lam_replacement_def[symmetric]
   by simp
 
 lemma lepoll_assumptions15:
   assumes types[simp]:"M(A)" "M(x)" "M(f)" "M(K)"
   shows "lepoll_assumptions15(M,A,F,S,fa,K,x,f,r)"
   using strong_replacement_separation[OF lam_replacement_sing_const_id separation_in_constant]
   by simp
 
 lemma lepoll_assumptions16:
   assumes types[simp]:"M(A)" "M(f)" "M(K)"
   shows "lepoll_assumptions16(M,A,F,S,fa,K,x,f,r)"
   using lam_replacement_imp_strong_replacement
     lam_replacement_inj_rel lam_replacement_constant
     lam_replacement_hcomp2[of _ _ "inj_rel(M)"]
     lam_replacement_constant[OF nonempty]
     lam_replacement_if[OF _ _ separation_in_constant]
     lam_replacement_hcomp
     lam_replacement_apply[OF converse_closed[OF \<open>M(f)\<close>]]
     lam_lepoll_assumption_F[of A]
   by simp
 
 lemma lepoll_assumptions17:
   assumes types[simp]:"M(A)" "M(f)" "M(K)"
   shows "lepoll_assumptions17(M,A,F,S,fa,K,x,f,r)"
   using lam_replacement_Sigfun lam_replacement_imp_strong_replacement
     lam_replacement_inj_rel lam_replacement_constant
     lam_replacement_hcomp2[of _ _ "inj_rel(M)"]
     lam_replacement_constant[OF nonempty]
     lam_replacement_if[OF _ _ separation_in_constant]
     lam_replacement_hcomp
     lam_replacement_apply[OF converse_closed[OF \<open>M(f)\<close>]]
     lam_lepoll_assumption_F[of A]
   by simp
 
 lemma lepoll_assumptions18:
   assumes types[simp]:"M(A)" "M(K)" "M(f)" "M(r)"
   shows "lepoll_assumptions18(M,A,F,S,fa,K,x,f,r)"
   using lam_replacement_constant lam_replacement_inj_rel lam_lepoll_assumption_F
     lam_replacement_minimum lam_replacement_identity lam_replacement_apply2 separation_in_constant
   unfolding lepoll_assumptions18_def lam_replacement_def[symmetric]
   by (rule_tac lam_replacement_hcomp2[of _ _ minimum], simp_all,
       rule_tac lam_replacement_hcomp2[of _ _ "inj_rel(M)"], simp_all)
     (rule_tac lam_replacement_if, rule_tac lam_replacement_hcomp[of _ "F(A)"],
       rule_tac lam_replacement_hcomp2[of _ _ "(`)"], simp_all)
 
 lemmas lepoll_assumptions = lepoll_assumptions1 lepoll_assumptions2
   lepoll_assumptions3 lepoll_assumptions4 lepoll_assumptions5
   lepoll_assumptions6 lepoll_assumptions7 lepoll_assumptions8
   lepoll_assumptions9 lepoll_assumptions10 lepoll_assumptions11
   lepoll_assumptions12 lepoll_assumptions13 lepoll_assumptions14
   lepoll_assumptions15 lepoll_assumptions16
   lepoll_assumptions17 lepoll_assumptions18
 
 end \<comment> \<open>\<^locale>\<open>M_replacement_lepoll\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Univ_Relative.thy b/thys/Transitive_Models/Univ_Relative.thy
--- a/thys/Transitive_Models/Univ_Relative.thy
+++ b/thys/Transitive_Models/Univ_Relative.thy
@@ -1,450 +1,418 @@
 section\<open>Relativization of the cumulative hierarchy\<close>
 theory Univ_Relative
   imports
     "ZF-Constructible.Rank"
     "ZF.Univ"
     Discipline_Cardinal
 
 begin
 
 declare arity_ordinal_fm[arity]
 
 context M_trivial
 begin
 declare powerset_abs[simp]
 
 lemma family_union_closed: "\<lbrakk>strong_replacement(M, \<lambda>x y. y = f(x)); M(A); \<forall>x\<in>A. M(f(x))\<rbrakk>
       \<Longrightarrow> M(\<Union>x\<in>A. f(x))"
   using RepFun_closed ..
 
 lemma family_union_closed': "\<lbrakk>strong_replacement(M, \<lambda>x y. x\<in>A \<and> y = f(x)); M(A); \<forall>x\<in>A. M(f(x))\<rbrakk>
       \<Longrightarrow> M(\<Union>x\<in>A. f(x))"
   using RepFun_closed2
   by simp
 
 end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
 
 definition
-  Powapply :: "[i,i] \<Rightarrow> i"  where
-  "Powapply(f,y) \<equiv> Pow(f`y)"
-
-reldb_add functional "Pow" "Pow_rel"
-reldb_add relational "Pow" "is_Pow"
-
-declare Replace_iff_sats[iff_sats]
-synthesize "is_Pow" from_definition assuming "nonempty"
-arity_theorem for "is_Pow_fm"
-
-relativize functional "Powapply" "Powapply_rel"
-relationalize "Powapply_rel" "is_Powapply"
-synthesize "is_Powapply" from_definition assuming "nonempty"
-arity_theorem for "is_Powapply_fm"
-
-notation Powapply_rel (\<open>Powapply\<^bsup>_\<^esup>'(_,_')\<close>)
-
-context M_basic
-begin
-
-rel_closed for "Powapply"
-  unfolding Powapply_rel_def
-  by simp
-
-is_iff_rel for "Powapply"
-  using Pow_rel_iff
-  unfolding is_Powapply_def Powapply_rel_def
-  by simp
-
-end \<comment>\<open>\<^locale>\<open>M_basic\<close>\<close>
-
-definition
   HVfrom :: "[i,i,i] \<Rightarrow> i" where
   "HVfrom(A,x,f) \<equiv> A \<union> (\<Union>y\<in>x. Powapply(f,y))"
 
 relativize functional "HVfrom" "HVfrom_rel"
 relationalize "HVfrom_rel" "is_HVfrom"
 synthesize "is_HVfrom" from_definition assuming "nonempty"
 arity_theorem intermediate for "is_HVfrom_fm"
 
 lemma arity_is_HVfrom_fm:
   "A \<in> nat \<Longrightarrow>
     x \<in> nat \<Longrightarrow>
     f \<in> nat \<Longrightarrow>
     d \<in> nat \<Longrightarrow>
     arity(is_HVfrom_fm(A, x, f, d)) = succ(A) \<union> succ(d) \<union> (succ(x) \<union> succ(f))"
   using arity_is_HVfrom_fm' arity_is_Powapply_fm
   by(simp,subst arity_Replace_fm[of "is_Powapply_fm(succ(succ(succ(succ(f)))), 0, 1)" "succ(succ(x))" 1])
     (simp_all, auto simp add:arity pred_Un_distrib)
 
 notation HVfrom_rel (\<open>HVfrom\<^bsup>_\<^esup>'(_,_,_')\<close>)
 
 locale M_HVfrom = M_eclose +
   assumes
     Powapply_replacement:
     "M(f) \<Longrightarrow> strong_replacement(M,\<lambda>y z. z = Powapply\<^bsup>M\<^esup>(f,y))"
 begin
 
 is_iff_rel for "HVfrom"
 proof -
   assume assms:"M(A)" "M(x)" "M(f)" "M(res)"
   then
   have "is_Replace(M,x,\<lambda>y z. z = Powapply\<^bsup>M\<^esup>(f,y),r) \<longleftrightarrow> r = {z . y\<in>x, z = Powapply\<^bsup>M\<^esup>(f,y)}"
     if "M(r)" for r
     using that Powapply_rel_closed
       Replace_abs[of x r "\<lambda>y z. z = Powapply\<^bsup>M\<^esup>(f,y)"] transM[of _ x]
     by simp
   moreover
   have "is_Replace(M,x,is_Powapply(M,f),r) \<longleftrightarrow>
         is_Replace(M,x,\<lambda>y z. z = Powapply\<^bsup>M\<^esup>(f,y),r)" if "M(r)" for r
     using assms that is_Powapply_iff is_Replace_cong
     by simp
   ultimately
   have "is_Replace(M,x,is_Powapply(M,f),r) \<longleftrightarrow> r = {z . y\<in>x, z = Powapply\<^bsup>M\<^esup>(f,y)}"
     if "M(r)" for r
     using that assms
     by simp
   moreover
   have "M({z . y \<in> x, z = Powapply\<^bsup>M\<^esup>(f,y)})"
     using assms strong_replacement_closed[OF Powapply_replacement]
       Powapply_rel_closed transM[of _ x]
     by simp
   moreover from assms
     \<comment> \<open>intermediate step for body of Replace\<close>
   have "{z . y \<in> x, z = Powapply\<^bsup>M\<^esup>(f,y)} = {y . w \<in> x, M(y) \<and> M(w) \<and> y = Powapply\<^bsup>M\<^esup>(f,w)}"
     by (auto dest:transM)
   ultimately
   show ?thesis
     using assms
     unfolding is_HVfrom_def HVfrom_rel_def
     by (auto dest:transM)
 qed
 
 rel_closed for "HVfrom"
 proof -
   assume assms:"M(A)" "M(x)" "M(f)"
   have "M({z . y \<in> x, z = Powapply\<^bsup>M\<^esup>(f,y)})"
     using assms strong_replacement_closed[OF Powapply_replacement]
       Powapply_rel_closed transM[of _ x]
     by simp
   then
   have "M(A \<union> \<Union>({z . y\<in>x, z = Powapply\<^bsup>M\<^esup>(f,y)}))"
     using assms
     by simp
   moreover from assms
     \<comment> \<open>intermediate step for body of Replace\<close>
   have "{z . y \<in> x, z = Powapply\<^bsup>M\<^esup>(f,y)} = {y . w \<in> x, M(y) \<and> M(w) \<and> y = Powapply\<^bsup>M\<^esup>(f,w)}"
     by (auto dest:transM)
   ultimately
   show ?thesis
     using assms
     unfolding HVfrom_rel_def
     by simp
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_HVfrom\<close>\<close>
 
 definition
   Vfrom_rel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> i" (\<open>Vfrom\<^bsup>_\<^esup>'(_,_')\<close>) where
   "Vfrom\<^bsup>M\<^esup>(A,i) = transrec(i, HVfrom_rel(M,A))"
 
 definition
   is_Vfrom :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
   "is_Vfrom(M,A,i,z) \<equiv> is_transrec(M,is_HVfrom(M,A),i,z)"
 
 definition
   Hrank :: "[i,i] \<Rightarrow> i" where
   "Hrank(x,f) \<equiv> (\<Union>y\<in>x. succ(f`y))"
 
 definition
   rrank :: "i \<Rightarrow> i" where
   "rrank(a) \<equiv> Memrel(eclose({a}))^+"
 
 relativize functional "Hrank" "Hrank_rel"
 relationalize "Hrank_rel" "is_Hrank"
 synthesize "is_Hrank" from_definition assuming "nonempty"
 
 lemma arity_is_Hrank_fm : "x \<in> nat \<Longrightarrow>
     f \<in> nat \<Longrightarrow>
     d \<in> nat \<Longrightarrow>
     arity(is_Hrank_fm(x, f, d)) =
     succ(d) \<union> succ(x) \<union> succ(f)"
   unfolding is_Hrank_fm_def
   using  arity_fun_apply_fm arity_big_union_fm
     arity_fun_apply_fm arity_succ_fm arity_And arity_Exists
     arity_Replace_fm[of
       "(\<cdot>\<exists>\<cdot>\<cdot>succ(0) is 2\<cdot> \<and> \<cdot> succ(succ(succ(succ(f))))`1 is 0\<cdot>\<cdot>\<cdot>)"
       "succ(x)" 0 "4+\<^sub>\<omega>f"]
   by(simp_all add:Un_assoc pred_Un,simp add:ord_simp_union)
 
 locale M_Vfrom = M_HVfrom +
   assumes
     trepl_HVfrom : "\<lbrakk> M(A);M(i) \<rbrakk> \<Longrightarrow> transrec_replacement(M,is_HVfrom(M,A),i)"
     and
     Hrank_replacement : "M(f) \<Longrightarrow> strong_replacement(M,\<lambda>x y . y = succ(f`x))"
     and
     is_Hrank_replacement : "M(x) \<Longrightarrow> wfrec_replacement(M,is_Hrank(M),rrank(x))"
     and
     HVfrom_replacement : "\<lbrakk> M(i) ; M(A) \<rbrakk> \<Longrightarrow>
                           transrec_replacement(M,is_HVfrom(M,A),i)"
 
 begin
 
 lemma Vfrom_rel_iff :
   assumes "M(A)" "M(i)" "M(z)" "Ord(i)"
   shows "is_Vfrom(M,A,i,z) \<longleftrightarrow> z = Vfrom\<^bsup>M\<^esup>(A,i)"
 proof -
   have "relation2(M, is_HVfrom(M, A), HVfrom_rel(M, A))"
     using assms is_HVfrom_iff
     unfolding relation2_def
     by simp
   then
   show ?thesis
     using assms HVfrom_rel_closed trepl_HVfrom
       transrec_abs[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)" z]
     unfolding is_Vfrom_def Vfrom_rel_def
     by simp
 qed
 
 lemma relation2_HVfrom: "M(A) \<Longrightarrow> relation2(M,is_HVfrom(M,A),HVfrom_rel(M,A))"
   using is_HVfrom_iff
   unfolding relation2_def
   by auto
 
 lemma HVfrom_closed :
   "M(A) \<Longrightarrow> \<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(HVfrom_rel(M,A,x,g))"
   using HVfrom_rel_closed by simp
 
 lemma Vfrom_rel_closed:
   assumes "M(A)" "M(i)" "Ord(i)"
   shows "M(transrec(i, HVfrom_rel(M, A)))"
   using is_HVfrom_iff HVfrom_closed HVfrom_replacement assms trepl_HVfrom relation2_HVfrom
     transrec_closed[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"]
   by simp
 
 lemma transrec_HVfrom:
   assumes "M(A)"
   shows "Ord(i) \<Longrightarrow> M(i) \<Longrightarrow> {x\<in>Vfrom(A,i). M(x)} = transrec(i,HVfrom_rel(M,A))"
 proof (induct rule:trans_induct)
   have eq:"(\<Union>x\<in>i. {x \<in> Pow(transrec(x, HVfrom_rel(M, A))) . M(x)}) =  \<Union>{y . x \<in> i, y = Pow\<^bsup>M\<^esup>(transrec(x, HVfrom_rel(M, A)))}"
     if "Ord(i)" "M(i)" for i
     using assms Pow_rel_char[OF Vfrom_rel_closed[OF \<open>M(A)\<close> transM[of _ i]]] Ord_in_Ord' that
     by auto
   case (step i)
   then
   have 0: "M(Pow\<^bsup>M\<^esup>(transrec(x, HVfrom_rel(M, A))))" if "x\<in>i" for x
     using assms that transM[of _ i] Ord_in_Ord
       transrec_closed[of "is_HVfrom(M,A)" _ "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom
     by auto
   have "Vfrom(A,i) = A \<union> (\<Union>y\<in>i. Pow((\<lambda>x\<in>i. Vfrom(A, x)) ` y))"
     using def_transrec[OF Vfrom_def, of A i] by simp
   then
   have "Vfrom(A,i) = A \<union> (\<Union>y\<in>i. Pow(Vfrom(A, y)))"
     by simp
   then
   have "{x\<in>Vfrom(A,i). M(x)} = {x\<in>A. M(x)} \<union> (\<Union>y\<in>i. {x\<in>Pow(Vfrom(A, y)). M(x)})"
     by auto
   with \<open>M(A)\<close>
   have "{x\<in>Vfrom(A,i). M(x)} = A \<union> (\<Union>y\<in>i. {x\<in>Pow(Vfrom(A, y)). M(x)})"
     by (auto intro:transM)
   also
   have "... = A \<union> (\<Union>y\<in>i. {x\<in>Pow({z\<in>Vfrom(A,y). M(z)}). M(x)})"
   proof -
     have "{x\<in>Pow(Vfrom(A, y)). M(x)} = {x\<in>Pow({z\<in>Vfrom(A,y). M(z)}). M(x)}"
       if "y\<in>i" for y by (auto intro:transM)
     then
     show ?thesis by simp
   qed
   also from step
   have " ... = A \<union> (\<Union>y\<in>i. {x\<in>Pow(transrec(y, HVfrom_rel(M, A))). M(x)})"
     using transM[of _ i]
     by auto
   also
   have " ... = transrec(i, HVfrom_rel(M, A))"
     using 0 step assms transM[of _ i] eq
       def_transrec[of "\<lambda>y. transrec(y, HVfrom_rel(M, A))" "HVfrom_rel(M, A)" i]
     unfolding Powapply_rel_def HVfrom_rel_def
     by auto
   finally
   show ?case .
 qed
 
 lemma Vfrom_abs: "\<lbrakk> M(A); M(i); M(V); Ord(i) \<rbrakk> \<Longrightarrow> is_Vfrom(M,A,i,V) \<longleftrightarrow> V = {x\<in>Vfrom(A,i). M(x)}"
   unfolding is_Vfrom_def
   using is_HVfrom_iff
     transrec_abs[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom
     transrec_HVfrom
   by simp
 
 lemma Vfrom_closed: "\<lbrakk> M(A); M(i); Ord(i) \<rbrakk> \<Longrightarrow> M({x\<in>Vfrom(A,i). M(x)})"
   unfolding is_Vfrom_def
   using is_HVfrom_iff HVfrom_closed HVfrom_replacement
     transrec_closed[of "is_HVfrom(M,A)" i "HVfrom_rel(M,A)"] trepl_HVfrom relation2_HVfrom
     transrec_HVfrom
   by simp
 
 end \<comment> \<open>\<^locale>\<open>M_Vfrom\<close>\<close>
 
 subsection\<open>Formula synthesis\<close>
 
 context M_Vfrom
 begin
 
 rel_closed for "Hrank"
   unfolding Hrank_rel_def
   using Hrank_replacement
   by simp
 
 is_iff_rel for "Hrank"
 proof -
   assume "M(f)" "M(x)" "M(res)"
   moreover from this
   have "{a . y \<in> x, M(a) \<and> M(y) \<and> a = succ(f ` y)} = {a . y \<in> x,  a = succ(f ` y)}"
     using transM[of _ x]
     by auto
   ultimately
   show ?thesis
     unfolding is_Hrank_def Hrank_rel_def
     using Replace_abs transM[of _ x] Hrank_replacement
     by auto
 qed
 
 lemma relation2_Hrank :
   "relation2(M,is_Hrank(M),Hrank)"
   unfolding  relation2_def
 proof(clarify)
   fix x f res
   assume "M(x)" "M(f)" "M(res)"
   moreover from this
   have "{a . y \<in> x, M(a) \<and> M(y) \<and> a = succ(f ` y)} = {a . y \<in> x,  a = succ(f ` y)}"
     using transM[of _ x]
     by auto
   ultimately
   show "is_Hrank(M, x, f, res) \<longleftrightarrow> res = Hrank(x, f)"
     unfolding  Hrank_def relation2_def
     using is_Hrank_iff[unfolded Hrank_rel_def]
     by auto
 qed
 
 lemma Hrank_closed :
   "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(Hrank(x,g))"
 proof(clarify)
   fix x g
   assume "M(x)" "M(g)"
   then
   show "M(Hrank(x,g))"
     using RepFun_closed[OF Hrank_replacement] transM[of _ x]
     unfolding Hrank_def
     by auto
 qed
 
 end \<comment>\<open>\<^locale>\<open>M_basic\<close>\<close>
 
 context M_eclose
 begin
 
 lemma wf_rrank : "M(x) \<Longrightarrow> wf(rrank(x))"
   unfolding rrank_def using wf_trancl[OF wf_Memrel] .
 
 lemma trans_rrank : "M(x) \<Longrightarrow> trans(rrank(x))"
   unfolding rrank_def using trans_trancl .
 
 lemma relation_rrank : "M(x) \<Longrightarrow> relation(rrank(x))"
   unfolding rrank_def using relation_trancl .
 
 lemma rrank_in_M : "M(x) \<Longrightarrow> M(rrank(x))"
   unfolding rrank_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_eclose\<close>\<close>
 
 lemma Hrank_trancl:"Hrank(y, restrict(f,Memrel(eclose({x}))-``{y}))
                   = Hrank(y, restrict(f,(Memrel(eclose({x}))^+)-``{y}))"
   unfolding Hrank_def
   using restrict_trans_eq by simp
 
 lemma rank_trancl: "rank(x) = wfrec(rrank(x), x, Hrank)"
 proof -
   have "rank(x) =  wfrec(Memrel(eclose({x})), x, Hrank)"
     (is "_ = wfrec(?r,_,_)")
     unfolding rank_def transrec_def Hrank_def by simp
   also
   have " ... = wftrec(?r^+, x, \<lambda>y f. Hrank(y, restrict(f,?r-``{y})))"
     unfolding wfrec_def ..
   also
   have " ... = wftrec(?r^+, x, \<lambda>y f. Hrank(y, restrict(f,(?r^+)-``{y})))"
     using Hrank_trancl by simp
   also
   have " ... =  wfrec(?r^+, x, Hrank)"
     unfolding wfrec_def using trancl_eq_r[OF relation_trancl trans_trancl] by simp
   finally
   show ?thesis unfolding rrank_def .
 qed
 
 definition
   Vset' :: "[i] \<Rightarrow> i" where
   "Vset'(A) \<equiv> Vfrom(0,A)"
 
 reldb_add relational "Vfrom" "is_Vfrom"
 reldb_add functional "Vfrom" "Vfrom_rel"
 relativize functional "Vset'" "Vset_rel"
 relationalize "Vset_rel" "is_Vset"
 reldb_rem relational "Vset"
 reldb_rem functional "Vset_rel"
 reldb_add relational "Vset" "is_Vset"
 reldb_add functional "Vset" "Vset_rel"
 
 schematic_goal sats_is_Vset_fm_auto:
   assumes
     "i\<in>nat" "v\<in>nat" "env\<in>list(A)" "0\<in>A"
     "i < length(env)" "v < length(env)"
   shows
     "is_Vset(##A,nth(i, env),nth(v, env)) \<longleftrightarrow> sats(A,?ivs_fm(i,v),env)"
   unfolding is_Vset_def is_Vfrom_def
   by (insert assms; (rule sep_rules is_HVfrom_iff_sats is_transrec_iff_sats | simp)+)
 
 synthesize "is_Vset" from_schematic "sats_is_Vset_fm_auto"
 arity_theorem for "is_Vset_fm"
 context M_Vfrom
 begin
 
 lemma Vset_abs: "\<lbrakk> M(i); M(V); Ord(i) \<rbrakk> \<Longrightarrow> is_Vset(M,i,V) \<longleftrightarrow> V = {x\<in>Vset(i). M(x)}"
   using Vfrom_abs unfolding is_Vset_def by simp
 
 lemma Vset_closed: "\<lbrakk> M(i); Ord(i) \<rbrakk> \<Longrightarrow> M({x\<in>Vset(i). M(x)})"
   using Vfrom_closed unfolding is_Vset_def by simp
 
 lemma rank_closed: "M(a) \<Longrightarrow> M(rank(a))"
   unfolding rank_trancl
   using Hrank_closed is_Hrank_replacement relation2_Hrank
     wf_rrank relation_rrank trans_rrank rrank_in_M
     trans_wfrec_closed[of "rrank(a)" a "is_Hrank(M)"]
     transM[of _ a]
   by auto
 
 lemma M_into_Vset:
   assumes "M(a)"
   shows "\<exists>i[M]. \<exists>V[M]. ordinal(M,i) \<and> is_Vset(M,i,V) \<and> a\<in>V"
 proof -
   let ?i="succ(rank(a))"
   from assms
   have "a\<in>{x\<in>Vfrom(0,?i). M(x)}" (is "a\<in>?V")
     using Vset_Ord_rank_iff by simp
   moreover from assms
   have "M(?i)"
     using rank_closed by simp
   moreover
   note \<open>M(a)\<close>
   moreover from calculation
   have "M(?V)"
     using Vfrom_closed by simp
   moreover from calculation
   have "ordinal(M,?i) \<and> is_Vfrom(M, 0, ?i, ?V) \<and> a \<in> ?V"
     using Ord_rank Vfrom_abs by simp
   ultimately
   show ?thesis
     using nonempty empty_abs
     unfolding is_Vset_def
     by blast
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_HVfrom\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/ZF_Library_Relative.thy b/thys/Transitive_Models/ZF_Library_Relative.thy
--- a/thys/Transitive_Models/ZF_Library_Relative.thy
+++ b/thys/Transitive_Models/ZF_Library_Relative.thy
@@ -1,1081 +1,1072 @@
 section\<open>Library of basic $\mathit{ZF}$ results\label{sec:zf-lib}\<close>
 
 theory ZF_Library_Relative
   imports
     Aleph_Relative\<comment> \<open>must be before Cardinal\_AC\_Relative!\<close>
     Cardinal_AC_Relative
     FiniteFun_Relative
 begin
 
 no_notation sum (infixr \<open>+\<close> 65)
 notation oadd (infixl \<open>+\<close> 65)
 
 lemma (in M_cardinal_arith_jump) csucc_rel_cardinal_rel:
   assumes "Ord(\<kappa>)" "M(\<kappa>)"
   shows "(|\<kappa>|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup> = (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
 proof (intro le_anti_sym)\<comment> \<open>show both inequalities\<close>
   from assms
   have hips:"M((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "Ord((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "\<kappa> < (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
     using Card_rel_csucc_rel[THEN Card_rel_is_Ord]
       csucc_rel_basic by simp_all
   then
   show "(|\<kappa>|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
     using Ord_cardinal_rel_le[THEN lt_trans1]
       Card_rel_csucc_rel
     unfolding csucc_rel_def
     by (rule_tac Least_antitone) (assumption, simp_all add:assms)
   from assms
   have "\<kappa> < L" if "Card\<^bsup>M\<^esup>(L)" "|\<kappa>|\<^bsup>M\<^esup> < L" "M(L)" for L
     using (* Card_rel_le_iff[THEN iffD1, THEN le_trans, of \<kappa> _ L] *) that
       Card_rel_is_Ord leI Card_rel_le_iff[of \<kappa> L]
     by (rule_tac ccontr, auto dest:not_lt_imp_le) (fast dest: le_imp_not_lt)
   with hips
   show "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (|\<kappa>|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
     using Ord_cardinal_rel_le[THEN lt_trans1] Card_rel_csucc_rel
     unfolding csucc_rel_def
     by (rule_tac Least_antitone) (assumption, auto simp add:assms)
 qed
 
 lemma (in M_cardinal_arith_jump) csucc_rel_le_mono:
   assumes "\<kappa> \<le> \<nu>" "M(\<kappa>)" "M(\<nu>)"
   shows "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<nu>\<^sup>+)\<^bsup>M\<^esup>"
 proof (cases "\<kappa> = \<nu>")
   case True
   with assms
   show ?thesis using Card_rel_csucc_rel [THEN Card_rel_is_Ord] by simp
 next
   case False
   with assms
   have "\<kappa> < \<nu>" using le_neq_imp_lt by simp
   show ?thesis\<comment> \<open>by way of contradiction\<close>
   proof (rule ccontr)
     assume "\<not> (\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<nu>\<^sup>+)\<^bsup>M\<^esup>"
     with assms
     have "(\<nu>\<^sup>+)\<^bsup>M\<^esup> < (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
       using Card_rel_csucc_rel[THEN Card_rel_is_Ord] le_Ord2 lt_Ord
       by (intro not_le_iff_lt[THEN iffD1]) auto
     with assms
     have "(\<nu>\<^sup>+)\<^bsup>M\<^esup> \<le> |\<kappa>|\<^bsup>M\<^esup>"
       using le_Ord2[THEN Card_rel_csucc_rel, of \<kappa> \<nu>]
         Card_rel_lt_csucc_rel_iff[of "(\<nu>\<^sup>+)\<^bsup>M\<^esup>" "|\<kappa>|\<^bsup>M\<^esup>", THEN iffD1]
         csucc_rel_cardinal_rel[OF lt_Ord] leI[of "(\<nu>\<^sup>+)\<^bsup>M\<^esup>" "(\<kappa>\<^sup>+)\<^bsup>M\<^esup>"]
       by simp
     with assms
     have "(\<nu>\<^sup>+)\<^bsup>M\<^esup> \<le> \<kappa>"
       using Ord_cardinal_rel_le[OF lt_Ord] le_trans by auto
     with assms
     have "\<nu> < \<kappa>"
       using csucc_rel_basic le_Ord2[THEN Card_rel_csucc_rel, of \<kappa> \<nu>] Card_rel_is_Ord
         le_Ord2
       by (rule_tac j="(\<nu>\<^sup>+)\<^bsup>M\<^esup>" in lt_trans2) simp_all
     with \<open>\<kappa> < \<nu>\<close>
     show "False" using le_imp_not_lt leI by blast
   qed
 qed
 
 lemma (in M_cardinal_AC) cardinal_rel_succ_not_0:   "|A|\<^bsup>M\<^esup> = succ(n) \<Longrightarrow> M(A) \<Longrightarrow> M(n) \<Longrightarrow> A \<noteq> 0"
   by auto
 
 (* "Finite_to_one(X,Y) \<equiv> {f:X\<rightarrow>Y. \<forall>y\<in>Y. Finite({x\<in>X . f`x = y})}" *)
 reldb_add functional "Finite" "Finite" \<comment> \<open>wrongly done? Finite is absolute\<close>
 relativize functional "Finite_to_one" "Finite_to_one_rel" external
   (* reldb_add relational "Finite" "is_Finite" \<comment> \<open>don't have is_Finite yet\<close>
 relationalize "Finite_to_one_rel" "is_Finite_to_one" *)
 
 notation Finite_to_one_rel (\<open>Finite'_to'_one\<^bsup>_\<^esup>'(_,_')\<close>)
 
 abbreviation
   Finite_to_one_r_set :: "[i,i,i] \<Rightarrow> i" (\<open>Finite'_to'_one\<^bsup>_\<^esup>'(_,_')\<close>) where
   "Finite_to_one\<^bsup>M\<^esup>(X,Y) \<equiv> Finite_to_one_rel(##M,X,Y)"
 
-locale M_ZF_library =  M_cardinal_arith + M_aleph + M_FiniteFun + M_replacement_extra
+locale M_ZF_library = M_aleph + M_FiniteFun
 begin
 
 lemma Finite_Collect_imp: "Finite({x\<in>X . Q(x)}) \<Longrightarrow> Finite({x\<in>X . M(x) \<and> Q(x)})"
   (is "Finite(?A) \<Longrightarrow> Finite(?B)")
   using subset_Finite[of ?B ?A] by auto
 
 lemma Finite_to_one_relI[intro]:
   assumes "f:X\<rightarrow>\<^bsup>M\<^esup>Y" "\<And>y. y\<in>Y \<Longrightarrow> Finite({x\<in>X . f`x = y})"
     and types:"M(f)" "M(X)" "M(Y)"
   shows "f \<in> Finite_to_one\<^bsup>M\<^esup>(X,Y)"
   using assms Finite_Collect_imp unfolding Finite_to_one_rel_def
   by (simp)
 
 lemma Finite_to_one_relI'[intro]:
   assumes "f:X\<rightarrow>\<^bsup>M\<^esup>Y" "\<And>y. y\<in>Y \<Longrightarrow> Finite({x\<in>X . M(x) \<and> f`x = y})"
     and types:"M(f)" "M(X)" "M(Y)"
   shows "f \<in> Finite_to_one\<^bsup>M\<^esup>(X,Y)"
   using assms unfolding Finite_to_one_rel_def
   by (simp)
 
 lemma Finite_to_one_relD[dest]:
   "f \<in> Finite_to_one\<^bsup>M\<^esup>(X,Y) \<Longrightarrow>f:X\<rightarrow>\<^bsup>M\<^esup>Y"
   "f \<in> Finite_to_one\<^bsup>M\<^esup>(X,Y) \<Longrightarrow> y\<in>Y \<Longrightarrow> M(Y) \<Longrightarrow> Finite({x\<in>X . M(x) \<and> f`x = y})"
   unfolding Finite_to_one_rel_def by simp_all
 
 lemma Diff_bij_rel:
   assumes "\<forall>A\<in>F. X \<subseteq> A"
     and types: "M(F)" "M(X)" shows "(\<lambda>A\<in>F. A-X) \<in> bij\<^bsup>M\<^esup>(F, {A-X. A\<in>F})"
   using assms  def_inj_rel def_surj_rel unfolding bij_rel_def
   apply (auto)
    apply (subgoal_tac "M(\<lambda>A\<in>F. A - X)" "M({A - X . A \<in> F})")
      apply (auto simp add:mem_function_space_rel_abs)
       apply (rule_tac lam_type, auto)
      prefer 4
      apply (subgoal_tac "M(\<lambda>A\<in>F. A - X)" "M({A - X . A \<in> F})")
        apply(tactic \<open>distinct_subgoals_tac\<close>)
      apply (auto simp add:mem_function_space_rel_abs)
      apply (rule_tac lam_type, auto) prefer 3
     apply (subst subset_Diff_Un[of X])
      apply auto
 proof -
   from types
   show "M({A - X . A \<in> F})"
     using diff_replacement
     by (rule_tac RepFun_closed) (auto dest:transM[of _ F])
   from types
   show "M(\<lambda>A\<in>F. A - X)"
     using Pair_diff_replacement
     by (rule_tac lam_closed, auto dest:transM)
 qed
 
 lemma function_space_rel_nonempty:
   assumes "b\<in>B"  and types: "M(B)" "M(A)"
   shows "(\<lambda>x\<in>A. b) : A \<rightarrow>\<^bsup>M\<^esup> B"
 proof -
   note assms
   moreover from this
   have "M(\<lambda>x\<in>A. b)"
     using tag_replacement by (rule_tac lam_closed, auto dest:transM)
   ultimately
   show ?thesis
     by (simp add:mem_function_space_rel_abs)
 qed
 
 lemma mem_function_space_rel:
   assumes "f \<in> A \<rightarrow>\<^bsup>M\<^esup> y" "M(A)" "M(y)"
   shows  "f \<in> A \<rightarrow> y"
   using assms function_space_rel_char by simp
 
 lemmas range_fun_rel_subset_codomain = range_fun_subset_codomain[OF mem_function_space_rel]
 
 end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
 
 context M_Pi_assumptions
 begin
 
 lemma mem_Pi_rel: "f \<in> Pi\<^bsup>M\<^esup>(A,B) \<Longrightarrow> f \<in> Pi(A, B)"
   using trans_closed mem_Pi_rel_abs
   by force
 
 lemmas Pi_rel_rangeD = Pi_rangeD[OF mem_Pi_rel]
 
 lemmas rel_apply_Pair = apply_Pair[OF mem_Pi_rel]
 
 lemmas rel_apply_rangeI = apply_rangeI[OF mem_Pi_rel]
 
 lemmas Pi_rel_range_eq = Pi_range_eq[OF mem_Pi_rel]
 
 lemmas Pi_rel_vimage_subset = Pi_vimage_subset[OF mem_Pi_rel]
 
 end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions\<close>\<close>
 
 context M_ZF_library
 begin
 
-lemma mem_bij_rel: "\<lbrakk>f \<in> bij\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f\<in>bij(A,B)"
-  using bij_rel_char by simp
-
-lemma mem_inj_rel: "\<lbrakk>f \<in> inj\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f\<in>inj(A,B)"
-  using inj_rel_char by simp
-
-lemma mem_surj_rel: "\<lbrakk>f \<in> surj\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f\<in>surj(A,B)"
-  using surj_rel_char by simp
-
-lemmas rel_apply_in_range = apply_in_range[OF _ _ mem_function_space_rel]
+lemmas rel_apply_in_range = apply_in_codomain_Ord[OF _ _ mem_function_space_rel]
 
 lemmas rel_range_eq_image = ZF_Library.range_eq_image[OF mem_function_space_rel]
 
 lemmas rel_Image_sub_codomain = Image_sub_codomain[OF mem_function_space_rel]
 
 lemma rel_inj_to_Image: "\<lbrakk>f:A\<rightarrow>\<^bsup>M\<^esup>B; f \<in> inj\<^bsup>M\<^esup>(A,B); M(A); M(B)\<rbrakk> \<Longrightarrow> f \<in> inj\<^bsup>M\<^esup>(A,f``A)"
   using inj_to_Image[OF mem_function_space_rel mem_inj_rel]
     transM[OF _ function_space_rel_closed] by simp
 
 lemma inj_rel_imp_surj_rel:
   fixes f b
   defines [simp]: "ifx(x) \<equiv> if x\<in>range(f) then converse(f)`x else b"
   assumes "f \<in> inj\<^bsup>M\<^esup>(B,A)" "b\<in>B" and types: "M(f)" "M(B)" "M(A)"
   shows "(\<lambda>x\<in>A. ifx(x)) \<in> surj\<^bsup>M\<^esup>(A,B)"
 proof -
   from types and \<open>b\<in>B\<close>
   have "M(\<lambda>x\<in>A. ifx(x))"
     using ifx_replacement by (rule_tac lam_closed) (auto dest:transM)
   with assms(2-)
   show ?thesis
     using inj_imp_surj mem_surj_abs by simp
 qed
 
 lemma function_space_rel_disjoint_Un:
   assumes "f \<in> A\<rightarrow>\<^bsup>M\<^esup>B" "g \<in> C\<rightarrow>\<^bsup>M\<^esup>D"  "A \<inter> C = 0"
     and types:"M(A)" "M(B)" "M(C)" "M(D)"
   shows "f \<union> g \<in> (A \<union> C)\<rightarrow>\<^bsup>M\<^esup> (B \<union> D)"
   using assms fun_Pi_disjoint_Un[OF mem_function_space_rel
       mem_function_space_rel, OF assms(1) _ _ assms(2)]
     function_space_rel_char by auto
 
 lemma restrict_eq_imp_Un_into_function_space_rel:
   assumes "f \<in> A\<rightarrow>\<^bsup>M\<^esup>B" "g \<in> C\<rightarrow>\<^bsup>M\<^esup>D"  "restrict(f, A \<inter> C) = restrict(g, A \<inter> C)"
     and types:"M(A)" "M(B)" "M(C)" "M(D)"
   shows "f \<union> g \<in> (A \<union> C)\<rightarrow>\<^bsup>M\<^esup> (B \<union> D)"
   using assms restrict_eq_imp_Un_into_Pi[OF mem_function_space_rel
       mem_function_space_rel, OF assms(1) _ _ assms(2)]
     function_space_rel_char by auto
 
 lemma lepoll_relD[dest]: "A \<lesssim>\<^bsup>M\<^esup> B \<Longrightarrow> \<exists>f[M]. f \<in> inj\<^bsup>M\<^esup>(A, B)"
   unfolding lepoll_rel_def .
 
 \<comment> \<open>Should the assumptions be on \<^term>\<open>f\<close> or on \<^term>\<open>A\<close> and \<^term>\<open>B\<close>?
     Should BOTH be intro rules?\<close>
 lemma lepoll_relI[intro]: "f \<in> inj\<^bsup>M\<^esup>(A, B) \<Longrightarrow> M(f) \<Longrightarrow> A \<lesssim>\<^bsup>M\<^esup> B"
   unfolding lepoll_rel_def by blast
 
 lemma eqpollD[dest]: "A \<approx>\<^bsup>M\<^esup> B \<Longrightarrow> \<exists>f[M]. f \<in> bij\<^bsup>M\<^esup>(A, B)"
   unfolding eqpoll_rel_def .
 
 \<comment> \<open>Same as @{thm lepoll_relI}\<close>
 lemma bij_rel_imp_eqpoll_rel[intro]: "f \<in> bij\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(f) \<Longrightarrow> A \<approx>\<^bsup>M\<^esup> B"
   unfolding eqpoll_rel_def by blast
 
 lemma restrict_bij_rel:\<comment> \<open>Unused\<close>
   assumes "f \<in> inj\<^bsup>M\<^esup>(A,B)"  "C\<subseteq>A"
     and types:"M(A)" "M(B)" "M(C)"
   shows "restrict(f,C)\<in> bij\<^bsup>M\<^esup>(C, f``C)"
   using assms restrict_bij inj_rel_char bij_rel_char by auto
 
 lemma range_of_subset_eqpoll_rel:
   assumes "f \<in> inj\<^bsup>M\<^esup>(X,Y)" "S \<subseteq> X"
     and types:"M(X)" "M(Y)" "M(S)"
   shows "S \<approx>\<^bsup>M\<^esup> f `` S"
   using assms restrict_bij bij_rel_char
     trans_inj_rel_closed[OF \<open>f \<in> inj\<^bsup>M\<^esup>(X,Y)\<close>]
   unfolding eqpoll_rel_def
   by (rule_tac x="restrict(f,S)" in rexI) auto
 
 lemmas inj_rel_is_fun = inj_is_fun[OF mem_inj_rel]
 
 lemma inj_rel_bij_rel_range: "f \<in> inj\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> f \<in> bij\<^bsup>M\<^esup>(A,range(f))"
   using bij_rel_char inj_rel_char inj_bij_range by force
 
 lemma bij_rel_is_inj_rel: "f \<in> bij\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> f \<in> inj\<^bsup>M\<^esup>(A,B)"
   unfolding bij_rel_def by simp
 
 lemma inj_rel_weaken_type: "[| f \<in> inj\<^bsup>M\<^esup>(A,B);  B\<subseteq>D; M(A); M(B); M(D) |] ==> f \<in> inj\<^bsup>M\<^esup>(A,D)"
   using inj_rel_char inj_rel_is_fun inj_weaken_type by auto
 
 lemma bij_rel_converse_bij_rel [TC]: "f \<in> bij\<^bsup>M\<^esup>(A,B)  \<Longrightarrow> M(A) \<Longrightarrow> M(B) ==> converse(f): bij\<^bsup>M\<^esup>(B,A)"
   using bij_rel_char by force
 
 lemma bij_rel_is_fun_rel: "f \<in> bij\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow>  f \<in> A\<rightarrow>\<^bsup>M\<^esup>B"
   using bij_rel_char mem_function_space_rel_abs bij_is_fun by simp
 
 lemmas bij_rel_is_fun = bij_rel_is_fun_rel[THEN mem_function_space_rel]
 
 lemma comp_bij_rel:
   "g \<in> bij\<^bsup>M\<^esup>(A,B) \<Longrightarrow> f \<in> bij\<^bsup>M\<^esup>(B,C) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> M(C) \<Longrightarrow> (f O g) \<in> bij\<^bsup>M\<^esup>(A,C)"
   using bij_rel_char comp_bij by force
 
 lemma inj_rel_converse_fun: "f \<in> inj\<^bsup>M\<^esup>(A,B) \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> converse(f) \<in> range(f)\<rightarrow>\<^bsup>M\<^esup>A"
 proof -
   assume "f \<in> inj\<^bsup>M\<^esup>(A,B)" "M(A)" "M(B)"
   then
   have "M(f)" "M(converse(f))" "M(range(f))" "f\<in>inj(A,B)"
     using inj_rel_char converse_closed range_closed
     by auto
   then
   show ?thesis
     using inj_converse_inj function_space_rel_char inj_is_fun \<open>M(A)\<close> by auto
 qed
 
 lemma fg_imp_bijective_rel:
   assumes "f \<in> A \<rightarrow>\<^bsup>M\<^esup>B"  "g \<in> B\<rightarrow>\<^bsup>M\<^esup>A"  "f O g = id(B)" "g O f = id(A)" "M(A)" "M(B)"
   shows "f \<in> bij\<^bsup>M\<^esup>(A,B)"
   using assms mem_bij_abs fg_imp_bijective mem_function_space_rel_abs[THEN iffD2] function_space_rel_char
   by auto
 
 end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
 
 (*************   Discipline for cexp   ****************)
 relativize functional "cexp" "cexp_rel" external
 relationalize "cexp_rel" "is_cexp"
 
 context M_ZF_library
 begin
 
 is_iff_rel for "cexp"
   using is_cardinal_iff is_function_space_iff unfolding cexp_rel_def is_cexp_def
   by (simp)
 
 rel_closed for "cexp" unfolding cexp_rel_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
 
 synthesize "is_cexp" from_definition assuming "nonempty"
 notation is_cexp_fm (\<open>\<cdot>_\<^bsup>\<up>_\<^esup> is _\<cdot>\<close>)
 arity_theorem for "is_cexp_fm"
 
 abbreviation
   cexp_r :: "[i,i,i\<Rightarrow>o] \<Rightarrow> i"  (\<open>_\<^bsup>\<up>_,_\<^esup>\<close>) where
   "cexp_r(x,y,M) \<equiv> cexp_rel(M,x,y)"
 
 abbreviation
   cexp_r_set :: "[i,i,i] \<Rightarrow> i"  (\<open>_\<^bsup>\<up>_,_\<^esup>\<close>) where
   "cexp_r_set(x,y,M) \<equiv> cexp_rel(##M,x,y)"
 
 context M_ZF_library
 begin
 
 lemma Card_rel_cexp_rel: "M(\<kappa>) \<Longrightarrow> M(\<nu>) \<Longrightarrow> Card\<^bsup>M\<^esup>(\<kappa>\<^bsup>\<up>\<nu>,M\<^esup>)"
   unfolding cexp_rel_def by simp
 
 \<comment> \<open>Restoring congruence rule, but NOTE: beware\<close>
 declare conj_cong[cong]
 
 lemma eq_csucc_rel_ord:
   "Ord(i) \<Longrightarrow> M(i) \<Longrightarrow> (i\<^sup>+)\<^bsup>M\<^esup> = (|i|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
   using Card_rel_lt_iff Least_cong unfolding csucc_rel_def by auto
 
 lemma lesspoll_succ_rel:
   assumes "Ord(\<kappa>)" "M(\<kappa>)"
   shows "\<kappa> \<lesssim>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
   using csucc_rel_basic assms lt_Card_rel_imp_lesspoll_rel
     Card_rel_csucc_rel lepoll_rel_iff_leqpoll_rel
   by auto
 
 lemma lesspoll_rel_csucc_rel:
   assumes "Ord(\<kappa>)"
     and types:"M(\<kappa>)" "M(d)"
   shows "d \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<longleftrightarrow> d \<lesssim>\<^bsup>M\<^esup> \<kappa>"
 proof
   assume "d \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
   moreover
   note Card_rel_csucc_rel assms Card_rel_is_Ord
   moreover from calculation
   have "Card\<^bsup>M\<^esup>((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "M((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "Ord((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)"
     using Card_rel_is_Ord by simp_all
   moreover from calculation
   have "d \<prec>\<^bsup>M\<^esup> (|\<kappa>|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>" "d \<approx>\<^bsup>M\<^esup> |d|\<^bsup>M\<^esup>"
     using eq_csucc_rel_ord[OF _ \<open>M(\<kappa>)\<close>]
       lesspoll_rel_imp_eqpoll_rel eqpoll_rel_sym by simp_all
   moreover from calculation
   have "|d|\<^bsup>M\<^esup> < (|\<kappa>|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
     using lesspoll_cardinal_lt_rel by simp
   moreover from calculation
   have "|d|\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> |\<kappa>|\<^bsup>M\<^esup>"
     using Card_rel_lt_csucc_rel_iff le_imp_lepoll_rel by simp
   moreover from calculation
   have "|d|\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> \<kappa>"
     using Ord_cardinal_rel_eqpoll_rel lepoll_rel_eq_trans
     by simp
   ultimately
   show "d \<lesssim>\<^bsup>M\<^esup> \<kappa>"
     using eq_lepoll_rel_trans by simp
 next
   from \<open>Ord(\<kappa>)\<close>
   have "\<kappa> < (\<kappa>\<^sup>+)\<^bsup>M\<^esup>" "Card\<^bsup>M\<^esup>((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)" "M((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)"
     using Card_rel_csucc_rel lt_csucc_rel_iff types eq_csucc_rel_ord[OF _ \<open>M(\<kappa>)\<close>]
     by simp_all
   then
   have "\<kappa> \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
     using lt_Card_rel_imp_lesspoll_rel[OF _ \<open>\<kappa> <_\<close>] types by simp
   moreover
   assume "d \<lesssim>\<^bsup>M\<^esup> \<kappa>"
   ultimately
   have "d \<lesssim>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
     using Card_rel_csucc_rel types lesspoll_succ_rel lepoll_rel_trans \<open>Ord(\<kappa>)\<close>
     by simp
   moreover
   from \<open>d \<lesssim>\<^bsup>M\<^esup> \<kappa>\<close> \<open>Ord(\<kappa>)\<close>
   have "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<lesssim>\<^bsup>M\<^esup> \<kappa>" if "d \<approx>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
     using eqpoll_rel_sym[OF that] types eq_lepoll_rel_trans[OF _ \<open>d\<lesssim>\<^bsup>M\<^esup>\<kappa>\<close>]
     by simp
   moreover from calculation \<open>\<kappa> \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>\<close>
   have False if "d \<approx>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
     using lesspoll_rel_irrefl[OF _ \<open>M((\<kappa>\<^sup>+)\<^bsup>M\<^esup>)\<close>] lesspoll_rel_trans1 types that
     by auto
   ultimately
   show "d \<prec>\<^bsup>M\<^esup> (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
     unfolding lesspoll_rel_def by auto
 qed
 
 lemma Infinite_imp_nats_lepoll:
   assumes "Infinite(X)" "n \<in> \<omega>"
   shows "n \<lesssim> X"
   using \<open>n \<in> \<omega>\<close>
 proof (induct)
   case 0
   then
   show ?case using empty_lepollI by simp
 next
   case (succ x)
   show ?case
   proof -
     from \<open>Infinite(X)\<close> and \<open>x \<in> \<omega>\<close>
     have "\<not> (x \<approx> X)"
       using eqpoll_sym unfolding Finite_def by auto
     with \<open>x \<lesssim> X\<close>
     obtain f where "f \<in> inj(x,X)" "f \<notin> surj(x,X)"
       unfolding bij_def eqpoll_def by auto
     moreover from this
     obtain b where "b \<in> X" "\<forall>a\<in>x. f`a \<noteq> b"
       using inj_is_fun unfolding surj_def by auto
     ultimately
     have "f \<in> inj(x,X-{b})"
       unfolding inj_def by (auto intro:Pi_type)
     then
     have "cons(\<langle>x, b\<rangle>, f) \<in> inj(succ(x), cons(b, X - {b}))"
       using inj_extend[of f x "X-{b}" x b] unfolding succ_def
       by (auto dest:mem_irrefl)
     moreover from \<open>b\<in>X\<close>
     have "cons(b, X - {b}) = X" by auto
     ultimately
     show "succ(x) \<lesssim> X" by auto
   qed
 qed
 
 lemma nepoll_imp_nepoll_rel :
   assumes "\<not> x \<approx> X" "M(x)" "M(X)"
   shows "\<not> (x \<approx>\<^bsup>M\<^esup> X)"
   using assms unfolding eqpoll_def eqpoll_rel_def by simp
 
 lemma Infinite_imp_nats_lepoll_rel:
   assumes "Infinite(X)" "n \<in> \<omega>"
     and types: "M(X)"
   shows "n \<lesssim>\<^bsup>M\<^esup> X"
   using \<open>n \<in> \<omega>\<close>
 proof (induct)
   case 0
   then
   show ?case using empty_lepoll_relI types by simp
 next
   case (succ x)
   show ?case
   proof -
     from \<open>Infinite(X)\<close> and \<open>x \<in> \<omega>\<close>
     have "\<not> (x \<approx> X)" "M(x)" "M(succ(x))"
       using eqpoll_sym unfolding Finite_def by auto
     then
     have "\<not> (x \<approx>\<^bsup>M\<^esup> X)"
       using nepoll_imp_nepoll_rel types by simp
     with \<open>x \<lesssim>\<^bsup>M\<^esup> X\<close>
     obtain f where "f \<in> inj\<^bsup>M\<^esup>(x,X)" "f \<notin> surj\<^bsup>M\<^esup>(x,X)" "M(f)"
       unfolding bij_rel_def eqpoll_rel_def by auto
     with \<open>M(X)\<close> \<open>M(x)\<close>
     have "f\<notin>surj(x,X)" "f\<in>inj(x,X)"
       using surj_rel_char by simp_all
     moreover
     from this
     obtain b where "b \<in> X" "\<forall>a\<in>x. f`a \<noteq> b"
       using inj_is_fun unfolding surj_def by auto
     moreover
     from this calculation \<open>M(x)\<close>
     have "f \<in> inj(x,X-{b})" "M(<x,b>)"
       unfolding inj_def using transM[OF _ \<open>M(X)\<close>]
       by (auto intro:Pi_type)
     moreover
     from this
     have "cons(\<langle>x, b\<rangle>, f) \<in> inj(succ(x), cons(b, X - {b}))" (is "?g\<in>_")
       using inj_extend[of f x "X-{b}" x b] unfolding succ_def
       by (auto dest:mem_irrefl)
     moreover
     note \<open>M(<x,b>)\<close> \<open>M(f)\<close> \<open>b\<in>X\<close> \<open>M(X)\<close> \<open>M(succ(x))\<close>
     moreover from this
     have "M(?g)" "cons(b, X - {b}) = X" by auto
     moreover from calculation
     have "?g\<in>inj_rel(M,succ(x),X)"
       using mem_inj_abs by simp
     with \<open>M(?g)\<close>
     show "succ(x) \<lesssim>\<^bsup>M\<^esup> X" using lepoll_relI by simp
   qed
 qed
 
 lemma lepoll_rel_imp_lepoll: "A \<lesssim>\<^bsup>M\<^esup> B \<Longrightarrow> M(A) \<Longrightarrow> M(B) \<Longrightarrow> A \<lesssim> B"
   unfolding lepoll_rel_def by auto
 
 lemma zero_lesspoll_rel: assumes "0<\<kappa>" "M(\<kappa>)" shows "0 \<prec>\<^bsup>M\<^esup> \<kappa>"
   using assms eqpoll_rel_0_iff[THEN iffD1, of \<kappa>] eqpoll_rel_sym
   unfolding lesspoll_rel_def lepoll_rel_def
   by (auto simp add:inj_def)
 
 lemma lepoll_rel_nat_imp_Infinite: "\<omega> \<lesssim>\<^bsup>M\<^esup> X \<Longrightarrow> M(X) \<Longrightarrow> Infinite(X)"
   using  lepoll_nat_imp_Infinite lepoll_rel_imp_lepoll by simp
 
 lemma InfCard_rel_imp_Infinite: "InfCard\<^bsup>M\<^esup>(\<kappa>) \<Longrightarrow> M(\<kappa>) \<Longrightarrow> Infinite(\<kappa>)"
   using le_imp_lepoll_rel[THEN lepoll_rel_nat_imp_Infinite, of \<kappa>]
   unfolding InfCard_rel_def by simp
 
 lemma lt_surj_rel_empty_imp_Card_rel:
   assumes "Ord(\<kappa>)" "\<And>\<alpha>. \<alpha> < \<kappa> \<Longrightarrow> surj\<^bsup>M\<^esup>(\<alpha>,\<kappa>) = 0"
     and types:"M(\<kappa>)"
   shows "Card\<^bsup>M\<^esup>(\<kappa>)"
 proof -
   {
     define min where "min\<equiv>\<mu> x. \<exists>f[M]. f \<in> bij\<^bsup>M\<^esup>(x,\<kappa>)"
     moreover
     note \<open>Ord(\<kappa>)\<close> \<open>M(\<kappa>)\<close>
     moreover
     assume "|\<kappa>|\<^bsup>M\<^esup> < \<kappa>"
     moreover from calculation
     have "\<exists>f. f \<in> bij\<^bsup>M\<^esup>(min,\<kappa>)"
       using LeastI[of "\<lambda>i. i \<approx>\<^bsup>M\<^esup> \<kappa>" \<kappa>, OF eqpoll_rel_refl]
       unfolding Card_rel_def cardinal_rel_def eqpoll_rel_def
       by (auto)
     moreover from calculation
     have "min < \<kappa>"
       using lt_trans1[of min "\<mu> i. M(i) \<and> (\<exists>f[M]. f \<in> bij\<^bsup>M\<^esup>(i, \<kappa>))" \<kappa>]
         Least_le[of "\<lambda>i. i \<approx>\<^bsup>M\<^esup> \<kappa>" "|\<kappa>|\<^bsup>M\<^esup>", OF Ord_cardinal_rel_eqpoll_rel]
       unfolding Card_rel_def cardinal_rel_def eqpoll_rel_def
       by (simp)
     moreover
     note \<open>min < \<kappa> \<Longrightarrow> surj\<^bsup>M\<^esup>(min,\<kappa>) = 0\<close>
     ultimately
     have "False"
       unfolding bij_rel_def by simp
   }
   with assms
   show ?thesis
     using Ord_cardinal_rel_le[of \<kappa>] not_lt_imp_le[of "|\<kappa>|\<^bsup>M\<^esup>" \<kappa>] le_anti_sym
     unfolding Card_rel_def by auto
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
 
 relativize functional "mono_map" "mono_map_rel" external
 relationalize "mono_map_rel" "is_mono_map"
 synthesize "is_mono_map" from_definition assuming "nonempty"
 
 notation mono_map_rel (\<open>mono'_map\<^bsup>_\<^esup>'(_,_,_,_')\<close>)
 
 abbreviation
   mono_map_r_set  :: "[i,i,i,i,i]\<Rightarrow>i"  (\<open>mono'_map\<^bsup>_\<^esup>'(_,_,_,_')\<close>) where
   "mono_map\<^bsup>M\<^esup>(a,r,b,s) \<equiv> mono_map_rel(##M,a,r,b,s)"
 
 context M_ZF_library
 begin
 
 lemma mono_map_rel_char:
   assumes "M(a)" "M(b)"
   shows "mono_map\<^bsup>M\<^esup>(a,r,b,s) = {f\<in>mono_map(a,r,b,s) . M(f)}"
   using assms function_space_rel_char unfolding mono_map_rel_def mono_map_def
   by auto
 
 text\<open>Just a sample of porting results on \<^term>\<open>mono_map\<close>\<close>
 lemma mono_map_rel_mono:
   assumes
     "f \<in> mono_map\<^bsup>M\<^esup>(A,r,B,s)" "B \<subseteq> C"
     and types:"M(A)" "M(B)" "M(C)"
   shows
     "f \<in> mono_map\<^bsup>M\<^esup>(A,r,C,s)"
   using assms mono_map_mono mono_map_rel_char by auto
 
 lemma nats_le_InfCard_rel:
   assumes "n \<in> \<omega>" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
   shows "n \<le> \<kappa>"
   using assms Ord_is_Transset
     le_trans[of n \<omega> \<kappa>, OF le_subset_iff[THEN iffD2]]
   unfolding InfCard_rel_def Transset_def by simp
 
 lemma nat_into_InfCard_rel:
   assumes "n \<in> \<omega>" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
   shows "n \<in> \<kappa>"
   using assms  le_imp_subset[of \<omega> \<kappa>]
   unfolding InfCard_rel_def by auto
 
 lemma Finite_lesspoll_rel_nat:
   assumes "Finite(x)" "M(x)"
   shows "x \<prec>\<^bsup>M\<^esup> nat"
 proof -
   note assms
   moreover from this
   obtain n where "n \<in> \<omega>" "M(n)" "x \<approx> n"
     unfolding Finite_def by auto
   moreover from calculation
   obtain f where "f \<in> bij(x,n)" "f: x-||>n"
     using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun
     unfolding eqpoll_def by auto
   ultimately
   have "x\<approx>\<^bsup>M\<^esup> n" unfolding eqpoll_rel_def by (auto dest:transM)
   with assms and \<open>M(n)\<close>
   have "n \<approx>\<^bsup>M\<^esup> x" using eqpoll_rel_sym by simp
   moreover
   note \<open>n\<in>\<omega>\<close> \<open>M(n)\<close>
   ultimately
   show ?thesis
     using assms eq_lesspoll_rel_trans[OF \<open>x\<approx>\<^bsup>M\<^esup> n\<close> n_lesspoll_rel_nat]
     by simp
 qed
 
 lemma Finite_cardinal_rel_in_nat [simp]:
   assumes "Finite(A)" "M(A)" shows "|A|\<^bsup>M\<^esup> \<in> \<omega>"
 proof -
   note assms
   moreover from this
   obtain n where "n \<in> \<omega>" "M(n)" "A \<approx> n"
     unfolding Finite_def by auto
   moreover from calculation
   obtain f where "f \<in> bij(A,n)" "f: A-||>n"
     using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun
     unfolding eqpoll_def by auto
   ultimately
   have "A \<approx>\<^bsup>M\<^esup> n" unfolding eqpoll_rel_def by (auto dest:transM)
   with assms and \<open>M(n)\<close>
   have "n \<approx>\<^bsup>M\<^esup> A" using eqpoll_rel_sym by simp
   moreover
   note \<open>n\<in>\<omega>\<close> \<open>M(n)\<close>
   ultimately
   show ?thesis
     using assms Least_le[of "\<lambda>i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A" n]
       lt_trans1[of _ n \<omega>, THEN ltD]
     unfolding cardinal_rel_def Finite_def
     by (auto dest!:naturals_lt_nat)
 qed
 
 lemma Finite_cardinal_rel_eq_cardinal:
   assumes "Finite(A)" "M(A)" shows "|A|\<^bsup>M\<^esup> = |A|"
 proof -
   \<comment> \<open>Copy-paste from @{thm Finite_cardinal_rel_in_nat}\<close>
   note assms
   moreover from this
   obtain n where "n \<in> \<omega>" "M(n)" "A \<approx> n"
     unfolding Finite_def by auto
   moreover from this
   have "|A| = n"
     using cardinal_cong[of A n]
       nat_into_Card[THEN Card_cardinal_eq, of n] by simp
   moreover from calculation
   obtain f where "f \<in> bij(A,n)" "f: A-||>n"
     using Finite_Fin[THEN fun_FiniteFunI, OF _ subset_refl] bij_is_fun
     unfolding eqpoll_def by auto
   ultimately
   have "A \<approx>\<^bsup>M\<^esup> n" unfolding eqpoll_rel_def by (auto dest:transM)
   with assms and \<open>M(n)\<close> \<open>n\<in>\<omega>\<close>
   have "|A|\<^bsup>M\<^esup> = n"
     using cardinal_rel_cong[of A n]
       nat_into_Card_rel[THEN Card_rel_cardinal_rel_eq, of n]
     by simp
   with \<open>|A| = n\<close>
   show ?thesis by simp
 qed
 
 lemma Finite_imp_cardinal_rel_cons:
   assumes FA: "Finite(A)" and a: "a\<notin>A" and types:"M(A)" "M(a)"
   shows "|cons(a,A)|\<^bsup>M\<^esup> = succ(|A|\<^bsup>M\<^esup>)"
   using assms Finite_imp_cardinal_cons Finite_cardinal_rel_eq_cardinal by simp
 
 lemma Finite_imp_succ_cardinal_rel_Diff:
   assumes "Finite(A)" "a \<in> A" "M(A)"
   shows "succ(|A-{a}|\<^bsup>M\<^esup>) = |A|\<^bsup>M\<^esup>"
 proof -
   from assms
   have inM: "M(A-{a})" "M(a)" "M(A)" by (auto dest:transM)
   with \<open>Finite(A)\<close>
   have "succ(|A-{a}|\<^bsup>M\<^esup>) = succ(|A-{a}|)"
     using Diff_subset[THEN subset_Finite,
         THEN Finite_cardinal_rel_eq_cardinal, of A "{a}"] by simp
   also from assms
   have "\<dots> = |A|"
     using Finite_imp_succ_cardinal_Diff by simp
   also from assms
   have "\<dots> = |A|\<^bsup>M\<^esup>" using Finite_cardinal_rel_eq_cardinal by simp
   finally
   show ?thesis .
 qed
 
 lemma InfCard_rel_Aleph_rel:
   notes Aleph_rel_zero[simp]
   assumes "Ord(\<alpha>)"
     and types: "M(\<alpha>)"
   shows "InfCard\<^bsup>M\<^esup>(\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>)"
 proof -
   have "\<not> (\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> \<in> \<omega>)"
   proof (cases "\<alpha>=0")
     case True
     then show ?thesis using mem_irrefl by auto
   next
     case False
     with assms
     have "\<omega> \<in> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>" using Ord_0_lt[of \<alpha>] ltD by (auto dest:Aleph_rel_increasing)
     then show ?thesis using foundation by blast
   qed
   with assms
   have "\<not> (|\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>|\<^bsup>M\<^esup> \<in> \<omega>)"
     using Card_rel_cardinal_rel_eq by auto
   with assms
   have "Infinite(\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>)" using Ord_Aleph_rel by clarsimp
   with assms
   show ?thesis
     using Inf_Card_rel_is_InfCard_rel by simp
 qed
 
 lemmas Limit_Aleph_rel = InfCard_rel_Aleph_rel[THEN InfCard_rel_is_Limit]
 
 bundle Ord_dests = Limit_is_Ord[dest] Card_rel_is_Ord[dest]
 bundle Aleph_rel_dests = Aleph_rel_cont[dest]
 bundle Aleph_rel_intros = Aleph_rel_increasing[intro!]
 bundle Aleph_rel_mem_dests = Aleph_rel_increasing[OF ltI, THEN ltD, dest]
 
 lemma f_imp_injective_rel:
   assumes "f \<in> A \<rightarrow>\<^bsup>M\<^esup> B" "\<forall>x\<in>A. d(f ` x) = x" "M(A)" "M(B)"
   shows "f \<in> inj\<^bsup>M\<^esup>(A, B)"
   using assms
   apply (simp (no_asm_simp) add: def_inj_rel)
   apply (auto intro: subst_context [THEN box_equals])
   done
 
 lemma lam_injective_rel:
   assumes "\<And>x. x \<in> A \<Longrightarrow> c(x) \<in> B"
     "\<And>x. x \<in> A \<Longrightarrow> d(c(x)) = x"
     "\<forall>x[M]. M(c(x))" "lam_replacement(M,c)"
     "M(A)" "M(B)"
   shows "(\<lambda>x\<in>A. c(x)) \<in> inj\<^bsup>M\<^esup>(A, B)"
   using assms function_space_rel_char lam_replacement_iff_lam_closed
   by (rule_tac d = d in f_imp_injective_rel)
     (auto simp add: lam_type)
 
 lemma f_imp_surjective_rel:
   assumes "f \<in> A \<rightarrow>\<^bsup>M\<^esup> B" "\<And>y. y \<in> B \<Longrightarrow> d(y) \<in> A" "\<And>y. y \<in> B \<Longrightarrow> f ` d(y) = y"
     "M(A)" "M(B)"
   shows "f \<in> surj\<^bsup>M\<^esup>(A, B)"
   using assms
   by (simp add: def_surj_rel, blast)
 
 lemma lam_surjective_rel:
   assumes "\<And>x. x \<in> A \<Longrightarrow> c(x) \<in> B"
     "\<And>y. y \<in> B \<Longrightarrow> d(y) \<in> A"
     "\<And>y. y \<in> B \<Longrightarrow> c(d(y)) = y"
     "\<forall>x[M]. M(c(x))" "lam_replacement(M,c)"
     "M(A)" "M(B)"
   shows "(\<lambda>x\<in>A. c(x)) \<in> surj\<^bsup>M\<^esup>(A, B)"
   using assms function_space_rel_char lam_replacement_iff_lam_closed
   by (rule_tac d = d in f_imp_surjective_rel)
     (auto simp add: lam_type)
 
 lemma lam_bijective_rel:
   assumes "\<And>x. x \<in> A \<Longrightarrow> c(x) \<in> B"
     "\<And>y. y \<in> B \<Longrightarrow> d(y) \<in> A"
     "\<And>x. x \<in> A \<Longrightarrow> d(c(x)) = x"
     "\<And>y. y \<in> B \<Longrightarrow> c(d(y)) = y"
     "\<forall>x[M]. M(c(x))" "lam_replacement(M,c)"
     "M(A)" "M(B)"
   shows "(\<lambda>x\<in>A. c(x)) \<in> bij\<^bsup>M\<^esup>(A, B)"
   using assms
   apply (unfold bij_rel_def)
   apply (blast intro!: lam_injective_rel lam_surjective_rel)
   done
 
 lemma function_space_rel_eqpoll_rel_cong:
   assumes
     "A \<approx>\<^bsup>M\<^esup> A'" "B \<approx>\<^bsup>M\<^esup> B'" "M(A)" "M(A')" "M(B)" "M(B')"
   shows
     "A \<rightarrow>\<^bsup>M\<^esup> B \<approx>\<^bsup>M\<^esup> A' \<rightarrow>\<^bsup>M\<^esup> B'"
 proof -
   from assms(1)[THEN eqpoll_rel_sym] assms(2) assms lam_type
   obtain f g where "f \<in> bij\<^bsup>M\<^esup>(A',A)" "g \<in> bij\<^bsup>M\<^esup>(B,B')"
     by blast
   with assms
   have "converse(g) : bij\<^bsup>M\<^esup>(B', B)" "converse(f): bij\<^bsup>M\<^esup>(A, A')"
     using bij_converse_bij by auto
   let ?H="\<lambda> h \<in> A \<rightarrow>\<^bsup>M\<^esup> B . g O h O f"
   let ?I="\<lambda> h \<in> A' \<rightarrow>\<^bsup>M\<^esup> B' . converse(g) O h O converse(f)"
   have go:"g O F O f : A' \<rightarrow>\<^bsup>M\<^esup> B'" if "F: A \<rightarrow>\<^bsup>M\<^esup> B" for F
   proof -
     note assms \<open>f\<in>_\<close> \<open>g\<in>_\<close> that
     moreover from this
     have "g O F O f : A' \<rightarrow> B'"
       using bij_rel_is_fun[OF \<open>g\<in>_\<close>] bij_rel_is_fun[OF \<open>f\<in>_\<close>] comp_fun
         mem_function_space_rel[OF \<open>F\<in>_\<close>]
       by blast
     ultimately
     show "g O F O f : A' \<rightarrow>\<^bsup>M\<^esup> B'"
       using comp_closed function_space_rel_char bij_rel_char
       by auto
   qed
   have og:"converse(g) O F O converse(f) : A \<rightarrow>\<^bsup>M\<^esup> B" if "F: A' \<rightarrow>\<^bsup>M\<^esup> B'" for F
   proof -
     note assms that \<open>converse(f) \<in> _\<close> \<open>converse(g) \<in> _\<close>
     moreover from this
     have "converse(g) O F O converse(f) : A \<rightarrow> B"
       using bij_rel_is_fun[OF \<open>converse(g)\<in>_\<close>] bij_rel_is_fun[OF \<open>converse(f)\<in>_\<close>] comp_fun
         mem_function_space_rel[OF \<open>F\<in>_\<close>]
       by blast
     ultimately
     show "converse(g) O F O converse(f) : A \<rightarrow>\<^bsup>M\<^esup> B" (is "?G\<in>_")
       using comp_closed function_space_rel_char bij_rel_char
       by auto
   qed
   with go
   have tc:"?H \<in> (A \<rightarrow>\<^bsup>M\<^esup> B) \<rightarrow> (A'\<rightarrow>\<^bsup>M\<^esup> B')" "?I \<in> (A' \<rightarrow>\<^bsup>M\<^esup> B') \<rightarrow> (A\<rightarrow>\<^bsup>M\<^esup> B)"
     using lam_type by auto
   with assms \<open>f\<in>_\<close> \<open>g\<in>_\<close>
   have "M(g O x O f)" and "M(converse(g) O x O converse(f))" if "M(x)" for x
     using bij_rel_char comp_closed that by auto
   with assms \<open>f\<in>_\<close> \<open>g\<in>_\<close>
   have "M(?H)" "M(?I)"
     using lam_replacement_iff_lam_closed[THEN iffD1,OF _ lam_replacement_comp']
       bij_rel_char by auto
   show ?thesis
     unfolding eqpoll_rel_def
   proof (intro rexI[of _ ?H] fg_imp_bijective_rel)
     from og go
     have "(\<And>x. x \<in> A' \<rightarrow>\<^bsup>M\<^esup> B' \<Longrightarrow> converse(g) O x O converse(f) \<in> A \<rightarrow>\<^bsup>M\<^esup> B)"
       by simp
   next
     show "M(A \<rightarrow>\<^bsup>M\<^esup> B)" using assms by simp
   next
     show "M(A' \<rightarrow>\<^bsup>M\<^esup> B')" using assms by simp
   next
     from og assms
     have "?H O ?I = (\<lambda>x\<in>A' \<rightarrow>\<^bsup>M\<^esup> B' . (g O converse(g)) O x O (converse(f) O f))"
       using lam_cong[OF refl[of "A' \<rightarrow>\<^bsup>M\<^esup> B'"]] comp_assoc comp_lam
       by auto
     also
     have "... = (\<lambda>x\<in>A' \<rightarrow>\<^bsup>M\<^esup> B' . id(B') O x O (id(A')))"
       using left_comp_inverse[OF mem_inj_rel[OF bij_rel_is_inj_rel]] \<open>f\<in>_\<close>
         right_comp_inverse[OF bij_is_surj[OF mem_bij_rel]] \<open>g\<in>_\<close> assms
       by auto
     also
     have "... = (\<lambda>x\<in>A' \<rightarrow>\<^bsup>M\<^esup> B' . x)"
       using left_comp_id[OF fun_is_rel[OF mem_function_space_rel]]
         right_comp_id[OF fun_is_rel[OF mem_function_space_rel]] assms
       by auto
     also
     have "... = id(A'\<rightarrow>\<^bsup>M\<^esup>B')" unfolding id_def by simp
     finally
     show "?H O ?I = id(A' \<rightarrow>\<^bsup>M\<^esup> B')" .
   next
     from go assms
     have "?I O ?H = (\<lambda>x\<in>A \<rightarrow>\<^bsup>M\<^esup> B . (converse(g) O g) O x O (f O converse(f)))"
       using lam_cong[OF refl[of "A \<rightarrow>\<^bsup>M\<^esup> B"]] comp_assoc comp_lam by auto
     also
     have "... = (\<lambda>x\<in>A \<rightarrow>\<^bsup>M\<^esup> B . id(B) O x O (id(A)))"
       using
         left_comp_inverse[OF mem_inj_rel[OF bij_rel_is_inj_rel[OF \<open>g\<in>_\<close>]]]
         right_comp_inverse[OF bij_is_surj[OF mem_bij_rel[OF \<open>f\<in>_\<close>]]] assms
       by auto
     also
     have "... = (\<lambda>x\<in>A \<rightarrow>\<^bsup>M\<^esup> B . x)"
       using left_comp_id[OF fun_is_rel[OF mem_function_space_rel]]
         right_comp_id[OF fun_is_rel[OF mem_function_space_rel]]
         assms
       by auto
     also
     have "... = id(A\<rightarrow>\<^bsup>M\<^esup>B)" unfolding id_def by simp
     finally
     show "?I O ?H = id(A \<rightarrow>\<^bsup>M\<^esup> B)" .
   next
     from assms tc \<open>M(?H)\<close> \<open>M(?I)\<close>
     show "?H \<in> (A\<rightarrow>\<^bsup>M\<^esup> B) \<rightarrow>\<^bsup>M\<^esup> (A'\<rightarrow>\<^bsup>M\<^esup> B')" "M(?H)"
       "?I \<in> (A'\<rightarrow>\<^bsup>M\<^esup> B') \<rightarrow>\<^bsup>M\<^esup> (A\<rightarrow>\<^bsup>M\<^esup> B)"
       using mem_function_space_rel_abs by auto
   qed
 qed
 
 lemma curry_eqpoll_rel:
   fixes \<nu>1 \<nu>2  \<kappa>
   assumes  "M(\<nu>1)" "M(\<nu>2)" "M(\<kappa>)"
   shows "\<nu>1 \<rightarrow>\<^bsup>M\<^esup> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>) \<approx>\<^bsup>M\<^esup> \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>"
   unfolding eqpoll_rel_def
 proof (intro rexI, rule lam_bijective_rel,
     rule_tac [1-2] mem_function_space_rel_abs[THEN iffD2],
     rule_tac [4] lam_type, rule_tac [8] lam_type,
     rule_tac [8] mem_function_space_rel_abs[THEN iffD2],
     rule_tac [11] lam_type, simp_all add:assms)
   let ?cur="\<lambda>x. \<lambda>w\<in>\<nu>1 \<times> \<nu>2. x ` fst(w) ` snd(w)"
   fix f z
   assume "f : \<nu>1 \<rightarrow>\<^bsup>M\<^esup> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>)"
   moreover
   note assms
   moreover from calculation
   have "M(\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>)"
     using function_space_rel_closed by simp
   moreover from calculation
   have "M(f)" "f : \<nu>1 \<rightarrow> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>)"
     using function_space_rel_char by (auto dest:transM)
   moreover from calculation
   have "x \<in> \<nu>1 \<Longrightarrow> f`x : \<nu>2 \<rightarrow> \<kappa>" for x
     by (auto dest:transM intro!:mem_function_space_rel_abs[THEN iffD1])
   moreover from this
   show "(\<lambda>a\<in>\<nu>1. \<lambda>b\<in>\<nu>2. ?cur(f) ` \<langle>a, b\<rangle>) = f"
     using Pi_type[OF \<open>f \<in> \<nu>1 \<rightarrow> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>\<close>, of "\<lambda>_.\<nu>2 \<rightarrow> \<kappa>"] by simp
   moreover
   assume "z \<in> \<nu>1 \<times> \<nu>2"
   moreover from calculation
   have "f`fst(z): \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>" by simp
   ultimately
   show "f`fst(z)`snd(z) \<in> \<kappa>"
     using mem_function_space_rel_abs by (auto dest:transM)
 next \<comment> \<open>one composition is the identity:\<close>
   let ?cur="\<lambda>x. \<lambda>w\<in>\<nu>1 \<times> \<nu>2. x ` fst(w) ` snd(w)"
   fix f
   assume "f : \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>"
   with assms
   show "?cur(\<lambda>x\<in>\<nu>1. \<lambda>xa\<in>\<nu>2. f ` \<langle>x, xa\<rangle>) = f"
     using function_space_rel_char mem_function_space_rel_abs
     by (auto dest:transM intro:fun_extension)
   fix x y
   assume "x\<in>\<nu>1" "y\<in>\<nu>2"
   with assms \<open>f : \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>\<close>
   show "f`\<langle>x,y\<rangle> \<in> \<kappa>"
     using function_space_rel_char mem_function_space_rel_abs
     by (auto dest:transM[of _ "\<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>"])
 next
   let ?cur="\<lambda>x. \<lambda>w\<in>\<nu>1 \<times> \<nu>2. x ` fst(w) ` snd(w)"
   note assms
   moreover from this
   show "\<forall>x[M]. M(?cur(x))"
     using  lam_replacement_fst lam_replacement_snd
       lam_replacement_apply2[THEN [5] lam_replacement_hcomp2,
         THEN [1] lam_replacement_hcomp2, where h="(`)", OF
         lam_replacement_constant] lam_replacement_apply2
     by (auto intro: lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
   moreover from calculation
   show "x \<in> \<nu>1 \<rightarrow>\<^bsup>M\<^esup> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>) \<Longrightarrow> M(?cur(x))" for x
     by (auto dest:transM)
   moreover from assms
   show "lam_replacement(M, ?cur)"
     using lam_replacement_Lambda_apply_fst_snd by simp
   ultimately
   show "M(\<lambda>x\<in>\<nu>1 \<rightarrow>\<^bsup>M\<^esup> (\<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa>). ?cur(x))"
     using lam_replacement_iff_lam_closed
     by (auto dest:transM)
   from assms
   show "y \<in> \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa> \<Longrightarrow> x \<in> \<nu>1 \<Longrightarrow> M(\<lambda>xa\<in>\<nu>2. y ` \<langle>x, xa\<rangle>)" for x y
     using lam_replacement_apply_const_id
     by (rule_tac lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
       (auto dest:transM)
   from assms
   show "y \<in> \<nu>1 \<times> \<nu>2 \<rightarrow>\<^bsup>M\<^esup> \<kappa> \<Longrightarrow> M(\<lambda>x\<in>\<nu>1. \<lambda>xa\<in>\<nu>2. y ` \<langle>x, xa\<rangle>)" for y
     using lam_replacement_apply2[THEN [5] lam_replacement_hcomp2,
         OF lam_replacement_constant lam_replacement_const_id]
       lam_replacement_Lambda_apply_Pair[of \<nu>2]
     by (auto dest:transM
         intro!: lam_replacement_iff_lam_closed[THEN iffD1, rule_format])
 qed
 
 lemma Pow_rel_eqpoll_rel_function_space_rel:
   fixes d X
   notes bool_of_o_def [simp]
   defines [simp]:"d(A) \<equiv> (\<lambda>x\<in>X. bool_of_o(x\<in>A))"
     \<comment> \<open>the witnessing map for the thesis:\<close>
   assumes "M(X)"
   shows "Pow\<^bsup>M\<^esup>(X) \<approx>\<^bsup>M\<^esup> X \<rightarrow>\<^bsup>M\<^esup> 2"
 proof -
   from assms
   interpret M_Pi_assumptions M X "\<lambda>_. 2"
     using Pi_replacement Pi_separation lam_replacement_identity
       lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement]
       Pi_replacement1[of _ 2] transM[of _ X] lam_replacement_constant
     by unfold_locales auto
   have "lam_replacement(M, \<lambda>x. bool_of_o(x\<in>A))" if "M(A)" for A
     using that lam_replacement_if lam_replacement_constant
       separation_in_constant by simp
   with assms
   have "lam_replacement(M, \<lambda>x. d(x))"
     using separation_in_constant[THEN [3] lam_replacement_if, of "\<lambda>_.1" "\<lambda>_.0"]
       lam_replacement_identity lam_replacement_constant lam_replacement_Lambda_if_mem
     by simp
   show ?thesis
     unfolding eqpoll_rel_def
   proof (intro rexI, rule lam_bijective_rel)
     \<comment> \<open>We give explicit mutual inverses\<close>
     fix A
     assume "A\<in>Pow\<^bsup>M\<^esup>(X)"
     moreover
     note \<open>M(X)\<close>
     moreover from calculation
     have "M(A)" by (auto dest:transM)
     moreover
     note \<open>_ \<Longrightarrow> lam_replacement(M, \<lambda>x. bool_of_o(x\<in>A))\<close>
     ultimately
     show "d(A) : X \<rightarrow>\<^bsup>M\<^esup> 2"
       using function_space_rel_char lam_replacement_iff_lam_closed[THEN iffD1]
       by (simp, rule_tac lam_type[of X "\<lambda>x. bool_of_o(x\<in>A)" "\<lambda>_. 2", simplified])
         auto
     from \<open>A\<in>Pow\<^bsup>M\<^esup>(X)\<close> \<open>M(X)\<close>
     show "{y\<in>X. d(A)`y = 1} = A"
       using Pow_rel_char by auto
   next
     fix f
     assume "f: X\<rightarrow>\<^bsup>M\<^esup> 2"
     with assms
     have "f: X\<rightarrow> 2" "M(f)" using function_space_rel_char by simp_all
     then
     show "d({y \<in> X . f ` y = 1}) = f"
       using apply_type[OF \<open>f: X\<rightarrow>2\<close>] by (force intro:fun_extension)
     from \<open>M(X)\<close> \<open>M(f)\<close>
     show "{ya \<in> X . f ` ya = 1} \<in> Pow\<^bsup>M\<^esup>(X)"
       using Pow_rel_char separation_equal_apply by auto
   next
     from assms \<open>lam_replacement(M, \<lambda>x. d(x))\<close>
       \<open>\<And>A. _ \<Longrightarrow> lam_replacement(M, \<lambda>x. bool_of_o(x\<in>A))\<close>
     show "M(\<lambda>x\<in>Pow\<^bsup>M\<^esup>(X). d(x))" "lam_replacement(M, \<lambda>x. d(x))"
       "\<forall>x[M]. M(d(x))"
       using lam_replacement_iff_lam_closed[THEN iffD1] by auto
   qed (auto simp:\<open>M(X)\<close>)
 qed
 
 lemma Pow_rel_bottom: "M(B) \<Longrightarrow> 0 \<in> Pow\<^bsup>M\<^esup>(B)"
   using Pow_rel_char by simp
 
 lemma cantor_surj_rel:
   assumes "M(f)" "M(A)"
   shows "f \<notin> surj\<^bsup>M\<^esup>(A,Pow\<^bsup>M\<^esup>(A))"
 proof
   assume "f \<in> surj\<^bsup>M\<^esup>(A,Pow\<^bsup>M\<^esup>(A))"
   with assms
   have "f \<in> surj(A,Pow\<^bsup>M\<^esup>(A))" using surj_rel_char by simp
   moreover
   note assms
   moreover from this
   have "M({x \<in> A . x \<in> f ` x})" "{x \<in> A . x \<notin> f ` x} = A - {x \<in> A . x \<in> f ` x}"
     using lam_replacement_apply[THEN [4] separation_in, of  "\<lambda>x. x"]
       lam_replacement_identity lam_replacement_constant by auto
   with \<open>M(A)\<close>
   have "{x\<in>A . x \<notin> f`x} \<in> Pow\<^bsup>M\<^esup>(A)"
     by (intro mem_Pow_rel_abs[THEN iffD2]) auto
   ultimately
   obtain d where "d\<in>A" "f`d = {x\<in>A . x \<notin> f`x}"
     unfolding surj_def by blast
   show False
   proof (cases "d \<in> f`d")
     case True
     note \<open>d \<in> f`d\<close>
     also
     note \<open>f`d = {x\<in>A . x \<notin> f`x}\<close>
     finally
     have "d \<notin> f`d" using \<open>d\<in>A\<close> by simp
     then
     show False using \<open>d \<in> f ` d\<close> by simp
   next
     case False
     with \<open>d\<in>A\<close>
     have "d \<in> {x\<in>A . x \<notin> f`x}" by simp
     also from \<open>f`d = \<dots>\<close>
     have "\<dots> = f`d" by simp
     finally
     show False using \<open>d \<notin> f`d\<close> by simp
   qed
 qed
 
 lemma cantor_inj_rel: "M(f) \<Longrightarrow> M(A) \<Longrightarrow> f \<notin> inj\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(A),A)"
   using inj_rel_imp_surj_rel[OF _ Pow_rel_bottom, of f A A]
     cantor_surj_rel[of "\<lambda>x\<in>A. if x \<in> range(f) then converse(f) ` x else 0" A]
     lam_replacement_if separation_in_constant[of "range(f)"]
     lam_replacement_converse_app[THEN [5] lam_replacement_hcomp2]
     lam_replacement_identity lam_replacement_constant
     lam_replacement_iff_lam_closed by auto
 
 end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/ZF_Miscellanea.thy b/thys/Transitive_Models/ZF_Miscellanea.thy
--- a/thys/Transitive_Models/ZF_Miscellanea.thy
+++ b/thys/Transitive_Models/ZF_Miscellanea.thy
@@ -1,181 +1,204 @@
 section\<open>Various results missing from ZF.\<close>
 
 theory ZF_Miscellanea
   imports
     ZF
     Nat_Miscellanea
 begin
 
+lemma rex_mono :
+  assumes "\<exists> d \<in> A . P(d)" "A\<subseteq>B"
+  shows "\<exists> d \<in> B. P(d)"
+  using assms by auto
+
 lemma function_subset:
   "function(f) \<Longrightarrow> g\<subseteq>f \<Longrightarrow> function(g)"
   unfolding function_def subset_def by auto
 
 lemma converse_refl : "refl(A,r) \<Longrightarrow> refl(A,converse(r))"
   unfolding refl_def by simp
 
 lemma Ord_lt_subset : "Ord(b) \<Longrightarrow> a<b \<Longrightarrow> a\<subseteq>b"
   by(intro subsetI,frule ltD,rule_tac Ord_trans,simp_all)
 
 lemma funcI : "f \<in> A \<rightarrow> B \<Longrightarrow> a \<in> A \<Longrightarrow> b= f ` a \<Longrightarrow> \<langle>a, b\<rangle> \<in> f"
   by(simp_all add: apply_Pair)
 
 lemma vimage_fun_sing:
   assumes "f\<in>A\<rightarrow>B" "b\<in>B"
   shows "{a\<in>A . f`a=b} = f-``{b}"
   using assms vimage_singleton_iff function_apply_equality Pi_iff funcI by auto
 
 lemma image_fun_subset: "S\<in>A\<rightarrow>B \<Longrightarrow> C\<subseteq>A\<Longrightarrow> {S ` x . x\<in> C} = S``C"
   using image_function[symmetric,of S C] domain_of_fun Pi_iff by auto
 
 lemma subset_Diff_Un: "X \<subseteq> A \<Longrightarrow> A = (A - X) \<union> X " by auto
 
 lemma Diff_bij:
   assumes "\<forall>A\<in>F. X \<subseteq> A" shows "(\<lambda>A\<in>F. A-X) \<in> bij(F, {A-X. A\<in>F})"
   using assms unfolding bij_def inj_def surj_def
   by (auto intro:lam_type, subst subset_Diff_Un[of X]) auto
 
 lemma function_space_nonempty:
   assumes "b\<in>B"
   shows "(\<lambda>x\<in>A. b) : A \<rightarrow> B"
   using assms lam_type by force
 
+lemma lam_constant_eq_cartprod: "(\<lambda>_\<in>A. y) = A \<times> {y}"
+  unfolding lam_def by auto
+
 lemma vimage_lam: "(\<lambda>x\<in>A. f(x)) -`` B = { x\<in>A . f(x) \<in> B }"
   using lam_funtype[of A f, THEN [2] domain_type]
     lam_funtype[of A f, THEN [2] apply_equality] lamI[of _ A f]
   by auto blast
 
 lemma range_fun_subset_codomain:
   assumes "h:B \<rightarrow> C"
   shows "range(h) \<subseteq> C"
   unfolding range_def domain_def converse_def using range_type[OF _ assms]  by auto
 
 lemma Pi_rangeD:
   assumes "f\<in>Pi(A,B)" "b \<in> range(f)"
   shows "\<exists>a\<in>A. f`a = b"
   using assms apply_equality[OF _ assms(1), of _ b]
     domain_type[OF _ assms(1)] by auto
 
 lemma Pi_range_eq: "f \<in> Pi(A,B) \<Longrightarrow> range(f) = {f ` x . x \<in> A}"
   using Pi_rangeD[of f A B] apply_rangeI[of f A B]
   by blast
 
 lemma Pi_vimage_subset : "f \<in> Pi(A,B) \<Longrightarrow> f-``C \<subseteq> A"
   unfolding Pi_def by auto
 
 definition
   minimum :: "i \<Rightarrow> i \<Rightarrow> i" where
   "minimum(r,B) \<equiv> THE b. first(b,B,r)"
 
+lemma minimum_in': "minimum(r,B) \<in> B \<union> {0}"
+  using the_0 first_is_elem unfolding minimum_def
+  by (cases "\<exists>!b. first(b, B, r)")
+    (auto dest!:theI[of "\<lambda>b. first(b, B, r)"])
+
 lemma minimum_in: "\<lbrakk> well_ord(A,r); B\<subseteq>A; B\<noteq>0 \<rbrakk> \<Longrightarrow> minimum(r,B) \<in> B"
   using the_first_in unfolding minimum_def by simp
 
 lemma well_ord_surj_imp_inj_inverse:
   assumes "well_ord(A,r)" "h \<in> surj(A,B)"
   shows "(\<lambda>b\<in>B. minimum(r, {a\<in>A. h`a=b})) \<in> inj(B,A)"
 proof -
   let ?f="\<lambda>b\<in>B. minimum(r, {a\<in>A. h`a=b})"
   have "minimum(r, {a \<in> A . h ` a = b}) \<in> {a\<in>A. h`a=b}" if "b\<in>B" for b
   proof -
     from \<open>h \<in> surj(A,B)\<close> that
     have "{a\<in>A. h`a=b} \<noteq> 0"
       unfolding surj_def by blast
     with \<open>well_ord(A,r)\<close>
     show "minimum(r,{a\<in>A. h`a=b}) \<in> {a\<in>A. h`a=b}"
       using minimum_in by blast
   qed
   moreover from this
   have "?f : B \<rightarrow> A"
     using lam_type[of B _ "\<lambda>_.A"] by simp
   moreover
   have "?f ` w = ?f ` x \<Longrightarrow> w = x" if "w\<in>B" "x\<in>B" for w x
   proof -
     from calculation that
     have "w = h ` minimum(r,{a\<in>A. h`a=w})"
       "x = h ` minimum(r,{a\<in>A. h`a=x})"
       by simp_all
     moreover
     assume "?f ` w = ?f ` x"
     moreover from this and that
     have "minimum(r, {a \<in> A . h ` a = w}) = minimum(r, {a \<in> A . h ` a = x})"
       unfolding minimum_def by simp_all
     moreover from calculation(1,2,4)
     show "w=x" by simp
   qed
   ultimately
   show ?thesis
     unfolding inj_def by blast
 qed
 
 lemma well_ord_surj_imp_lepoll:
   assumes "well_ord(A,r)" "h \<in> surj(A,B)"
   shows "B\<lesssim>A"
   unfolding lepoll_def using well_ord_surj_imp_inj_inverse[OF assms]
   by blast
 
 \<comment> \<open>New result\<close>
 lemma surj_imp_well_ord:
   assumes "well_ord(A,r)" "h \<in> surj(A,B)"
   shows "\<exists>s. well_ord(B,s)"
   using assms lepoll_well_ord[OF well_ord_surj_imp_lepoll]
   by force
 
 lemma Pow_sing : "Pow({a}) = {0,{a}}"
 proof(intro equalityI,simp_all)
   have "z \<in> {0,{a}}" if "z \<subseteq> {a}" for z
     using that by auto
   then
   show " Pow({a}) \<subseteq> {0, {a}}" by auto
 qed
 
 lemma Pow_cons:
   shows "Pow(cons(a,A)) = Pow(A) \<union> {{a} \<union> X . X: Pow(A)}"
   using Un_Pow_subset Pow_sing
 proof(intro equalityI,auto simp add:Un_Pow_subset)
   {
     fix C D
     assume "\<And> B . B\<in>Pow(A) \<Longrightarrow> C \<noteq> {a} \<union> B" "C \<subseteq> {a} \<union> A" "D \<in> C"
     moreover from this
     have "\<forall>x\<in>C . x=a \<or> x\<in>A" by auto
     moreover from calculation
     consider (a) "D=a" | (b) "D\<in>A" by auto
     from this
     have "D\<in>A"
     proof(cases)
       case a
       with calculation show ?thesis by auto
     next
       case b
       then show ?thesis by simp
     qed
   }
   then show "\<And>x xa. (\<forall>xa\<in>Pow(A). x \<noteq> {a} \<union> xa) \<Longrightarrow> x \<subseteq> cons(a, A) \<Longrightarrow> xa \<in> x \<Longrightarrow> xa \<in> A"
     by auto
 qed
 
 lemma app_nm :
   assumes "n\<in>nat" "m\<in>nat" "f\<in>n\<rightarrow>m" "x \<in> nat"
   shows "f`x \<in> nat"
 proof(cases "x\<in>n")
   case True
   then show ?thesis using assms in_n_in_nat apply_type by simp
 next
   case False
   then show ?thesis using assms apply_0 domain_of_fun by simp
 qed
 
 lemma Upair_eq_cons: "Upair(a,b) = {a,b}"
   unfolding cons_def by auto
 
 lemma converse_apply_eq : "converse(f) ` x = \<Union>(f -`` {x})"
   unfolding apply_def vimage_def by simp
 
 lemmas app_fun = apply_iff[THEN iffD1]
 
 lemma Finite_imp_lesspoll_nat:
   assumes "Finite(A)"
   shows "A \<prec> nat"
   using assms subset_imp_lepoll[OF naturals_subset_nat] eq_lepoll_trans
     n_lesspoll_nat eq_lesspoll_trans
   unfolding Finite_def lesspoll_def by auto
 
+definition curry :: "[i,i,i] \<Rightarrow> i" where
+  "curry(A,B,f) \<equiv> \<lambda>x\<in>A . \<lambda>y\<in>B . f`\<langle>x,y\<rangle>"
+
+lemma curry_type :
+  assumes "f \<in> A\<times>B \<rightarrow> C"
+  shows "curry(A,B,f) \<in> A \<rightarrow> (B \<rightarrow> C)"
+  using assms lam_funtype
+  unfolding curry_def
+  by auto
+
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/document/root.tex b/thys/Transitive_Models/document/root.tex
--- a/thys/Transitive_Models/document/root.tex
+++ b/thys/Transitive_Models/document/root.tex
@@ -1,184 +1,184 @@
-\documentclass[11pt,a4paper]{article}
+\documentclass[11pt,a4paper,english]{article}
 \usepackage{isabelle,isabellesym}
 \usepackage[numbers]{natbib}
 \usepackage{babel}
 
 \usepackage{relsize}
 \DeclareRobustCommand{\isactrlbsub}{\emph\bgroup\math{}\sb\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
 \DeclareRobustCommand{\isactrlesub}{\egroup\egroup\endmath\egroup}
 \DeclareRobustCommand{\isactrlbsup}{\emph\bgroup\math{}\sp\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
 \DeclareRobustCommand{\isactrlesup}{\egroup\egroup\endmath\egroup}
 
 % further packages required for unusual symbols (see also
 % isabellesym.sty), use only when needed
 
 \usepackage{amssymb}
   %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
   %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
   %\<triangleq>, \<yen>, \<lozenge>
 
 %\usepackage{eurosym}
   %for \<euro>
 
 %\usepackage[only,bigsqcap]{stmaryrd}
   %for \<Sqinter>
 
 %\usepackage{eufrak}
   %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
 
 %\usepackage{textcomp}
   %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
   %\<currency>
 
 % this should be the last package used
 \usepackage{pdfsetup}
 
 % urls in roman style, theory text in math-similar italics
 \urlstyle{rm}
 \isabellestyle{it}
 
 % for uniform font size
 %\renewcommand{\isastyle}{\isastyleminor}
 \newcommand{\forces}{\Vdash}
 \newcommand{\dom}{\mathsf{dom}}
 \renewcommand{\isacharunderscorekeyword}{\mbox{\_}}
 \renewcommand{\isacharunderscore}{\mbox{\_}}
 \renewcommand{\isasymtturnstile}{\isamath{\Vdash}}
 \renewcommand{\isacharminus}{-}
 \newcommand{\session}[1]{\textit{#1}}
 \newcommand{\theory}[1]{\texttt{#1}}
 \newcommand{\axiomas}[1]{\mathit{#1}}
 \newcommand{\ZFC}{\axiomas{ZFC}}
 \newcommand{\ZF}{\axiomas{ZF}}
 \newcommand{\AC}{\axiomas{AC}}
 \newcommand{\CH}{\axiomas{CH}}
 
 \begin{document}
 
 \title{Transitive Models of Fragments of ZF}
 \author{Emmanuel Gunther\thanks{Universidad Nacional de C\'ordoba.
     Facultad de Matem\'atica, Astronom\'{\i}a,  F\'{\i}sica y
     Computaci\'on.}
   \and
   Miguel Pagano\footnotemark[1]
   \and
   Pedro S\'anchez Terraf\footnotemark[1] \thanks{Centro de Investigaci\'on y Estudios de Matem\'atica
     (CIEM-FaMAF), Conicet. C\'ordoba. Argentina.
     Supported by Secyt-UNC project 33620180100465CB.}
   \and
   Mat\'{\i}as Steinberg\footnotemark[1]
 }
 \maketitle
 
 \begin{abstract}
   We extend the ZF-Constructibility library by relativizing theories
   of the Isabelle/ZF and Delta System Lemma sessions to a transitive
   class. We also relativize Paulson's work on Aleph and our former
   treatment of the Axiom of Dependent Choices. This work is a
   prerequisite to our formalization of the independence of the
   Continuum Hypothesis.
 \end{abstract}
 
 
 \tableofcontents
 
 % sane default for proof documents
 \parindent 0pt\parskip 0.5ex
 
 \section{Introduction}
 
 Relativization of concepts is a key tool to obtain results in forcing,
 as it is explained in \cite[Sect.~3]{2020arXiv200109715G} and elsewhere.
 
 In this session, we cast some theories in relative form, in a
 way that they now refer to a fixed class $M$ as the universe of
 discourse. Whenever it was possible, we tried to minimize the changes
 to the structure and proof scripts of the absolute concepts. For
 this reason, some comments of the original text as well as
 outdated \textbf{apply} commands appear profusely in the following
 theories.
 
 A repeated pattern that appears is that the relativized result can be
 proved \emph{mutatis mutandis}, with remaining proof obligations that
 the objects constructed actually belong to the model $M$. Another
 aspect was that the management of higher order constructs always posed
 some extra problems, already noted by Paulson \cite[Sect.~7.3]{MR2051585}.
 
 In the theory \theory{Lambda\_Replacement} we introduce a new locale assuming
 two instances of separation and twelve instances of ``lambda replacements''
 (i.e., replacements using definable functions of the form $\lambda x y. y=\langle x, f(x) \rangle$)
 that allow for having some form of compositionality of further instances
 of separations and replacements.
 
 We proceed to enumerate the theories that were ``ported'' to relative
 form, briefly commenting on each of them. Below, we refer to the
 original theories as the \emph{source} and, correspondingly, call
 \emph{target} the relativized version. We omit the \theory{.thy}
 suffixes.
 
 \begin{enumerate}
 \item From \session{ZF}:
   \begin{enumerate}
   \item \theory{Univ}. Here we decided to relativize only the term
     \isatt{Vfrom} that constructs the cumulative hierarchy up to some
     ordinal length and starting from an arbitrary set.
   \item \theory{Cardinal}. There are two targets for this source,
     \theory{Least} and \theory{Cardinal\_Relative}. Both require some
     fair amount of preparation, trying to take advantage of absolute
     concepts. It is not straightforward to compare source and targets
     in a line-by-line fashion at this point.
   \item \theory{CardinalArith}. The hardest part was to formalize the
     cardinal successor function. We also disregarded the part treating
     finite cardinals since it is an absolute concept. Apart from that,
     the relative version closely parallels the source.
   \item \theory{Cardinal\_AC}. After some boilerplate, porting was
     rather straightforward, excepting cardinal arithmetic involving
     the higher-order union operator.
   \end{enumerate}
 \item From \session{ZF-Constructible}:
   \begin{enumerate}
   \item \theory{Normal}. The target here is \theory{Aleph\_Relative}
     since that is the only concept that we ported. Instead of porting
     all the machinery of normal functions (since it involved
     higher-order variables), we particularized the results for the
     Aleph function. We also used an alternative definition of the
     latter that worked better with our relativization discipline.
   \end{enumerate}
 \item From \session{Delta\_System\_Lemma}:
   \begin{enumerate}
   \item \theory{ZF\_Library}. The target includes a big section of
     auxiliary lemmas and commands that aid the relativization. We
     needed to make explicit the witnesses (mainly functions) in some of the
     existential results proved in the source, since only in that way
     we would be able to show that they belonged to the model.
   \item \theory{Cardinal\_Library}. Porting was relatively
     straightforward; most of the extra work laid in adjusting locale
     assumptions to obtain an appropriate context to state and prove
     the theorems.
   \item \theory{Delta\_System}. Same comments as in the case of
     \theory{Cardinal\_Library} apply here.
   \end{enumerate}
 \item From \session{Forcing}:
   \begin{enumerate}
   \item \theory{Pointed\_DC}. This case was similar to
     \theory{Cardinal\_AC} above, although a bit of care was needed to
     handle the recursive construction. Also, a fraction of the theory
     \theory{AC} from \session{ZF} was ported here as it was a
     prerequisite. A complete relativization of \theory{AC} would be
     desirable but still missing.
   \end{enumerate}
 \end{enumerate}
 % generated text of all theories
 
 \input{session}
 
 \bibliographystyle{root}
 \bibliography{root}
 
 \end{document}
 
 %%% Local Variables:
 %%% mode: latex
 %%% TeX-master: t
 %%% ispell-local-dictionary: "american"
 %%% End: