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,691 +1,680 @@
 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 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 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 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>
 
 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 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/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,1064 +1,1079 @@
 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_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>Most properties of cardinals depend on $\AC$, even for the countable.
+Here we just state the definition of this concept, and most proofs will
+appear after assuming Choice.\<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
+
+
 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/Independence_CH/CH.thy b/thys/Independence_CH/CH.thy
--- a/thys/Independence_CH/CH.thy
+++ b/thys/Independence_CH/CH.thy
@@ -1,447 +1,442 @@
 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 ?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 "?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>?rnf. d \<supseteq> h \<and> d \<supseteq> g" if "h \<in> ?rnf" "g \<in> ?rnf" for h g
     proof -
       from calculation
       have "?rnf={f`x . x\<in>\<omega>}"
         using  image_function[of f \<omega>] Pi_iff domain_of_fun
         by auto
       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>?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 "?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> ?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>?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>?rnf"]
       by auto
     moreover from calculation
     have "\<Union>?rnf\<in>Coll"
       unfolding Fn_rel_def
       by simp
     moreover from calculation
     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>
 
 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)
 
 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_CH
 begin
 
 notation Leq (infixl "\<preceq>" 50)
 notation Incompatible (infixl "\<bottom>" 50)
 
 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 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 -
   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 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 M_generic_denseD[of "dom_dense(x)"]
     by auto
   then
   show "x \<in> domain(f\<^bsub>G\<^esub>)" by blast
 qed
 
 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
     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!: 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!: 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
+    by fast
   ultimately
   show ?thesis
     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) }"
 
 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"
   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 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 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],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
     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] 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_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_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_CH}\<close>
   interpret M_ZFC4 M
-    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>
+    using M_satT_overhead_imp_M_ZF4 unfolding overhead_CH_def overhead_notCH_def by auto
+  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH}\<close> \<open>Transset(M)\<close>
   interpret M_ZF_ground_CH_trans M
     using M_satT_imp_M_ZF_ground_CH_trans
-    by simp
+    unfolding ZC_def by auto
   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_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_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_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,495 +1,488 @@
 section\<open>Preservation of cardinals in generic extensions\<close>
 
 theory Cardinal_Preservation
   imports
     Forcing_Main
 begin
 
 context forcing_data1
 
 begin
 
 lemma antichain_abs' [absolut]:
   "\<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 transitivity[of _ A]
   by (auto simp add:absolut)
 
 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
     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_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(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(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>" ]
     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 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
    \<^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(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]
     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>
 
 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"
   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]
+    lam_replacement_product
     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> ))"
+  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),hcomp_fm(fst_fm,fst_fm),2,0)"
+    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_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
       by (simp_all add:arity)
     ultimately
     show ?thesis
       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
+  with assms
   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] assms
+    using lam_replacement_imp_lam_closed separation_conj separation_in
+      lam_replacement_product lam_replacement_constant transitivity[of _ B]
+      lam_replacement_snd lam_replacement_Collect' ccc_fun_closed_lemma_aux
     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> ))"
+  have "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, fst(fst(z))\<^sup>v, snd(fst(z))\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
   proof -
     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 ?g_fm="hcomp_fm(check_fm(6),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
     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
       by (simp_all add:arity)
     ultimately
     show ?thesis
       using separation_sat_after_function3 assms sats_check_fm check_abs
         fst_abs snd_abs
       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 1:"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 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
       by (simp_all add:arity)
     ultimately
     show ?thesis
       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]
+    using lam_replacement_imp_lam_closed lam_replacement_Collect' transitivity[of _ A]
+      lam_replacement_constant lam_replacement_identity lam_replacement_snd
+      lam_replacement_product separation_conj separation_in separation_bex separation_iff'
     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(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 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:transitivity)
     moreover
     note \<open>B\<in>M\<close> \<open>f = val(G,f_dot)\<close>
     moreover from calculation
     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 lam_replacement_imp_strong_replacement[OF
           lam_replacement_Sigfun[OF lam_replacement_constant]]
         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(P,leq,range(q))"
       using Pi_range_eq[of _  _ "\<lambda>_ . P"]
       unfolding antichain_def compat_in_def by auto
     moreover from this and \<open>q\<in>M\<close>
     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\<^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,326 +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
 
 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
 
 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 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(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(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(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(G,f(x)) . x \<in> a}"
     by auto
   finally
   show ?thesis
     by simp
 qed
 
 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
 
 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_product
     lam_replacement_fst lam_replacement_snd lam_replacement_constant
   unfolding upair_name_def
   by simp
 
 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"
     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
 
 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(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(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
       by simp
     then
     have "f \<in> M[G]"
       unfolding f_def
       by (blast intro:GenExtI)
     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(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(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(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(G,\<sigma>) = y\<close>
       have "val(G,s`\<beta>) = y"
         by simp
       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
 
 locale G_generic2_AC = G_generic1_AC + G_generic2 + M_ctm2_AC
 
 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,552 +1,547 @@
 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>)"
 
 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 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 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 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_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)
         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,628 +1,630 @@
 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
 \<^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 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}
 *)
 
 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 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)
 *)
 
 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)
 *)
 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,[])))" ..
 
 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 .
 
 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>
 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)))
 *)
 
 
 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>
 
 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)
 *)
 
 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))
 *)
 
 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)*)
 
 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>
 *)
 
 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\label{sec:relative-arith}\<close>
 
 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
 
 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
 
 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 .
 
 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_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_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>
 *)
 
 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>
 
 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)
 *)
 
 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)
 *)
 
-text\<open>These results can be strengthened by enumerating five finite sets of
+text\<open>These results can be strengthened by enumerating six 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>, and \<^term>\<open>instances_ground_fms\<close> which are
-then collected into the $35$-element set \<^term>\<open>overhead\<close>.
+through \<^term>\<open>instances4_fms\<close>, \<^term>\<open>instances_ground_fms\<close>, and
+\<^term>\<open>instances_ground_notCH_fms\<close>,
+which are then collected into the $33$-element set \<^term>\<open>overhead_notCH\<close>.
 For example, we have:\<close>
 
 thm instances1_fms_def
 text\<open>@{thm [display] instances1_fms_def}\<close>
 (*
 instances1_fms \<equiv>
-{ 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 }
+{ 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>
+thm overhead_def overhead_notCH_def
+text\<open>@{thm [display] overhead_def overhead_notCH_def overhead_CH_def}\<close>
 (*
-overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances3_fms \<union>
-  instances4_fms \<union> instances_ground_fms
+  overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances_ground_fms
+
+  overhead_notCH \<equiv> overhead \<union>
+    instances3_fms \<union> instances4_fms \<union> instances_ground_notCH_fms
 *)
 
-text\<open>One further instance is needed to force $\CH$:\<close>
-
+text\<open>One further instance is needed to force $\CH$, with a total count
+of $32$ instances:\<close>
 thm overhead_CH_def
 text\<open>@{thm [display] overhead_CH_def}\<close>
 (*
-overhead_CH \<equiv> overhead \<union> {replacement_dcwit_repl_body_fm}
+  overhead_CH \<equiv> overhead_notCH \<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 \<union> instances_ground_fms} \<Longrightarrow>
+M \<Turnstile> \<cdot>Z\<cdot> \<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>
     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>}
 *)
 
 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>
+M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH} \<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)
 *)
 
 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_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)
 *)
 
 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>
 *)
 
 end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
 
 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,1021 +1,1011 @@
 section\<open>Concepts involved in instances of Replacement\<close>
 theory Fm_Definitions
   imports
     Transitive_Models.Renaming_Auto
     Transitive_Models.Aleph_Relative
     FrecR_Arities
 begin
 
 (* 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]
 
 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(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(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(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>)
 
 \<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 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 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
 
 synthesize "is_ordermap" from_definition assuming "nonempty"
 
 synthesize "is_ordertype" from_definition assuming "nonempty"
 
-definition is_order_body
-  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
 
-lemma arity_is_order_body: "arity(is_order_body_fm(2,0,1)) = 3"
+lemma arity_is_order_body: "arity(is_order_body_fm(0,1)) = 2"
   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 replacement_is_order_body_fm where "replacement_is_order_body_fm \<equiv>  (\<cdot>\<exists>\<cdot>is_order_body_fm(1, 0) \<and> \<cdot>\<langle>1,0\<rangle> is 2 \<cdot>\<cdot>\<cdot>)"
 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'_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 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 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 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(\<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
+end
\ No newline at end of file
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,854 +1,852 @@
 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)
 
 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 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 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] 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 (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 eq
     then
     have "n1 \<in> eclose(b) \<or> n1 \<in> eclose(c)"
       using Un_iff in_dom_in_eclose by auto
     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 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
     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> 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 \<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 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 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 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 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 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 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
 
 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
   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
   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> (q \<tturnstile> \<phi> env) \<and> (q \<tturnstile> \<psi> env))"
   unfolding forces_def
   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> (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. 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,161 +1,163 @@
 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
     ZF_Trans_Interpretations
 begin
 
 no_notation Aleph (\<open>\<aleph>_\<close> [90] 90)
 
 subsection\<open>A forcing locale and generic filters\<close>
 
 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 + 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
 
 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)"
 
 declare iff_trans [trans]
 
+lemma M_generic_imp_filter[dest]: "M_generic(G) \<Longrightarrow> filter(G)"
+  unfolding M_generic_def by blast
+
 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)
+  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)
+  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)
+  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
+  using generic by auto
 
 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,169 +1,170 @@
 section\<open>The main theorem\<close>
 
 theory Forcing_Main
   imports
     Ordinals_In_MG
     Choice_Axiom
     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(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(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>
 
 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 \<union> instances_ground_fms}"
+    "M \<approx> \<omega>" "Transset(M)"
+    "M \<Turnstile> \<cdot>Z\<cdot> \<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> 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> _\<close> \<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_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[G]"
     using cohen_extension_is_proper
     by blast
   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_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[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[G])" using choice_in_MG by simp
     then
     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[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[G])" using Transset_MG .
   moreover
   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[G]" in exI, auto)
 qed
 
-lemma ZF_replacement_instances12_sub_ZF: "{\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms \<union> instances_ground_fms} \<subseteq> ZF"
+lemma ZF_replacement_instances12_sub_ZF: "{\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<subseteq> ZF"
   using instances1_fms_type instances2_fms_type instances_ground_fms_type
-  unfolding ZF_def ZF_schemes_def by auto
+  unfolding overhead_def 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,429 +1,432 @@
 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_subset_notion[dest]: "filter(G) \<Longrightarrow> G \<subseteq> P"
+  by (auto dest:filterD)
+
 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,1528 +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 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
   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
   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
   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 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 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(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(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(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" "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(2), of s] leq_transD[of _ s r]
         by blast
     qed
   qed
   have "?D\<subseteq>P" by auto
   let ?d_fm="\<cdot>\<cdot>\<not>compat_in_fm(1, 2, 3, 0) \<cdot> \<or> \<cdot>0 \<in> 4\<cdot>\<cdot>"
   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 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 zero_in_M
     by simp
   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
     by simp
   ultimately
   have "?D\<in>M"
     using Collect_in_M[of ?d_fm "[P,leq,p,D]"] \<open>D\<in>M\<close>
     by simp
   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
   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 (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 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 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 assms Collect_in_M[of ?\<phi> "[P,leq,\<pi>,\<tau>]"]
     by simp
 qed
 
 (* Lemma IV.2.40(a), membership *)
 lemma IV240a_mem:
   assumes
     "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(G,\<pi>) = val(G,\<sigma>)" (* inductive hypothesis *)
   shows
     "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>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>p\<in>G\<close>
   ultimately
   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(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(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
     "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(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(G,\<sigma>) \<in> val(G,\<theta>)" *)
   shows
     "val(G,\<tau>) \<subseteq> val(G,\<theta>)"
 proof
   fix x
   assume "x\<in>val(G,\<tau>)"
   then
   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>
   have "q\<in>P" "p\<in>P" by blast+
   moreover from calculation
   have "q forces\<^sub>a (\<sigma> \<in> \<tau>)"
     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 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
     "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(G,\<sigma>) \<in> val(G,\<tau>)) \<and>
         (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(G,\<sigma>) \<in> val(G,\<theta>))"
   shows
     "val(G,\<theta>) \<subseteq> val(G,\<tau>)"
 proof
   fix x
   assume "x\<in>val(G,\<theta>)"
   then
   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>
   have "q\<in>P" "p\<in>P" by blast+
   moreover from calculation
   have "q forces\<^sub>a (\<sigma> \<in> \<theta>)"
     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 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
     "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(G,\<sigma>) \<in> val(G,\<tau>)) \<and>
         (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(G,\<sigma>) \<in> val(G,\<theta>))"
   shows
     "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 (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 (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 (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:
   shows
     "(\<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(G, \<tau>) = val(G, \<sigma>)"
     if "q\<in>P" "q\<in>G" for q \<sigma>
     using that domain_closed[of \<theta>] transitivity by auto
   ultimately
   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" and d:"\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> ?R(\<sigma>,\<tau>) \<and> ?R(\<sigma>,\<theta>)" for \<sigma>
   moreover from this
   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
     "val(G,\<pi>)\<in>val(G,\<tau>)" "\<pi>\<in>M" "\<tau>\<in>M"
     and
     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(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
   ultimately
   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>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>\<^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 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
       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
       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 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 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 assms forces_nmem
       Collect_in_M[of ?\<phi> "[P,leq,\<tau>,\<theta>]"]
     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
     "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(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>?D . d \<preceq> p" by blast
   qed
   moreover
   have "?D \<subseteq> P"
     by auto
   ultimately
   obtain p where "p\<in>G" "p\<in>?D"
     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(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>)" 
       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
     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(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>)" 
       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
     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:
     "(\<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>
   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(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
   ultimately
   show "?Q(\<tau>,\<theta>)"
     using IV240b_eq by auto
 qed
 
 lemma truth_lemma_mem:
   assumes
     "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(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
 
 lemma truth_lemma_eq:
   assumes
     "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(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
 
 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
 
 end
 
 context G_generic1
 begin
 
 lemma  truth_lemma_Neg:
   assumes
     "\<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(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(G),env) \<Turnstile> Neg(\<phi>))"
   moreover
   note assms
   moreover from calculation
   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" "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
     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(G),env) \<Turnstile> Neg(\<phi>)"
   with assms
   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)}"
   from assms
   have "?D \<in> M"
     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"
       using refl_leq Forces_Neg by (cases "q \<tturnstile> Neg(\<phi>) env", auto)
   qed
   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(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)"
     and
     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(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(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(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" "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 auto
   moreover from calculation
   have "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)" (* can't solve as separate goals *)
     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 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 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
       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"
     "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
   shows
     "(\<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 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 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>)
   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>)
   then
   show ?case
   proof (intro iffI)
     assume "\<exists>p\<in>G. (p \<tturnstile> Forall(\<phi>) env)"
     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)"]
     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(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 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>
       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 generic
     ultimately
     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-)
       obtain p where "p\<in>G" "p\<in>P" "p \<tturnstile> \<phi> ([b] @ env)"
         using pred_le2 map_val_in_MG M_genericD by (auto iff:GenExt_iff)
       moreover
       note \<open>d\<in>G\<close>
       ultimately
       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(G),env) \<Turnstile> \<phi>)"
 proof (intro iffI allI impI, elim conjE)
   fix G
   assume "(p \<tturnstile> \<phi> env)" "M_generic(G)" "p \<in> G"
   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(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 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
+      using filter_leqD by auto
     moreover note 1
     ultimately
     have "M[G], map(val(G),env) \<Turnstile> \<phi>"
       by simp
     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 \<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
     ultimately
     have "\<exists>q\<in>P. q\<preceq>r \<and> (q \<tturnstile> \<phi> env)"
       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/Interface.thy b/thys/Independence_CH/Interface.thy
--- a/thys/Independence_CH/Interface.thy
+++ b/thys/Independence_CH/Interface.thy
@@ -1,1717 +1,1668 @@
 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
 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,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,wfrec_rank_fm)"
     "replacement_assm(M,env,trans_repl_HVFrom_fm)"
     "replacement_assm(M,env,tl_repl_intf_fm)"
 
 definition instances1_fms where "instances1_fms \<equiv>
   { 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
  }"
 
 text\<open>This set has 9 internalized formulas.\<close>
 
 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 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 "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 "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 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 pair_in_M_iff[simplified] cons_closed[simplified]
   unfolding strong_replacement_def univalent_def
   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])
   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>
 
 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
 
 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"
 
 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>
             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(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 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.
          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
 
 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(3)[unfolded replacement_assm_def]
   by simp
 
 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(9)[unfolded replacement_assm_def]
   by simp
 
 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(5)[unfolded replacement_assm_def]
     ord_simp_union
   by simp
 
 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(2)[unfolded replacement_assm_def] repl_sats[of M ?f "[A,0,nat]"]
     by simp
 qed
 
 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 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(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>
 
 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"
 
 declare is_Hrank_fm_def[fm_definitions add]
 
 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(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
 
 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(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
 
 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/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,732 +1,723 @@
 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_product
     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
     (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)" *)
 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)
   from \<open>a\<in>A\<close> \<open>A\<in>M\<close>
   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( G), [f_dot, A\<^sup>v, B\<^sup>v]) \<in> list(M[G])" by simp
   moreover from calculation
   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(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:transitivity)
   moreover from calculation
   have "M[G], map(val(G), [f_dot, a\<^sup>v, ?b\<^sup>v]) \<Turnstile> \<cdot>0`1 is 2\<cdot>"
     by simp
   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>" "[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:transitivity simp add: union_abs2 union_abs1)
   ultimately
   show ?thesis by auto
 qed
 
 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 -
   let ?f_fm="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
     by (simp_all add:arity)
   ultimately
   show ?thesis
     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>)"
   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
     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 sats_check_fm check_abs
       fst_abs snd_abs
     unfolding hcomp_fm_def
     by simp
   moreover from assms
   have "?\<rho>(z) \<in> list(M)" if "(##M)(z)" for z
     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 sats_incr_bv_iff[of _ _ M _ "[_,_,_,_,_,_]"]
     by simp
   ultimately
   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 -
     let ?f_fm="hcomp_fm(snd_fm,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
       by (simp_all add:arity)
     ultimately
     show ?thesis
       using separation_sat_after_function sats_check_fm check_abs fst_abs snd_abs that
       unfolding hcomp_fm_def
       by simp
   qed
   with assms
   show ?thesis
     using separation_in lam_replacement_constant lam_replacement_snd lam_replacement_fst
-      lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] pred_nat_closed
+      lam_replacement_product 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)
 qed
 
-lemma separation_ball_leq_and_forces_apply_aux:
+lemma separation_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> ))))"
+     (##M, \<lambda>p .  snd(snd(p)) \<preceq> fst(snd(p)) \<and>
+    (\<exists>b\<in>B. M, [snd(snd(p)), P, leq, \<one>, f_dot, (\<Union>fst(p))\<^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>)"
+  have "separation(##M, \<lambda>z. M, [snd(snd(fst(z))), P, leq, \<one>, f_dot, (\<Union>fst(fst(z)))\<^sup>v, snd(z)\<^sup>v] \<Turnstile> \<chi>)"
     if "\<chi>\<in>formula" "arity(\<chi>) \<le> 7" for \<chi>
   proof -
-    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 ?f_fm="hcomp_fm(snd_fm,hcomp_fm(snd_fm,fst_fm),1,0)"
+    let ?g="\<lambda>z . (\<Union>(fst(fst(z))))\<^sup>v"
+    let ?g_fm="hcomp_fm(check_fm(6),hcomp_fm(big_union_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 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
       by (simp_all add:arity)
     ultimately
     show ?thesis
       using separation_sat_after_function3[OF _ _ _ f_fm_facts] check_abs
-        sats_check_fm that fst_abs snd_abs
+        sats_check_fm that fst_abs snd_abs sats_fst_fm sats_snd_fm
       unfolding hcomp_fm_def
       by simp
   qed
   with assms
   show ?thesis
     using
-      separation_ball separation_imp separation_conj separation_bex separation_in separation_iff'
-      lam_replacement_constant lam_replacement_identity lam_replacement_hcomp
+      separation_conj separation_bex
+      lam_replacement_constant 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]]
+      separation_in[OF _ lam_replacement_product]
     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 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
       by (simp_all add:arity)
     ultimately
     show ?thesis
       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
   with assms
   show ?thesis
-    using separation_conj separation_in
-      lam_replacement_constant lam_replacement_fst
-      lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
-      G_subset_M[THEN subsetD]
+    using separation_conj separation_in G_subset_M[THEN subsetD]
+      lam_replacement_constant lam_replacement_fst lam_replacement_product
       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 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(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>" "[\<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 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(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>" "[\<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 *)
   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)"]
       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 by simp
     moreover from calculation
     have "S \<in> M"
-      using separation_ball_leq_and_forces_apply_aux separation_leq_and_forces_apply_aux
+      using  separation_leq_and_forces_apply_aux separation_leq_and_forces_apply_aux'
         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)
+      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: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
       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 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']
           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: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 H
       let ?f="val(H,f_dot)"
       assume "M_generic(H) \<and> r \<in> H"
       moreover from this
       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 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 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:transitivity)
         moreover
         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[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 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(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: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/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,600 +1,593 @@
 section\<open>Model of the negation of the Continuum Hypothesis\<close>
 
 theory Not_CH
   imports
     Cardinal_Preservation
 begin
 
 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 +
   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>)"
 
 subsection\<open>Non-absolute concepts between extensions\<close>
 
 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]
   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)
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_master_sub\<close>\<close>
 
 lemmas (in M_ZF3_trans) sep_instances =
   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
 
-sublocale M_ZFC3_ground_trans \<subseteq> M_master "##M"
+sublocale M_ZFC3_ground_notCH_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)
 
 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 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
   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]
     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> \<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_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> \<open>Ord(z)\<close> \<open>z\<in>M\<close>
   have "\<alpha> \<lesssim>\<^bsup>M\<^esup> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
     using
       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>"]
       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)
+    by (cases "0<z"; rule_tac lepoll_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>
+    using j.B_replacement
     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)
 
 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
   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) }"
 
 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 "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 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 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(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>,2,w,x) \<in> M"
   using transM[OF _ Aleph_rel2_closed] separation_conj separation_bex
-    lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+    lam_replacement_product
     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 -
   have "0\<in>2" by auto
   with assms
   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.curry_closed[unfolded curry_def] G_in_MG
   unfolding h_G_def
   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 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[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 Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
     by auto
   moreover from calculation
   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[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
     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 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_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_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}"
+    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH}"
     "\<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>
+  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH}\<close>
   interpret M_ZFC4 M
-    using M_satT_overhead_imp_M_ZF4 by simp
-  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
+    using M_satT_overhead_imp_M_ZF4 unfolding overhead_notCH_def by force
+  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH}\<close> \<open>Transset(M)\<close>
+  interpret M_ZF_ground_notCH_trans M
+    using M_satT_imp_M_ZF_ground_notCH_trans
+    unfolding ZC_def by auto
   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_notCH_sub_ZFC: "{\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH} \<subseteq> ZFC"
+  using overhead_notCH_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_overhead_notCH_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/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,83 +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_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:
   shows "G \<notin> M"
 proof
   assume "G\<in>M"
   then
   have "P - G \<in> M"
     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 generic
   ultimately
   show "False"
     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 ?*)
+    by auto
 qed
 
 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,306 +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_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>)"
   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(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 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(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
   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)
   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 .
   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
     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)
   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 \<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> 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,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 separation_Ord separation_closed Union_closed by simp
   then
   have "{x\<in>Vset(?sup). x \<in> M} \<times> {\<one>} \<in> M" (is "?big_name \<in> M")
     using Vset_closed cartprod_closed singleton_closed by simp
   then
   have "val(G,?big_name) \<in> M[G]"
     by (blast intro:GenExtI)
   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(G,\<pi>')=c\<close> \<open>\<pi>'\<in>M\<close>
     moreover
     from calculation
     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)" "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
+      using generic by blast
     let ?\<alpha>="succ(rank(\<sigma>))"
     note \<open>\<sigma>\<in>M\<close>
     moreover from this
     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(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(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(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(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 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
   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(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> = "(\<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. 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)" "univalent(##M[G], A, ?R)"
     with assms
     have "(##M[G])(?Y)"
       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>(##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
     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,1352 +1,1367 @@
 section\<open>More Instances of Replacement\<close>
 
 theory Replacement_Instances
   imports
     Separation_Instances
     Transitive_Models.Pointed_DC_Relative
 begin
 
 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>g[N].
                        (\<forall>u[N].
                            u \<in> g \<longleftrightarrow>
                            (\<exists>a[N].
                                \<exists>y[N].
                                   \<exists>ax[N].
                                      \<exists>sx[N].
                                         \<exists>r_sx[N].
                                            \<exists>f_r_sx[N].
                                               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 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 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
   "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].
                       upair(M, a, a, sa) \<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)))"
 
 
 synthesize "is_trans_apply_image_body" from_definition assuming "nonempty"
 arity_theorem for "is_trans_apply_image_body_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 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_HAleph_wfrec_repl_body_fm)"
     "replacement_assm(M,env,replacement_is_order_eq_map_fm)"
-    "replacement_assm(M,env,banach_iterates_fm)"
 
 definition instances2_fms where "instances2_fms \<equiv>
   { replacement_HAleph_wfrec_repl_body_fm,
-    replacement_is_order_eq_map_fm,
-    banach_iterates_fm }"
+    replacement_is_order_eq_map_fm }"
 
 text\<open>This set has 12 internalized formulas.\<close>
 
 lemmas replacement_instances2_defs =
   replacement_HAleph_wfrec_repl_body_fm_def
   replacement_is_order_eq_map_fm_def
-  banach_iterates_fm_def
+  (* banach_iterates_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 }"
+    Lambda_in_M_fm(check_fm(2,0,1),1) }"
 
 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 +
+locale M_ZF_ground_notCH = M_ZF_ground +
+  assumes
+    ZF_ground_notCH_replacements:
+    "replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
+    "replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
+
+definition instances_ground_notCH_fms where "instances_ground_notCH_fms \<equiv>
+  { replacement_transrec_apply_image_body_fm,
+    replacement_is_trans_apply_image_fm }"
+
+lemma instances_ground_notCH_fms_type[TC]: "instances_ground_notCH_fms \<subseteq> formula"
+  unfolding instances_ground_notCH_fms_def replacement_transrec_apply_image_body_fm_def
+    replacement_is_trans_apply_image_fm_def
+  by simp
+
+declare (in M_ZF_ground_notCH) replacement_transrec_apply_image_body_fm_def[simp]
+  replacement_is_trans_apply_image_fm_def[simp]
+
+locale M_ZF_ground_notCH_trans = M_ZF_ground_trans + M_ZF_ground_notCH
+
+locale M_ZF_ground_CH = M_ZF_ground_notCH +
   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_ZF_ground_CH_trans = M_ZF_ground_notCH_trans + M_ZF_ground_CH
 
 locale M_ZFC2 = M_ZFC1 + M_ZF2
 
 locale M_ZFC2_trans = M_ZFC1_trans + M_ZF2_trans + M_ZFC2
 
 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
 
 locale M_ctm2 = M_ctm1 + M_ZF_ground_trans
 
 locale M_ctm2_AC = M_ctm2 + M_ZFC2_trans
 
 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 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 (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 dcwit_replacement
   unfolding replacement_dcwit_repl_body_fm_def
   by simp
 
 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
 
-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_Diff lam_replacement_converse
+lemmas M_replacement_ZF_instances = lam_replacement_fst lam_replacement_snd
+  lam_replacement_Union lam_replacement_Image
   lam_replacement_middle_del lam_replacement_prodRepl
-  lam_replacement_comp
 
 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)
 
 end
 
 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 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
 
 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
 
 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(2)
   by simp
 
+(*
+
+These lemmas were required for the original proof of Schröder-Bernstein.
+
 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(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 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 " (\<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
   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
     by(rule_tac separation_cong[THEN iffD2],auto)
 qed
 
 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 assms banach_repl_iter' separation_banach_functor_iterates
   by simp
 
+*)
+
 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]. M(trans_apply_image(f, x, g))"
   unfolding trans_apply_image_def by simp
 
 end \<comment> \<open>\<^locale>\<open>M_ZF2_trans\<close>\<close>
 
-context M_ZF_ground_trans
+context M_ZF_ground_notCH_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
-    ZF_ground_replacements(4)
+    ZF_ground_notCH_replacements(1)
   by simp
 
 lemma transrec_replacement_apply_image:
   assumes "(##M)(f)" "(##M)(\<alpha>)"
   shows "transrec_replacement(##M, is_trans_apply_image(##M, f), \<alpha>)"
   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 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 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 ZF_ground_replacements(5)[unfolded replacement_assm_def, rule_format, where env="[\<beta>,f]",simplified])
+  apply(rule_tac ZF_ground_notCH_replacements(2)[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 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
   unfolding trans_apply_image_def
   by auto
 
 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>
+end \<comment> \<open>\<^locale>\<open>M_ZF_ground_notCH_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
     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
     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
           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,291 +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(G),nenv)"
   using assms
 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
     "A\<in>M[G]"
     "\<phi> \<in> formula" "env\<in>list(M[G])" "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)"
   shows
     "{x \<in> A . (M[G], [x] @ env \<Turnstile> \<phi>)} \<in> M[G]"
 proof -
   from \<open>A\<in>M[G]\<close>
   obtain \<pi> where "\<pi> \<in> M" "val(G, \<pi>) = A"
     using GenExt_def by auto
   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>="(\<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" "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)"
     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" "?\<psi>\<in>formula"
     using arity_rensep[OF definability[of "?\<chi>"]]
     by auto
   then
   have "arity(?\<psi>) \<le> 5 +\<^sub>\<omega> length(env)"
     using ord_simp_union arity_forces pred_mono[OF _ pred_mono[OF _ \<open>arity(?new_form) \<le> _\<close>]]
     by (auto simp:arity)
   from \<open>env \<in> _\<close>
   obtain nenv where "nenv\<in>list(M)" "env = map(val(G),nenv)" "length(nenv) = length(env)"
     using map_val by auto
   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>
   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 -
       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"
       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 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 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 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 ?thesis
         by simp
     qed
     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(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(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 "[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(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(G, \<theta>)] @ env @ [val(G, \<pi>)]) = val(G,\<pi>)"
     if "\<theta>\<in>M" for \<theta>
     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(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,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,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(G, \<theta>)\<in>val(G, \<pi>) \<and> (M[G], ?vals(\<theta>) \<Turnstile> \<phi>))}"
     (is "?n\<subseteq>?m")
     by auto
   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
+    by auto
   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(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(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> A. (M[G], [x] @ env @ [A] \<Turnstile> \<phi>)}"
     using \<open>G\<subseteq>P\<close> G_nonempty by force
   finally
   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(G,?m)"
     with val_m
     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
     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(G,\<theta>), val(G,\<pi>)] @ env \<in> list(M[G])" "[\<theta>] @ nenv @ [\<pi>]\<in>list(M)"
       using GenExt_def by auto
     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
         \<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>
     have "p\<in>P" "r\<in>P" "q\<in>P" "p\<in>M"
       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(_)\<close>
     have "\<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 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> = \<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>,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(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(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> 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 A
     assume "A\<in>M[G]"
     moreover from \<open>env \<in> _\<close>
     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 "{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,212 +1,211 @@
 subsection\<open>More Instances of Separation\<close>
 
 theory Separation_Instances
   imports
     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 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"
 
-
 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)"
+  "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_replacement) separation_well_ord:
+lemma (in M_replacement) separation_well_ord_iso:
   "(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
-    lam_replacement_apply[of f] lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+    lam_replacement_apply[of f] lam_replacement_product
   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"
 
 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
 
 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
 
 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)
 
 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)
 
 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)
 
 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"
 
 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 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
 
 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 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
 
 end  \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<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,134 +1,133 @@
 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>\<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"
 
 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)}"
 
 context forcing_data1
 begin
 
 lemma Union_name_closed :
   assumes "\<tau> \<in> M"
   shows "Union_name(P,leq,\<tau>) \<in> M"
 proof -
   let ?Q="Union_name_body(P,leq,\<tau>)"
   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
   moreover from this
   have "?d \<times> P \<in> M"
     using cartprod_closed by simp
   note types = assms \<open>?d\<times>P \<in> M\<close> \<open>?d\<in>M\<close>
   ultimately
   show ?thesis
     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]
+      lam_replacement_fst lam_replacement_snd lam_replacement_product
       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(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(G,\<tau>))"
     by simp
   then
   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(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(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"
     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(G,\<theta>) \<in> val(G,Union_name(P,leq,\<tau>))"
     using val_of_elem by simp
   ultimately
   show "x \<in> val(G,Union_name(P,leq,\<tau>))"
     by simp
 next
   fix x
   assume "x \<in> (val(G,Union_name(P,leq,\<tau>)))"
   moreover
   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(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 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(G,\<sigma>) \<in> val(G,\<tau>)" "val(G,\<theta>) \<in> val(G,\<sigma>)"
     using val_of_elem by simp+
   ultimately
   show "x \<in> \<Union> a"
     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(G,\<tau>)"
     using GenExtD by blast
   moreover from this
   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)
+  by (auto simp: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,665 +1,647 @@
 section\<open>Further instances of axiom-schemes\<close>
 
 theory ZF_Trans_Interpretations
   imports
     Internal_ZFC_Axioms
     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)"
 
 definition instances3_fms where "instances3_fms \<equiv>
   { replacement_is_order_body_fm,
-    wfrec_replacement_order_pred_fm,
-    replacement_is_jump_cardinal_body_fm }"
+    wfrec_replacement_order_pred_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_ZF3_ground = M_ZF3 + M_ZF_ground
-
-locale M_ZF3_ground_trans = M_ZF3_trans + M_ZF3_ground + M_ZF_ground_trans
-
-locale M_ZFC3_ground = M_ZFC3 + M_ZF3_ground
+locale M_ZF3_ground_notCH = M_ZF3 + M_ZF_ground_notCH
 
-locale M_ZFC3_ground_trans = M_ZFC3_trans + M_ZF3_ground_trans
+locale M_ZF3_ground_notCH_trans = M_ZF3_trans + M_ZF3_ground_notCH + M_ZF_ground_notCH_trans
 
-locale M_ZFC3_ground_CH_trans = M_ZFC3_ground_trans + M_ZF_ground_CH_trans
+locale M_ZFC3_ground_notCH = M_ZFC3 + M_ZF3_ground_notCH
 
-locale M_ctm3 = M_ctm2 + M_ZF3_ground_trans
+locale M_ZFC3_ground_notCH_trans = M_ZFC3_trans + M_ZFC3_ground_notCH + M_ZF3_ground_notCH_trans
 
-locale M_ctm3_AC = M_ctm3 + M_ctm1_AC + M_ZFC3_ground_trans
+locale M_ZFC3_ground_CH_trans = M_ZFC3_ground_notCH_trans + M_ZF_ground_CH_trans
+
+locale M_ctm3 = M_ctm2 + M_ZF3_ground_notCH_trans
+
+locale M_ctm3_AC = M_ctm3 + M_ctm1_AC + M_ZFC3_ground_notCH_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_well_ord_iso
   separation_obase_equals separation_is_obase
   separation_PiP_rel separation_surjP_rel
   separation_radd_body separation_rmult_body
 
-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>)"
+  "omap_wfrec_body(A,r) \<equiv> (\<cdot>\<exists>\<cdot>image_fm(2, 0, 1) \<and> pred_set_fm(A #+ 9, 3, r #+ 9, 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(1,0)) = 2"
+   using arity_is_order_body_fm arity_is_ordertype ord_simp_union
+   by (simp add:FOL_arities)
 
-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))"
+  "strong_replacement(##M, \<lambda>x z . \<exists>y[##M]. is_order_body(##M,x,y) \<and> z = \<langle>x,y\<rangle>)"
   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 )
+        where P="\<lambda> x f. M,[x,f] \<Turnstile> (\<cdot>\<exists> \<cdot>is_order_body_fm(1,0) \<and> pair_fm(1,0,2) \<cdot>\<cdot>)",THEN iffD1])
+   apply(simp add: is_order_body_iff_sats[where env="[_,_]",symmetric])
+   apply(simp_all add:zero_in_M )
+  apply(rule_tac replacement_ax3(1)[unfolded replacement_assm_def, rule_format, where env="[]",simplified])
+    apply(simp_all add:arity_is_order_body arity pred_Un_distrib ord_simp_union)
   done
 
 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
+    replacement_is_order_eq_map[unfolded order_eq_map_def]
   by unfold_locales simp_all
 
-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'_rel(##M))"
-  apply(rule_tac strong_replacement_cong[
-        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' )
-  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)
+definition is_well_ord_fst_snd where
+  "is_well_ord_fst_snd(A,x) \<equiv> (\<exists>a[A]. \<exists>b[A]. is_well_ord(A,a,b) \<and> is_snd(A, x, b) \<and> is_fst(A, x, a))"
 
-lemma (in M_pre_cardinal_arith) is_jump_cardinal_body_abs :
-  "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,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
+synthesize "is_well_ord_fst_snd" from_definition assuming "nonempty"
+arity_theorem for "is_well_ord_fst_snd_fm"
 
-lemma (in M_ZF3_trans) replacement_jump_cardinal_body:
-  "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]
-     is_jump_cardinal_body_abs
-  by simp
+lemma (in M_ZF3_trans) separation_well_ord: "separation(##M, \<lambda>x. is_well_ord(##M,fst(x), snd(x)))"
+  using arity_is_well_ord_fst_snd_fm is_well_ord_iff_sats[symmetric] nonempty
+    fst_closed snd_closed fst_abs snd_abs
+    separation_in_ctm[where env="[]" and \<phi>="is_well_ord_fst_snd_fm(0)"]
+  by(simp_all add: is_well_ord_fst_snd_def)
+
 
 sublocale M_ZF3_trans \<subseteq> M_pre_aleph "##M"
-  using  replacement_jump_cardinal_body[unfolded jump_cardinal_body'_rel_def]
-    HAleph_wfrec_repl replacement_is_order_body[unfolded is_order_body_def]
+  using HAleph_wfrec_repl replacement_is_order_body
+    separation_well_ord separation_Pow_rel
   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]: "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
 
 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>"
 
 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"
   using separation_bex_Aleph_rel[unfolded bex_Aleph_rel_def]
   by unfold_locales
 
 sublocale M_ZF2_trans \<subseteq> M_FiniteFun "##M"
   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"
   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 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,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,wfrec_rank_fm)"
     "ground_replacement_assm(M,env,trans_repl_HVFrom_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_HAleph_wfrec_repl_body_fm)"
     "ground_replacement_assm(M,env,replacement_is_order_eq_map_fm)"
-    "ground_replacement_assm(M,env,banach_iterates_fm)"
 
 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(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(wfrec_rank_fm),
     ground_repl_fm(trans_repl_HVFrom_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_HAleph_wfrec_repl_body_fm),
-    ground_repl_fm(replacement_is_order_eq_map_fm),
-    ground_repl_fm(banach_iterates_fm) }"
+    ground_repl_fm(replacement_is_order_eq_map_fm) }"
 
-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>
+text\<open>This set has $13$ 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>instances_ground_notCH_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 \<union> instances_ground_fms"
+  "overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances_ground_fms"
+
+definition overhead_notCH where
+  "overhead_notCH \<equiv> overhead \<union> instances3_fms \<union>
+     instances4_fms \<union> instances_ground_notCH_fms"
 
 definition overhead_CH where
-  "overhead_CH \<equiv> overhead \<union> { replacement_dcwit_repl_body_fm }"
+  "overhead_CH \<equiv> overhead_notCH \<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
+text\<open>Hence, the “overhead” to create a proper extension of a ctm by forcing
+consists of $16$ replacement instances. To force $\neg\CH$,
+31 instances are need, and one further instance is required 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
+    wfrec_replacement_order_pred_fm_def replacement_is_aleph_fm_def
   by (auto simp del: Lambda_in_M_fm_def)
 
 lemma overhead_type: "overhead \<subseteq> formula"
   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)
+  unfolding overhead_def replacement_instances1_defs replacement_instances2_defs
+  by simp
+
+lemma overhead_notCH_type: "overhead_notCH \<subseteq> formula"
+  using overhead_type
+  unfolding overhead_notCH_def replacement_transrec_apply_image_body_fm_def
+    replacement_is_trans_apply_image_fm_def instances_ground_notCH_fms_def
+    instances3_fms_def instances4_fms_def
+  by (auto simp: replacement_instances1_defs replacement_instances2_defs
+      replacement_instances3_defs 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
+  using overhead_notCH_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
 
 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
 
 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}"
+  assumes "Transset(M)" "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
   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
+    unfolding overhead_def 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_notCH_trans:
+  assumes
+    "Transset(M)"
+    "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH}"
+  shows "M_ZF_ground_notCH_trans(M)"
+proof -
+  from assms
+  interpret M_ZF_ground_trans M
+    using M_satT_imp_M_ZF_ground_trans unfolding overhead_notCH_def by force
+  {
+    fix \<phi> env
+    assume "\<phi> \<in> instances_ground_notCH_fms" "env\<in>list(M)"
+    moreover from this and assms
+    have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>"
+      unfolding overhead_notCH_def 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_notCH_fms_type by auto
+  }
+  then
+  show ?thesis
+    by unfold_locales (simp_all add:replacement_assm_def instances_ground_notCH_fms_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}}"
+    "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH }"
   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
+  interpret M_ZF_ground_notCH_trans M
+    using M_satT_imp_M_ZF_ground_notCH_trans unfolding overhead_CH_def 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
+    have "M, [] \<Turnstile> \<cdot>Replacement(replacement_dcwit_repl_body_fm)\<cdot>"
+      unfolding overhead_CH_def 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)"
+  "(M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH}) \<longrightarrow> M_ZFC4(M)"
 proof
-  assume "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
+  assume "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH}"
   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>
+    from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH}\<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
+      unfolding ZC_def Zermelo_fms_def ZF_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>
+    assume "\<phi> \<in> overhead_notCH" "env\<in>list(M)"
+    moreover from this and \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_notCH}\<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
+      using sats_ZF_replacement_fm_iff[of \<phi>] overhead_notCH_type by auto
   }
   ultimately
   show "M_ZFC4(M)"
-    unfolding overhead_def instances1_fms_def
+    unfolding overhead_def overhead_notCH_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/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,1603 +1,1611 @@
 section\<open>Relative, Choice-less Cardinal Arithmetic\<close>
 
 theory CardinalArith_Relative
   imports
     Cardinal_Relative
 
 begin
 
 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"
+relativize_tm "\<langle>fst(x) \<union> snd(x), fst(x), snd(x)\<rangle>" "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,i] \<Rightarrow> i" where
   "jump_cardinal_body(U,X) \<equiv>
     {z . r \<in> U, well_ord(X, r) \<and> z = ordertype(X, r)}"
 
+lemma jump_cardinal_body_char :
+  "jump_cardinal_body(U,X) = {ordertype(X, r) . r \<in> {r\<in>U . well_ord(X, r)}}"
+  unfolding jump_cardinal_body_def
+  by auto
+
+\<comment> \<open>We internalize the relativized version of this particular instance.\<close>
 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)"
 
 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)"
+  using csquare_lam_closed[unfolded csquare_lam_eq_lam]
   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  ****************)
+subsection\<open>Discipline for \<^term>\<open>csucc\<close>\<close>
+
 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)
-*)
+text\<open>We are not relativizing directly the results involving unions of
+(ordinal) indexed families (namely, @{thm [source] Card_UN} and
+@{thm [source] Card_OUN}, respectively) because of their higher order nature.\<close>
 
 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)"
 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 -
     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 that omap_exists[of A r] by auto
     moreover from calculation
     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
   show ?thesis
   proof(intro iffI)
     note assms
     moreover
     assume "otype(M, A, r, i)"
     moreover from calculation
     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 "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
 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
 
-(*
-This apparent duplication of definitions is needed because in ZF-Constructible
-pairs are in their absolute version and this breaks the synthesis of formulas.
-*)
+\<comment> \<open>This apparent duplication of definitions is needed because in \<^session>\<open>ZF-Constructible\<close>
+pairs are in their absolute version and this breaks the synthesis of formulas.\<close>
 
 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"
 
 \<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>
 (*
-\<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>
+\<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 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"
 
 lemma wfrec_on_pred_eq:
   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
   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\<^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 -
   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 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
 qed
 
 lemma wfrec_on_pred_closed':
   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 Pow_rel_char
   by simp
 
 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" "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>
+  have 1:"
     (\<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
+    z = \<langle>x,wfrec(r,x,\<lambda>x f. f `` Order.pred(A, x, r))\<rangle>" if "M(x)" "M(z)" for x z
+    using that 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]
       wfrec_pred_replacement
     unfolding relation2_def
     by auto
   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))>)"
+  have "strong_replacement(M,\<lambda>x z. z = \<langle>x,wfrec(r,x,\<lambda>x f. f `` Order.pred(A, x, r))\<rangle>)"
     using strong_replacement_cong[of M,OF 1,THEN iffD1,OF _ _
         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
     using lam_cong[OF refl wfrec_on_pred_eq] wfrec_on_pred_closed lam_closed
     by auto
 qed
 
 lemma is_ordermap_iff:
   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> _\<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"
+  have "r \<inter> A\<times>A = r" "M(r)" "r \<in> Pow(A\<times>A)" "\<And> x y . \<langle>x,y\<rangle>\<in>r \<Longrightarrow> x\<in>A"
     using Pow_rel_char
     by auto
   with assms
-  have 1:"wf(r)" "trans(r)" "relation(r)"
+  have "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
+    using ordermap_rel_closed[of r A] assms wfrec_on_pred_closed wfrec_pred_replacement
     unfolding is_ordermap_def ordermap_rel_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)
+     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>
 
 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)"
+  where "is_order_body(M,p,z) \<equiv> \<exists>X[M].\<exists>r[M].\<exists>A[M]. is_fst(M,p,X) \<and> is_snd(M,p,r) \<and>
+      cartprod(M,X,X,A) \<and> subset(M,r,A) \<and> M(z) \<and> M(r) \<and> is_well_ord(M,X,r) \<and> is_ordertype(M,X,r,z)"
 
 context M_pre_cardinal_arith
 begin
 
 lemma is_ordertype_iff:
-  assumes "r \<in> Pow\<^bsup>M\<^esup>(A\<times>A)" "wf[A](r)" "trans[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_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\<^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
+  unfolding is_ordertype_def ordertype_rel_def wf_on_def well_ord_def part_ord_def tot_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 (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
+  "M(Xr) \<Longrightarrow> M(z) \<Longrightarrow> is_order_body(M, Xr, z) \<longleftrightarrow>
+    snd(Xr)\<in>Pow\<^bsup>M\<^esup>(fst(Xr)\<times>fst(Xr)) \<and> well_ord(fst(Xr), snd(Xr)) \<and> z = ordertype(fst(Xr), snd(Xr))"
+  using is_ordertype_iff ordertype_rel_abs well_ord_is_linear Pow_rel_char
+    is_well_ord_iff_wellordered snd_abs fst_abs
   unfolding is_order_body_def
   by simp
 
 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>
 
 relativize functional "jump_cardinal_body" "jump_cardinal_body_rel"
 relationalize "jump_cardinal_body_rel" "is_jump_cardinal_body_rel"
 
 relativize functional "jump_cardinal_body'" "jump_cardinal_body'_rel"
 relationalize "jump_cardinal_body'_rel" "is_jump_cardinal_body'_rel"
 
-\<comment> \<open>NOTE: not quite the same as \<^term>\<open>jump_cardinal\<close>,
-    note \<^term>\<open>Pow(X*X)\<close>.\<close>
+text\<open>Notice that this is not quite the same as \<^term>\<open>jump_cardinal\<close>:
+observe \<^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)}"
 
 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))"
+    is_ordertype_replacement :
+    "strong_replacement(M,\<lambda> x z . \<exists>y[M]. is_order_body(M,x,y) \<and> z=\<langle>x,y\<rangle>)"
     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))"
+    pow_rel_separation : "\<forall>A[M]. separation(M, \<lambda>y. \<exists>x[M]. x \<in> A \<and> y = \<langle>x, Pow\<^bsup>M\<^esup>(x)\<rangle>)"
+    and
+    separation_is_well_ord : "separation(M, \<lambda>x . is_well_ord(M,fst(x),snd(x)))"
 begin
 
-lemma jump_cardinal_closed_aux1:
-  assumes "M(X)"
-  shows "M(jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X),X))"
+lemmas Pow_rel_replacement = lam_replacement_Pow_rel[OF pow_rel_separation]
+
+lemma ordtype_replacement :
+  "strong_replacement(M , \<lambda>x z . (snd(x) \<in> Pow\<^bsup>M\<^esup>(fst(x)\<times>fst(x)) \<and> well_ord(fst(x),snd(x))) \<and>
+      z =\<langle>x, ordertype(fst(x),snd(x))\<rangle>)"
+  using strong_replacement_cong[THEN iffD1,OF _ is_ordertype_replacement] is_order_body_abs
+  by simp
+
+lemma separation_well_ord : "separation(M, \<lambda>x . well_ord(fst(x),snd(x)))"
+  using separation_cong[THEN iffD1] separation_is_well_ord is_well_ord_iff_wellordered well_ord_abs
+  by simp
+
+lemma jump_cardinal_body_lam_replacement :
+  shows "lam_replacement(M, \<lambda>X .jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X),X))" and
+    "M(X) \<Longrightarrow> 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
+  define WO where "WO \<equiv> \<lambda>X . {r\<in>Pow\<^bsup>M\<^esup>(X\<times>X) . well_ord(X,r)}"
+  define lam_jump_cardinal_body where
+     "lam_jump_cardinal_body \<equiv> \<lambda>X . \<lambda>r\<in>WO(X) . ordertype(X,r)"
+  have "lam_jump_cardinal_body(X) = {\<langle>r,ordertype(X,r)\<rangle> . r \<in> WO(X)}" for X
+    unfolding lam_jump_cardinal_body_def WO_def lam_def
+    by simp
+  then
+  have "jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X),X) = {snd(p) . p \<in> lam_jump_cardinal_body(X)}" if "M(X)" for X
+    unfolding jump_cardinal_body_def WO_def lam_def
+    by force
+  moreover
+  have "lam_replacement(M, \<lambda>x. {y . r \<in> Pow\<^bsup>M\<^esup>(x \<times> x), (r \<in> Pow\<^bsup>M\<^esup>(x \<times> x) \<and> well_ord(x, r)) \<and> y = ordertype(x, r)})"
+    (is "lam_replacement(M,?q)")
+  using Pow_rel_replacement[THEN [2] lam_replacement_hcomp]
+      lam_replacement_CartProd lam_replacement_identity lam_replacement_fst lam_replacement_snd
+      fst_closed[OF transM] snd_closed[OF transM]
+      separation_well_ord separation_in separation_conj transM[of _ "Pow\<^bsup>M\<^esup>(_\<times>_)"]
+      strong_lam_replacement_imp_lam_replacement_RepFun[OF ordtype_replacement, where g="\<lambda>X. Pow\<^bsup>M\<^esup>(X \<times> X)"]
+  by force
+  moreover
+  have "M(?q(x))" if "M(x)" for x
+    using that Pow_rel_replacement[THEN [2] lam_replacement_hcomp]
+      lam_replacement_CartProd lam_replacement_identity
+      ordertype_closed transM[of _ "Pow\<^bsup>M\<^esup>(_\<times>_)"]
+      fst_closed[OF transM] snd_closed[OF transM]
+    by(rule_tac strong_lam_replacement_imp_strong_replacement[OF ordtype_replacement,THEN strong_replacement_closed],
+        auto)
+  moreover
+  have "?q(x)={snd(p) . p \<in> (\<lambda>r\<in>WO(x). ordertype(x, r))}" if "M(x)" for x
+    using that
+    unfolding lam_def WO_def
+    by force
+  moreover from calculation
+  have "?q(X) = jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X), X)" if "M(X)" for X
+    using that
+    unfolding lam_jump_cardinal_body_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
+  have "M(jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X), X))" if "M(X)" for X
+    using that 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
+  have 1:"lam_replacement(M, \<lambda>x . {snd(p) . p \<in> lam_jump_cardinal_body(x)})"
+    using lam_replacement_cong
     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
+  show "lam_replacement(M, \<lambda>X .jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X),X))" and
+    "M(X) \<Longrightarrow> M(jump_cardinal_body(Pow\<^bsup>M\<^esup>(X \<times> X), X))"
+    using lam_replacement_imp_strong_replacement[OF lam_replacement_snd]
+      lam_replacement_cong[OF 1,unfolded lam_jump_cardinal_body_def]
+    by simp_all
 qed
 
-lemma jump_cardinal_body_closed:
+lemmas jump_cardinal_body_closed = jump_cardinal_body_lam_replacement(2)
+
+lemma jump_cardinal_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
+  using assms jump_cardinal_body_lam_replacement lam_replacement_imp_strong_replacement
+    transM[of _ "Pow\<^bsup>M\<^esup>(K)"] RepFun_closed
+  by auto
 
 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_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 def_jump_cardinal_rel_aux:
   "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
   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>{jump_cardinal_body(Pow\<^bsup>M\<^esup>(K*K),X) . X\<in> Pow\<^bsup>M\<^esup>(K)})"
 proof -
   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 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>(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)"]
+    using jump_cardinal_body_closed[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"]
+  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
       ordertype_rel_abs transM[of _ "Pow\<^bsup>M\<^esup>(K)"] transM[of _ "Pow\<^bsup>M\<^esup>(K\<times>K)"]
       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)"])
+    apply(intro equalityI subsetI,auto dest:transM[of _ "Pow\<^bsup>M\<^esup>(K)"],rename_tac y r)
     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
 
 lemma Ord_jump_cardinal_rel: "M(K) \<Longrightarrow> Ord(jump_cardinal_rel(M,K))"
   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 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)})"
+         (\<Union>X\<in>Pow\<^bsup>M\<^esup>(K). {z. r \<in> Pow\<^bsup>M\<^esup>(X\<times>X), well_ord(X,r) \<and> 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
+    using def_jump_cardinal_rel_aux jump_cardinal_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)
+   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,441 +1,436 @@
 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 +
   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)+
+    lam_replacement_identity lam_replacement_hcomp2[of _ _ minimum]
+  by simp
 
 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,1258 +1,1241 @@
 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
+    using lam_closed[of "\<lambda> x. S`x"] apply_type[OF \<open>S\<in>_\<close>] transM[OF _ \<open>M(B)\<close>]
     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:
+lemma lepoll_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
+  using assms lepoll_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
     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
     cardinal_rel_separation :
     "separation(M, \<lambda>\<langle>x,y\<rangle>. cardinal_rel(M,x) = y)"
     and
     separation_cardinal_rel_lt :
     "M(\<gamma>) \<Longrightarrow> separation(M, \<lambda>Z . cardinal_rel(M,Z) < \<gamma>)"
 
 begin
 
-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
+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_product] separation_ball
+    lam_replacement_fst lam_replacement_snd lam_replacement_constant
   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 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 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_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_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
+      using le_Aleph_rel1_nat[of "|G ` n|\<^bsup>M\<^esup>"] lepoll_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>]
+    using InfCard_rel_nat lepoll_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>
 
 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
 
 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 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_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 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 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 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] separation_orthogonal
+      using cdlt_assms[where Q=Q] surj_imp_inj_replacement3
+        lam_replacement_Collect_ball_Pair[THEN lam_replacement_imp_strong_replacement]
+        lam_replacement_minimum[THEN [5] lam_replacement_hcomp2,OF
+          lam_replacement_constant lam_replacement_Collect_ball_Pair,unfolded lam_replacement_def]
+        lam_replacement_Sigfun[OF lam_replacement_Collect_ball_Pair,THEN
+          lam_replacement_imp_strong_replacement]
       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>]
+    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_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> \<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 "\<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 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_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
+      using lepoll_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_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,1331 +1,1487 @@
 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
 
 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>
 
+context M_Perm
+begin
+
+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: "\<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: "\<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
+
+end \<comment> \<open>\<^locale>\<open>M_Perm\<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
-    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)
+  using separation_Pair separation_in lam_replacement_product
+    lam_replacement_fst lam_replacement_snd lam_replacement_constant
+    lam_replacement_apply2[THEN [5] lam_replacement_hcomp2]
+  by simp
 
 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 **)
+subsection\<open>Banach's Decomposition Theorem\<close>
 
 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)"
+    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))"
   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) |] ==>
+  assumes
+    banach_repl_iter: "M(f) \<Longrightarrow> M(g) \<Longrightarrow> M(X) \<Longrightarrow> M(Y) \<Longrightarrow>
+               strong_replacement(M, \<lambda>x y. x\<in>nat \<and> y = banach_functor(X, Y, f, g)^x (0))"
+  shows
+    "[| 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]
+  using lfp_banach_functor_closed[of g X Y f] assms
   unfolding banach_functor_def by simp_all
 
 lemma schroeder_bernstein_closed:
+  assumes
+    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))"
+  shows
   "[| 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 (insert banach_decomposition_rel [of f g X Y, OF banach_repl_iter])
   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
+text\<open>The previous lemmas finish our original, direct relativization
+of the material involving the iterative proof (as appearing in \<^theory>\<open>ZF.Cardinal\<close>)
+of the Schröder-Bernstein theorem. Next, we formalize 
+Zermelo's proof that replaces the recursive construction by a fixed point
+represented as an intersection \cite[Exr. x4.27]{moschovakis1994notes}. This allows
+to avoid at least one replacement assumption.\<close>
 
-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 dedekind_zermelo:
+  assumes
+    "A' \<subseteq> B" "B \<subseteq> A" "A \<approx>\<^bsup>M\<^esup> A'"
+    and types: "M(A')" "M(B)" "M(A)"
+  shows
+    "A \<approx>\<^bsup>M\<^esup> B"
+proof -
+  from \<open>A \<approx>\<^bsup>M\<^esup> A'\<close> and types
+  obtain f where "f \<in> bij\<^bsup>M\<^esup>(A,A')"
+    unfolding eqpoll_rel_def by blast
+  let ?Q="B - f``A"
+  from \<open>f \<in> _\<close> \<open>A' \<subseteq> B\<close> types
+  have "f``X \<subseteq> B" for X
+    using mem_bij_rel[THEN bij_is_fun, THEN Image_sub_codomain, of f A A'] by auto
+  moreover
+  note \<open>B \<subseteq> A\<close>
+  moreover from calculation
+  have "f``X \<subseteq> A" for X by auto
+  moreover
+  define \<T> where "\<T>  \<equiv> { X \<in> Pow\<^bsup>M\<^esup>(A) . ?Q \<union> f `` X \<subseteq> X}"
+  moreover from calculation
+  have "A \<in> \<T>" using def_Pow_rel by (auto simp:types)
+  ultimately
+  have "\<T> \<noteq> 0" unfolding \<T>_def by auto
+  let ?T="\<Inter>\<T>"
+  have "?T \<subseteq> A"
+  proof
+    fix x
+    assume "x \<in> ?T"
+    with \<open>\<T> \<noteq> 0\<close>
+    obtain X where "x \<in> X" "X \<in> \<T>"
+      by blast
+    moreover from this
+    have "X \<in> Pow\<^bsup>M\<^esup>(A)"
+      unfolding \<T>_def by simp
+    moreover from calculation and \<open>M(A)\<close>
+    have "M(x)" using Pow_rel_char by (auto dest:transM)
+    ultimately
+    show "x \<in> A" using Pow_rel_char by (auto simp:types)
+  qed
+  moreover from \<open>\<T> \<noteq> 0\<close>
+  have "?Q \<union> f``?T \<subseteq> ?T"
+    using image_mono unfolding \<T>_def by blast
+  moreover from \<open>f \<in> _\<close>
+  have "M(\<T>)"
+    using zermelo_separation unfolding \<T>_def by (auto simp:types dest:transM)
+  moreover from this
+  have "M(?T)" by simp
+  moreover
+  note \<open>\<T> \<noteq> 0\<close>
+  ultimately
+  have "?T \<in> \<T>"
+    unfolding \<T>_def using def_Pow_rel
+    by (auto simp:types)
+  have "?T \<subseteq> ?Q \<union> f``?T"
+  proof (intro subsetI, rule ccontr)
+    fix x
+    from \<open>_ \<union> f ``?T \<subseteq> ?T\<close>
+    have "f `` (?T - {x}) \<subseteq> ?T" "f `` (?T - {x}) \<subseteq> f`` ?T" by auto
+    assume "x \<in> ?T" "x \<notin> ?Q \<union> f``?T"
+    then
+    have "?T - {x} \<in> \<T>"
+    proof -
+      note \<open>f `` (?T - {x}) \<subseteq> ?T\<close>
+      moreover from this and \<open>x \<notin> _ \<union> f``?T\<close>
+      have "x \<notin> f `` ?T" by simp
+      ultimately
+      have "f `` (?T - {x}) \<subseteq> ?T - {x}" by auto
+      moreover from \<open>x \<notin> ?Q \<union> _\<close> \<open>?Q \<union> _ \<subseteq> ?T\<close>
+      have "?Q \<subseteq> ?T - {x}" by auto
+      moreover
+      note \<open>?T \<in> _\<close> \<open>x \<in> ?T\<close> \<open>M(?T)\<close> \<open>?T \<subseteq> _\<close>
+      ultimately
+      show ?thesis
+        using def_Pow_rel[of "?T - {x}" A] transM[of _ ?T]
+        unfolding \<T>_def
+        by (auto simp:types)
+    qed
+    moreover
+    note \<open>f `` (?T - {x}) \<subseteq> f`` ?T\<close>
+    ultimately
+    have "?T \<subseteq> ?T - {x}" by auto
+    with \<open>x \<in> ?T\<close>
+    show False by auto
+  qed
+  with \<open>?Q \<union> f``?T \<subseteq> ?T\<close>
+  have "?T = ?Q \<union> f``?T" by auto
+  from \<open>\<And>X. f``X \<subseteq> B\<close>
+  have "(?Q \<union> f``?T) \<union> (f``A - f``?T) \<subseteq> B" by auto
+  with \<open>?T = _\<close>
+  have "?T \<union> (f``A - f``?T) \<subseteq> B" by simp
+  with \<open>\<T> \<noteq> 0\<close> \<open>?T = _\<close>
+  have "B = ?T \<union> (f``A - f``?T)"
+  proof (intro equalityI, intro subsetI)
+    fix x
+    assume "x \<in> B"
+    with \<open>\<T> \<noteq> 0\<close> \<open>?T = _\<close>
+    show "x \<in> ?T \<union> (f``A - f``?T)"
+      by (subst \<open>?T = _\<close>, clarify)
+  qed
+  moreover from \<open>?T \<subseteq> A\<close>
+  have "A = ?T \<union> (A - ?T)" by auto
+  moreover from \<open>M(?T)\<close> \<open>f \<in> _\<close>
+  have "M(id(?T) \<union> restrict(f,A-?T))"
+    using bij_rel_closed[THEN [2] transM] id_closed by (auto simp:types)
+  moreover from \<open>?T = _\<close> \<open>f \<in> _\<close>
+  have "f``A - f``?T = f``(A - ?T)"
+    using bij_rel_char bij_is_inj[THEN inj_range_Diff, of f A]
+    by (auto simp:types)
+  from \<open>f \<in> _\<close> types
+  have "id(?T) \<union> restrict(f, A-?T) \<in> bij(?T \<union> (A - ?T),?T \<union> (f``A - f``?T))"
+    using id_bij mem_bij_rel[of _ A A', THEN bij_is_inj]
+    by (rule_tac bij_disjoint_Un; clarsimp)
+      (subst \<open>f``A - f``?T =_ \<close>, auto intro:restrict_bij, subst \<open>?T = _\<close>, auto)
+  moreover
+  note types
+  ultimately
+  show ?thesis
+    using bij_rel_char unfolding eqpoll_rel_def by fastforce
+qed
 
-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 schroeder_bernstein_closed':
+  assumes "f \<in> inj\<^bsup>M\<^esup>(A,C)" " g \<in> inj\<^bsup>M\<^esup>(C,A)"
+    and types:"M(A)" "M(C)"
+  shows "A \<approx>\<^bsup>M\<^esup> C"
+proof -
+  from assms
+  have "f \<in> inj(A,C)" " g \<in> inj(C,A)" "M(f)" "M(g)"
+    using inj_rel_char by auto
+  moreover from this
+  have "g \<in> bij(C,range(g))" "g O f \<in> bij(A,range(g O f))"
+    using inj_bij_range comp_inj by auto blast
+  moreover from calculation
+  have "range(g O f) \<subseteq> range(g)" "range(g) \<subseteq> A"
+    using inj_is_fun[THEN range_fun_subset_codomain] by auto
+  moreover from calculation
+  obtain h where "h \<in> bij\<^bsup>M\<^esup>(A, range(g))"
+    using dedekind_zermelo[of "range(g O f)" "range(g)" A]
+      bij_rel_char def_eqpoll_rel
+    by (auto simp:types)
+  ultimately
+  show ?thesis
+    using bij_rel_char def_eqpoll_rel comp_bij[of h A "range(g)" "converse(g)" C]
+      bij_converse_bij[of g C "range(g)"] by (auto simp:types)
+qed
 
-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
+text\<open>Relative equipollence is an equivalence relation\<close>
+
+declare mem_bij_abs[simp] mem_inj_abs[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 **)
+text\<open>Relative le-pollence is a preorder\<close>
 
 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
+  unfolding def_lepoll_rel using schroeder_bernstein_closed'
+  by (auto simp del:mem_inj_abs)
 
 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> *)
+\<comment> \<open>\<^term>\<open>M(Y) \<Longrightarrow> 0 \<lesssim>\<^bsup>M\<^esup> Y\<close>\<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>
+subsection\<open>lesspoll: 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 **)
+\<comment> \<open>Variations on transitivity\<close>
 
 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*)
+    \<comment> \<open>Proving it's in the function space \<^term>\<open>A\<rightarrow>B\<close>\<close>
     apply (rule if_type [THEN lam_type])
      apply (blast dest: apply_funtype)
     apply (blast elim!: mem_irrefl dest: apply_funtype)
-    (*Proving it's injective*)
+    \<comment> \<open>Proving it's injective\<close>
    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)"
+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
+end
\ No newline at end of file
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,378 +1,373 @@
 section\<open>The Delta System Lemma, Relativized\label{sec:dsl-rel}\<close>
 
 theory Delta_System_Relative
   imports
     Cardinal_Library_Relative
 begin
 
 relativize functional "delta_system" "delta_system_rel" external
 
 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
 
 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
   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>\<forall>A\<in>F. Finite(A)\<close> \<open>M(F)\<close>
   have "M(\<lambda>A\<in>F. |A|\<^bsup>M\<^esup>)"
     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
+            lam_replacement_Collect'[of G "\<lambda>x y. x\<in>y"] mem_F_bound6[of _ G]
+            lam_replacement_minimum separation_in lam_replacement_fst lam_replacement_snd
+          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,
+            le_Card_rel_iff[THEN iffD2, THEN [3] lepoll_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,659 +1,638 @@
 theory Discipline_Base
   imports
     "ZF-Constructible.Rank"
     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
+lemmas (in M_trivial) singleton_closed = singleton_in_MI
 
 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
 
+\<comment> \<open>In the next lemma, the absoluteness hypotheses on \<^term>\<open>g1\<close> and \<^term>\<open>g2\<close> can be restricted
+to the actual parameters.\<close>
 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] *)
+  unfolding is_hcomp2_2_def
+  using assms
   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>
+definition
   Sigfun :: "[i,i\<Rightarrow>i]\<Rightarrow>i"  where
   "Sigfun(x,B) \<equiv> \<Union>y\<in>B(x). {\<langle>x,y\<rangle>}"
 
+lemma SigFun_char : "Sigfun(x,B) = {x}\<times>B(x)"
+  unfolding Sigfun_def by auto
+
 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>
+definition \<comment> \<open>Note that $B$ below is a higher order argument\<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]
+      Sigfun_closed Sigma_Sigfun 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
+    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 *)
+definition \<comment> \<open>completely relational\<close>
   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
+\<comment> \<open>From this point on, the higher order variable \<^term>\<open>B\<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,173 +1,179 @@
+section\<open>Basic relativization of cardinality\<close>
+
 theory Discipline_Cardinal
   imports
     Discipline_Function
 begin
 
 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
+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
+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
 
 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
-
+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
+end \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
 
 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)"
 
+subsection\<open>Disicpline for \<^term>\<open>cadd\<close>\<close>
 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
+context M_basic
+begin
 rel_closed for "cadd"
   using cardinal_rel_closed
   unfolding cadd_rel_def
   by simp
-end
-
-(* relativization *)
+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
 
 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
+context M_Perm
+begin
 is_iff_rel for "cadd"
   using is_cardinal_iff
   unfolding is_cadd_def cadd_rel_def
   by simp
-end
+
+end  \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
+
+subsection\<open>Disicpline for \<^term>\<open>cmult\<close>\<close>
 
 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
-
+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 \<comment> \<open>\<^locale>\<open>M_Perm\<close>\<close>
 
 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,963 +1,928 @@
+section\<open>Basic relativization of function spaces\<close>
+
 theory Discipline_Function
   imports
     Arities
 begin
 
-(**********************************************************)
-paragraph\<open>Discipline for \<^term>\<open>fst\<close>\<close>
+subsection\<open>Discipline for \<^term>\<open>fst\<close> and \<^term>\<open>snd\<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_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_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>
 
+subsection\<open>Discipline for \<^term>\<open>minimum\<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 *)
+definition \<comment> \<open>completely relational\<close>
   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 *)
+definition \<comment> \<open>completely relational\<close>
   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 ******************)
+subsection\<open>Discipline for \<^term>\<open>surj\<close>\<close>
 
 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 *)
+definition \<comment> \<open>completely relational\<close>
   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  *********************)
+subsection\<open>Discipline for \<^term>\<open>Inter\<close>\<close>
 
 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 *)
+text\<open>The next lemma is not part of the discipline\<close>
 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 *)
+\<comment> \<open>This lemma is not part of the discipline.\<close>
 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/Higher_Order_Constructs.thy b/thys/Transitive_Models/Higher_Order_Constructs.thy
--- a/thys/Transitive_Models/Higher_Order_Constructs.thy
+++ b/thys/Transitive_Models/Higher_Order_Constructs.thy
@@ -1,152 +1,152 @@
-section\<open>Fully relational versions of higher order construct \<close>
+section\<open>Fully relational versions of higher order constructs\<close>
 theory Higher_Order_Constructs
   imports
     Recursion_Thms
     Least
 begin
 
 syntax
   "_sats"  :: "[i, i, i] \<Rightarrow> o"  ("(_, _ \<Turnstile> _)" [36,36,36] 25)
 translations
   "(M,env \<Turnstile> \<phi>)" \<rightleftharpoons> "CONST sats(M,\<phi>,env)"
 
 definition
   is_If :: "[i\<Rightarrow>o,o,i,i,i] \<Rightarrow> o" where
   "is_If(M,b,t,f,r) \<equiv> (b \<longrightarrow> r=t) \<and> (\<not>b \<longrightarrow> r=f)"
 
 lemma (in M_trans) If_abs:
   "is_If(M,b,t,f,r) \<longleftrightarrow> r = If(b,t,f)"
   by (simp add: is_If_def)
 
 
 definition
   is_If_fm :: "[i,i,i,i] \<Rightarrow> i" where
   "is_If_fm(\<phi>,t,f,r) \<equiv> Or(And(\<phi>,Equal(t,r)),And(Neg(\<phi>),Equal(f,r)))"
 
 lemma is_If_fm_type [TC]: "\<phi> \<in> formula \<Longrightarrow> t \<in> nat \<Longrightarrow> f \<in> nat \<Longrightarrow> r \<in> nat \<Longrightarrow>
   is_If_fm(\<phi>,t,f,r) \<in> formula"
   unfolding is_If_fm_def by auto
 
 lemma sats_is_If_fm:
   assumes Qsats: "Q \<longleftrightarrow> A, env \<Turnstile> \<phi>" "env \<in> list(A)"
   shows "is_If(##A, Q, nth(t, env), nth(f, env), nth(r, env)) \<longleftrightarrow> A, env \<Turnstile> is_If_fm(\<phi>,t,f,r)"
   using assms unfolding is_If_def is_If_fm_def by auto
 
 lemma is_If_fm_iff_sats [iff_sats]:
   assumes Qsats: "Q \<longleftrightarrow> A, env \<Turnstile> \<phi>" and
     "nth(t, env) = ta" "nth(f, env) = fa" "nth(r, env) = ra"
     "t \<in> nat" "f \<in> nat" "r \<in> nat" "env \<in> list(A)"
   shows "is_If(##A,Q,ta,fa,ra) \<longleftrightarrow> A, env \<Turnstile> is_If_fm(\<phi>,t,f,r)"
   using assms sats_is_If_fm[of Q A \<phi> env t f r] by simp
 
 lemma arity_is_If_fm [arity]:
   "\<phi> \<in> formula \<Longrightarrow> t \<in> nat \<Longrightarrow> f \<in> nat \<Longrightarrow> r \<in> nat \<Longrightarrow>
     arity(is_If_fm(\<phi>, t, f, r)) = arity(\<phi>) \<union> succ(t) \<union> succ(r) \<union> succ(f)"
   unfolding is_If_fm_def
   by auto
 
 definition
   is_The :: "[i\<Rightarrow>o,i\<Rightarrow>o,i] \<Rightarrow> o" where
   "is_The(M,Q,i) \<equiv> (Q(i) \<and> (\<exists>x[M]. Q(x) \<and> (\<forall>y[M]. Q(y) \<longrightarrow> y = x))) \<or>
                    (\<not>(\<exists>x[M]. Q(x) \<and> (\<forall>y[M]. Q(y) \<longrightarrow> y = x))) \<and> empty(M,i) "
 
 (*
 definition
   is_The_fm :: "[i,i] \<Rightarrow> i" where
   "is_The_fm(q,i) \<equiv> Or(And(Exists(And(Equal(succ(i),0),q)),
                   Exists(And(q,Forall(Implies(q,Equal(1,0)))))),
                           And(Neg(Exists(And(q,Forall(Implies(q,Equal(1,0)))))),empty_fm(i)))"
 
 (* this doesn't work yet *)
 lemma sats_The_fm :
   assumes p_iff_sats:
     "\<And>a. a \<in> A \<Longrightarrow> P(a) \<longleftrightarrow> sats(A, p, Cons(a, env))"
   shows
     "\<lbrakk>y \<in> nat; env \<in> list(A) ; 0\<in>A\<rbrakk>
     \<Longrightarrow> sats(A, is_The_fm(p,y), env) \<longleftrightarrow>
         is_The(##A, P, nth(y,env))"
   using nth_closed p_iff_sats
   unfolding is_The_def is_The_fm_def
   oops
 
 lemma The_iff_sats [iff_sats]:
   assumes is_Q_iff_sats:
       "\<And>a. a \<in> A \<Longrightarrow> is_Q(a) \<longleftrightarrow> sats(A, q, Cons(a,env))"
   shows
   "\<lbrakk>nth(j,env) = y; j \<in> nat; env \<in> list(A); 0\<in>A\<rbrakk>
    \<Longrightarrow> is_The(##A, is_Q, y) \<longleftrightarrow> sats(A, is_The_fm(q,j), env)"
   using sats_The_fm [OF is_Q_iff_sats, of j , symmetric]
   by simp
 *)
 
 lemma (in M_trans) The_abs:
   assumes "\<And>x. Q(x) \<Longrightarrow> M(x)" "M(a)"
   shows "is_The(M,Q,a) \<longleftrightarrow> a = (THE x. Q(x))"
 proof (cases "\<exists>x[M]. Q(x) \<and> (\<forall>y[M]. Q(y) \<longrightarrow> y = x)")
   case True
   with assms
   show ?thesis
     unfolding is_The_def
     by (intro iffI the_equality[symmetric])
       (auto, blast intro:theI)
 next
   case False
   with \<open>\<And>x. Q(x) \<Longrightarrow> M(x)\<close>
   have " \<not> (\<exists>x. Q(x) \<and> (\<forall>y. Q(y) \<longrightarrow> y = x))"
     by auto
   then
   have "The(Q) = 0"
     by (intro the_0) auto
   with assms and False
   show ?thesis
     unfolding is_The_def
     by auto
 qed
 
 (*
 definition
   recursor  :: "[i, [i,i]=>i, i]=>i"  where
     "recursor(a,b,k) \<equiv>  transrec(k, \<lambda>n f. nat_case(a, \<lambda>m. b(m, f`m), n))"
 *)
 
 definition
   is_recursor :: "[i\<Rightarrow>o,i,[i,i,i]\<Rightarrow>o,i,i] \<Rightarrow>o" where
   "is_recursor(M,a,is_b,k,r) \<equiv> is_transrec(M, \<lambda>n f ntc. is_nat_case(M,a,
       \<lambda>m bmfm.
       \<exists>fm[M]. fun_apply(M,f,m,fm) \<and> is_b(m,fm,bmfm),n,ntc),k,r)"
 
 lemma (in M_eclose) recursor_abs:
   assumes "Ord(k)" and
     types: "M(a)" "M(k)" "M(r)" and
     b_iff: "\<And>m f bmf. M(m) \<Longrightarrow> M(f) \<Longrightarrow> M(bmf) \<Longrightarrow> is_b(m,f,bmf)  \<longleftrightarrow> bmf = b(m,f)" and
     b_closed: "\<And>m f bmf. M(m) \<Longrightarrow> M(f) \<Longrightarrow> M(b(m,f))" and
     repl: "transrec_replacement(M, \<lambda>n f ntc. is_nat_case(M, a,
         \<lambda>m bmfm. \<exists>fm[M]. fun_apply(M, f, m, fm) \<and> is_b( m, fm, bmfm), n, ntc), k)"
   shows
     "is_recursor(M,a,is_b,k,r) \<longleftrightarrow> r = recursor(a,b,k)"
   unfolding is_recursor_def recursor_def
   using assms
   apply (rule_tac transrec_abs)
        apply (auto simp:relation2_def)
    apply (rule nat_case_abs[THEN iffD1, where is_b1="\<lambda>m bmfm.
       \<exists>fm[M]. fun_apply(M,_,m,fm) \<and> is_b(m,fm,bmfm)"])
       apply (auto simp:relation1_def)
   apply (rule nat_case_abs[THEN iffD2, where is_b1="\<lambda>m bmfm.
       \<exists>fm[M]. fun_apply(M,_,m,fm) \<and> is_b(m,fm,bmfm)"])
      apply (auto simp:relation1_def)
   done
 
 definition
   is_wfrec_on :: "[i=>o,[i,i,i]=>o,i,i,i, i] => o" where
   "is_wfrec_on(M,MH,A,r,a,z) == is_wfrec(M,MH,r,a,z)"
 
 lemma (in M_trancl) trans_wfrec_on_abs:
   "[|wf(r);  trans(r);  relation(r);  M(r);  M(a);  M(z);
      wfrec_replacement(M,MH,r);  relation2(M,MH,H);
      \<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(H(x,g));
      r-``{a}\<subseteq>A; a \<in> A|]
    ==> is_wfrec_on(M,MH,A,r,a,z) \<longleftrightarrow> z=wfrec[A](r,a,H)"
   using trans_wfrec_abs wfrec_trans_restr
   unfolding is_wfrec_on_def by simp
 
 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,2361 +1,2508 @@
 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
 
+\<comment> \<open>\<close>
 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
 
+\<comment> \<open>This lemma could be modularized into the instantiation (fixing \<^term>\<open>X\<close>)
+and the projection of the result of \<^term>\<open>f\<close>.\<close>
+lemma strong_lam_replacement_imp_strong_replacement :
+  assumes  "strong_replacement(M,\<lambda> x z . P(fst(x),snd(x)) \<and> z=\<langle>x,f(fst(x),snd(x))\<rangle>)"
+    "\<And>A . M(A) \<Longrightarrow> \<forall>x\<in>A. P(X,x) \<longrightarrow> M(f(X,x))" "M(X)"
+  shows "strong_replacement(M,\<lambda> x z . P(X,x) \<and> z=f(X,x))"
+  unfolding strong_replacement_def
+proof(clarsimp)
+  fix A
+  assume "M(A)"
+  moreover from this \<open>M(X)\<close>
+  have "M({X}\<times>A)" (is "M(?A)")
+    by simp
+  moreover
+  have "fst(x) = X" if "x\<in>?A" for x
+    using that by auto
+  moreover from calculation assms
+  have "M({z . x\<in>?A , P(fst(x),snd(x)) \<and> z=\<langle>x,f(fst(x),snd(x))\<rangle>})" (is "M(?F)")
+    using transM[of _ ?A]
+    by(rule_tac strong_replacement_closed,simp_all)
+  moreover
+  have "?F=({\<langle>x,f(fst(x),snd(x))\<rangle> . x\<in> {x\<in>?A .  P(fst(x),snd(x))}})" (is "_=(?G)")
+    by auto
+  moreover
+  note \<open>M(?A)\<close>
+  ultimately
+  have "M(?G``?A)"
+    by simp
+  moreover
+  have "?G``?A = {y . x\<in>?A , P(fst(x),snd(x)) \<and> y = f(fst(x),snd(x))}" (is "_=(?H)")
+    by auto
+  ultimately
+  show "\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x\<in>A. P(X,x) \<and> b = f(X,x))"
+    by(rule_tac rexI[of _ ?H],auto,force)
+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 fst_in_double_Union:
-  assumes "x\<in>X" "M(X)"
+  assumes "x\<in>X"
   shows "fst(x) \<in> {0} \<union> \<Union>\<Union>X"
 proof -
   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)"
+  assumes "x\<in>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 ?thesis
       by simp
   qed
   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 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[M]. x\<in>A \<and> y = \<langle>x, fst(x)\<rangle>)"
   shows "lam_replacement(M,fst)"
   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
 
+\<comment> \<open>We can prove this separation in the locale introduced below.\<close>
 lemma lam_replacement_restrict:
   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 -
   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)"
+  assumes "x\<in>X" "y\<in>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
     lam_replacement_middle_del: "lam_replacement(M, \<lambda>r. middle_del(fst(r),snd(r)))"
     and
     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
 
+\<comment> \<open>This lemma is similar to @{thm strong_lam_replacement_imp_strong_replacement}
+and @{thm lam_replacement_imp_strong_replacement_aux} but does not require
+\<^term>\<open>g\<close> to be closed under \<^term>\<open>M\<close>.\<close>
 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 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]
     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 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 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:
   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_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 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)"
+  using lam_replacement_product lam_replacement_fst lam_replacement_snd
+  by simp
+
+lemma lam_replacement_Upair: "lam_replacement(M, \<lambda>p. Upair(fst(p), snd(p)))"
+proof -
+  have "(\<not>(\<exists>a b . x = <a,b>)) \<Longrightarrow> fst(x) = 0 \<and> snd(x) = 0" for x
+    unfolding fst_def snd_def
+    by (simp add:the_0)
   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
+  have "Upair(fst(x),snd(x)) = (if (\<exists>w . \<exists> z . x=<w,z>) then (\<Union>x) else ({0}))" for x
+    using fst_conv snd_conv Upair_eq_cons
+    by (auto simp add:Pair_def)
+  moreover
+  have "lam_replacement(M, \<lambda>x . (if (\<exists>w . \<exists> z . x=<w,z>) then (\<Union>x) else ({0})))"
+    using lam_replacement_Union lam_replacement_constant relation_separation lam_replacement_if
+    by simp
+  ultimately
+  show ?thesis
+    using lam_replacement_cong
+    by simp
 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_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 "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
+        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]
+      using rep_closed lam_replacement_product
         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))"
+    "\<forall>x[M].\<forall>y\<in>g(x).M(f(x,y))" "\<forall>x[M].M(g(x))"
   shows "lam_replacement(M,\<lambda>x .  {f(x,z) . z\<in>g(x)})"
 proof -
+  note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed]
   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
+    using that transM[of _ "g(_)"] rep_closed
       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)
+    by simp
   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
+      using rep_closed transM[of _ A]
       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
+      using singleton_closed transM[of _ A] transM[of _ "g(_)"] rep_closed
         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]
+      using transM[of _ A] rep_closed
         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]
+        lam_replacement_constant lam_replacement_sing
       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
 
+lemma lam_replacement_Collect :
+  assumes "lam_replacement(M,f)" "\<forall>x[M].M(f(x))"
+    "separation(M,\<lambda>x . F(fst(x),snd(x)))"
+  shows "lam_replacement(M,\<lambda>x. {y\<in>f(x) . F(x,y)})"
+proof -
+  note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed]
+  from assms
+  have 1:"lam_replacement(M,\<lambda>x.{x}\<times>f(x))"
+    using lam_replacement_CartProd lam_replacement_sing
+    by auto
+  have "M({u\<in>f(x) . F(x,u)})" if "M(x)" for x
+  proof -
+    from assms that
+    have "M({u \<in> {x}\<times>f(x) . F(fst(u),snd(u))})" (is "M(?F)")
+      by simp
+    with assms that
+    have "M({snd(u) . u \<in> ?F})"
+      using rep_closed transM[of _ "f(x)"] lam_replacement_snd
+      by simp
+    moreover
+    have "{snd(u) . u \<in> ?F} = {u\<in>f(x) . F(x,u)}"
+      by auto
+    ultimately show ?thesis by simp
+  qed
+  moreover
+  have "M(\<lambda>z\<in>A.{y \<in> f(z) . F(z,y)})" if "M(A)" for A
+  proof -
+    from 1 that assms
+    have "M(\<Union>{{x}\<times>f(x) . x\<in>A})" (is "M(?C)")
+      using rep_closed transM[of _ A]
+      by simp
+    moreover from this assms
+    have "M({p \<in> ?C . F(fst(p),snd(p))})" (is "M(?B)")
+      by(rule_tac separation_closed,simp_all)
+    with \<open>M(A)\<close>
+    have "M({\<langle>x,?B``{x}\<rangle> . x\<in>A})"
+      using transM[of _ A] rep_closed
+        lam_replacement_product[OF lam_replacement_identity]
+        lam_replacement_Image[THEN [5] lam_replacement_hcomp2]
+        lam_replacement_constant lam_replacement_sing
+      by simp
+    moreover
+    have "?B``{z} = {u\<in>f(z) . F(z,u)}" 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,{u\<in>f(z) . F(z,u)}\<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
+
+
+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_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
+
+lemma lam_replacement_domain: "lam_replacement(M,domain)"
+proof -
+  have 1:"{fst(z) . z\<in> {u\<in>x . (\<exists> a b. u = <a,b>)}} =domain(x)" for x
+    unfolding domain_def
+    by (intro equalityI subsetI,auto,rule_tac x="<xa,y>" in bexI,auto)
+  moreover
+  have "lam_replacement(M,\<lambda> x .{fst(z) . z\<in> {u\<in>x . (\<exists> a b. u = <a,b>)}})"
+    using lam_replacement_hcomp lam_replacement_snd lam_replacement_fst
+snd_closed[OF transM] fst_closed[OF transM] lam_replacement_identity
+relation_separation relation_separation[THEN separation_comp,where f=snd]
+lam_replacement_Collect
+    by(rule_tac lam_replacement_RepFun,simp_all)
+  ultimately
+  show ?thesis
+    using lam_replacement_cong
+    by auto
+qed
+
+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 separation_all:
+  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)"
+  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 . 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 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(g(z),x)" if "z\<in>A" "x\<in>f(z)" "f(z) = ?Prod``{<g(z),f(z)>}" for z x
+      using that
+      by(rule_tac imageE[of x ?Prod "{<g(z),f(z)>}"],simp_all)
+    moreover
+    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 force
+    ultimately
+    show ?thesis
+      by auto
+  qed
+  ultimately
+  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_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 lam_replacement_converse: "lam_replacement(M,converse)"
+proof-
+  note lr_Un = lam_replacement_Union[THEN [2] lam_replacement_hcomp]
+  note lr_fs = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]
+  note lr_ff = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]
+  note lr_ss = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_snd]
+  note lr_sf = lam_replacement_hcomp[OF  lr_ff lam_replacement_snd]
+  note lr_fff = lam_replacement_hcomp[OF lam_replacement_fst lr_ff]
+  note lr_f4 = lam_replacement_hcomp[OF lr_ff lr_ff]
+  have eq:"converse(x) = {\<langle>snd(y),fst(y)\<rangle> . y \<in> {z \<in> x. \<exists> u \<in>\<Union>\<Union>x . \<exists>v\<in>\<Union>\<Union>x . z=<u,v>}}" for x
+    unfolding converse_def
+    by(intro equalityI subsetI,auto,rename_tac a b,rule_tac x="<a,b>" in bexI,simp_all)
+     (auto simp : Pair_def)
+  have "M(x) \<Longrightarrow> M({z \<in> x. \<exists> u \<in>\<Union>\<Union>x . \<exists>v\<in>\<Union>\<Union>x . z=<u,v>})" for x
+    using lam_replacement_identity lr_Un[OF lr_Un] lr_Un lr_Un[OF lam_replacement_Union]
+      lam_replacement_snd lr_ff lam_replacement_fst lam_replacement_hcomp lr_fff
+      lam_replacement_product[OF lr_sf lam_replacement_snd] lr_f4
+      lam_replacement_hcomp[OF lr_f4 lam_replacement_snd] separation_eq
+      lam_replacement_constant
+    by(rule_tac separation_closed,rule_tac separation_ex,rule_tac separation_ex,simp_all)
+  moreover
+  have sep:"separation(M, \<lambda>x. \<exists>u\<in>\<Union>\<Union>fst(x). \<exists>v\<in>\<Union>\<Union>fst(x). snd(x) = \<langle>u, v\<rangle>)"
+    using lam_replacement_identity lr_Un[OF lr_Un] lr_Un
+      lam_replacement_snd lr_ff lam_replacement_fst lam_replacement_hcomp lr_fff
+      lam_replacement_product[OF lr_sf lam_replacement_snd]
+      lam_replacement_hcomp[OF lr_f4 lam_replacement_snd] separation_eq
+    by(rule_tac separation_ex,rule_tac separation_ex,simp_all)
+  moreover from calculation
+  have "lam_replacement(M, \<lambda>x. {z \<in> x . \<exists>u\<in>\<Union>\<Union>x. \<exists>v\<in>\<Union>\<Union>x. z = \<langle>u, v\<rangle>})"
+    using lam_replacement_identity
+    by(rule_tac lam_replacement_Collect,simp_all)
+  ultimately
+  have 1:"lam_replacement(M, \<lambda>x . {\<langle>snd(y),fst(y)\<rangle> . y \<in> {z \<in> x. \<exists>u \<in>\<Union>\<Union>x . \<exists>v\<in>\<Union>\<Union>x. z=<u,v>}})"
+    using lam_replacement_product lam_replacement_fst lam_replacement_hcomp
+      lam_replacement_identity lr_ff lr_ss
+      lam_replacement_snd lam_replacement_identity sep
+    by(rule_tac lam_replacement_RepFun,simp_all,force dest:transM)
+  with eq[symmetric]
+  show ?thesis
+    by(rule_tac lam_replacement_cong[OF 1],simp_all)
+qed
+
+lemma lam_replacement_Diff: "lam_replacement(M, \<lambda>x . fst(x) - snd(x))"
+proof -
+  have eq:"X - Y = {x\<in>X . x\<notin>Y}" for X Y
+    by auto
+  moreover
+  have "lam_replacement(M, \<lambda>x . {y \<in> fst(x) . y\<notin>snd(x)})"
+    using  lam_replacement_fst lam_replacement_hcomp
+      lam_replacement_snd lam_replacement_identity separation_in separation_neg
+    by(rule_tac lam_replacement_Collect,simp_all)
+  then
+  show ?thesis
+    by(rule_tac lam_replacement_cong,auto,subst eq[symmetric],simp)
+qed
+
+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
+
 lemmas tag_replacement = lam_replacement_constant[unfolded lam_replacement_def]
 
+lemma tag_lam_replacement : "M(X) \<Longrightarrow> lam_replacement(M,\<lambda>x. <X,x>)"
+  using lam_replacement_product[OF lam_replacement_constant] lam_replacement_identity
+  by simp
+
+lemma strong_lam_replacement_imp_lam_replacement_RepFun :
+  assumes  "strong_replacement(M,\<lambda> x z . P(fst(x),snd(x)) \<and> z=\<langle>x,f(fst(x),snd(x))\<rangle>)"
+  "lam_replacement(M,g)"
+  "\<And>A y . M(y) \<Longrightarrow> M(A) \<Longrightarrow> \<forall>x\<in>A. P(y,x) \<longrightarrow> M(f(y,x))"
+  "\<forall>x[M]. M(g(x))"
+  "separation(M, \<lambda>x. P(fst(x),snd(x)))"
+  shows "lam_replacement(M, \<lambda>x. {y . r\<in> g(x) , P(x,r) \<and> y=f(x,r)}) "
+proof -
+  note rep_closed = lam_replacement_imp_strong_replacement[THEN RepFun_closed]
+  moreover
+  have "{f(x, xa) . xa \<in> {xa \<in> g(x) . P(x, xa)}} = {y . z \<in> g(x), P(x, z) \<and> y = f(x, z)}" for x
+    by(intro equalityI subsetI,auto)
+  moreover from assms
+  have 0:"M({xa \<in> g(x) . P(x, xa)})" if "M(x)" for x
+    using that separation_closed assms(5)[THEN separation_comp,OF tag_lam_replacement]
+    by simp
+  moreover from assms
+  have 1:"lam_replacement(M,\<lambda>x.{x}\<times>{u\<in>g(x) . P(x,u)})" (is "lam_replacement(M,\<lambda>x.?R(x))")
+    using separation_closed assms(5)[THEN separation_comp,OF tag_lam_replacement]
+    by(rule_tac lam_replacement_CartProd[OF lam_replacement_sing lam_replacement_Collect],simp_all)
+  moreover from assms
+  have "M({y . z\<in>g(x) , P(x,z) \<and> y=f(x,z)})" (is "M(?Q(x))") if "M(x)" for x
+    using that transM[of _ "g(_)"]
+      separation_closed assms(5)[THEN separation_comp,OF tag_lam_replacement]
+      assms(3)[of "x" "g(x)"] strong_lam_replacement_imp_strong_replacement
+    by simp
+  moreover
+  have "M(\<lambda>z\<in>A.{f(z,r) . r \<in> {u\<in> g(z) . P(z,u)}})" if "M(A)" for A
+  proof -
+    from that assms calculation
+    have "M(\<Union>{?R(x) . x\<in>A})" (is "M(?C)")
+      using transM[of _ A] rep_closed
+      by simp
+    moreover from assms \<open>M(A)\<close>
+    have "x \<in> {y} \<times> {x \<in> g(y) . P(y, x)} \<Longrightarrow> M(x) \<and> M(f(fst(x),snd(x)))" if "y\<in>A" for y x
+      using assms(3)[of "y" "g(y)"] transM[of _ A] transM[of _ "g(y)"] that
+      by force
+    moreover from this
+    have "\<exists>y\<in>A . x \<in> {y} \<times> {x \<in> g(y) . P(y, x)} \<Longrightarrow> M(x) \<and> M(f(fst(x),snd(x)))" for x
+      by auto
+    moreover note assms \<open>M(A)\<close>
+    ultimately
+    have "M({z . x\<in>?C , P(fst(x),snd(x)) \<and> z = \<langle>x,f(fst(x),snd(x))\<rangle>})" (is "M(?B)")
+      using singleton_closed transM[of _ A] transM[of _ "g(_)"] rep_closed
+        lam_replacement_product[OF lam_replacement_fst]
+        lam_replacement_hcomp[OF lam_replacement_snd] transM[OF _ 0]
+      by(rule_tac strong_replacement_closed,simp_all)
+    then
+    have "M({\<langle>fst(fst(x)),snd(x)\<rangle> . x\<in>?B})" (is "M(?D)")
+      using rep_closed transM[of _ ?B]
+        lam_replacement_product[OF
+          lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]
+          lam_replacement_snd]
+      by simp
+    with \<open>M(A)\<close>
+    have "M({\<langle>x,?D``{x}\<rangle> . x\<in>A})"
+      using transM[of _ A] rep_closed
+        lam_replacement_product[OF lam_replacement_identity]
+        lam_replacement_Image[THEN [5] lam_replacement_hcomp2]
+        lam_replacement_constant lam_replacement_sing
+      by simp
+    moreover from calculation
+    have "?D``{z} = {f(z,r) . r \<in> {u\<in> g(z) . P(z,u)}}" if "z\<in>A" for z
+      using that
+      by (intro equalityI subsetI,auto,intro imageI,force,auto)
+    moreover from this
+    have "{\<langle>x,?D``{x}\<rangle> . x\<in>A} = {\<langle>z,{f(z,r) . r \<in> {u\<in> g(z) . P(z,u)}}\<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
+
+lemma lam_replacement_Collect' :
+  assumes "M(A)" "separation(M,\<lambda>p . F(fst(p),snd(p)))"
+  shows "lam_replacement(M,\<lambda>x. {y\<in>A . F(x,y)})"
+  using assms lam_replacement_constant
+  by(rule_tac lam_replacement_Collect, simp_all)
+
 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_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 simp
 
 lemma lam_replacement_apply:"M(S) \<Longrightarrow> lam_replacement(M, \<lambda>x.  S ` x)"
   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
     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[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 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 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))"
   using assms lam_replacement_constant lam_replacement_product lam_replacement_snd
-    lam_replacement_RepFun
+    lam_replacement_RepFun transM[of _ W]
   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
+  by(rule_tac lam_replacement_RepFun,auto dest:transM)
 
 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 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 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[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(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]
+\<comment> \<open>We need a tactic to deal with composition of replacements!\<close>
+lemma lam_replacement_comp :
+  "lam_replacement(M, \<lambda>x . fst(x) O snd(x))"
+proof -
   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 . 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 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(g(z),x)" if "z\<in>A" "x\<in>f(z)" "f(z) = ?Prod``{<g(z),f(z)>}" for z x
-      using that
-      by(rule_tac imageE[of x ?Prod "{<g(z),f(z)>}"],simp_all)
-    moreover
-    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 force
-    ultimately
-    show ?thesis
-      by auto
-  qed
+  note lr_ff = lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]
+  note lr_ss = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_snd]
+  note lr_sf = lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_fst]
+  note lr_fff = lam_replacement_hcomp[OF lam_replacement_fst lr_ff]
+  have eq:"R O S =
+      {xz \<in> domain(S) \<times> range(R) .
+        \<exists>y\<in>range(S)\<inter>domain(R) . \<langle>fst(xz),y\<rangle>\<in>S \<and> \<langle>y,snd(xz)\<rangle>\<in>R}" for R S
+    unfolding comp_def
+    by(intro equalityI subsetI,auto)
+  moreover
+  have "lam_replacement(M, \<lambda>x . {xz \<in> domain(snd(x)) \<times> range(fst(x)) .
+        \<exists>y\<in>range(snd(x))\<inter>domain(fst(x)) . \<langle>fst(xz),y\<rangle>\<in>snd(x) \<and> \<langle>y,snd(xz)\<rangle>\<in>fst(x)})"
+    using lam_replacement_CartProd lam_replacement_hcomp
+      lam_replacement_range lam_replacement_domain lam_replacement_fst lam_replacement_snd
+      lam_replacement_identity lr_fs lr_ff lr_ss lam_replacement_product
+      lam_replacement_Int[THEN [5] lam_replacement_hcomp2]
+      lam_replacement_hcomp[OF lr_ff lam_replacement_domain]
+      lam_replacement_hcomp[OF lr_fs lam_replacement_range]
+      lam_replacement_hcomp[OF lr_ff lr_ff]
+      lam_replacement_hcomp[OF lr_ff lr_ss]
+      lam_replacement_hcomp[OF lr_ff lr_sf]
+      lr_fff
+      lam_replacement_hcomp[OF lr_fff lam_replacement_snd ]
+      separation_ex separation_conj separation_in
+    by(rule_tac lam_replacement_Collect,simp_all,rule_tac separation_ex,rule_tac separation_conj,auto)
   ultimately
-  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)
+  show ?thesis
+    by(rule_tac lam_replacement_cong,auto,subst eq[symmetric],rule_tac comp_closed,auto)
 qed
 
-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 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 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 *)
+\<comment> \<open>Gives the orthogonal of \<^term>\<open>x\<close> with respect to the relation \<^term>\<open>Q\<close>.\<close>
 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_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>
 
 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]
+  using lam_replacement_fst fst_closed snd_closed lam_replacement_product
 lam_replacement_snd lam_replacement_hcomp lam_replacement_sing_fun
-  lam_replacement_RepFun[of "\<lambda> x z . {<snd(x),z>}" "fst"]
-  by(simp_all)
+   transM[OF _ fst_closed]
+lam_replacement_RepFun[of "\<lambda> x z . {<snd(x),z>}" "fst"]
+  by simp
 
 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 assms lam_replacement_Union lam_replacement_sing_fun lam_replacement_Pair
-      lam_replacement_hcomp[of _ Union] tag_singleton_closed lam_replacement_RepFun
+       tag_singleton_closed transM[of _ "f(_)"] lam_replacement_hcomp[of _ Union]
+       lam_replacement_RepFun
   unfolding Sigfun_def
   by simp
 
 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_Pi: "M(y) \<Longrightarrow> lam_replacement(M, \<lambda>x. \<Union>xa\<in>y. {\<langle>x, xa\<rangle>})"
   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]
   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\<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
 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)))"
+lemma separation_is_insnd_restrict_eq_dom : "separation(M, \<lambda>p. (\<exists>r\<in>A. restrict(r, B) = fst(p) \<and> snd(p) = 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)
+  using that lam_replacement_fst lam_replacement_snd
+    separation_eq lam_replacement_hcomp lam_replacement_domain
+    lam_replacement_hcomp[OF _ lam_replacement_restrict']
+  by( 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)"
+  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
+  using lam_replacement_cong[OF lam_replacement_Collect'[OF _ separation_is_insnd_restrict_eq_dom]]
+    assms drSR_Y_equality separation_restrict_eq_dom_eq
   by simp
 
 lemma drSR_Y_closed:
-  assumes
-    "M(B)" "M(D)" "M(A)" "M(f)"
+  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]]
+  using assms drSR_Y_equality lam_replacement_Collect'[OF \<open>M(D)\<close>]
     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'
+  have "separation(M, \<lambda>p.  domain(snd(p)) = fst(p))" if "M(A)" for A
+    using separation_eq that
       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"]
+    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
+  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"]
+  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_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)"
+  assumes  "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
+  have "separation(M, \<lambda>p. (\<forall>s\<in>fst(p). \<langle>s, snd(p)\<rangle> \<in> Q))"
+         using separation_in assms lam_replacement_identity
+      lam_replacement_constant lam_replacement_hcomp[OF lam_replacement_fst
+        lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_snd]]
+      lam_replacement_snd lam_replacement_fst
+      lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]
+         by(rule_tac separation_all,simp_all,rule_tac separation_in,simp_all,rule_tac lam_replacement_product[of "snd" "\<lambda>x . snd(fst(fst(x)))"],simp_all)
+       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
+  assumes  "M(G)" "M(Q)" "M(x)"
+  shows "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>})"
+proof -
+  from assms
+  have "separation(M, \<lambda>z. \<forall>s\<in>x. \<langle>s, z\<rangle> \<in> Q)"
+    using lam_replacement_swap lam_replacement_constant separation_in separation_ball
+    by simp
+  with assms
+  show ?thesis
+    using separation_in_constant lam_replacement_sing_const_id[of x] separation_conj
+    by(rule_tac strong_replacement_separation,simp_all)
+qed
 
 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
 
+lemma zermelo_separation: "M(Q) \<Longrightarrow> M(f) \<Longrightarrow> separation(M, \<lambda>X. Q \<union> f `` X \<subseteq> X)"
+  using lam_replacement_identity lam_replacement_Un[THEN [5] lam_replacement_hcomp2]
+    lam_replacement_constant lam_replacement_Image[THEN [5] lam_replacement_hcomp2]
+    separation_subset
+  by simp
+
 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
+end
diff --git a/thys/Transitive_Models/Least.thy b/thys/Transitive_Models/Least.thy
--- a/thys/Transitive_Models/Least.thy
+++ b/thys/Transitive_Models/Least.thy
@@ -1,164 +1,163 @@
 section\<open>The binder \<^term>\<open>Least\<close>\<close>
 theory Least
   imports
     "Internalizations"
 
 begin
 
 text\<open>We have some basic results on the least ordinal satisfying
 a predicate.\<close>
 
 lemma Least_Ord: "(\<mu> \<alpha>. R(\<alpha>)) = (\<mu> \<alpha>. Ord(\<alpha>) \<and> R(\<alpha>))"
   unfolding Least_def by (simp add:lt_Ord)
 
 lemma Ord_Least_cong:
   assumes "\<And>y. Ord(y) \<Longrightarrow> R(y) \<longleftrightarrow> Q(y)"
   shows "(\<mu> \<alpha>. R(\<alpha>)) = (\<mu> \<alpha>. Q(\<alpha>))"
 proof -
   from assms
   have "(\<mu> \<alpha>. Ord(\<alpha>) \<and> R(\<alpha>)) = (\<mu> \<alpha>. Ord(\<alpha>) \<and> Q(\<alpha>))"
     by simp
   then
   show ?thesis using Least_Ord by simp
 qed
 
 definition
   least :: "[i\<Rightarrow>o,i\<Rightarrow>o,i] \<Rightarrow> o" where
   "least(M,Q,i) \<equiv> ordinal(M,i) \<and> (
          (empty(M,i) \<and> (\<forall>b[M]. ordinal(M,b) \<longrightarrow> \<not>Q(b)))
        \<or> (Q(i) \<and> (\<forall>b[M]. ordinal(M,b) \<and> b\<in>i\<longrightarrow> \<not>Q(b))))"
 
 definition
   least_fm :: "[i,i] \<Rightarrow> i" where
   "least_fm(q,i) \<equiv> And(ordinal_fm(i),
    Or(And(empty_fm(i),Forall(Implies(ordinal_fm(0),Neg(q)))),
       And(Exists(And(q,Equal(0,succ(i)))),
           Forall(Implies(And(ordinal_fm(0),Member(0,succ(i))),Neg(q))))))"
 
 lemma least_fm_type[TC] :"i \<in> nat \<Longrightarrow> q\<in>formula \<Longrightarrow> least_fm(q,i) \<in> formula"
   unfolding least_fm_def
   by simp
 
-(* Refactorize Formula and Relative to include the following three lemmas *)
 lemmas basic_fm_simps = sats_subset_fm' sats_transset_fm' sats_ordinal_fm'
 
 lemma sats_least_fm :
   assumes p_iff_sats:
     "\<And>a. a \<in> A \<Longrightarrow> P(a) \<longleftrightarrow> sats(A, p, Cons(a, env))"
   shows
     "\<lbrakk>y \<in> nat; env \<in> list(A) ; 0\<in>A\<rbrakk>
     \<Longrightarrow> sats(A, least_fm(p,y), env) \<longleftrightarrow>
         least(##A, P, nth(y,env))"
   using nth_closed p_iff_sats unfolding least_def least_fm_def
   by (simp add:basic_fm_simps)
 
 lemma least_iff_sats [iff_sats]:
   assumes is_Q_iff_sats:
     "\<And>a. a \<in> A \<Longrightarrow> is_Q(a) \<longleftrightarrow> sats(A, q, Cons(a,env))"
   shows
     "\<lbrakk>nth(j,env) = y; j \<in> nat; env \<in> list(A); 0\<in>A\<rbrakk>
    \<Longrightarrow> least(##A, is_Q, y) \<longleftrightarrow> sats(A, least_fm(q,j), env)"
   using sats_least_fm [OF is_Q_iff_sats, of j , symmetric]
   by simp
 
 lemma least_conj: "a\<in>M \<Longrightarrow> least(##M, \<lambda>x. x\<in>M \<and> Q(x),a) \<longleftrightarrow> least(##M,Q,a)"
   unfolding least_def by simp
 
 
 context M_trivial
 begin
 
 subsection\<open>Uniqueness, absoluteness and closure under \<^term>\<open>Least\<close>\<close>
 
 lemma unique_least:
   assumes "M(a)" "M(b)" "least(M,Q,a)" "least(M,Q,b)"
   shows "a=b"
 proof -
   from assms
   have "Ord(a)" "Ord(b)"
     unfolding least_def
     by simp_all
   then
   consider (le) "a\<in>b" | "a=b" | (ge) "b\<in>a"
     using Ord_linear[OF \<open>Ord(a)\<close> \<open>Ord(b)\<close>] by auto
   then
   show ?thesis
   proof(cases)
     case le
     then show ?thesis using assms unfolding least_def by auto
   next
     case ge
     then show ?thesis using assms unfolding least_def by auto
   qed
 qed
 
 lemma least_abs:
   assumes "\<And>x. Q(x) \<Longrightarrow> Ord(x) \<Longrightarrow> \<exists>y[M]. Q(y) \<and> Ord(y)" "M(a)"
   shows "least(M,Q,a) \<longleftrightarrow> a = (\<mu> x. Q(x))"
   unfolding least_def
 proof (cases "\<forall>b[M]. Ord(b) \<longrightarrow> \<not> Q(b)"; intro iffI; simp add:assms)
   case True
   with assms
   have "\<not> (\<exists>i. Ord(i) \<and> Q(i)) " by blast
   then
   show "0 =(\<mu> x. Q(x))" using Least_0 by simp
   then
   show "ordinal(M, \<mu> x. Q(x)) \<and> (empty(M, Least(Q)) \<or> Q(Least(Q)))"
     by simp
 next
   assume "\<exists>b[M]. Ord(b) \<and> Q(b)"
   then
   obtain i where "M(i)" "Ord(i)" "Q(i)" by blast
   assume "a = (\<mu> x. Q(x))"
   moreover
   note \<open>M(a)\<close>
   moreover from  \<open>Q(i)\<close> \<open>Ord(i)\<close>
   have "Q(\<mu> x. Q(x))" (is ?G)
     by (blast intro:LeastI)
   moreover
   have "(\<forall>b[M]. Ord(b) \<and> b \<in> (\<mu> x. Q(x)) \<longrightarrow> \<not> Q(b))" (is "?H")
     using less_LeastE[of Q _ False]
     by (auto, drule_tac ltI, simp, blast)
   ultimately
   show "ordinal(M, \<mu> x. Q(x)) \<and> (empty(M, \<mu> x. Q(x)) \<and> (\<forall>b[M]. Ord(b) \<longrightarrow> \<not> Q(b)) \<or> ?G \<and> ?H)"
     by simp
 next
   assume 1:"\<exists>b[M]. Ord(b) \<and> Q(b)"
   then
   obtain i where "M(i)" "Ord(i)" "Q(i)" by blast
   assume "Ord(a) \<and> (a = 0 \<and> (\<forall>b[M]. Ord(b) \<longrightarrow> \<not> Q(b)) \<or> Q(a) \<and> (\<forall>b[M]. Ord(b) \<and> b \<in> a \<longrightarrow> \<not> Q(b)))"
   with 1
   have "Ord(a)" "Q(a)" "\<forall>b[M]. Ord(b) \<and> b \<in> a \<longrightarrow> \<not> Q(b)"
     by blast+
   moreover from this and assms
   have "Ord(b) \<Longrightarrow> b \<in> a \<Longrightarrow> \<not> Q(b)" for b
     by (auto dest:transM)
   moreover from this and \<open>Ord(a)\<close>
   have "b < a \<Longrightarrow> \<not> Q(b)" for b
     unfolding lt_def using Ord_in_Ord by blast
   ultimately
   show "a = (\<mu> x. Q(x))"
     using Least_equality by simp
 qed
 
 lemma Least_closed:
   assumes "\<And>x. Q(x) \<Longrightarrow> Ord(x) \<Longrightarrow> \<exists>y[M]. Q(y) \<and> Ord(y)"
   shows "M(\<mu> x. Q(x))"
   using assms Least_le[of Q] Least_0[of Q]
   by (cases "(\<exists>i[M]. Ord(i) \<and> Q(i))") (force dest:transM ltD)+
 
 text\<open>Older, easier to apply versions (with a simpler assumption
 on \<^term>\<open>Q\<close>).\<close>
 lemma least_abs':
   assumes "\<And>x. Q(x) \<Longrightarrow> M(x)" "M(a)"
   shows "least(M,Q,a) \<longleftrightarrow> a = (\<mu> x. Q(x))"
   using assms least_abs[of Q] by auto
 
 lemma Least_closed':
   assumes "\<And>x. Q(x) \<Longrightarrow> M(x)"
   shows "M(\<mu> x. Q(x))"
   using assms Least_closed[of Q] by auto
 
 end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/M_Basic_No_Repl.thy b/thys/Transitive_Models/M_Basic_No_Repl.thy
--- a/thys/Transitive_Models/M_Basic_No_Repl.thy
+++ b/thys/Transitive_Models/M_Basic_No_Repl.thy
@@ -1,320 +1,304 @@
 theory M_Basic_No_Repl
   imports "ZF-Constructible.Relative"
 begin
 
 txt\<open>This locale is exactly \<^locale>\<open>M_basic\<close> without its only replacement
 instance.\<close>
 
 locale M_basic_no_repl = M_trivial +
   assumes Inter_separation:
     "M(A) ==> separation(M, \<lambda>x. \<forall>y[M]. y\<in>A \<longrightarrow> x\<in>y)"
     and Diff_separation:
     "M(B) ==> separation(M, \<lambda>x. x \<notin> B)"
     and cartprod_separation:
     "[| M(A); M(B) |]
       ==> separation(M, \<lambda>z. \<exists>x[M]. x\<in>A & (\<exists>y[M]. y\<in>B & pair(M,x,y,z)))"
     and image_separation:
     "[| M(A); M(r) |]
       ==> separation(M, \<lambda>y. \<exists>p[M]. p\<in>r & (\<exists>x[M]. x\<in>A & pair(M,x,y,p)))"
     and converse_separation:
     "M(r) ==> separation(M,
          \<lambda>z. \<exists>p[M]. p\<in>r & (\<exists>x[M]. \<exists>y[M]. pair(M,x,y,p) & pair(M,y,x,z)))"
     and restrict_separation:
     "M(A) ==> separation(M, \<lambda>z. \<exists>x[M]. x\<in>A & (\<exists>y[M]. pair(M,x,y,z)))"
     and comp_separation:
     "[| M(r); M(s) |]
       ==> separation(M, \<lambda>xz. \<exists>x[M]. \<exists>y[M]. \<exists>z[M]. \<exists>xy[M]. \<exists>yz[M].
                   pair(M,x,z,xz) & pair(M,x,y,xy) & pair(M,y,z,yz) &
                   xy\<in>s & yz\<in>r)"
     and pred_separation:
     "[| M(r); M(x) |] ==> separation(M, \<lambda>y. \<exists>p[M]. p\<in>r & pair(M,y,x,p))"
     and Memrel_separation:
     "separation(M, \<lambda>z. \<exists>x[M]. \<exists>y[M]. pair(M,x,y,z) & x \<in> y)"
     and is_recfun_separation:
     \<comment> \<open>for well-founded recursion: used to prove \<open>is_recfun_equal\<close>\<close>
     "[| M(r); M(f); M(g); M(a); M(b) |]
      ==> separation(M,
             \<lambda>x. \<exists>xa[M]. \<exists>xb[M].
                 pair(M,x,a,xa) & xa \<in> r & pair(M,x,b,xb) & xb \<in> r &
                 (\<exists>fx[M]. \<exists>gx[M]. fun_apply(M,f,x,fx) & fun_apply(M,g,x,gx) &
                                    fx \<noteq> gx))"
     and power_ax:         "power_ax(M)"
 
 lemma (in M_basic_no_repl) cartprod_iff:
   "[| M(A); M(B); M(C) |]
       ==> cartprod(M,A,B,C) \<longleftrightarrow>
           (\<exists>p1[M]. \<exists>p2[M]. powerset(M,A \<union> B,p1) & powerset(M,p1,p2) &
                    C = {z \<in> p2. \<exists>x\<in>A. \<exists>y\<in>B. z = <x,y>})"
   apply (simp add: Pair_def cartprod_def, safe)
     defer 1
     apply (simp add: powerset_def)
    apply blast
   txt\<open>Final, difficult case: the left-to-right direction of the theorem.\<close>
   apply (insert power_ax, simp add: power_ax_def)
   apply (frule_tac x="A \<union> B" and P="\<lambda>x. rex(M,Q(x))" for Q in rspec)
    apply (blast, clarify)
   apply (drule_tac x=z and P="\<lambda>x. rex(M,Q(x))" for Q in rspec)
    apply assumption
   apply (blast intro: cartprod_iff_lemma)
   done
 
 lemma (in M_basic_no_repl) cartprod_closed_lemma:
   "[| M(A); M(B) |] ==> \<exists>C[M]. cartprod(M,A,B,C)"
   apply (simp del: cartprod_abs add: cartprod_iff)
   apply (insert power_ax, simp add: power_ax_def)
   apply (frule_tac x="A \<union> B" and P="\<lambda>x. rex(M,Q(x))" for Q in rspec)
    apply (blast, clarify)
   apply (drule_tac x=z and P="\<lambda>x. rex(M,Q(x))" for Q in rspec, auto)
   apply (intro rexI conjI, simp+)
   apply (insert cartprod_separation [of A B], simp)
   done
 
 text\<open>All the lemmas above are necessary because Powerset is not absolute.
       I should have used Replacement instead!\<close>
 lemma (in M_basic_no_repl) cartprod_closed [intro,simp]:
   "[| M(A); M(B) |] ==> M(A*B)"
   by (frule cartprod_closed_lemma, assumption, force)
 
 lemma (in M_basic_no_repl) sum_closed [intro,simp]:
   "[| M(A); M(B) |] ==> M(A+B)"
   by (simp add: sum_def)
 
 lemma (in M_basic_no_repl) sum_abs [simp]:
   "[| M(A); M(B); M(Z) |] ==> is_sum(M,A,B,Z) \<longleftrightarrow> (Z = A+B)"
   by (simp add: is_sum_def sum_def singleton_0 nat_into_M)
 
 lemma (in M_basic_no_repl) M_converse_iff:
   "M(r) ==>
       converse(r) =
       {z \<in> \<Union>(\<Union>(r)) * \<Union>(\<Union>(r)).
        \<exists>p\<in>r. \<exists>x[M]. \<exists>y[M]. p = \<langle>x,y\<rangle> & z = \<langle>y,x\<rangle>}"
   apply (rule equalityI)
    prefer 2 apply (blast dest: transM, clarify, simp)
   apply (simp add: Pair_def)
   apply (blast dest: transM)
   done
 
 lemma (in M_basic_no_repl) converse_closed [intro,simp]:
   "M(r) ==> M(converse(r))"
   apply (simp add: M_converse_iff)
   apply (insert converse_separation [of r], simp)
   done
 
 lemma (in M_basic_no_repl) converse_abs [simp]:
   "[| M(r); M(z) |] ==> is_converse(M,r,z) \<longleftrightarrow> z = converse(r)"
   apply (simp add: is_converse_def)
   apply (rule iffI)
    prefer 2 apply blast
   apply (rule M_equalityI)
     apply simp
     apply (blast dest: transM)+
   done
 
 
 subsubsection \<open>image, preimage, domain, range\<close>
 
 lemma (in M_basic_no_repl) image_closed [intro,simp]:
   "[| M(A); M(r) |] ==> M(r``A)"
   apply (simp add: image_iff_Collect)
   apply (insert image_separation [of A r], simp)
   done
 
 lemma (in M_basic_no_repl) vimage_abs [simp]:
   "[| M(r); M(A); M(z) |] ==> pre_image(M,r,A,z) \<longleftrightarrow> z = r-``A"
   apply (simp add: pre_image_def)
   apply (rule iffI)
    apply (blast intro!: equalityI dest: transM, blast)
   done
 
 lemma (in M_basic_no_repl) vimage_closed [intro,simp]:
   "[| M(A); M(r) |] ==> M(r-``A)"
   by (simp add: vimage_def)
 
 
 subsubsection\<open>Domain, range and field\<close>
 
 lemma (in M_basic_no_repl) domain_closed [intro,simp]:
   "M(r) ==> M(domain(r))"
   apply (simp add: domain_eq_vimage)
   done
 
 lemma (in M_basic_no_repl) range_closed [intro,simp]:
   "M(r) ==> M(range(r))"
   apply (simp add: range_eq_image)
   done
 
 lemma (in M_basic_no_repl) field_abs [simp]:
   "[| M(r); M(z) |] ==> is_field(M,r,z) \<longleftrightarrow> z = field(r)"
   by (simp add: is_field_def field_def)
 
 lemma (in M_basic_no_repl) field_closed [intro,simp]:
   "M(r) ==> M(field(r))"
   by (simp add: field_def)
 
 
 subsubsection\<open>Relations, functions and application\<close>
 
 lemma (in M_basic_no_repl) apply_closed [intro,simp]:
   "[|M(f); M(a)|] ==> M(f`a)"
   by (simp add: apply_def)
 
 lemma (in M_basic_no_repl) apply_abs [simp]:
   "[| M(f); M(x); M(y) |] ==> fun_apply(M,f,x,y) \<longleftrightarrow> f`x = y"
   apply (simp add: fun_apply_def apply_def, blast)
   done
 
 lemma (in M_basic_no_repl) injection_abs [simp]:
   "[| M(A); M(f) |] ==> injection(M,A,B,f) \<longleftrightarrow> f \<in> inj(A,B)"
   apply (simp add: injection_def apply_iff inj_def)
   apply (blast dest: transM [of _ A])
   done
 
 lemma (in M_basic_no_repl) surjection_abs [simp]:
   "[| M(A); M(B); M(f) |] ==> surjection(M,A,B,f) \<longleftrightarrow> f \<in> surj(A,B)"
   by (simp add: surjection_def surj_def)
 
 lemma (in M_basic_no_repl) bijection_abs [simp]:
   "[| M(A); M(B); M(f) |] ==> bijection(M,A,B,f) \<longleftrightarrow> f \<in> bij(A,B)"
   by (simp add: bijection_def bij_def)
 
 
 subsubsection\<open>Composition of relations\<close>
 
 lemma (in M_basic_no_repl) M_comp_iff:
   "[| M(r); M(s) |]
       ==> r O s =
           {xz \<in> domain(s) * range(r).
             \<exists>x[M]. \<exists>y[M]. \<exists>z[M]. xz = \<langle>x,z\<rangle> & \<langle>x,y\<rangle> \<in> s & \<langle>y,z\<rangle> \<in> r}"
   apply (simp add: comp_def)
   apply (rule equalityI)
    apply clarify
    apply simp
    apply  (blast dest:  transM)+
   done
 
 lemma (in M_basic_no_repl) comp_closed [intro,simp]:
   "[| M(r); M(s) |] ==> M(r O s)"
   apply (simp add: M_comp_iff)
   apply (insert comp_separation [of r s], simp)
   done
 
 lemma (in M_basic_no_repl) composition_abs [simp]:
   "[| M(r); M(s); M(t) |] ==> composition(M,r,s,t) \<longleftrightarrow> t = r O s"
   apply safe
   txt\<open>Proving \<^term>\<open>composition(M, r, s, r O s)\<close>\<close>
    prefer 2
    apply (simp add: composition_def comp_def)
    apply (blast dest: transM)
   txt\<open>Opposite implication\<close>
   apply (rule M_equalityI)
     apply (simp add: composition_def comp_def)
     apply (blast del: allE dest: transM)+
   done
 
 text\<open>no longer needed\<close>
 lemma (in M_basic_no_repl) restriction_is_function:
   "[| restriction(M,f,A,z); function(f); M(f); M(A); M(z) |]
       ==> function(z)"
   apply (simp add: restriction_def ball_iff_equiv)
   apply (unfold function_def, blast)
   done
 
 lemma (in M_basic_no_repl) restrict_closed [intro,simp]:
   "[| M(A); M(r) |] ==> M(restrict(r,A))"
   apply (simp add: M_restrict_iff)
   apply (insert restrict_separation [of A], simp)
   done
 
 lemma (in M_basic_no_repl) Inter_closed [intro,simp]:
   "M(A) ==> M(\<Inter>(A))"
   by (insert Inter_separation, simp add: Inter_def)
 
 lemma (in M_basic_no_repl) Int_closed [intro,simp]:
   "[| M(A); M(B) |] ==> M(A \<inter> B)"
   apply (subgoal_tac "M({A,B})")
    apply (frule Inter_closed, force+)
   done
 
 lemma (in M_basic_no_repl) Diff_closed [intro,simp]:
   "[|M(A); M(B)|] ==> M(A-B)"
   by (insert Diff_separation, simp add: Diff_def)
 
 subsubsection\<open>Some Facts About Separation Axioms\<close>
 
 lemma (in M_basic_no_repl) separation_conj:
   "[|separation(M,P); separation(M,Q)|] ==> separation(M, \<lambda>z. P(z) & Q(z))"
   by (simp del: separation_closed
       add: separation_iff Collect_Int_Collect_eq [symmetric])
 
 lemma (in M_basic_no_repl) separation_disj:
   "[|separation(M,P); separation(M,Q)|] ==> separation(M, \<lambda>z. P(z) | Q(z))"
   by (simp del: separation_closed
       add: separation_iff Collect_Un_Collect_eq [symmetric])
 
 lemma (in M_basic_no_repl) separation_neg:
   "separation(M,P) ==> separation(M, \<lambda>z. ~P(z))"
   by (simp del: separation_closed
       add: separation_iff Diff_Collect_eq [symmetric])
 
 lemma (in M_basic_no_repl) separation_imp:
   "[|separation(M,P); separation(M,Q)|]
       ==> separation(M, \<lambda>z. P(z) \<longrightarrow> Q(z))"
   by (simp add: separation_neg separation_disj not_disj_iff_imp [symmetric])
 
 text\<open>This result is a hint of how little can be done without the Reflection
   Theorem.  The quantifier has to be bounded by a set.  We also need another
   instance of Separation!\<close>
 lemma (in M_basic_no_repl) separation_rall:
   "[|M(Y); \<forall>y[M]. separation(M, \<lambda>x. P(x,y));
         \<forall>z[M]. strong_replacement(M, \<lambda>x y. y = {u \<in> z . P(u,x)})|]
       ==> separation(M, \<lambda>x. \<forall>y[M]. y\<in>Y \<longrightarrow> P(x,y))"
   apply (simp del: separation_closed rall_abs
       add: separation_iff Collect_rall_eq)
   apply (blast intro!:  RepFun_closed dest: transM)
   done
 
 
 subsubsection\<open>Functions and function space\<close>
 
 lemma (in M_basic_no_repl) succ_fun_eq2:
   "[|M(B); M(n->B)|] ==>
       succ(n) -> B =
       \<Union>{z. p \<in> (n->B)*B, \<exists>f[M]. \<exists>b[M]. p = <f,b> & z = {cons(<n,b>, f)}}"
   apply (simp add: succ_fun_eq)
   apply (blast dest: transM)
   done
 
-(* lemma (in M_basic_no_repl) funspace_succ:
-     "[|M(n); M(B); M(n->B) |] ==> M(succ(n) -> B)"
-apply (insert funspace_succ_replacement [of n], simp)
-apply (force simp add: succ_fun_eq2 univalent_def)
-done
-
-text\<open>\<^term>\<open>M\<close> contains all finite function spaces.  Needed to prove the
-absoluteness of transitive closure.  See the definition of
-\<open>rtrancl_alt\<close> in in \<open>WF_absolute.thy\<close>.\<close>
-lemma (in M_basic_no_repl) finite_funspace_closed [intro,simp]:
-     "[|n\<in>nat; M(B)|] ==> M(n->B)"
-apply (induct_tac n, simp)
-apply (simp add: funspace_succ nat_into_M)
-done
- *)
-
 lemma (in M_basic_no_repl) list_case'_closed [intro,simp]:
   "[|M(k); M(a); \<forall>x[M]. \<forall>y[M]. M(b(x,y))|] ==> M(list_case'(a,b,k))"
   apply (case_tac "quasilist(k)")
    apply (simp add: quasilist_def, force)
   apply (simp add: non_list_case)
   done
 
 lemma (in M_basic_no_repl) tl'_closed: "M(x) ==> M(tl'(x))"
   apply (simp add: tl'_def)
   apply (force simp add: quasilist_def)
   done
 
 sublocale M_basic \<subseteq> mbnr:M_basic_no_repl
   using Inter_separation Diff_separation cartprod_separation image_separation
     converse_separation restrict_separation comp_separation pred_separation
     Memrel_separation is_recfun_separation power_ax by unfold_locales
 
 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,947 +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) . \<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)
   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 calculation
   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 . \<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_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_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_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>}"
+\<comment> \<open>Eventually we can define \<^term>\<open>Fn_rel\<close> as the relativization of \<^term>\<open>Fn\<close>\<close>
 
 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 "\<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 "\<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>
 
 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,469 +1,459 @@
 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 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])
+  interpret mpiA:M_Pi_assumption_repl _ A "\<lambda>x . x"
+    by unfold_locales (simp_all add:lam_replacement_identity)
+  from \<open>M(A)\<close>
+  interpret mpi2:M_Pi_assumption_repl _ "\<Union>A" "\<lambda>x . x"
+    by unfold_locales (simp_all add:lam_replacement_identity)
   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)
+    using 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,rename_tac f,rule_tac x=f 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
+    by (rule_tac lam_replacement_imp_lam_closed, 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]
+    using lam_replacement_fst lam_replacement_snd lam_replacement_apply[of S]
+      lam_replacement_product[of "\<lambda>x. fst(fst(x))" "\<lambda>x. fst(snd(x))",
+        THEN [2] separation_in, of "\<lambda>x. S ` snd(snd(x))"]
       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,364 +1,363 @@
 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 *)
+\<comment> \<open>We obtain this lemmas as a consequence of the previous one;
+alternatively it can be obtained using @{thm Ordinal.Memrel_type}\<close>
 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/Relativization.ml b/thys/Transitive_Models/Relativization.ml
new file mode 100644
--- /dev/null
+++ b/thys/Transitive_Models/Relativization.ml
@@ -0,0 +1,714 @@
+signature Relativization =
+  sig
+    structure Data: GENERIC_DATA
+    val Rel_add: attribute
+    val Rel_del: attribute
+    val add_rel_const : Database.mode -> term -> term -> Data.T -> Data.T
+    val add_constant : Database.mode -> string -> string -> Proof.context -> Proof.context
+    val rem_constant : (term -> Data.T -> Data.T) -> string -> Proof.context -> Proof.context
+    val db: Data.T
+    val init_db : Data.T -> theory -> theory
+    val get_db : Proof.context -> Data.T
+    val relativ_fm: bool -> bool -> term -> Data.T -> (term * (term * term)) list * Proof.context * term list * bool -> term -> term * ((term * (term * term)) list * term list * term list * Proof.context)
+    val relativ_tm: bool -> bool -> term option -> term -> Data.T -> (term * (term * term)) list * Proof.context -> term -> term * (term * (term * term)) list * Proof.context
+    val read_new_const : Proof.context -> string -> term
+    val relativ_tm_frm': bool -> bool -> term -> Data.T -> Proof.context -> term -> term option * term
+    val relativize_def: bool -> bool -> bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context
+    val relativize_tm: bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context
+    val rel_closed_goal : string -> Position.T -> Proof.context -> Proof.state
+    val iff_goal : string -> Position.T -> Proof.context -> Proof.state
+    val univalent_goal : string -> Position.T -> Proof.context -> Proof.state
+  end
+
+structure Relativization : Relativization = struct
+
+infix 6 &&&
+val op &&& = Utils.&&&
+
+infix 6 ***
+val op *** = Utils.***
+
+infix 6 @@
+val op @@ = Utils.@@
+
+infix 6 ---
+val op --- = Utils.---
+
+fun insert_abs2rel ((t, u), db) = ((t, u), Database.insert Database.abs2rel (t, t) db)
+
+fun insert_rel2is ((t, u), db) = Database.insert Database.rel2is (t, u) db
+
+(* relativization db of relation constructors *)
+val db = [ (@{const relation}, @{const Relative.is_relation})
+         , (@{const function}, @{const Relative.is_function})
+         , (@{const mem}, @{const mem})
+         , (@{const True}, @{const True})
+         , (@{const False}, @{const False})
+         , (@{const Memrel}, @{const membership})
+         , (@{const trancl}, @{const tran_closure})
+         , (@{const IFOL.eq(i)}, @{const IFOL.eq(i)})
+         , (@{const Subset}, @{const Relative.subset})
+         , (@{const quasinat}, @{const Relative.is_quasinat})
+         , (@{const apply}, @{const Relative.fun_apply})
+         , (@{const Upair}, @{const Relative.upair})
+         ]
+         |> List.foldr (insert_rel2is o insert_abs2rel) Database.empty
+         |> Database.insert Database.abs2is (@{const Pi}, @{const is_funspace})
+
+fun var_i v = Free (v, @{typ i})
+fun var_io v = Free (v, @{typ "i \<Rightarrow> o"})
+val const_name = #1 o dest_Const
+
+val lookup_tm  = AList.lookup (op aconv)
+val update_tm  =  AList.update (op aconv)
+val join_tm = AList.join (op aconv) (K #1)
+
+val conj_ = Utils.binop @{const "IFOL.conj"}
+
+(* generic data *)
+structure Data = Generic_Data
+(
+  type T = Database.db
+  val empty = Database.empty (* Should we initialize this outside this file? *)
+  val merge = Database.merge
+);
+
+fun init_db db = Context.theory_map (Data.put db)
+
+fun get_db thy = Data.get (Context.Proof thy)
+
+val read_const = Proof_Context.read_const {proper = true, strict = true}
+val read_new_const = Proof_Context.read_term_pattern
+
+fun add_rel_const mode c t = Database.insert mode (c, t)
+
+fun get_consts thm =
+  let val (c_rel, rhs) = Thm.concl_of thm |> Utils.dest_trueprop |>
+                          Utils.dest_iff_tms |>> head_of
+  in case try Utils.dest_eq_tms rhs of
+       SOME tm => (c_rel, tm |> #2 |> head_of)
+     | NONE => (c_rel, rhs |> Utils.dest_mem_tms |> #2 |> head_of)
+  end
+
+fun add_rule thm rs =
+  let val (c_rel,c_abs) = get_consts thm
+  (* in (add_rel_const Database.rel2is c_abs c_rel o add_rel_const Database.abs2rel c_abs c_abs) rs *)
+  in (add_rel_const Database.abs2rel c_abs c_abs o add_rel_const Database.abs2is c_abs c_rel) rs
+end
+
+fun get_mode is_functional relationalising = if relationalising then Database.rel2is else if is_functional then Database.abs2rel else Database.abs2is
+
+fun add_constant mode abs rel thy =
+  let
+    val c_abs = read_new_const thy abs
+    val c_rel = read_new_const thy rel
+    val db_map = Data.map (Database.insert mode (c_abs, c_rel))
+    fun add_to_context ctxt' = Context.proof_map db_map ctxt'
+    fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt'
+  in
+    Local_Theory.target (add_to_theory o add_to_context) thy
+ end
+
+fun rem_constant rem_op c thy =
+  let
+    val c = read_new_const thy c
+    val db_map = Data.map (rem_op c)
+    fun add_to_context ctxt' = Context.proof_map db_map ctxt'
+    fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt'
+  in
+    Local_Theory.target (add_to_theory o add_to_context) thy
+  end
+
+val del_rel_const = Database.remove_abs
+
+fun del_rule thm = del_rel_const (thm |> get_consts |> #2)
+
+val Rel_add =
+  Thm.declaration_attribute (fn thm => fn context =>
+    Data.map (add_rule (Thm.trim_context thm)) context);
+
+val Rel_del =
+  Thm.declaration_attribute (fn thm => fn context =>
+    Data.map (del_rule (Thm.trim_context thm)) context);
+
+(* Conjunction of a list of terms *)
+fun conjs [] = @{term IFOL.True}
+  | conjs (fs as _ :: _) = foldr1 (uncurry conj_) fs
+
+(* Produces a relativized existential quantification of the term t *)
+fun rex p t (Free v) = @{const rex} $ p $ lambda (Free v) t
+  | rex _ t (Bound _) = t
+  | rex _ t tm = raise TERM ("rex shouldn't handle this.",[tm,t])
+
+(* Constants that do not take the class predicate *)
+val absolute_rels = [ @{const ZF_Base.mem}
+                    , @{const IFOL.eq(i)}
+                    , @{const Memrel}
+                    , @{const True}
+                    , @{const False}
+                    ]
+
+(* Creates the relational term corresponding to a term of type i. If the last
+  argument is (SOME v) then that variable is not bound by an existential
+  quantifier.
+*)
+fun close_rel_tm pred tm tm_var rs =
+  let val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs
+      val (vars, tms) = split_list (map #2 news) ||> (curry op @) (the_list tm)
+      val vars = case tm_var of
+        SOME w => filter (fn v => not (v = w)) vars
+      | NONE => vars
+  in fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars (conjs tms)
+  end
+
+fun relativ_tms __ _ _ rs ctxt [] = ([], rs, ctxt)
+  | relativ_tms is_functional relationalising pred rel_db rs ctxt (u :: us) =
+      let val (w_u, rs_u, ctxt_u) = relativ_tm is_functional relationalising NONE pred rel_db (rs, ctxt) u
+          val (w_us, rs_us, ctxt_us) = relativ_tms is_functional relationalising pred rel_db rs_u ctxt_u us
+      in (w_u :: w_us, join_tm (rs_u , rs_us), ctxt_us)
+      end
+and
+    (* The result of the relativization of a term is a triple consisting of
+      a. the relativized term (it can be a free or a bound variable but also a Collect)
+      b. a list of (term * (term, term)), taken as a map, which is used
+         to reuse relativization of different occurrences of the same term. The
+         first element is the original term, the second its relativized version,
+         and the last one is the predicate corresponding to it.
+      c. the resulting context of created variables.
+    *)
+    relativ_tm is_functional relationalising mv pred rel_db (rs,ctxt) tm =
+      let
+      (* relativization of a fully applied constant *)
+      fun mk_rel_const mv c (args, after) abs_args ctxt =
+        case Database.lookup (get_mode is_functional relationalising) c rel_db of
+          SOME p =>
+            let
+              val args' = List.filter (not o member (op =) (Utils.frees p)) args
+              val (v, ctxt1) =
+                the_default
+                  (Variable.variant_fixes [""] ctxt |>> var_i o hd)
+                  (Utils.map_option (I &&& K ctxt) mv)
+              val args' =
+                (* FIXME: This special case for functional relativization of sigma should not be needed *)
+                if c = @{const Sigma} andalso is_functional
+                  then
+                    let
+                      val t = hd args'
+                      val t' = Abs ("uu_", @{typ "i"}, (hd o tl) args' |> incr_boundvars 1)
+                    in
+                      [t, t']
+                    end
+                  else
+                    args'
+              val arg_list = if after then abs_args @ args' else args' @ abs_args
+              val r_tm =
+                if is_functional
+                  then list_comb (p, if p = c then arg_list else pred :: arg_list)
+                  else list_comb (p, if (not o null) args' andalso  hd args' = pred then arg_list @ [v] else pred :: arg_list @ [v])
+            in
+              if is_functional
+                then (r_tm, r_tm, ctxt)
+                else (v, r_tm, ctxt1)
+            end
+        | NONE => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil)
+      (* relativization of a partially applied constant *)
+      fun relativ_app mv mctxt tm abs_args (Const c) (args, after) rs =
+            let
+              val (w_ts, rs_ts, ctxt_ts) = relativ_tms is_functional relationalising pred rel_db rs (the_default ctxt mctxt) args
+              val (w_tm, r_tm, ctxt_tm) = mk_rel_const mv (Const c) (w_ts, after) abs_args ctxt_ts
+              val rs_ts' = if is_functional then rs_ts else update_tm (tm, (w_tm, r_tm)) rs_ts
+            in
+              (w_tm, rs_ts', ctxt_tm)
+            end
+        | relativ_app _ _ _ _ t _ _ =
+            raise TERM ("Tried to relativize an application with a non-constant in head position",[t])
+
+      (* relativization of non dependent product and sum *)
+      fun relativ_app_no_dep mv tm c t t' rs =
+          if loose_bvar1 (t', 0)
+            then
+              raise TERM("A dependency was found when trying to relativize", [tm])
+            else
+              relativ_app mv NONE tm [] c ([t, incr_boundvars ~1 t'], false) rs
+
+      fun relativ_replace mv t body after ctxt' =
+        let
+          val (v, b) = Utils.dest_abs body |>> var_i ||> after
+          val (b', (rs', ctxt'')) =
+            relativ_fm is_functional relationalising pred rel_db (rs, ctxt', single v, false) b |>> incr_boundvars 1 ||> #1 &&& #4
+        in
+          relativ_app mv (SOME ctxt'') tm [lambda v b'] @{const Replace} ([t], false) rs'
+        end
+
+      fun get_abs_body (Abs body) = body
+        | get_abs_body t = raise TERM ("Term is not Abs", [t])
+
+      fun go _ (Var _) = raise TERM ("Var: Is this possible?",[])
+        | go mv (@{const Replace} $ t $ Abs body) = relativ_replace mv t body I ctxt
+        (* It is easier to rewrite RepFun as Replace before relativizing,
+           since { f(x) . x \<in> t } = { y . x \<in> t, y = f(x) } *)
+        | go mv (@{const RepFun} $ t $ Abs body) =
+            let
+              val (y, ctxt') = Variable.variant_fixes [""] ctxt |>> var_i o hd
+            in
+              relativ_replace mv t body (lambda y o Utils.eq_ y o incr_boundvars 1) ctxt'
+            end
+        | go mv (@{const Collect} $ t $ pc) =
+            let
+              val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4
+            in
+              relativ_app mv (SOME ctxt') tm [pc'] @{const Collect} ([t], false) rs'
+            end
+        | go mv (@{const Least} $ pc) =
+            let
+              val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4
+            in
+              relativ_app mv (SOME ctxt') tm [pc'] @{const Least} ([], false) rs'
+            end
+        | go mv (@{const transrec} $ t $ Abs body) =
+            let
+              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
+              val (x, b') = Utils.dest_abs body |>> var_i
+              val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
+              val p = Utils.eq_ res b |> lambda res
+              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
+              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
+            in
+              relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const transrec} ([t], not is_functional) rs'
+            end
+        | go mv (tm as @{const Sigma} $ t $ Abs (_, _, t')) =
+            relativ_app_no_dep mv tm @{const Sigma} t t' rs
+        | go mv (tm as @{const Pi} $ t $ Abs (_, _, t')) =
+            relativ_app_no_dep mv tm @{const Pi} t t' rs
+        | go mv (tm as @{const bool_of_o} $ t) =
+            let
+              val (t', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) t ||> #1 &&& #4
+            in
+              relativ_app mv (SOME ctxt') tm [t'] @{const bool_of_o} ([], false) rs'
+            end
+        | go mv (tm as @{const If} $ b $ t $ t') =
+            let
+              val (br, (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) b ||> #1 &&& #4
+            in
+              relativ_app mv (SOME ctxt') tm [br] @{const If} ([t,t'], true) rs'
+            end
+        | go mv (@{const The} $ pc) =
+            let
+              val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4
+            in
+              relativ_app mv (SOME ctxt') tm [pc'] @{const The} ([], false) rs'
+            end
+        | go mv (@{const recursor} $ t $ Abs body $ t') =
+            let
+              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
+              val (x, b') = Utils.dest_abs body |>> var_i
+              val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
+              val p = Utils.eq_ res b |> lambda res
+              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
+              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
+              val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t
+            in
+              relativ_app mv (SOME ctxt''') tm [tr, p' |> lambda x o lambda y] @{const recursor} ([t'], true) rs''
+            end
+        | go mv (@{const wfrec} $ t1 $ t2 $ Abs body) =
+            let
+              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
+              val (x, b') = Utils.dest_abs body |>> var_i
+              val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
+              val p = Utils.eq_ res b |> lambda res
+              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
+              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
+            in
+              relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const wfrec} ([t1,t2], not is_functional) rs'
+            end
+        | go mv (@{const wfrec_on} $ t1 $ t2 $ t3 $ Abs body) =
+            let
+              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
+              val (x, b') = Utils.dest_abs body |>> var_i
+              val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
+              val p = Utils.eq_ res b |> lambda res
+              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
+              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
+            in
+              relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const wfrec_on} ([t1,t2,t3], not is_functional) rs'
+            end
+        | go mv (@{const Lambda} $ t $ Abs body) =
+            let
+              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
+              val (x, b) = Utils.dest_abs body |>> var_i
+              val p = Utils.eq_ res b |> lambda res
+              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x], true) p |>> incr_boundvars 2 ||> #1 &&& #4
+              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
+              val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t
+            in
+              relativ_app mv (SOME ctxt''') tm [tr, p' |> lambda x] @{const Lambda} ([], true) rs''
+            end
+        (* The following are the generic cases *)
+        | go mv (tm as Const _) = relativ_app mv NONE tm [] tm ([], false) rs
+        | go mv (tm as _ $ _) = (strip_comb tm ||> I &&& K false |> uncurry (relativ_app mv NONE tm [])) rs
+        | go _ tm = if is_functional then (tm, rs, ctxt) else (tm, update_tm (tm,(tm,tm)) rs, ctxt)
+
+      (* we first check if the term has been already relativized as a variable *)
+      in case lookup_tm rs tm of
+           NONE => go mv tm
+         | SOME (w, _) => (w, rs, ctxt)
+      end
+and
+  relativ_fm is_functional relationalising pred rel_db (rs, ctxt, vs, is_term) fm =
+  let
+
+  (* relativization of a fully applied constant *)
+  fun relativ_app (ctxt, rs) c args = case Database.lookup (get_mode is_functional relationalising) c rel_db of
+    SOME p =>
+      let (* flag indicates whether the relativized constant is absolute or not. *)
+        val flag = not (exists (curry op aconv c) absolute_rels orelse c = p)
+        val (args, rs_ts, ctxt') = relativ_tms is_functional relationalising pred rel_db rs ctxt args
+        (* TODO: Verify if next line takes care of locales' definitions *)
+        val args' = List.filter (not o member (op =) (Utils.frees p)) args
+        val args'' = if not (null args') andalso hd args' = pred then args' else pred :: args'
+        val tm = list_comb (p, if flag then args'' else args')
+        (* TODO: Verify if next line is necessary *)
+        val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs_ts
+        val (vars, tms) = split_list (map #2 news)
+        (* val vars = filter (fn v => not (v = tm)) vars *) (* Verify if this line is necessary *)
+       in (tm, (rs_ts, vars, tms, ctxt'))
+       end
+   | NONE   => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil)
+
+  fun close_fm quantifier (f, (rs, vars, tms, ctxt)) =
+    let
+      fun contains_b0 t = loose_bvar1 (t, 0)
+
+      fun contains_extra_var t = fold (fn v => fn acc => acc orelse fold_aterms (fn t => fn acc => t = v orelse acc) t false) vs false
+
+      fun contains_b0_extra t = contains_b0 t orelse contains_extra_var t
+
+      (* t1 $ v \<hookrightarrow> t2 iff v \<in> FV(t2) *)
+      fun chained_frees (_ $ v) t2 = member (op =) (Utils.frees t2) v
+        | chained_frees t _ = raise TERM ("Malformed term", [t])
+
+      val tms_to_close = filter contains_b0_extra tms |> Utils.reachable chained_frees tms
+      val tms_to_keep = map (incr_boundvars ~1) (tms --- tms_to_close)
+      val vars_to_close = inter (op =) (map (List.last o #2 o strip_comb) tms_to_close) vars
+      val vars_to_keep = vars --- vars_to_close
+      val new_rs =
+        rs
+        |> filter (fn (k, (v, rel)) => not (contains_b0_extra k orelse contains_b0_extra v orelse contains_b0_extra rel))
+        |> map (fn (k, (v, rel)) => (incr_boundvars ~1 k, (incr_boundvars ~1 v, incr_boundvars ~1 rel)))
+
+      val f' =
+        if not is_term andalso not quantifier andalso is_functional
+          then pred $ Bound 0 :: (map (curry (op $) pred) vs) @ [f]
+          else [f]
+    in
+      (fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars_to_close (conjs (f' @ tms_to_close)),
+       (new_rs, vars_to_keep, tms_to_keep, ctxt))
+    end
+
+  (* Handling of bounded quantifiers. *)
+  fun bquant (ctxt, rs) quant conn dom pred =
+    let val (v,pred') = Utils.dest_abs pred |>> var_i
+    in
+      go (ctxt, rs, false) (quant $ (lambda v o incr_boundvars 1) (conn $ (@{const mem} $ v $ dom) $ pred'))
+    end
+  and
+  bind_go (ctxt, rs) const f f' =
+    let
+      val (r , (rs1, vars1, tms1, ctxt1)) = go (ctxt, rs, false) f
+      val (r', (rs2, vars2, tms2, ctxt2)) = go (ctxt1, rs1, false) f'
+    in
+      (const $ r $ r', (rs2, vars1 @@ vars2, tms1 @@ tms2, ctxt2))
+    end
+  and
+      relativ_eq_var (ctxt, rs) v t =
+        let
+          val (_, rs', ctxt') = relativ_tm is_functional relationalising (SOME v) pred rel_db (rs, ctxt) t
+          val f = lookup_tm rs' t |> #2 o the
+          val rs'' = filter (not o (curry (op =) t) o #1) rs'
+          val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs''
+          val (vars, tms) = split_list (map #2 news)
+        in
+          (f, (rs'', vars, tms, ctxt'))
+        end
+  and
+      relativ_eq (ctxt, rs) t1 t2 =
+        if is_functional orelse ((is_Free t1 orelse is_Bound t1) andalso (is_Free t2 orelse is_Bound t2)) then
+          relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2]
+        else if is_Free t1 orelse is_Bound t1 then
+          relativ_eq_var (ctxt, rs) t1 t2
+        else if is_Free t2 orelse is_Bound t2 then
+          relativ_eq_var (ctxt, rs) t2 t1
+        else
+          relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2]
+  and
+      go (ctxt, rs, _         ) (@{const IFOL.conj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.conj} f f'
+    | go (ctxt, rs, _         ) (@{const IFOL.disj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.disj} f f'
+    | go (ctxt, rs, _         ) (@{const IFOL.Not} $ f) = go (ctxt, rs, false) f |>> ((curry op $) @{const IFOL.Not})
+    | go (ctxt, rs, _         ) (@{const IFOL.iff} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.iff} f f'
+    | go (ctxt, rs, _         ) (@{const IFOL.imp} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.imp} f f'
+    | go (ctxt, rs, _         ) (@{const IFOL.All(i)} $ f) = go (ctxt, rs, true) f |>> ((curry op $) (@{const OrdQuant.rall} $ pred))
+    | go (ctxt, rs, _         ) (@{const IFOL.Ex(i)} $ f) = go (ctxt, rs, true) f |>> ((curry op $) (@{const OrdQuant.rex} $ pred))
+    | go (ctxt, rs, _         ) (@{const Bex} $ f $ Abs p) = bquant (ctxt, rs) @{const Ex(i)} @{const IFOL.conj} f p
+    | go (ctxt, rs, _         ) (@{const Ball} $ f $ Abs p) = bquant (ctxt, rs) @{const All(i)} @{const IFOL.imp} f p
+    | go (ctxt, rs, _         ) (@{const rall} $ _ $ p) = go (ctxt, rs, true) p |>> (curry op $) (@{const rall} $ pred)
+    | go (ctxt, rs, _         ) (@{const rex} $ _ $ p) = go (ctxt, rs, true) p |>> (curry op $) (@{const rex} $ pred)
+    | go (ctxt, rs, _         ) (@{const IFOL.eq(i)} $ t1 $ t2) = relativ_eq (ctxt, rs) t1 t2
+    | go (ctxt, rs, _         ) (Const c) = relativ_app (ctxt, rs) (Const c) []
+    | go (ctxt, rs, _         ) (tm as _ $ _) = strip_comb tm |> uncurry (relativ_app (ctxt, rs))
+    | go (ctxt, rs, quantifier) (Abs (v, _, t)) =
+      let
+        val new_rs = map (fn (k, (v, rel)) => (incr_boundvars 1 k, (incr_boundvars 1 v, incr_boundvars 1 rel))) rs
+      in
+        go (ctxt, new_rs, false) t |> close_fm quantifier |>> lambda (var_i v)
+      end
+    | go _ t = raise TERM ("Relativization of formulas cannot handle this case.",[t])
+  in
+    go (ctxt, rs, false) fm
+  end
+
+
+fun relativ_tm_frm' is_functional relationalising cls_pred db ctxt tm =
+  let
+    fun get_bounds (l as Abs _) = op @@ (strip_abs l |>> map (op #1) ||> get_bounds)
+      | get_bounds (t as _$_) = strip_comb t |> op :: |> map get_bounds |> flat
+      | get_bounds _ = []
+
+    val ty = fastype_of tm
+    val initial_ctxt = fold Utils.add_to_context (get_bounds tm) ctxt
+  in
+    case ty of
+        @{typ i} =>
+          let
+            val (w, rs, _) =  relativ_tm is_functional relationalising NONE cls_pred db ([], initial_ctxt) tm
+          in
+            if is_functional
+              then (NONE, w)
+              else (SOME w, close_rel_tm cls_pred NONE (SOME w) rs)
+          end
+      | @{typ o} =>
+          let
+            fun close_fm (f, (_, vars, tms, _)) =
+              fold (fn  v => fn t => rex cls_pred (incr_boundvars 1 t) v) vars (conjs (f :: tms))
+          in
+            (NONE, relativ_fm is_functional relationalising cls_pred db ([], initial_ctxt, [], false) tm |> close_fm)
+          end
+      | ty' => raise TYPE ("We can relativize only terms of types i and o", [ty'], [tm])
+  end
+
+fun lname ctxt = Local_Theory.full_name ctxt o Binding.name
+
+fun destroy_first_lambdas (Abs (body as (_, ty, _))) =
+     Utils.dest_abs body ||> destroy_first_lambdas |> (#1 o #2) &&& ((fn v => Free (v, ty)) *** #2) ||> op ::
+  | destroy_first_lambdas t = (t, [])
+
+fun freeType (Free (_, ty)) = ty
+  | freeType t = raise TERM ("freeType", [t])
+
+fun relativize_def is_external is_functional relationalising def_name thm_ref pos lthy =
+  let
+    val ctxt = lthy
+    val (vars,tm,ctxt1) = Utils.thm_concl_tm ctxt (thm_ref ^ "_def")
+    val db' = Data.get (Context.Proof lthy)
+    val (tm, lambdavars) = tm |> destroy_first_lambdas o #2 o Utils.dest_eq_tms' o Utils.dest_trueprop
+    val ctxt1 = fold Utils.add_to_context (map Utils.freeName lambdavars) ctxt1
+    val (cls_pred, ctxt1, vars, lambdavars) =
+      if (not o null) vars andalso (#2 o #1 o hd) vars = @{typ "i \<Rightarrow> o"} then
+        ((Thm.term_of o #2 o hd) vars, ctxt1, tl vars, lambdavars)
+      else if null vars andalso (not o null) lambdavars andalso (freeType o hd) lambdavars = @{typ "i \<Rightarrow> o"} then
+        (hd lambdavars, ctxt1, vars, tl lambdavars)
+      else Variable.variant_fixes ["N"] ctxt1 |>> var_io o hd |> (fn (cls, ctxt) => (cls, ctxt, vars, lambdavars))
+    val db' = db' |> Database.insert Database.abs2rel (cls_pred, cls_pred)
+                     o Database.insert Database.rel2is (cls_pred, cls_pred)
+    val (v,t) = relativ_tm_frm' is_functional relationalising cls_pred db' ctxt1 tm
+    val t_vars = sort_strings (Term.add_free_names tm [])
+    val vs' = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars
+    val vs = cls_pred :: map (Thm.term_of o #2) vs' @ lambdavars @ the_list v
+    val at = List.foldr (uncurry lambda) t vs
+    val abs_const = read_const lthy (if is_external then thm_ref else lname lthy thm_ref)
+    fun new_const ctxt' = read_new_const ctxt' def_name
+    fun db_map ctxt' =
+       Data.map (add_rel_const (get_mode is_functional relationalising) abs_const (new_const ctxt'))
+    fun add_to_context ctxt' = Context.proof_map (db_map ctxt') ctxt'
+    fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map (db_map ctxt')) ctxt'
+  in
+    lthy
+    |> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at))
+    |>> (#2 #> (fn (s,t) => (s,[t])))
+    |> Utils.display "theorem" pos
+    |> Local_Theory.target (add_to_theory o add_to_context)
+  end
+
+fun relativize_tm is_functional def_name term pos lthy =
+  let
+    val ctxt = lthy
+    val (cls_pred, ctxt1) = Variable.variant_fixes ["N"] ctxt |>> var_io o hd
+    val tm = Syntax.read_term ctxt1 term
+    val db' = Data.get (Context.Proof lthy)
+    val db' = db' |> Database.insert Database.abs2rel (cls_pred, cls_pred)
+                     o Database.insert Database.rel2is (cls_pred, cls_pred)
+    val vs' = Variable.add_frees ctxt1 tm []
+    val ctxt2 = fold Utils.add_to_context (map #1 vs') ctxt1
+    val (v,t) = relativ_tm_frm' is_functional false cls_pred db' ctxt2 tm
+    val vs = cls_pred :: map Free vs' @ the_list v
+    val at = List.foldr (uncurry lambda) t vs
+  in
+    lthy
+    |> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at))
+    |>> (#2 #> (fn (s,t) => (s,[t])))
+    |> Utils.display "theorem" pos
+  end
+
+val op $` = curry ((op $) o swap)
+infix $`
+
+fun is_free_i (Free (_, @{typ "i"})) = true
+  | is_free_i _ = false
+
+fun rel_closed_goal target pos lthy =
+  let
+    val (_, tm, _) = Utils.thm_concl_tm lthy (target ^ "_rel_def")
+    val (def, tm) = tm |> Utils.dest_eq_tms'
+    fun first_lambdas (Abs (body as (_, ty, _))) =
+        if ty = @{typ "i"}
+          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
+          else Utils.dest_abs body |> first_lambdas o #2
+      | first_lambdas _ = []
+    val (def, vars) = Term.strip_comb def ||> filter is_free_i
+    val vs = vars @ first_lambdas tm
+    val class = Free ("M", @{typ "i \<Rightarrow> o"})
+    val def = fold (op $`) (class :: vs) def
+    val hyps = map (fn v => class $ v |> Utils.tp) vs
+    val concl = class $ def
+    val goal = Logic.list_implies (hyps, Utils.tp concl)
+    val attribs = @{attributes [intro, simp]}
+  in
+    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
+                                    o Local_Theory.note ((Binding.name (target ^ "_rel_closed"), attribs), hd thmss))
+    [[(goal, [])]] lthy
+  end
+
+fun iff_goal target pos lthy =
+  let
+    val (_, tm, ctxt') = Utils.thm_concl_tm lthy (target ^ "_rel_def")
+    val (_, is_def, ctxt) = Utils.thm_concl_tm ctxt' ("is_" ^ target ^ "_def")
+    val is_def = is_def |> Utils.dest_eq_tms' |> #1 |> Term.strip_comb |> #1
+    val (def, tm) = tm |> Utils.dest_eq_tms'
+    fun first_lambdas (Abs (body as (_, ty, _))) =
+        if ty = @{typ "i"}
+          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
+          else Utils.dest_abs body |> first_lambdas o #2
+      | first_lambdas _ = []
+    val (def, vars) = Term.strip_comb def ||> filter is_free_i
+    val vs = vars @ first_lambdas tm
+    val class = Free ("M", @{typ "i \<Rightarrow> o"})
+    val def = fold (op $`) (class :: vs) def
+    val ty = fastype_of def
+    val res = if ty = @{typ "i"}
+                then Variable.variant_fixes ["res"] ctxt |> SOME o Utils.var_i o hd o #1
+                else NONE
+    val is_def = fold (op $`) (class :: vs @ the_list res) is_def
+    val hyps = map (fn v => class $ v |> Utils.tp) (vs @ the_list res)
+    val concl = @{const "IFOL.iff"} $ is_def
+              $ (if ty = @{typ "i"} then (@{const IFOL.eq(i)} $ the res $ def) else def)
+    val goal = Logic.list_implies (hyps, Utils.tp concl)
+  in
+    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
+                                    o Local_Theory.note ((Binding.name ("is_" ^ target ^ "_iff"), []), hd thmss))
+    [[(goal, [])]] lthy
+  end
+
+fun univalent_goal target pos lthy =
+  let
+    val (_, tm, ctxt) = Utils.thm_concl_tm lthy ("is_" ^ target ^ "_def")
+    val (def, tm) = tm |> Utils.dest_eq_tms'
+    fun first_lambdas (Abs (body as (_, ty, _))) =
+        if ty = @{typ "i"}
+          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
+          else Utils.dest_abs body |> first_lambdas o #2
+      | first_lambdas _ = []
+    val (def, vars) = Term.strip_comb def ||> filter is_free_i
+    val vs = vars @ first_lambdas tm
+    val n = length vs
+    val vs = List.take (vs, n - 2)
+    val class = Free ("M", @{typ "i \<Rightarrow> o"})
+    val def = fold (op $`) (class :: vs) def
+    val v = Variable.variant_fixes ["A"] ctxt |> Utils.var_i o hd o #1
+    val hyps = map (fn v => class $ v |> Utils.tp) (v :: vs)
+    val concl = @{const "Relative.univalent"} $ class $ v $ def
+    val goal = Logic.list_implies (hyps, Utils.tp concl)
+  in
+    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
+                                    o Local_Theory.note ((Binding.name ("univalent_is_" ^ target), []), hd thmss))
+    [[(goal, [])]] lthy
+  end
+
+end
+
+local
+  val full_mode_parser =
+       Scan.option (((Parse.$$$ "functional" |-- Parse.$$$ "relational") >> K Database.rel2is)
+                    || (((Scan.option (Parse.$$$ "absolute")) |-- Parse.$$$ "functional") >> K Database.abs2rel)
+                    || (((Scan.option (Parse.$$$ "absolute")) |-- Parse.$$$ "relational") >> K Database.abs2is))
+       >> (fn mode => the_default Database.abs2is mode)
+
+  val reldb_parser =
+       Parse.position (full_mode_parser -- (Parse.string -- Parse.string));
+
+  val singlemode_parser = (Parse.$$$ "absolute" >> K Database.remove_abs)
+                       || (Parse.$$$ "functional" >> K Database.remove_rel)
+                       || (Parse.$$$ "relational" >> K Database.remove_is)
+
+  val reldb_rem_parser = Parse.position (singlemode_parser -- Parse.string)
+
+  val mode_parser =
+       Scan.option ((Parse.$$$ "relational" >> K false) || (Parse.$$$ "functional" >> K true))
+       >> (fn mode => if is_none mode then false else the mode)
+
+  val relativize_parser =
+       Parse.position (mode_parser -- (Parse.string -- Parse.string) -- (Scan.optional (Parse.$$$ "external" >> K true) false));
+
+  val _ =
+     Outer_Syntax.local_theory \<^command_keyword>\<open>reldb_add\<close> "ML setup for adding relativized/absolute pairs"
+       (reldb_parser >> (fn ((mode, (abs_term,rel_term)),_) =>
+          Relativization.add_constant mode abs_term rel_term))
+
+  val _ =
+   Outer_Syntax.local_theory \<^command_keyword>\<open>reldb_rem\<close> "ML setup for adding relativized/absolute pairs"
+     (reldb_rem_parser >> (uncurry Relativization.rem_constant o #1))
+
+  val _ =
+     Outer_Syntax.local_theory \<^command_keyword>\<open>relativize\<close> "ML setup for relativizing definitions"
+       (relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) =>
+          Relativization.relativize_def is_external is_functional false thm bndg pos))
+
+  val _ =
+     Outer_Syntax.local_theory \<^command_keyword>\<open>relativize_tm\<close> "ML setup for relativizing definitions"
+       (relativize_parser >> (fn (((is_functional, (bndg,term)), _),pos) =>
+          Relativization.relativize_tm is_functional term bndg pos))
+
+  val _ =
+     Outer_Syntax.local_theory \<^command_keyword>\<open>relationalize\<close> "ML setup for relativizing definitions"
+       (relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) =>
+          Relativization.relativize_def is_external is_functional true thm bndg pos))
+
+  val _ =
+    Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>rel_closed\<close> "ML setup for rel_closed theorem"
+      (Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) =>
+        Relativization.rel_closed_goal target pos))
+
+  val _ =
+    Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>is_iff_rel\<close> "ML setup for rel_closed theorem"
+      (Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) =>
+        Relativization.iff_goal target pos))
+
+  val _ =
+    Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>univalent\<close> "ML setup for rel_closed theorem"
+      (Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) =>
+        Relativization.univalent_goal target pos))
+
+val _ =
+  Theory.setup
+   (Attrib.setup \<^binding>\<open>Rel\<close> (Attrib.add_del Relativization.Rel_add Relativization.Rel_del)
+      "declaration of relativization rule") ;
+in
+end
diff --git a/thys/Transitive_Models/Relativization.thy b/thys/Transitive_Models/Relativization.thy
--- a/thys/Transitive_Models/Relativization.thy
+++ b/thys/Transitive_Models/Relativization.thy
@@ -1,856 +1,140 @@
 section\<open>Automatic relativization of terms and formulas\<close>
 
 text\<open>Relativization of terms and formulas. Relativization of formulas shares relativized terms as
 far as possible; assuming that the witnesses for the relativized terms are always unique.\<close>
 
 theory Relativization
   imports
     "ZF-Constructible.Datatype_absolute"
     Higher_Order_Constructs
   keywords
     "relativize" :: thy_decl % "ML"
     and
     "relativize_tm" :: thy_decl % "ML"
     and
     "reldb_add" :: thy_decl % "ML"
     and
     "reldb_rem" :: thy_decl % "ML"
     and
     "relationalize" :: thy_decl % "ML"
     and
     "rel_closed" :: thy_goal_stmt % "ML"
     and
     "is_iff_rel" :: thy_goal_stmt % "ML"
     and
     "univalent" :: thy_goal_stmt % "ML"
     and
     "absolute"
     and
     "functional"
     and
     "relational"
     and
     "external"
     and
     "for"
 
 begin
 
 ML_file\<open>Relativization_Database.ml\<close>
 
 ML\<open>
 structure Absoluteness = Named_Thms
   (val name = @{binding "absolut"}
    val description = "Theorems of absoulte terms and predicates.")
 \<close>
 setup\<open>Absoluteness.setup\<close>
 
 lemmas relative_abs =
   M_trans.empty_abs
   M_trans.pair_abs
   M_trivial.cartprod_abs
   M_trans.union_abs
   M_trans.inter_abs
   M_trans.setdiff_abs
   M_trans.Union_abs
   M_trivial.cons_abs
   (*M_trans.upair_abs*)
   M_trivial.successor_abs
   M_trans.Collect_abs
   M_trans.Replace_abs
   M_trivial.lambda_abs2
   M_trans.image_abs
   (*M_trans.powerset_abs*)
   M_trivial.nat_case_abs
   (*
   M_trans.transitive_set_abs
   M_trans.ordinal_abs
   M_trivial.limit_ordinal_abs
   M_trivial.successor_ordinal_abs
   M_trivial.finite_ordinal_abs
 *)
   M_trivial.omega_abs
   M_basic.sum_abs
   M_trivial.Inl_abs
   M_trivial.Inr_abs
   M_basic.converse_abs
   M_basic.vimage_abs
   M_trans.domain_abs
   M_trans.range_abs
   M_basic.field_abs
   (* M_basic.apply_abs *)
   (*
   M_trivial.typed_function_abs
   M_basic.injection_abs
   M_basic.surjection_abs
   M_basic.bijection_abs
   *)
   M_basic.composition_abs
   M_trans.restriction_abs
   M_trans.Inter_abs
   M_trivial.bool_of_o_abs
   M_trivial.not_abs
   M_trivial.and_abs
   M_trivial.or_abs
   M_trivial.Nil_abs
   M_trivial.Cons_abs
   (*M_trivial.quasilist_abs*)
   M_trivial.list_case_abs
   M_trivial.hd_abs
   M_trivial.tl_abs
   M_trivial.least_abs'
   M_eclose.transrec_abs
   M_trans.If_abs
   M_trans.The_abs
   M_eclose.recursor_abs
   M_trancl.trans_wfrec_abs
   M_trancl.trans_wfrec_on_abs
 
 lemmas datatype_abs =
   M_datatypes.list_N_abs
   M_datatypes.list_abs
   M_datatypes.formula_N_abs
   M_datatypes.formula_abs
   M_eclose.is_eclose_n_abs
   M_eclose.eclose_abs
   M_datatypes.length_abs
   M_datatypes.nth_abs
   M_trivial.Member_abs
   M_trivial.Equal_abs
   M_trivial.Nand_abs
   M_trivial.Forall_abs
   M_datatypes.depth_abs
   M_datatypes.formula_case_abs
 
 declare relative_abs[absolut]
 declare datatype_abs[absolut]
 
-ML\<open>
-signature Relativization =
-  sig
-    structure Data: GENERIC_DATA
-    val Rel_add: attribute
-    val Rel_del: attribute
-    val add_rel_const : Database.mode -> term -> term -> Data.T -> Data.T
-    val add_constant : Database.mode -> string -> string -> Proof.context -> Proof.context
-    val rem_constant : (term -> Data.T -> Data.T) -> string -> Proof.context -> Proof.context
-    val db: Data.T
-    val init_db : Data.T -> theory -> theory
-    val get_db : Proof.context -> Data.T
-    val relativ_fm: bool -> bool -> term -> Data.T -> (term * (term * term)) list * Proof.context * term list * bool -> term -> term * ((term * (term * term)) list * term list * term list * Proof.context)
-    val relativ_tm: bool -> bool -> term option -> term -> Data.T -> (term * (term * term)) list * Proof.context -> term -> term * (term * (term * term)) list * Proof.context
-    val read_new_const : Proof.context -> string -> term
-    val relativ_tm_frm': bool -> bool -> term -> Data.T -> Proof.context -> term -> term option * term
-    val relativize_def: bool -> bool -> bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context
-    val relativize_tm: bool -> bstring -> string -> Position.T -> Proof.context -> Proof.context
-    val rel_closed_goal : string -> Position.T -> Proof.context -> Proof.state
-    val iff_goal : string -> Position.T -> Proof.context -> Proof.state
-    val univalent_goal : string -> Position.T -> Proof.context -> Proof.state
-  end
-
-structure Relativization : Relativization = struct
-
-infix 6 &&&
-val op &&& = Utils.&&&
-
-infix 6 ***
-val op *** = Utils.***
-
-infix 6 @@
-val op @@ = Utils.@@
-
-infix 6 ---
-val op --- = Utils.---
-
-fun insert_abs2rel ((t, u), db) = ((t, u), Database.insert Database.abs2rel (t, t) db)
-
-fun insert_rel2is ((t, u), db) = Database.insert Database.rel2is (t, u) db
-
-(* relativization db of relation constructors *)
-val db = [ (@{const relation}, @{const Relative.is_relation})
-         , (@{const function}, @{const Relative.is_function})
-         , (@{const mem}, @{const mem})
-         , (@{const True}, @{const True})
-         , (@{const False}, @{const False})
-         , (@{const Memrel}, @{const membership})
-         , (@{const trancl}, @{const tran_closure})
-         , (@{const IFOL.eq(i)}, @{const IFOL.eq(i)})
-         , (@{const Subset}, @{const Relative.subset})
-         , (@{const quasinat}, @{const Relative.is_quasinat})
-         , (@{const apply}, @{const Relative.fun_apply})
-         , (@{const Upair}, @{const Relative.upair})
-         ]
-         |> List.foldr (insert_rel2is o insert_abs2rel) Database.empty
-         |> Database.insert Database.abs2is (@{const Pi}, @{const is_funspace})
-
-fun var_i v = Free (v, @{typ i})
-fun var_io v = Free (v, @{typ "i \<Rightarrow> o"})
-val const_name = #1 o dest_Const
-
-val lookup_tm  = AList.lookup (op aconv)
-val update_tm  =  AList.update (op aconv)
-val join_tm = AList.join (op aconv) (K #1)
-
-val conj_ = Utils.binop @{const "IFOL.conj"}
-
-(* generic data *)
-structure Data = Generic_Data
-(
-  type T = Database.db
-  val empty = Database.empty (* Should we initialize this outside this file? *)
-  val merge = Database.merge
-);
-
-fun init_db db = Context.theory_map (Data.put db)
-
-fun get_db thy = Data.get (Context.Proof thy)
-
-val read_const = Proof_Context.read_const {proper = true, strict = true}
-val read_new_const = Proof_Context.read_term_pattern
-
-fun add_rel_const mode c t = Database.insert mode (c, t)
-
-fun get_consts thm =
-  let val (c_rel, rhs) = Thm.concl_of thm |> Utils.dest_trueprop |>
-                          Utils.dest_iff_tms |>> head_of
-  in case try Utils.dest_eq_tms rhs of
-       SOME tm => (c_rel, tm |> #2 |> head_of)
-     | NONE => (c_rel, rhs |> Utils.dest_mem_tms |> #2 |> head_of)
-  end
-
-fun add_rule thm rs =
-  let val (c_rel,c_abs) = get_consts thm
-  (* in (add_rel_const Database.rel2is c_abs c_rel o add_rel_const Database.abs2rel c_abs c_abs) rs *)
-  in (add_rel_const Database.abs2rel c_abs c_abs o add_rel_const Database.abs2is c_abs c_rel) rs
-end
-
-fun get_mode is_functional relationalising = if relationalising then Database.rel2is else if is_functional then Database.abs2rel else Database.abs2is
-
-fun add_constant mode abs rel thy =
-  let
-    val c_abs = read_new_const thy abs
-    val c_rel = read_new_const thy rel
-    val db_map = Data.map (Database.insert mode (c_abs, c_rel))
-    fun add_to_context ctxt' = Context.proof_map db_map ctxt'
-    fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt'
-  in
-    Local_Theory.target (add_to_theory o add_to_context) thy
- end
-
-fun rem_constant rem_op c thy =
-  let
-    val c = read_new_const thy c
-    val db_map = Data.map (rem_op c)
-    fun add_to_context ctxt' = Context.proof_map db_map ctxt'
-    fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map db_map) ctxt'
-  in
-    Local_Theory.target (add_to_theory o add_to_context) thy
-  end
-
-val del_rel_const = Database.remove_abs
-
-fun del_rule thm = del_rel_const (thm |> get_consts |> #2)
-
-val Rel_add =
-  Thm.declaration_attribute (fn thm => fn context =>
-    Data.map (add_rule (Thm.trim_context thm)) context);
-
-val Rel_del =
-  Thm.declaration_attribute (fn thm => fn context =>
-    Data.map (del_rule (Thm.trim_context thm)) context);
-
-(* Conjunction of a list of terms *)
-fun conjs [] = @{term IFOL.True}
-  | conjs (fs as _ :: _) = foldr1 (uncurry conj_) fs
-
-(* Produces a relativized existential quantification of the term t *)
-fun rex p t (Free v) = @{const rex} $ p $ lambda (Free v) t
-  | rex _ t (Bound _) = t
-  | rex _ t tm = raise TERM ("rex shouldn't handle this.",[tm,t])
-
-(* Constants that do not take the class predicate *)
-val absolute_rels = [ @{const ZF_Base.mem}
-                    , @{const IFOL.eq(i)}
-                    , @{const Memrel}
-                    , @{const True}
-                    , @{const False}
-                    ]
-
-(* Creates the relational term corresponding to a term of type i. If the last
-  argument is (SOME v) then that variable is not bound by an existential
-  quantifier.
-*)
-fun close_rel_tm pred tm tm_var rs =
-  let val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs
-      val (vars, tms) = split_list (map #2 news) ||> (curry op @) (the_list tm)
-      val vars = case tm_var of
-        SOME w => filter (fn v => not (v = w)) vars
-      | NONE => vars
-  in fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars (conjs tms)
-  end
-
-fun relativ_tms __ _ _ rs ctxt [] = ([], rs, ctxt)
-  | relativ_tms is_functional relationalising pred rel_db rs ctxt (u :: us) =
-      let val (w_u, rs_u, ctxt_u) = relativ_tm is_functional relationalising NONE pred rel_db (rs, ctxt) u
-          val (w_us, rs_us, ctxt_us) = relativ_tms is_functional relationalising pred rel_db rs_u ctxt_u us
-      in (w_u :: w_us, join_tm (rs_u , rs_us), ctxt_us)
-      end
-and
-    (* The result of the relativization of a term is a triple consisting of
-      a. the relativized term (it can be a free or a bound variable but also a Collect)
-      b. a list of (term * (term, term)), taken as a map, which is used
-         to reuse relativization of different occurrences of the same term. The
-         first element is the original term, the second its relativized version,
-         and the last one is the predicate corresponding to it.
-      c. the resulting context of created variables.
-    *)
-    relativ_tm is_functional relationalising mv pred rel_db (rs,ctxt) tm =
-      let
-      (* relativization of a fully applied constant *)
-      fun mk_rel_const mv c (args, after) abs_args ctxt =
-        case Database.lookup (get_mode is_functional relationalising) c rel_db of
-          SOME p =>
-            let
-              val args' = List.filter (not o member (op =) (Utils.frees p)) args
-              val (v, ctxt1) =
-                the_default
-                  (Variable.variant_fixes [""] ctxt |>> var_i o hd)
-                  (Utils.map_option (I &&& K ctxt) mv)
-              val args' =
-                (* FIXME: This special case for functional relativization of sigma should not be needed *)
-                if c = @{const Sigma} andalso is_functional
-                  then
-                    let
-                      val t = hd args'
-                      val t' = Abs ("uu_", @{typ "i"}, (hd o tl) args' |> incr_boundvars 1)
-                    in
-                      [t, t']
-                    end
-                  else
-                    args'
-              val arg_list = if after then abs_args @ args' else args' @ abs_args
-              val r_tm =
-                if is_functional
-                  then list_comb (p, if p = c then arg_list else pred :: arg_list)
-                  else list_comb (p, if (not o null) args' andalso  hd args' = pred then arg_list @ [v] else pred :: arg_list @ [v])
-            in
-              if is_functional
-                then (r_tm, r_tm, ctxt)
-                else (v, r_tm, ctxt1)
-            end
-        | NONE => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil)
-      (* relativization of a partially applied constant *)
-      fun relativ_app mv mctxt tm abs_args (Const c) (args, after) rs =
-            let
-              val (w_ts, rs_ts, ctxt_ts) = relativ_tms is_functional relationalising pred rel_db rs (the_default ctxt mctxt) args
-              val (w_tm, r_tm, ctxt_tm) = mk_rel_const mv (Const c) (w_ts, after) abs_args ctxt_ts
-              val rs_ts' = if is_functional then rs_ts else update_tm (tm, (w_tm, r_tm)) rs_ts
-            in
-              (w_tm, rs_ts', ctxt_tm)
-            end
-        | relativ_app _ _ _ _ t _ _ =
-            raise TERM ("Tried to relativize an application with a non-constant in head position",[t])
-
-      (* relativization of non dependent product and sum *)
-      fun relativ_app_no_dep mv tm c t t' rs =
-          if loose_bvar1 (t', 0)
-            then
-              raise TERM("A dependency was found when trying to relativize", [tm])
-            else
-              relativ_app mv NONE tm [] c ([t, incr_boundvars ~1 t'], false) rs
-
-      fun relativ_replace mv t body after ctxt' =
-        let
-          val (v, b) = Utils.dest_abs body |>> var_i ||> after
-          val (b', (rs', ctxt'')) =
-            relativ_fm is_functional relationalising pred rel_db (rs, ctxt', single v, false) b |>> incr_boundvars 1 ||> #1 &&& #4
-        in
-          relativ_app mv (SOME ctxt'') tm [lambda v b'] @{const Replace} ([t], false) rs'
-        end
-
-      fun get_abs_body (Abs body) = body
-        | get_abs_body t = raise TERM ("Term is not Abs", [t])
-
-      fun go _ (Var _) = raise TERM ("Var: Is this possible?",[])
-        | go mv (@{const Replace} $ t $ Abs body) = relativ_replace mv t body I ctxt
-        (* It is easier to rewrite RepFun as Replace before relativizing,
-           since { f(x) . x \<in> t } = { y . x \<in> t, y = f(x) } *)
-        | go mv (@{const RepFun} $ t $ Abs body) =
-            let
-              val (y, ctxt') = Variable.variant_fixes [""] ctxt |>> var_i o hd
-            in
-              relativ_replace mv t body (lambda y o Utils.eq_ y o incr_boundvars 1) ctxt'
-            end
-        | go mv (@{const Collect} $ t $ pc) =
-            let
-              val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4
-            in
-              relativ_app mv (SOME ctxt') tm [pc'] @{const Collect} ([t], false) rs'
-            end
-        | go mv (@{const Least} $ pc) =
-            let
-              val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4
-            in
-              relativ_app mv (SOME ctxt') tm [pc'] @{const Least} ([], false) rs'
-            end
-        | go mv (@{const transrec} $ t $ Abs body) =
-            let
-              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
-              val (x, b') = Utils.dest_abs body |>> var_i
-              val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
-              val p = Utils.eq_ res b |> lambda res
-              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
-              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
-            in
-              relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const transrec} ([t], not is_functional) rs'
-            end
-        | go mv (tm as @{const Sigma} $ t $ Abs (_, _, t')) =
-            relativ_app_no_dep mv tm @{const Sigma} t t' rs
-        | go mv (tm as @{const Pi} $ t $ Abs (_, _, t')) =
-            relativ_app_no_dep mv tm @{const Pi} t t' rs
-        | go mv (tm as @{const bool_of_o} $ t) =
-            let
-              val (t', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) t ||> #1 &&& #4
-            in
-              relativ_app mv (SOME ctxt') tm [t'] @{const bool_of_o} ([], false) rs'
-            end
-        | go mv (tm as @{const If} $ b $ t $ t') =
-            let
-              val (br, (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt, [], false) b ||> #1 &&& #4
-            in
-              relativ_app mv (SOME ctxt') tm [br] @{const If} ([t,t'], true) rs'
-            end
-        | go mv (@{const The} $ pc) =
-            let
-              val (pc', (rs', ctxt')) = relativ_fm is_functional relationalising pred rel_db (rs,ctxt, [], false) pc ||> #1 &&& #4
-            in
-              relativ_app mv (SOME ctxt') tm [pc'] @{const The} ([], false) rs'
-            end
-        | go mv (@{const recursor} $ t $ Abs body $ t') =
-            let
-              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
-              val (x, b') = Utils.dest_abs body |>> var_i
-              val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
-              val p = Utils.eq_ res b |> lambda res
-              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
-              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
-              val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t
-            in
-              relativ_app mv (SOME ctxt''') tm [tr, p' |> lambda x o lambda y] @{const recursor} ([t'], true) rs''
-            end
-        | go mv (@{const wfrec} $ t1 $ t2 $ Abs body) =
-            let
-              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
-              val (x, b') = Utils.dest_abs body |>> var_i
-              val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
-              val p = Utils.eq_ res b |> lambda res
-              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
-              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
-            in
-              relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const wfrec} ([t1,t2], not is_functional) rs'
-            end
-        | go mv (@{const wfrec_on} $ t1 $ t2 $ t3 $ Abs body) =
-            let
-              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
-              val (x, b') = Utils.dest_abs body |>> var_i
-              val (y, b) = get_abs_body b' |> Utils.dest_abs |>> var_i
-              val p = Utils.eq_ res b |> lambda res
-              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x, y], true) p |>> incr_boundvars 3 ||> #1 &&& #4
-              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
-            in
-              relativ_app mv (SOME ctxt'') tm [p' |> lambda x o lambda y] @{const wfrec_on} ([t1,t2,t3], not is_functional) rs'
-            end
-        | go mv (@{const Lambda} $ t $ Abs body) =
-            let
-              val (res, ctxt') = Variable.variant_fixes [if is_functional then "_aux" else ""] ctxt |>> var_i o hd
-              val (x, b) = Utils.dest_abs body |>> var_i
-              val p = Utils.eq_ res b |> lambda res
-              val (p', (rs', ctxt'')) = relativ_fm is_functional relationalising pred rel_db (rs, ctxt', [x], true) p |>> incr_boundvars 2 ||> #1 &&& #4
-              val p' = if is_functional then p' |> #2 o Utils.dest_eq_tms o #2 o Utils.dest_abs o get_abs_body else p'
-              val (tr, rs'', ctxt''') = relativ_tm is_functional relationalising NONE pred rel_db (rs', ctxt'') t
-            in
-              relativ_app mv (SOME ctxt''') tm [tr, p' |> lambda x] @{const Lambda} ([], true) rs''
-            end
-        (* The following are the generic cases *)
-        | go mv (tm as Const _) = relativ_app mv NONE tm [] tm ([], false) rs
-        | go mv (tm as _ $ _) = (strip_comb tm ||> I &&& K false |> uncurry (relativ_app mv NONE tm [])) rs
-        | go _ tm = if is_functional then (tm, rs, ctxt) else (tm, update_tm (tm,(tm,tm)) rs, ctxt)
+ML_file\<open>Relativization.ml\<close>
 
-      (* we first check if the term has been already relativized as a variable *)
-      in case lookup_tm rs tm of
-           NONE => go mv tm
-         | SOME (w, _) => (w, rs, ctxt)
-      end
-and
-  relativ_fm is_functional relationalising pred rel_db (rs, ctxt, vs, is_term) fm =
-  let
-
-  (* relativization of a fully applied constant *)
-  fun relativ_app (ctxt, rs) c args = case Database.lookup (get_mode is_functional relationalising) c rel_db of
-    SOME p =>
-      let (* flag indicates whether the relativized constant is absolute or not. *)
-        val flag = not (exists (curry op aconv c) absolute_rels orelse c = p)
-        val (args, rs_ts, ctxt') = relativ_tms is_functional relationalising pred rel_db rs ctxt args
-        (* TODO: Verify if next line takes care of locales' definitions *)
-        val args' = List.filter (not o member (op =) (Utils.frees p)) args
-        val args'' = if not (null args') andalso hd args' = pred then args' else pred :: args'
-        val tm = list_comb (p, if flag then args'' else args')
-        (* TODO: Verify if next line is necessary *)
-        val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs_ts
-        val (vars, tms) = split_list (map #2 news)
-        (* val vars = filter (fn v => not (v = tm)) vars *) (* Verify if this line is necessary *)
-       in (tm, (rs_ts, vars, tms, ctxt'))
-       end
-   | NONE   => raise TERM ("Constant " ^ const_name c ^ " is not present in the db." , nil)
-
-  fun close_fm quantifier (f, (rs, vars, tms, ctxt)) =
-    let
-      fun contains_b0 t = loose_bvar1 (t, 0)
-
-      fun contains_extra_var t = fold (fn v => fn acc => acc orelse fold_aterms (fn t => fn acc => t = v orelse acc) t false) vs false
-
-      fun contains_b0_extra t = contains_b0 t orelse contains_extra_var t
-
-      (* t1 $ v \<hookrightarrow> t2 iff v \<in> FV(t2) *)
-      fun chained_frees (_ $ v) t2 = member (op =) (Utils.frees t2) v
-        | chained_frees t _ = raise TERM ("Malformed term", [t])
-
-      val tms_to_close = filter contains_b0_extra tms |> Utils.reachable chained_frees tms
-      val tms_to_keep = map (incr_boundvars ~1) (tms --- tms_to_close)
-      val vars_to_close = inter (op =) (map (List.last o #2 o strip_comb) tms_to_close) vars
-      val vars_to_keep = vars --- vars_to_close
-      val new_rs =
-        rs
-        |> filter (fn (k, (v, rel)) => not (contains_b0_extra k orelse contains_b0_extra v orelse contains_b0_extra rel))
-        |> map (fn (k, (v, rel)) => (incr_boundvars ~1 k, (incr_boundvars ~1 v, incr_boundvars ~1 rel)))
-
-      val f' =
-        if not is_term andalso not quantifier andalso is_functional
-          then pred $ Bound 0 :: (map (curry (op $) pred) vs) @ [f]
-          else [f]
-    in
-      (fold (fn v => fn t => rex pred (incr_boundvars 1 t) v) vars_to_close (conjs (f' @ tms_to_close)),
-       (new_rs, vars_to_keep, tms_to_keep, ctxt))
-    end
-
-  (* Handling of bounded quantifiers. *)
-  fun bquant (ctxt, rs) quant conn dom pred =
-    let val (v,pred') = Utils.dest_abs pred |>> var_i
-    in
-      go (ctxt, rs, false) (quant $ (lambda v o incr_boundvars 1) (conn $ (@{const mem} $ v $ dom) $ pred'))
-    end
-  and
-  bind_go (ctxt, rs) const f f' =
-    let
-      val (r , (rs1, vars1, tms1, ctxt1)) = go (ctxt, rs, false) f
-      val (r', (rs2, vars2, tms2, ctxt2)) = go (ctxt1, rs1, false) f'
-    in
-      (const $ r $ r', (rs2, vars1 @@ vars2, tms1 @@ tms2, ctxt2))
-    end
-  and
-      relativ_eq_var (ctxt, rs) v t =
-        let
-          val (_, rs', ctxt') = relativ_tm is_functional relationalising (SOME v) pred rel_db (rs, ctxt) t
-          val f = lookup_tm rs' t |> #2 o the
-          val rs'' = filter (not o (curry (op =) t) o #1) rs'
-          val news = filter (not o (fn x => is_Free x orelse is_Bound x) o #1) rs''
-          val (vars, tms) = split_list (map #2 news)
-        in
-          (f, (rs'', vars, tms, ctxt'))
-        end
-  and
-      relativ_eq (ctxt, rs) t1 t2 =
-        if is_functional orelse ((is_Free t1 orelse is_Bound t1) andalso (is_Free t2 orelse is_Bound t2)) then
-          relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2]
-        else if is_Free t1 orelse is_Bound t1 then
-          relativ_eq_var (ctxt, rs) t1 t2
-        else if is_Free t2 orelse is_Bound t2 then
-          relativ_eq_var (ctxt, rs) t2 t1
-        else
-          relativ_app (ctxt, rs) @{const IFOL.eq(i)} [t1, t2]
-  and
-      go (ctxt, rs, _         ) (@{const IFOL.conj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.conj} f f'
-    | go (ctxt, rs, _         ) (@{const IFOL.disj} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.disj} f f'
-    | go (ctxt, rs, _         ) (@{const IFOL.Not} $ f) = go (ctxt, rs, false) f |>> ((curry op $) @{const IFOL.Not})
-    | go (ctxt, rs, _         ) (@{const IFOL.iff} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.iff} f f'
-    | go (ctxt, rs, _         ) (@{const IFOL.imp} $ f $ f') = bind_go (ctxt, rs) @{const IFOL.imp} f f'
-    | go (ctxt, rs, _         ) (@{const IFOL.All(i)} $ f) = go (ctxt, rs, true) f |>> ((curry op $) (@{const OrdQuant.rall} $ pred))
-    | go (ctxt, rs, _         ) (@{const IFOL.Ex(i)} $ f) = go (ctxt, rs, true) f |>> ((curry op $) (@{const OrdQuant.rex} $ pred))
-    | go (ctxt, rs, _         ) (@{const Bex} $ f $ Abs p) = bquant (ctxt, rs) @{const Ex(i)} @{const IFOL.conj} f p
-    | go (ctxt, rs, _         ) (@{const Ball} $ f $ Abs p) = bquant (ctxt, rs) @{const All(i)} @{const IFOL.imp} f p
-    | go (ctxt, rs, _         ) (@{const rall} $ _ $ p) = go (ctxt, rs, true) p |>> (curry op $) (@{const rall} $ pred)
-    | go (ctxt, rs, _         ) (@{const rex} $ _ $ p) = go (ctxt, rs, true) p |>> (curry op $) (@{const rex} $ pred)
-    | go (ctxt, rs, _         ) (@{const IFOL.eq(i)} $ t1 $ t2) = relativ_eq (ctxt, rs) t1 t2
-    | go (ctxt, rs, _         ) (Const c) = relativ_app (ctxt, rs) (Const c) []
-    | go (ctxt, rs, _         ) (tm as _ $ _) = strip_comb tm |> uncurry (relativ_app (ctxt, rs))
-    | go (ctxt, rs, quantifier) (Abs (v, _, t)) =
-      let
-        val new_rs = map (fn (k, (v, rel)) => (incr_boundvars 1 k, (incr_boundvars 1 v, incr_boundvars 1 rel))) rs
-      in
-        go (ctxt, new_rs, false) t |> close_fm quantifier |>> lambda (var_i v)
-      end
-    | go _ t = raise TERM ("Relativization of formulas cannot handle this case.",[t])
-  in
-    go (ctxt, rs, false) fm
-  end
-
-
-fun relativ_tm_frm' is_functional relationalising cls_pred db ctxt tm =
-  let
-    fun get_bounds (l as Abs _) = op @@ (strip_abs l |>> map (op #1) ||> get_bounds)
-      | get_bounds (t as _$_) = strip_comb t |> op :: |> map get_bounds |> flat
-      | get_bounds _ = []
-
-    val ty = fastype_of tm
-    val initial_ctxt = fold Utils.add_to_context (get_bounds tm) ctxt
-  in
-    case ty of
-        @{typ i} =>
-          let
-            val (w, rs, _) =  relativ_tm is_functional relationalising NONE cls_pred db ([], initial_ctxt) tm
-          in
-            if is_functional
-              then (NONE, w)
-              else (SOME w, close_rel_tm cls_pred NONE (SOME w) rs)
-          end
-      | @{typ o} =>
-          let
-            fun close_fm (f, (_, vars, tms, _)) =
-              fold (fn  v => fn t => rex cls_pred (incr_boundvars 1 t) v) vars (conjs (f :: tms))
-          in
-            (NONE, relativ_fm is_functional relationalising cls_pred db ([], initial_ctxt, [], false) tm |> close_fm)
-          end
-      | ty' => raise TYPE ("We can relativize only terms of types i and o", [ty'], [tm])
-  end
-
-fun lname ctxt = Local_Theory.full_name ctxt o Binding.name
-
-fun destroy_first_lambdas (Abs (body as (_, ty, _))) =
-     Utils.dest_abs body ||> destroy_first_lambdas |> (#1 o #2) &&& ((fn v => Free (v, ty)) *** #2) ||> op ::
-  | destroy_first_lambdas t = (t, [])
-
-fun freeType (Free (_, ty)) = ty
-  | freeType t = raise TERM ("freeType", [t])
-
-fun relativize_def is_external is_functional relationalising def_name thm_ref pos lthy =
-  let
-    val ctxt = lthy
-    val (vars,tm,ctxt1) = Utils.thm_concl_tm ctxt (thm_ref ^ "_def")
-    val db' = Data.get (Context.Proof lthy)
-    val (tm, lambdavars) = tm |> destroy_first_lambdas o #2 o Utils.dest_eq_tms' o Utils.dest_trueprop
-    val ctxt1 = fold Utils.add_to_context (map Utils.freeName lambdavars) ctxt1
-    val (cls_pred, ctxt1, vars, lambdavars) =
-      if (not o null) vars andalso (#2 o #1 o hd) vars = @{typ "i \<Rightarrow> o"} then
-        ((Thm.term_of o #2 o hd) vars, ctxt1, tl vars, lambdavars)
-      else if null vars andalso (not o null) lambdavars andalso (freeType o hd) lambdavars = @{typ "i \<Rightarrow> o"} then
-        (hd lambdavars, ctxt1, vars, tl lambdavars)
-      else Variable.variant_fixes ["N"] ctxt1 |>> var_io o hd |> (fn (cls, ctxt) => (cls, ctxt, vars, lambdavars))
-    val db' = db' |> Database.insert Database.abs2rel (cls_pred, cls_pred)
-                     o Database.insert Database.rel2is (cls_pred, cls_pred)
-    val (v,t) = relativ_tm_frm' is_functional relationalising cls_pred db' ctxt1 tm
-    val t_vars = sort_strings (Term.add_free_names tm [])
-    val vs' = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars
-    val vs = cls_pred :: map (Thm.term_of o #2) vs' @ lambdavars @ the_list v
-    val at = List.foldr (uncurry lambda) t vs
-    val abs_const = read_const lthy (if is_external then thm_ref else lname lthy thm_ref)
-    fun new_const ctxt' = read_new_const ctxt' def_name
-    fun db_map ctxt' =
-       Data.map (add_rel_const (get_mode is_functional relationalising) abs_const (new_const ctxt'))
-    fun add_to_context ctxt' = Context.proof_map (db_map ctxt') ctxt'
-    fun add_to_theory ctxt' = Local_Theory.raw_theory (Context.theory_map (db_map ctxt')) ctxt'
-  in
-    lthy
-    |> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at))
-    |>> (#2 #> (fn (s,t) => (s,[t])))
-    |> Utils.display "theorem" pos
-    |> Local_Theory.target (add_to_theory o add_to_context)
-  end
-
-fun relativize_tm is_functional def_name term pos lthy =
-  let
-    val ctxt = lthy
-    val (cls_pred, ctxt1) = Variable.variant_fixes ["N"] ctxt |>> var_io o hd
-    val tm = Syntax.read_term ctxt1 term
-    val db' = Data.get (Context.Proof lthy)
-    val db' = db' |> Database.insert Database.abs2rel (cls_pred, cls_pred)
-                     o Database.insert Database.rel2is (cls_pred, cls_pred)
-    val vs' = Variable.add_frees ctxt1 tm []
-    val ctxt2 = fold Utils.add_to_context (map #1 vs') ctxt1
-    val (v,t) = relativ_tm_frm' is_functional false cls_pred db' ctxt2 tm
-    val vs = cls_pred :: map Free vs' @ the_list v
-    val at = List.foldr (uncurry lambda) t vs
-  in
-    lthy
-    |> Local_Theory.define ((Binding.name def_name, NoSyn), ((Binding.name (def_name ^ "_def"), []), at))
-    |>> (#2 #> (fn (s,t) => (s,[t])))
-    |> Utils.display "theorem" pos
-  end
-
-val op $` = curry ((op $) o swap)
-infix $`
-
-fun is_free_i (Free (_, @{typ "i"})) = true
-  | is_free_i _ = false
-
-fun rel_closed_goal target pos lthy =
-  let
-    val (_, tm, _) = Utils.thm_concl_tm lthy (target ^ "_rel_def")
-    val (def, tm) = tm |> Utils.dest_eq_tms'
-    fun first_lambdas (Abs (body as (_, ty, _))) =
-        if ty = @{typ "i"}
-          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
-          else Utils.dest_abs body |> first_lambdas o #2
-      | first_lambdas _ = []
-    val (def, vars) = Term.strip_comb def ||> filter is_free_i
-    val vs = vars @ first_lambdas tm
-    val class = Free ("M", @{typ "i \<Rightarrow> o"})
-    val def = fold (op $`) (class :: vs) def
-    val hyps = map (fn v => class $ v |> Utils.tp) vs
-    val concl = class $ def
-    val goal = Logic.list_implies (hyps, Utils.tp concl)
-    val attribs = @{attributes [intro, simp]}
-  in
-    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
-                                    o Local_Theory.note ((Binding.name (target ^ "_rel_closed"), attribs), hd thmss))
-    [[(goal, [])]] lthy
-  end
-
-fun iff_goal target pos lthy =
-  let
-    val (_, tm, ctxt') = Utils.thm_concl_tm lthy (target ^ "_rel_def")
-    val (_, is_def, ctxt) = Utils.thm_concl_tm ctxt' ("is_" ^ target ^ "_def")
-    val is_def = is_def |> Utils.dest_eq_tms' |> #1 |> Term.strip_comb |> #1
-    val (def, tm) = tm |> Utils.dest_eq_tms'
-    fun first_lambdas (Abs (body as (_, ty, _))) =
-        if ty = @{typ "i"}
-          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
-          else Utils.dest_abs body |> first_lambdas o #2
-      | first_lambdas _ = []
-    val (def, vars) = Term.strip_comb def ||> filter is_free_i
-    val vs = vars @ first_lambdas tm
-    val class = Free ("M", @{typ "i \<Rightarrow> o"})
-    val def = fold (op $`) (class :: vs) def
-    val ty = fastype_of def
-    val res = if ty = @{typ "i"}
-                then Variable.variant_fixes ["res"] ctxt |> SOME o Utils.var_i o hd o #1
-                else NONE
-    val is_def = fold (op $`) (class :: vs @ the_list res) is_def
-    val hyps = map (fn v => class $ v |> Utils.tp) (vs @ the_list res)
-    val concl = @{const "IFOL.iff"} $ is_def
-              $ (if ty = @{typ "i"} then (@{const IFOL.eq(i)} $ the res $ def) else def)
-    val goal = Logic.list_implies (hyps, Utils.tp concl)
-  in
-    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
-                                    o Local_Theory.note ((Binding.name ("is_" ^ target ^ "_iff"), []), hd thmss))
-    [[(goal, [])]] lthy
-  end
-
-fun univalent_goal target pos lthy =
-  let
-    val (_, tm, ctxt) = Utils.thm_concl_tm lthy ("is_" ^ target ^ "_def")
-    val (def, tm) = tm |> Utils.dest_eq_tms'
-    fun first_lambdas (Abs (body as (_, ty, _))) =
-        if ty = @{typ "i"}
-          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
-          else Utils.dest_abs body |> first_lambdas o #2
-      | first_lambdas _ = []
-    val (def, vars) = Term.strip_comb def ||> filter is_free_i
-    val vs = vars @ first_lambdas tm
-    val n = length vs
-    val vs = List.take (vs, n - 2)
-    val class = Free ("M", @{typ "i \<Rightarrow> o"})
-    val def = fold (op $`) (class :: vs) def
-    val v = Variable.variant_fixes ["A"] ctxt |> Utils.var_i o hd o #1
-    val hyps = map (fn v => class $ v |> Utils.tp) (v :: vs)
-    val concl = @{const "Relative.univalent"} $ class $ v $ def
-    val goal = Logic.list_implies (hyps, Utils.tp concl)
-  in
-    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
-                                    o Local_Theory.note ((Binding.name ("univalent_is_" ^ target), []), hd thmss))
-    [[(goal, [])]] lthy
-  end
-
-end
-\<close>
-
-ML\<open>
-local
-  val full_mode_parser =
-       Scan.option (((Parse.$$$ "functional" |-- Parse.$$$ "relational") >> K Database.rel2is)
-                    || (((Scan.option (Parse.$$$ "absolute")) |-- Parse.$$$ "functional") >> K Database.abs2rel)
-                    || (((Scan.option (Parse.$$$ "absolute")) |-- Parse.$$$ "relational") >> K Database.abs2is))
-       >> (fn mode => the_default Database.abs2is mode)
-
-  val reldb_parser =
-       Parse.position (full_mode_parser -- (Parse.string -- Parse.string));
-
-  val singlemode_parser = (Parse.$$$ "absolute" >> K Database.remove_abs)
-                       || (Parse.$$$ "functional" >> K Database.remove_rel)
-                       || (Parse.$$$ "relational" >> K Database.remove_is)
-
-  val reldb_rem_parser = Parse.position (singlemode_parser -- Parse.string)
-
-  val mode_parser =
-       Scan.option ((Parse.$$$ "relational" >> K false) || (Parse.$$$ "functional" >> K true))
-       >> (fn mode => if is_none mode then false else the mode)
-
-  val relativize_parser =
-       Parse.position (mode_parser -- (Parse.string -- Parse.string) -- (Scan.optional (Parse.$$$ "external" >> K true) false));
-
-  val _ =
-     Outer_Syntax.local_theory \<^command_keyword>\<open>reldb_add\<close> "ML setup for adding relativized/absolute pairs"
-       (reldb_parser >> (fn ((mode, (abs_term,rel_term)),_) =>
-          Relativization.add_constant mode abs_term rel_term))
-
-  val _ =
-   Outer_Syntax.local_theory \<^command_keyword>\<open>reldb_rem\<close> "ML setup for adding relativized/absolute pairs"
-     (reldb_rem_parser >> (uncurry Relativization.rem_constant o #1))
-
-  val _ =
-     Outer_Syntax.local_theory \<^command_keyword>\<open>relativize\<close> "ML setup for relativizing definitions"
-       (relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) =>
-          Relativization.relativize_def is_external is_functional false thm bndg pos))
-
-  val _ =
-     Outer_Syntax.local_theory \<^command_keyword>\<open>relativize_tm\<close> "ML setup for relativizing definitions"
-       (relativize_parser >> (fn (((is_functional, (bndg,term)), _),pos) =>
-          Relativization.relativize_tm is_functional term bndg pos))
-
-  val _ =
-     Outer_Syntax.local_theory \<^command_keyword>\<open>relationalize\<close> "ML setup for relativizing definitions"
-       (relativize_parser >> (fn (((is_functional, (bndg,thm)), is_external),pos) =>
-          Relativization.relativize_def is_external is_functional true thm bndg pos))
-
-  val _ =
-    Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>rel_closed\<close> "ML setup for rel_closed theorem"
-      (Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) =>
-        Relativization.rel_closed_goal target pos))
-
-  val _ =
-    Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>is_iff_rel\<close> "ML setup for rel_closed theorem"
-      (Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) =>
-        Relativization.iff_goal target pos))
-
-  val _ =
-    Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>univalent\<close> "ML setup for rel_closed theorem"
-      (Parse.position (Parse.$$$ "for" |-- Parse.string) >> (fn (target,pos) =>
-        Relativization.univalent_goal target pos))
-
-val _ =
-  Theory.setup
-   (Attrib.setup \<^binding>\<open>Rel\<close> (Attrib.add_del Relativization.Rel_add Relativization.Rel_del)
-      "declaration of relativization rule") ;
-in
-end
-\<close>
 setup\<open>Relativization.init_db Relativization.db \<close>
 
 declare relative_abs[Rel]
-  (*todo: check all the duplicate cases here.*)
+(*TODO: check all the duplicate cases here.*)
 declare datatype_abs[Rel]
 
 ML\<open>
 val db = Relativization.get_db @{context}
 \<close>
 
 end
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,56 +1,23 @@
 theory Renaming_Auto
   imports
     Utils
     Renaming
 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/Renaming_ML.ml b/thys/Transitive_Models/Renaming_ML.ml
--- a/thys/Transitive_Models/Renaming_ML.ml
+++ b/thys/Transitive_Models/Renaming_ML.ml
@@ -1,179 +1,205 @@
 structure Renaming_ML = struct
 open Utils
 
 fun sum_ f g m n p = @{const Renaming.rsum} $ f $ g $ m $ n $ p
 
 (*Builds a finite mapping from rho to rho'.*)
 fun mk_ren rho rho' ctxt =
   let val rs  = to_ML_list rho
       val rs' = to_ML_list rho'
       val ixs = 0 upto (length rs-1)
       fun err t = "The element " ^ Syntax.string_of_term ctxt t ^ " is missing in the target environment"
       fun mkp i =
           case find_index (fn x => x = nth rs i) rs' of
             ~1 => nth rs i |> err |> error
           |  j => mk_Pair (mk_ZFnat i) (mk_ZFnat j)
   in  map mkp ixs |> mk_FinSet
   end
 
 fun mk_dom_lemma ren rho =
   let val n = rho |> to_ML_list |> length |> mk_ZFnat
   in eq_ n (@{const domain} $ ren) |> tp
 end
 
 fun ren_tc_goal fin ren rho rho' =
   let val n = rho |> to_ML_list |> length |> mk_ZFnat
       val m = rho' |> to_ML_list |> length |> mk_ZFnat
       val fun_ty = if fin then @{const_name "FiniteFun"} else @{const_abbrev "function_space"}
       val ty = Const (fun_ty,@{typ "i \<Rightarrow> i \<Rightarrow> i"}) $ n $ m
   in  mem_ ren ty |> tp
 end
 
 fun ren_action_goal ren rho rho' ctxt =
   let val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] |> hd |> Free
       val j = Variable.variant_frees ctxt [] [("j",@{typ i})] |> hd |> Free
       val vs = rho  |> to_ML_list
       val ws = rho' |> to_ML_list |> filter Term.is_Free
       val h1 = subset_ (mk_FinSet vs) setV
       val h2 = lt_ j (length vs |> mk_ZFnat)
       val fvs = [j,setV ] @ ws |> filter Term.is_Free |> map freeName
       val lhs = nth_ j rho
       val rhs = nth_ (app_ ren j)  rho'
       val concl = eq_ lhs rhs
    in (Logic.list_implies([tp h1,tp h2],tp concl),fvs)
   end
 
   fun sum_tc_goal f m n p =
     let val m_length = m |> to_ML_list |> length |> mk_ZFnat
         val n_length = n |> to_ML_list |> length |> mk_ZFnat
         val p_length = p |> length_
         val id_fun = @{const id} $ p_length
         val sum_fun = sum_ f id_fun m_length n_length p_length
         val dom = add_ m_length p_length
         val codom = add_ n_length p_length
         val fun_ty = @{const_abbrev "function_space"}
         val ty = Const (fun_ty,@{typ "i \<Rightarrow> i \<Rightarrow> i"}) $ dom $ codom
   in  (sum_fun, mem_ sum_fun ty |> tp)
   end
 
 fun sum_action_goal ren rho rho' ctxt =
   let val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] |> hd |> Free
       val envV = Variable.variant_frees ctxt [] [("env",@{typ i})] |> hd |> Free
       val j = Variable.variant_frees ctxt [] [("j",@{typ i})] |> hd |> Free
       val vs = rho  |> to_ML_list
       val ws = rho' |> to_ML_list |> filter Term.is_Free
       val envL = envV |> length_
       val rhoL = vs |> length |> mk_ZFnat
       val h1 = subset_ (append vs ws |> mk_FinSet) setV
       val h2 = lt_ j (add_ rhoL envL)
       val h3 = mem_ envV (list_ setV)
       val fvs = ([j,setV,envV] @ ws |> filter Term.is_Free) |> map freeName
       val lhs = nth_ j (concat_ rho envV)
       val rhs = nth_ (app_ ren j) (concat_ rho' envV)
       val concl = eq_ lhs rhs
    in (Logic.list_implies([tp h1,tp h2,tp h3],tp concl),fvs)
   end
 
   (* Tactics *)
   fun fin ctxt =
          REPEAT (resolve_tac ctxt [@{thm nat_succI}] 1)
          THEN   resolve_tac ctxt [@{thm nat_0I}] 1
 
   fun step ctxt thm =
     asm_full_simp_tac ctxt 1
     THEN asm_full_simp_tac ctxt 1
     THEN EqSubst.eqsubst_tac ctxt [1] [@{thm app_fun} OF [thm]] 1
     THEN simp_tac ctxt 1
     THEN simp_tac ctxt 1
 
   fun fin_fun_tac ctxt =
     REPEAT (
       resolve_tac ctxt [@{thm consI}] 1
       THEN resolve_tac ctxt [@{thm ltD}] 1
       THEN simp_tac ctxt 1
       THEN resolve_tac ctxt [@{thm ltD}] 1
       THEN simp_tac ctxt 1)
     THEN resolve_tac ctxt [@{thm emptyI}] 1
   THEN REPEAT (simp_tac ctxt 1)
 
   fun ren_thm e e' ctxt =
    let
     val r = mk_ren e e' ctxt
     val fin_tc_goal = ren_tc_goal true r e e'
     val dom_goal =  mk_dom_lemma r e
     val tc_goal = ren_tc_goal false r e e'
     val (action_goal,fvs) = ren_action_goal r e e' ctxt
     val fin_tc_lemma = Goal.prove ctxt [] [] fin_tc_goal (fn _ => fin_fun_tac ctxt)
     val dom_lemma = Goal.prove ctxt [] [] dom_goal (fn _ => blast_tac ctxt 1)
     val tc_lemma =  Goal.prove ctxt [] [] tc_goal
             (fn _ =>  EqSubst.eqsubst_tac ctxt [1] [dom_lemma] 1
               THEN resolve_tac ctxt [@{thm FiniteFun_is_fun}] 1
               THEN resolve_tac ctxt [fin_tc_lemma] 1)
     val action_lemma = Goal.prove ctxt [] [] action_goal
               (fn _ =>
                   forward_tac ctxt [@{thm le_natI}] 1
                   THEN fin ctxt
                   THEN REPEAT (resolve_tac ctxt [@{thm natE}] 1
                                THEN step ctxt tc_lemma)
                   THEN (step ctxt tc_lemma)
               )
     in (action_lemma, tc_lemma, fvs, r)
   end
 
 (*
 Returns the sum renaming, the goal for type_checking, and the actual lemmas
 for the left part of the sum.
 *)
  fun sum_ren_aux e e' ctxt =
   let val env = Variable.variant_frees ctxt [] [("env",@{typ i})] |> hd |> Free
       val (left_action_lemma,left_tc_lemma,_,r) = ren_thm e e' ctxt
       val (sum_ren,sum_goal_tc) = sum_tc_goal r e e' env
       val setV = Variable.variant_frees ctxt [] [("A",@{typ i})] |> hd |> Free
       fun hyp en = mem_ en (list_ setV)
   in (sum_ren,
       freeName env,
       Logic.list_implies (map (fn e => e |> hyp |> tp) [env], sum_goal_tc),
       left_tc_lemma,
       left_action_lemma)
 end
 
 fun sum_tc_lemma rho rho' ctxt =
   let val (sum_ren, envVar, tc_goal, left_tc_lemma, left_action_lemma) = sum_ren_aux rho rho' ctxt
       val (goal,fvs) = sum_action_goal sum_ren rho rho' ctxt
       val r = mk_ren rho rho' ctxt
   in (sum_ren, goal,envVar, r,left_tc_lemma, left_action_lemma ,fvs, Goal.prove ctxt [] [] tc_goal
                (fn _ =>
             resolve_tac ctxt [@{thm sum_type_id_aux2}] 1
             THEN asm_simp_tac ctxt 4
             THEN simp_tac ctxt 1
             THEN resolve_tac ctxt [left_tc_lemma] 1
             THEN (fin ctxt)
             THEN (fin ctxt)
   ))
   end
 
 fun sum_rename rho rho' ctxt =
   let
     val (_, goal, _, left_rename, left_tc_lemma, left_action_lemma, fvs, sum_tc_lemma) =
           sum_tc_lemma rho rho' ctxt
     val action_lemma = fix_vars left_action_lemma fvs ctxt
   in (sum_tc_lemma, Goal.prove ctxt [] [] goal
     (fn _ => resolve_tac ctxt [@{thm sum_action_id_aux}] 1
             THEN (simp_tac ctxt 4)
             THEN (simp_tac ctxt 1)
             THEN (resolve_tac ctxt [left_tc_lemma]  1)
             THEN (asm_full_simp_tac ctxt 1)
             THEN (asm_full_simp_tac ctxt 1)
             THEN (simp_tac ctxt 1)
             THEN (simp_tac ctxt 1)
             THEN (simp_tac ctxt 1)
             THEN (full_simp_tac ctxt 1)
             THEN (resolve_tac ctxt [action_lemma] 1)
             THEN (blast_tac ctxt  1)
             THEN (full_simp_tac ctxt  1)
             THEN (full_simp_tac ctxt  1)
 
    ), fvs, left_rename
    )
-end ;
+end
+
+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;
+
+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 ))
+
+
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Synthetic_Definition.ml b/thys/Transitive_Models/Synthetic_Definition.ml
new file mode 100644
--- /dev/null
+++ b/thys/Transitive_Models/Synthetic_Definition.ml
@@ -0,0 +1,328 @@
+val $` = curry ((op $) o swap)
+infix $`
+
+infix 6 &&&
+val op &&& = Utils.&&&
+
+infix 6 ***
+val op *** = Utils.***
+
+fun arity_goal intermediate def_name lthy =
+  let
+    val thm = Proof_Context.get_thm lthy (def_name ^ "_def")
+    val (_, tm, _) = Utils.thm_concl_tm lthy (def_name ^ "_def")
+    val (def, tm) = tm |> Utils.dest_eq_tms'
+    fun first_lambdas (Abs (body as (_, ty, _))) =
+        if ty = @{typ "i"}
+          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
+          else Utils.dest_abs body |> first_lambdas o #2
+      | first_lambdas _ = []
+    val (def, vars) = Term.strip_comb def
+    val vs = vars @ first_lambdas tm
+    val def = fold (op $`) vs def
+    val hyps = map (fn v => Utils.mem_ v Utils.nat_ |> Utils.tp) vs
+    val concl = @{const IFOL.eq(i)} $ (@{const arity} $ def) $ Var (("ar", 0), @{typ "i"})
+    val g_iff = Logic.list_implies (hyps, Utils.tp concl)
+    val attribs = if intermediate then [] else @{attributes [arity]}
+  in
+    (g_iff, "arity_" ^ def_name ^ (if intermediate then "'" else ""), attribs, thm, vs)
+  end
+
+fun manual_arity intermediate def_name pos lthy =
+  let
+    val (goal, thm_name, attribs, _, _) = arity_goal intermediate def_name lthy
+  in
+    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
+                                    o Local_Theory.note ((Binding.name thm_name, attribs), hd thmss))
+    [[(goal, [])]] lthy
+  end
+
+fun prove_arity thms goal ctxt =
+  let
+    val rules = (Named_Theorems.get ctxt \<^named_theorems>\<open>arity\<close>) @
+      (Named_Theorems.get ctxt \<^named_theorems>\<open>arity_aux\<close>)
+  in
+    Goal.prove ctxt [] [] goal
+    (K (rewrite_goal_tac ctxt thms 1 THEN Method.insert_tac ctxt rules 1 THEN asm_simp_tac ctxt 1))
+  end
+
+fun auto_arity intermediate def_name pos lthy =
+  let
+    val (goal, thm_name, attribs, def_thm, vs) = arity_goal intermediate def_name lthy
+    val intermediate_text = if intermediate then "intermediate" else ""
+    val help = "You can manually prove the arity_theorem by typing:\n"
+             ^ "manual_arity " ^ intermediate_text ^ " for \"" ^ def_name ^ "\"\n"
+    val thm = prove_arity [def_thm] goal lthy
+              handle ERROR s => help ^ "\n\n" ^ s |> Exn.reraise o ERROR
+    val thm = Utils.fix_vars thm (map Utils.freeName vs) lthy
+  in
+    Local_Theory.note ((Binding.name thm_name, attribs), [thm]) lthy |> Utils.display "theorem" pos
+  end
+
+fun prove_tc_form goal thms ctxt =
+  Goal.prove ctxt [] [] goal (K (rewrite_goal_tac ctxt thms 1 THEN auto_tac ctxt))
+
+fun prove_sats_tm thm_auto thms goal ctxt =
+  let
+    val ctxt' = ctxt |> Simplifier.add_simp (hd thm_auto)
+  in
+    Goal.prove ctxt [] [] goal
+    (K (rewrite_goal_tac ctxt thms 1 THEN PARALLEL_ALLGOALS (asm_simp_tac ctxt')))
+  end
+
+fun prove_sats_iff goal ctxt = Goal.prove ctxt [] [] goal (K (asm_simp_tac ctxt 1))
+
+fun is_mem (@{const mem} $ _ $  _) = true
+  | is_mem _ = false
+
+fun pre_synth_thm_sats term set env vars vs lthy =
+  let
+    val (_, tm, ctxt1) = Utils.thm_concl_tm lthy term
+    val (thm_refs, ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 |>> #2
+    val vs' = map (Thm.term_of o #2) vs
+    val vars' = map (Thm.term_of o #2) vars
+    val r_tm = tm |> Utils.dest_lhs_def |> fold (op $`) vs'
+    val sats = @{const apply} $ (@{const satisfies} $ set $ r_tm) $ env
+    val sats' = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero})
+  in
+    { vars = vars'
+    , vs = vs'
+    , sats = sats'
+    , thm_refs = thm_refs
+    , lthy = ctxt2
+    , env = env
+    , set = set
+    }
+  end
+
+fun synth_thm_sats_gen name lhs hyps pos attribs aux_funs environment lthy =
+  let
+    val ctxt = (#prepare_ctxt aux_funs) lthy
+    val ctxt = Utils.add_to_context (Utils.freeName (#set environment)) ctxt
+    val (new_vs, ctxt') = (#create_variables aux_funs) (#vs environment, ctxt)
+    val new_hyps = (#create_hyps aux_funs) (#vs environment, new_vs)
+    val concl = (#make_concl aux_funs) (lhs, #sats environment, new_vs)
+    val g_iff = Logic.list_implies (new_hyps @ hyps, Utils.tp concl)
+    val thm = (#prover aux_funs) g_iff ctxt'
+    val thm = Utils.fix_vars thm (map Utils.freeName ((#vars environment) @ new_vs)) lthy
+  in
+    Local_Theory.note ((name, attribs), [thm]) lthy |> Utils.display "theorem" pos
+  end
+
+fun synth_thm_sats_iff def_name lhs hyps pos environment =
+  let
+    val subst = Utils.zip_with (I *** I) (#vs environment)
+    fun subst_nth (@{const "nth"} $ v $ _) new_vs = AList.lookup (op =) (subst new_vs) v |> the
+      | subst_nth (t1 $ t2) new_vs = (subst_nth t1 new_vs) $ (subst_nth t2 new_vs)
+      | subst_nth (Abs (v, ty, t)) new_vs = Abs (v, ty, subst_nth t new_vs)
+      | subst_nth t _ = t
+    val name = Binding.name (def_name ^ "_iff_sats")
+    val iff_sats_attrib = @{attributes [iff_sats]}
+    val aux_funs = { prepare_ctxt = fold Utils.add_to_context (map Utils.freeName (#vs environment))
+                   , create_variables = fn (vs, ctxt) => Variable.variant_fixes (map Utils.freeName vs) ctxt |>> map Utils.var_i
+                   , create_hyps = fn (vs, new_vs) => Utils.zip_with (fn (v, nv) => Utils.eq_ (Utils.nth_ v (#env environment)) nv) vs new_vs |> map Utils.tp
+                   , make_concl = fn (lhs, rhs, new_vs) => @{const IFOL.iff} $ (subst_nth lhs new_vs) $ rhs
+                   , prover = prove_sats_iff
+                   }
+  in
+    synth_thm_sats_gen name lhs hyps pos iff_sats_attrib aux_funs environment
+  end
+
+fun synth_thm_sats_fm def_name lhs hyps pos thm_auto environment =
+  let
+    val name = Binding.name ("sats_" ^ def_name ^ "_fm")
+    val simp_attrib = @{attributes [simp]}
+    val aux_funs = { prepare_ctxt = I
+                   , create_variables = K [] *** I
+                   , create_hyps = K []
+                   , make_concl = fn (rhs, lhs, _) => @{const IFOL.iff} $ lhs $ rhs
+                   , prover = prove_sats_tm thm_auto (#thm_refs environment)
+                   }
+  in
+    synth_thm_sats_gen name lhs hyps pos simp_attrib aux_funs environment
+  end
+
+fun synth_thm_tc def_name term hyps vars pos lthy =
+  let
+    val (_,tm,ctxt1) = Utils.thm_concl_tm lthy term
+    val (thm_refs,ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 |>> #2
+    val vars' = map (Thm.term_of o #2) vars
+    val tc_attrib = @{attributes [TC]}
+    val r_tm = tm |> Utils.dest_lhs_def |> fold (op $`) vars'
+    val concl = @{const mem} $ r_tm $ @{const formula}
+    val g = Logic.list_implies(hyps, Utils.tp concl)
+    val thm = prove_tc_form g thm_refs ctxt2
+    val name = Binding.name (def_name ^ "_fm_type")
+    val thm = Utils.fix_vars thm (map Utils.freeName vars') ctxt2
+  in
+    Local_Theory.note ((name, tc_attrib), [thm]) lthy |> Utils.display "theorem" pos
+  end
+
+fun synthetic_def def_name thm_ref pos tc auto thy =
+  let
+    val thm = Proof_Context.get_thm thy thm_ref
+    val thm_vars = rev (Term.add_vars (Thm.full_prop_of thm) [])
+    val (((_,inst),thm_tms),_) = Variable.import true [thm] thy
+    val vars = map (fn v => (v, the (Vars.lookup inst v))) thm_vars
+    val (tm,hyps) = thm_tms |> hd |> Thm.concl_of &&& Thm.prems_of
+    val (lhs,rhs) = tm |> Utils.dest_iff_tms o Utils.dest_trueprop
+    val ((set,t),env) = rhs |> Utils.dest_sats_frm
+    fun relevant ts (@{const mem} $ t $ _) =
+          (not (t = @{term "0"})) andalso
+          (not (Term.is_Free t) orelse member (op =) ts (t |> Term.dest_Free |> #1))
+      | relevant _ _ = false
+    val t_vars = sort_strings (Term.add_free_names t [])
+    val vs = filter (Ord_List.member String.compare t_vars o #1 o #1 o #1) vars
+    val at = fold_rev (lambda o Thm.term_of o #2) vs t
+    val hyps' = filter (relevant t_vars o Utils.dest_trueprop) hyps
+    val def_attrs = @{attributes [fm_definitions]}
+  in
+    Local_Theory.define ((Binding.name (def_name ^ "_fm"), NoSyn),
+                        ((Binding.name (def_name ^ "_fm_def"), def_attrs), at)) thy
+    |>> (#2 #> I *** single) |> Utils.display "theorem" pos |>
+    (if tc then synth_thm_tc def_name (def_name ^ "_fm_def") hyps' vs pos else I) |>
+    (if auto then
+      pre_synth_thm_sats (def_name ^ "_fm_def") set env vars vs
+      #> I &&& #lthy
+      #> #1 &&& uncurry (synth_thm_sats_fm def_name lhs hyps pos thm_tms)
+      #> uncurry (synth_thm_sats_iff def_name lhs hyps pos)
+    else I)
+  end
+
+fun prove_schematic thms goal ctxt =
+  let
+    val rules = Named_Theorems.get ctxt \<^named_theorems>\<open>iff_sats\<close>
+  in
+    Goal.prove ctxt [] [] goal
+    (K (rewrite_goal_tac ctxt thms 1 THEN REPEAT1 (CHANGED (resolve_tac ctxt rules 1 ORELSE asm_simp_tac ctxt 1))))
+  end
+
+val valid_assumptions = [ ("nonempty", Utils.mem_ @{term "0"})
+                        ]
+
+fun pre_schematic_def target assuming lthy =
+let
+    val thm = Proof_Context.get_thm lthy (target ^ "_def")
+    val (vars, tm, ctxt1) = Utils.thm_concl_tm lthy (target ^ "_def")
+    val (const, tm) = tm |> Utils.dest_eq_tms' o Utils.dest_trueprop |>> #1 o strip_comb
+    val t_vars = sort_strings (Term.add_free_names tm [])
+    val vs = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars
+             |> List.filter ((curry op = @{typ "i"}) o #2 o #1)
+             |> List.map (Utils.var_i o #1 o #1 o #1)
+    fun first_lambdas (Abs (body as (_, ty, _))) =
+        if ty = @{typ "i"}
+          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
+          else Utils.dest_abs body |> first_lambdas o #2
+      | first_lambdas _ = []
+    val vs = vs @ (first_lambdas tm)
+    val ctxt1' = fold Utils.add_to_context (map Utils.freeName vs) ctxt1
+    val (set, ctxt2) = Variable.variant_fixes ["A"] ctxt1' |>> Utils.var_i o hd
+    val class = @{const "setclass"} $ set
+    val (env, ctxt3) = Variable.variant_fixes ["env"] ctxt2 |>> Utils.var_i o hd
+    val assumptions = filter (member (op =) assuming o #1) valid_assumptions |> map #2
+    val hyps = (List.map (fn v => Utils.tp (Utils.mem_ v Utils.nat_)) vs)
+               @ [Utils.tp (Utils.mem_ env (Utils.list_ set))]
+               @ Utils.zip_with (fn (f,x) => Utils.tp (f x)) assumptions (replicate (length assumptions) set)
+    val args = class :: map (fn v => Utils.nth_ v env) vs
+    val (fm_name, ctxt4) = Variable.variant_fixes ["fm"] ctxt3 |>> hd
+    val fm_type = fold (K (fn acc => Type ("fun", [@{typ "i"}, acc]))) vs @{typ "i"}
+    val fm = Var ((fm_name, 0), fm_type)
+    val lhs = fold (op $`) args const
+    val fm_app = fold (op $`) vs fm
+    val sats = @{const apply} $ (@{const satisfies} $ set $ fm_app) $ env
+    val rhs = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero})
+    val concl = @{const "IFOL.iff"} $ lhs $ rhs
+    val schematic = Logic.list_implies (hyps, Utils.tp concl)
+  in
+    (schematic, ctxt4, thm, set, env, vs)
+  end
+
+fun str_join _ [] = ""
+  | str_join _ [s] = s
+  | str_join c (s :: ss) = s ^ c ^ (str_join c ss)
+
+fun schematic_def def_name target assuming pos lthy =
+  let
+    val (schematic, ctxt, thm, set, env, vs) = pre_schematic_def target assuming lthy
+    val assuming_text = if null assuming then "" else "assuming " ^ (map (fn s => "\"" ^ s ^ "\"") assuming |> str_join " ")
+    val help = "You can manually prove the schematic_goal by typing:\n"
+             ^ "manual_schematic [sch_name] for \"" ^ target ^ "\"" ^ assuming_text ^"\n"
+             ^ "And then complete the synthesis with:\n"
+             ^ "synthesize \"" ^ target ^ "\" from_schematic [sch_name]\n"
+             ^ "In both commands, \<guillemotleft>sch_name\<guillemotright> must be the same and, if ommited, will be defaulted to sats_" ^ target ^ "_fm_auto.\n"
+             ^ "You can also try adding new assumptions and/or synthetizing definitions of sub-terms."
+    val thm = prove_schematic [thm] schematic ctxt
+              handle ERROR s => help ^ "\n\n" ^ s |> Exn.reraise o ERROR
+    val thm = Utils.fix_vars thm (map Utils.freeName (set :: env :: vs)) lthy
+  in
+    Local_Theory.note ((Binding.name def_name, []), [thm]) lthy |> Utils.display "theorem" pos
+  end
+
+fun schematic_synthetic_def def_name target assuming pos tc auto =
+    (synthetic_def def_name ("sats_" ^ def_name ^ "_fm_auto") pos tc auto)
+    o (schematic_def ("sats_" ^ def_name ^ "_fm_auto") target assuming pos)
+
+fun manual_schematic def_name target assuming pos lthy =
+  let
+    val (schematic, _, _, _, _, _) = pre_schematic_def target assuming lthy
+  in
+    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
+                                    o Local_Theory.note ((Binding.name def_name, []), hd thmss))
+    [[(schematic, [])]] lthy
+  end
+
+local
+  val simple_from_schematic_synth_constdecl =
+       Parse.string --| (Parse.$$$ "from_schematic")
+       >> (fn bndg => synthetic_def bndg ("sats_" ^ bndg ^ "_fm_auto"))
+
+  val full_from_schematic_synth_constdecl =
+       Parse.string -- ((Parse.$$$ "from_schematic" |-- Parse.thm))
+       >> (fn (bndg,thm) => synthetic_def bndg (#1 (thm |>> Facts.ref_name)))
+
+  val full_from_definition_synth_constdecl =
+       Parse.string -- ((Parse.$$$ "from_definition" |-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) [])
+       >> (fn ((bndg,target), assuming) => schematic_synthetic_def bndg target assuming)
+
+  val simple_from_definition_synth_constdecl =
+     Parse.string -- (Parse.$$$ "from_definition" |-- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string)) [])
+     >> (fn (bndg, assuming) => schematic_synthetic_def bndg bndg assuming)
+
+  val synth_constdecl =
+       Parse.position (full_from_schematic_synth_constdecl || simple_from_schematic_synth_constdecl
+                       || full_from_definition_synth_constdecl
+                       || simple_from_definition_synth_constdecl)
+
+  val full_schematic_decl =
+       Parse.string -- ((Parse.$$$ "for" |-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) [])
+
+  val simple_schematic_decl =
+       (Parse.$$$ "for" |-- Parse.string >> (fn name => "sats_" ^ name ^ "_fm_auto") &&& I) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) [])
+
+  val schematic_decl = Parse.position (full_schematic_decl || simple_schematic_decl)
+
+  val _ =
+     Outer_Syntax.local_theory \<^command_keyword>\<open>synthesize\<close> "ML setup for synthetic definitions"
+       (synth_constdecl >> (fn (f,p) => f p true true))
+
+  val _ =
+     Outer_Syntax.local_theory \<^command_keyword>\<open>synthesize_notc\<close> "ML setup for synthetic definitions"
+       (synth_constdecl >> (fn (f,p) => f p false false))
+
+  val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>generate_schematic\<close> "ML setup for schematic goals"
+       (schematic_decl >> (fn (((bndg,target), assuming),p) => schematic_def bndg target assuming p))
+
+  val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>manual_schematic\<close> "ML setup for schematic goals"
+       (schematic_decl >> (fn (((bndg,target), assuming),p) => manual_schematic bndg target assuming p))
+
+  val arity_parser = Parse.position ((Scan.option (Parse.$$$ "intermediate") >> is_some) -- (Parse.$$$ "for" |-- Parse.string))
+
+  val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>manual_arity\<close> "ML setup for arities"
+       (arity_parser >> (fn ((intermediate, target), pos) => manual_arity intermediate target pos))
+
+  val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>arity_theorem\<close> "ML setup for arities"
+       (arity_parser >> (fn ((intermediate, target), pos) => auto_arity intermediate target pos))
+
+in
+
+end
\ No newline at end of file
diff --git a/thys/Transitive_Models/Synthetic_Definition.thy b/thys/Transitive_Models/Synthetic_Definition.thy
--- a/thys/Transitive_Models/Synthetic_Definition.thy
+++ b/thys/Transitive_Models/Synthetic_Definition.thy
@@ -1,384 +1,53 @@
 section\<open>Automatic synthesis of formulas\<close>
 theory Synthetic_Definition
   imports
     Utils
   keywords
     "synthesize" :: thy_decl % "ML"
     and
     "synthesize_notc" :: thy_decl % "ML"
     and
     "generate_schematic" :: thy_decl % "ML"
     and
     "arity_theorem" :: thy_decl % "ML"
     and
     "manual_schematic" :: thy_goal_stmt % "ML"
     and
     "manual_arity" :: thy_goal_stmt % "ML"
     and
     "from_schematic"
     and
     "for"
     and
     "from_definition"
     and
     "assuming"
     and
     "intermediate"
 
 begin
 
 named_theorems fm_definitions "Definitions of synthetized formulas."
 
 named_theorems iff_sats "Theorems for synthetising formulas."
 
 named_theorems arity "Theorems for arity of formulas."
 
 named_theorems arity_aux "Auxiliary theorems for calculating arities."
 
-ML\<open>
-val $` = curry ((op $) o swap)
-infix $`
-
-infix 6 &&&
-val op &&& = Utils.&&&
-
-infix 6 ***
-val op *** = Utils.***
-
-fun arity_goal intermediate def_name lthy =
-  let
-    val thm = Proof_Context.get_thm lthy (def_name ^ "_def")
-    val (_, tm, _) = Utils.thm_concl_tm lthy (def_name ^ "_def")
-    val (def, tm) = tm |> Utils.dest_eq_tms'
-    fun first_lambdas (Abs (body as (_, ty, _))) =
-        if ty = @{typ "i"}
-          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
-          else Utils.dest_abs body |> first_lambdas o #2
-      | first_lambdas _ = []
-    val (def, vars) = Term.strip_comb def
-    val vs = vars @ first_lambdas tm
-    val def = fold (op $`) vs def
-    val hyps = map (fn v => Utils.mem_ v Utils.nat_ |> Utils.tp) vs
-    val concl = @{const IFOL.eq(i)} $ (@{const arity} $ def) $ Var (("ar", 0), @{typ "i"})
-    val g_iff = Logic.list_implies (hyps, Utils.tp concl)
-    val attribs = if intermediate then [] else @{attributes [arity]}
-  in
-    (g_iff, "arity_" ^ def_name ^ (if intermediate then "'" else ""), attribs, thm, vs)
-  end
-
-fun manual_arity intermediate def_name pos lthy =
-  let
-    val (goal, thm_name, attribs, _, _) = arity_goal intermediate def_name lthy
-  in
-    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
-                                    o Local_Theory.note ((Binding.name thm_name, attribs), hd thmss))
-    [[(goal, [])]] lthy
-  end
-
-fun prove_arity thms goal ctxt =
-  let
-    val rules = (Named_Theorems.get ctxt \<^named_theorems>\<open>arity\<close>) @
-      (Named_Theorems.get ctxt \<^named_theorems>\<open>arity_aux\<close>)
-  in
-    Goal.prove ctxt [] [] goal
-    (K (rewrite_goal_tac ctxt thms 1 THEN Method.insert_tac ctxt rules 1 THEN asm_simp_tac ctxt 1))
-  end
-
-fun auto_arity intermediate def_name pos lthy =
-  let
-    val (goal, thm_name, attribs, def_thm, vs) = arity_goal intermediate def_name lthy
-    val intermediate_text = if intermediate then "intermediate" else ""
-    val help = "You can manually prove the arity_theorem by typing:\n"
-             ^ "manual_arity " ^ intermediate_text ^ " for \"" ^ def_name ^ "\"\n"
-    val thm = prove_arity [def_thm] goal lthy
-              handle ERROR s => help ^ "\n\n" ^ s |> Exn.reraise o ERROR
-    val thm = Utils.fix_vars thm (map Utils.freeName vs) lthy
-  in
-    Local_Theory.note ((Binding.name thm_name, attribs), [thm]) lthy |> Utils.display "theorem" pos
-  end
-
-fun prove_tc_form goal thms ctxt =
-  Goal.prove ctxt [] [] goal (K (rewrite_goal_tac ctxt thms 1 THEN auto_tac ctxt))
-
-fun prove_sats_tm thm_auto thms goal ctxt =
-  let
-    val ctxt' = ctxt |> Simplifier.add_simp (hd thm_auto)
-  in
-    Goal.prove ctxt [] [] goal
-    (K (rewrite_goal_tac ctxt thms 1 THEN PARALLEL_ALLGOALS (asm_simp_tac ctxt')))
-  end
-
-fun prove_sats_iff goal ctxt = Goal.prove ctxt [] [] goal (K (asm_simp_tac ctxt 1))
-
-fun is_mem (@{const mem} $ _ $  _) = true
-  | is_mem _ = false
-
-fun pre_synth_thm_sats term set env vars vs lthy =
-  let
-    val (_, tm, ctxt1) = Utils.thm_concl_tm lthy term
-    val (thm_refs, ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 |>> #2
-    val vs' = map (Thm.term_of o #2) vs
-    val vars' = map (Thm.term_of o #2) vars
-    val r_tm = tm |> Utils.dest_lhs_def |> fold (op $`) vs'
-    val sats = @{const apply} $ (@{const satisfies} $ set $ r_tm) $ env
-    val sats' = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero})
-  in
-    { vars = vars'
-    , vs = vs'
-    , sats = sats'
-    , thm_refs = thm_refs
-    , lthy = ctxt2
-    , env = env
-    , set = set
-    }
-  end
-
-fun synth_thm_sats_gen name lhs hyps pos attribs aux_funs environment lthy =
-  let
-    val ctxt = (#prepare_ctxt aux_funs) lthy
-    val ctxt = Utils.add_to_context (Utils.freeName (#set environment)) ctxt
-    val (new_vs, ctxt') = (#create_variables aux_funs) (#vs environment, ctxt)
-    val new_hyps = (#create_hyps aux_funs) (#vs environment, new_vs)
-    val concl = (#make_concl aux_funs) (lhs, #sats environment, new_vs)
-    val g_iff = Logic.list_implies (new_hyps @ hyps, Utils.tp concl)
-    val thm = (#prover aux_funs) g_iff ctxt'
-    val thm = Utils.fix_vars thm (map Utils.freeName ((#vars environment) @ new_vs)) lthy
-  in
-    Local_Theory.note ((name, attribs), [thm]) lthy |> Utils.display "theorem" pos
-  end
-
-fun synth_thm_sats_iff def_name lhs hyps pos environment =
-  let
-    val subst = Utils.zip_with (I *** I) (#vs environment)
-    fun subst_nth (@{const "nth"} $ v $ _) new_vs = AList.lookup (op =) (subst new_vs) v |> the
-      | subst_nth (t1 $ t2) new_vs = (subst_nth t1 new_vs) $ (subst_nth t2 new_vs)
-      | subst_nth (Abs (v, ty, t)) new_vs = Abs (v, ty, subst_nth t new_vs)
-      | subst_nth t _ = t
-    val name = Binding.name (def_name ^ "_iff_sats")
-    val iff_sats_attrib = @{attributes [iff_sats]}
-    val aux_funs = { prepare_ctxt = fold Utils.add_to_context (map Utils.freeName (#vs environment))
-                   , create_variables = fn (vs, ctxt) => Variable.variant_fixes (map Utils.freeName vs) ctxt |>> map Utils.var_i
-                   , create_hyps = fn (vs, new_vs) => Utils.zip_with (fn (v, nv) => Utils.eq_ (Utils.nth_ v (#env environment)) nv) vs new_vs |> map Utils.tp
-                   , make_concl = fn (lhs, rhs, new_vs) => @{const IFOL.iff} $ (subst_nth lhs new_vs) $ rhs
-                   , prover = prove_sats_iff
-                   }
-  in
-    synth_thm_sats_gen name lhs hyps pos iff_sats_attrib aux_funs environment
-  end
-
-fun synth_thm_sats_fm def_name lhs hyps pos thm_auto environment =
-  let
-    val name = Binding.name ("sats_" ^ def_name ^ "_fm")
-    val simp_attrib = @{attributes [simp]}
-    val aux_funs = { prepare_ctxt = I
-                   , create_variables = K [] *** I
-                   , create_hyps = K []
-                   , make_concl = fn (rhs, lhs, _) => @{const IFOL.iff} $ lhs $ rhs
-                   , prover = prove_sats_tm thm_auto (#thm_refs environment)
-                   }
-  in
-    synth_thm_sats_gen name lhs hyps pos simp_attrib aux_funs environment
-  end
-
-fun synth_thm_tc def_name term hyps vars pos lthy =
-  let
-    val (_,tm,ctxt1) = Utils.thm_concl_tm lthy term
-    val (thm_refs,ctxt2) = Variable.import true [Proof_Context.get_thm lthy term] ctxt1 |>> #2
-    val vars' = map (Thm.term_of o #2) vars
-    val tc_attrib = @{attributes [TC]}
-    val r_tm = tm |> Utils.dest_lhs_def |> fold (op $`) vars'
-    val concl = @{const mem} $ r_tm $ @{const formula}
-    val g = Logic.list_implies(hyps, Utils.tp concl)
-    val thm = prove_tc_form g thm_refs ctxt2
-    val name = Binding.name (def_name ^ "_fm_type")
-    val thm = Utils.fix_vars thm (map Utils.freeName vars') ctxt2
-  in
-    Local_Theory.note ((name, tc_attrib), [thm]) lthy |> Utils.display "theorem" pos
-  end
-
-fun synthetic_def def_name thm_ref pos tc auto thy =
-  let
-    val thm = Proof_Context.get_thm thy thm_ref
-    val thm_vars = rev (Term.add_vars (Thm.full_prop_of thm) [])
-    val (((_,inst),thm_tms),_) = Variable.import true [thm] thy
-    val vars = map (fn v => (v, the (Vars.lookup inst v))) thm_vars
-    val (tm,hyps) = thm_tms |> hd |> Thm.concl_of &&& Thm.prems_of
-    val (lhs,rhs) = tm |> Utils.dest_iff_tms o Utils.dest_trueprop
-    val ((set,t),env) = rhs |> Utils.dest_sats_frm
-    fun relevant ts (@{const mem} $ t $ _) =
-          (not (t = @{term "0"})) andalso
-          (not (Term.is_Free t) orelse member (op =) ts (t |> Term.dest_Free |> #1))
-      | relevant _ _ = false
-    val t_vars = sort_strings (Term.add_free_names t [])
-    val vs = filter (Ord_List.member String.compare t_vars o #1 o #1 o #1) vars
-    val at = fold_rev (lambda o Thm.term_of o #2) vs t
-    val hyps' = filter (relevant t_vars o Utils.dest_trueprop) hyps
-    val def_attrs = @{attributes [fm_definitions]}
-  in
-    Local_Theory.define ((Binding.name (def_name ^ "_fm"), NoSyn),
-                        ((Binding.name (def_name ^ "_fm_def"), def_attrs), at)) thy
-    |>> (#2 #> I *** single) |> Utils.display "theorem" pos |>
-    (if tc then synth_thm_tc def_name (def_name ^ "_fm_def") hyps' vs pos else I) |>
-    (if auto then
-      pre_synth_thm_sats (def_name ^ "_fm_def") set env vars vs
-      #> I &&& #lthy
-      #> #1 &&& uncurry (synth_thm_sats_fm def_name lhs hyps pos thm_tms)
-      #> uncurry (synth_thm_sats_iff def_name lhs hyps pos)
-    else I)
-  end
-
-fun prove_schematic thms goal ctxt =
-  let
-    val rules = Named_Theorems.get ctxt \<^named_theorems>\<open>iff_sats\<close>
-  in
-    Goal.prove ctxt [] [] goal
-    (K (rewrite_goal_tac ctxt thms 1 THEN REPEAT1 (CHANGED (resolve_tac ctxt rules 1 ORELSE asm_simp_tac ctxt 1))))
-  end
-
-val valid_assumptions = [ ("nonempty", Utils.mem_ @{term "0"})
-                        ]
-
-fun pre_schematic_def target assuming lthy =
-let
-    val thm = Proof_Context.get_thm lthy (target ^ "_def")
-    val (vars, tm, ctxt1) = Utils.thm_concl_tm lthy (target ^ "_def")
-    val (const, tm) = tm |> Utils.dest_eq_tms' o Utils.dest_trueprop |>> #1 o strip_comb
-    val t_vars = sort_strings (Term.add_free_names tm [])
-    val vs = List.filter (#1 #> #1 #> #1 #> Ord_List.member String.compare t_vars) vars
-             |> List.filter ((curry op = @{typ "i"}) o #2 o #1)
-             |> List.map (Utils.var_i o #1 o #1 o #1)
-    fun first_lambdas (Abs (body as (_, ty, _))) =
-        if ty = @{typ "i"}
-          then (op ::) (Utils.dest_abs body |>> Utils.var_i ||> first_lambdas)
-          else Utils.dest_abs body |> first_lambdas o #2
-      | first_lambdas _ = []
-    val vs = vs @ (first_lambdas tm)
-    val ctxt1' = fold Utils.add_to_context (map Utils.freeName vs) ctxt1
-    val (set, ctxt2) = Variable.variant_fixes ["A"] ctxt1' |>> Utils.var_i o hd
-    val class = @{const "setclass"} $ set
-    val (env, ctxt3) = Variable.variant_fixes ["env"] ctxt2 |>> Utils.var_i o hd
-    val assumptions = filter (member (op =) assuming o #1) valid_assumptions |> map #2
-    val hyps = (List.map (fn v => Utils.tp (Utils.mem_ v Utils.nat_)) vs)
-               @ [Utils.tp (Utils.mem_ env (Utils.list_ set))]
-               @ Utils.zip_with (fn (f,x) => Utils.tp (f x)) assumptions (replicate (length assumptions) set)
-    val args = class :: map (fn v => Utils.nth_ v env) vs
-    val (fm_name, ctxt4) = Variable.variant_fixes ["fm"] ctxt3 |>> hd
-    val fm_type = fold (K (fn acc => Type ("fun", [@{typ "i"}, acc]))) vs @{typ "i"}
-    val fm = Var ((fm_name, 0), fm_type)
-    val lhs = fold (op $`) args const
-    val fm_app = fold (op $`) vs fm
-    val sats = @{const apply} $ (@{const satisfies} $ set $ fm_app) $ env
-    val rhs = @{const IFOL.eq(i)} $ sats $ (@{const succ} $ @{const zero})
-    val concl = @{const "IFOL.iff"} $ lhs $ rhs
-    val schematic = Logic.list_implies (hyps, Utils.tp concl)
-  in
-    (schematic, ctxt4, thm, set, env, vs)
-  end
-
-fun str_join _ [] = ""
-  | str_join _ [s] = s
-  | str_join c (s :: ss) = s ^ c ^ (str_join c ss)
-
-fun schematic_def def_name target assuming pos lthy =
-  let
-    val (schematic, ctxt, thm, set, env, vs) = pre_schematic_def target assuming lthy
-    val assuming_text = if null assuming then "" else "assuming " ^ (map (fn s => "\"" ^ s ^ "\"") assuming |> str_join " ")
-    val help = "You can manually prove the schematic_goal by typing:\n"
-             ^ "manual_schematic [sch_name] for \"" ^ target ^ "\"" ^ assuming_text ^"\n"
-             ^ "And then complete the synthesis with:\n"
-             ^ "synthesize \"" ^ target ^ "\" from_schematic [sch_name]\n"
-             ^ "In both commands, \<guillemotleft>sch_name\<guillemotright> must be the same and, if ommited, will be defaulted to sats_" ^ target ^ "_fm_auto.\n"
-             ^ "You can also try adding new assumptions and/or synthetizing definitions of sub-terms."
-    val thm = prove_schematic [thm] schematic ctxt
-              handle ERROR s => help ^ "\n\n" ^ s |> Exn.reraise o ERROR
-    val thm = Utils.fix_vars thm (map Utils.freeName (set :: env :: vs)) lthy
-  in
-    Local_Theory.note ((Binding.name def_name, []), [thm]) lthy |> Utils.display "theorem" pos
-  end
-
-fun schematic_synthetic_def def_name target assuming pos tc auto =
-    (synthetic_def def_name ("sats_" ^ def_name ^ "_fm_auto") pos tc auto)
-    o (schematic_def ("sats_" ^ def_name ^ "_fm_auto") target assuming pos)
-
-fun manual_schematic def_name target assuming pos lthy =
-  let
-    val (schematic, _, _, _, _, _) = pre_schematic_def target assuming lthy
-  in
-    Proof.theorem NONE (fn thmss => Utils.display "theorem" pos
-                                    o Local_Theory.note ((Binding.name def_name, []), hd thmss))
-    [[(schematic, [])]] lthy
-  end
-\<close>
-
-ML\<open>
-local
-  val simple_from_schematic_synth_constdecl =
-       Parse.string --| (Parse.$$$ "from_schematic")
-       >> (fn bndg => synthetic_def bndg ("sats_" ^ bndg ^ "_fm_auto"))
-
-  val full_from_schematic_synth_constdecl =
-       Parse.string -- ((Parse.$$$ "from_schematic" |-- Parse.thm))
-       >> (fn (bndg,thm) => synthetic_def bndg (#1 (thm |>> Facts.ref_name)))
-
-  val full_from_definition_synth_constdecl =
-       Parse.string -- ((Parse.$$$ "from_definition" |-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) [])
-       >> (fn ((bndg,target), assuming) => schematic_synthetic_def bndg target assuming)
-
-  val simple_from_definition_synth_constdecl =
-     Parse.string -- (Parse.$$$ "from_definition" |-- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string)) [])
-     >> (fn (bndg, assuming) => schematic_synthetic_def bndg bndg assuming)
-
-  val synth_constdecl =
-       Parse.position (full_from_schematic_synth_constdecl || simple_from_schematic_synth_constdecl
-                       || full_from_definition_synth_constdecl
-                       || simple_from_definition_synth_constdecl)
-
-  val full_schematic_decl =
-       Parse.string -- ((Parse.$$$ "for" |-- Parse.string)) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) [])
-
-  val simple_schematic_decl =
-       (Parse.$$$ "for" |-- Parse.string >> (fn name => "sats_" ^ name ^ "_fm_auto") &&& I) -- (Scan.optional (Parse.$$$ "assuming" |-- Scan.repeat Parse.string) [])
-
-  val schematic_decl = Parse.position (full_schematic_decl || simple_schematic_decl)
-
-  val _ =
-     Outer_Syntax.local_theory \<^command_keyword>\<open>synthesize\<close> "ML setup for synthetic definitions"
-       (synth_constdecl >> (fn (f,p) => f p true true))
-
-  val _ =
-     Outer_Syntax.local_theory \<^command_keyword>\<open>synthesize_notc\<close> "ML setup for synthetic definitions"
-       (synth_constdecl >> (fn (f,p) => f p false false))
-
-  val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>generate_schematic\<close> "ML setup for schematic goals"
-       (schematic_decl >> (fn (((bndg,target), assuming),p) => schematic_def bndg target assuming p))
-
-  val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>manual_schematic\<close> "ML setup for schematic goals"
-       (schematic_decl >> (fn (((bndg,target), assuming),p) => manual_schematic bndg target assuming p))
-
-  val arity_parser = Parse.position ((Scan.option (Parse.$$$ "intermediate") >> is_some) -- (Parse.$$$ "for" |-- Parse.string))
-
-  val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>manual_arity\<close> "ML setup for arities"
-       (arity_parser >> (fn ((intermediate, target), pos) => manual_arity intermediate target pos))
-
-  val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>arity_theorem\<close> "ML setup for arities"
-       (arity_parser >> (fn ((intermediate, target), pos) => auto_arity intermediate target pos))
-
-in
-
-end
-\<close>
+ML_file\<open>Synthetic_Definition.ml\<close>
 
 text\<open>The \<^ML>\<open>synthetic_def\<close> function extracts definitions from
 schematic goals. A new definition is added to the context. \<close>
 
 (* example of use *)
 (*
 schematic_goal mem_formula_ex :
   assumes "m\<in>nat" "n\<in> nat" "env \<in> list(M)"
   shows "nth(m,env) \<in> nth(n,env) \<longleftrightarrow> sats(M,?frm,env)"
   by (insert assms ; (rule sep_rules empty_iff_sats cartprod_iff_sats | simp del:sats_cartprod_fm)+)
 
 synthesize "\<phi>" from_schematic mem_formula_ex
 *)
 
 end
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,1072 +1,1077 @@
 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>
+    Aleph_Relative \<comment> \<open>must be before \<^theory>\<open>Transitive_Models.Cardinal_AC_Relative\<close>!\<close>
     Cardinal_AC_Relative
     FiniteFun_Relative
 begin
 
+locale M_Pi_assumption_repl = M_Pi_replacement +
+  fixes A f
+  assumes A_in_M: "M(A)" and
+  f_repl : "lam_replacement(M,f)" and
+  f_closed : "\<forall>x[M]. M(f(x))"
+begin
+
+sublocale M_Pi_assumptions M A f
+    using Pi_replacement Pi_separation  A_in_M f_repl f_closed
+      lam_replacement_Sigfun[THEN lam_replacement_imp_strong_replacement]
+    by unfold_locales (simp_all add:transM[of _ A])
+
+end \<comment> \<open>\<^locale>\<open>M_Pi_assumption_repl\<close>\<close>
+
 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>
+proof (intro le_anti_sym) \<comment> \<open>we 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]
+    using 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>
+  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" *)
+(* reldb_add relational "Finite" "is_Finite" *) \<comment> \<open>don't have \<^term>\<open>is_Finite\<close> 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_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)
+  from assms
+  have "A - X = C - X \<Longrightarrow> A = C" if "A\<in>F" "C\<in>F" for A C
+    using that subset_Diff_Un[of X A] subset_Diff_Un[of X C]
+    by simp
+  moreover
+  note assms
+  moreover from this
+  have "M({A-X . A\<in>F})"  "(\<lambda>A\<in>F. A-X) \<in> F \<rightarrow> {A-X. A\<in>F}" (is "?H \<in> _") "M(\<lambda>A\<in>F. A-X)"
+    using lam_type lam_replacement_Diff[THEN [5] lam_replacement_hcomp2] lam_replacement_constant
+      lam_replacement_identity transM[of _ F] lam_replacement_imp_strong_replacement RepFun_closed
+      lam_replacement_imp_lam_closed
+    by (simp,rule_tac lam_type,auto)
+  ultimately
+  show ?thesis
+    using assms def_inj_rel def_surj_rel function_space_rel_char
+    unfolding bij_rel_def
+    by auto
 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
 
 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   ****************)
+subsection\<open>Discipline for \<^term>\<open>cexp\<close>\<close>
+
 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>
+\<comment> \<open>Restoring congruence rule\<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
+  by (simp (no_asm_simp) add: def_inj_rel,auto intro: subst_context [THEN box_equals])
 
 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
+  unfolding bij_rel_def
+  by (blast intro!: lam_injective_rel lam_surjective_rel)
 
 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
+  interpret M_Pi_assumption_repl M X "\<lambda>x . 2"
+    by unfold_locales (simp_all add:lam_replacement_constant)
   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,204 +1,209 @@
 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 inj_range_Diff:
+  assumes "f \<in> inj(A,A')"
+  shows "f``A - f``T = f``(A - T)"
+    using inj_equality[OF _ _ assms] 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
+  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.bib b/thys/Transitive_Models/document/root.bib
--- a/thys/Transitive_Models/document/root.bib
+++ b/thys/Transitive_Models/document/root.bib
@@ -1,92 +1,102 @@
 @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}
 }
 
 @article {MR2051585,
     AUTHOR = {Paulson, Lawrence C.},
      TITLE = {The relative consistency of the axiom of choice mechanized
               using {I}sabelle/{ZF}},
       NOTE = {Appendix A available electronically at
               \url{http://www.lms.ac.uk/jcm/6/lms2003-001/appendix-a/}},
    JOURNAL = {LMS J. Comput. Math.},
   FJOURNAL = {LMS Journal of Computation and Mathematics},
     VOLUME = {6},
       YEAR = {2003},
      PAGES = {198--248},
       ISSN = {1461-1570},
    MRCLASS = {03B35 (03E25 03E35 68T15)},
   MRNUMBER = {2051585},
        DOI = {10.1007/978-3-540-69407-6_52},
        URL = {http://dx.doi.org/10.1007/978-3-540-69407-6_52},
 }
 @inproceedings{2018arXiv180705174G,
        author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
   title     = {First Steps Towards a Formalization of Forcing},
   booktitle = {Proceedings of the 13th Workshop on Logical and Semantic Frameworks
                with Applications, {LSFA} 2018, Fortaleza, Brazil, September 26-28,
                2018},
   pages     = {119--136},
   year      = {2018},
   url       = {https://doi.org/10.1016/j.entcs.2019.07.008},
   doi       = {10.1016/j.entcs.2019.07.008},
   timestamp = {Wed, 05 Feb 2020 13:47:23 +0100},
   biburl    = {https://dblp.org/rec/journals/entcs/GuntherPT19.bib},
   bibsource = {dblp computer science bibliography, https://dblp.org}
 }
 
 
 @ARTICLE{2019arXiv190103313G,
        author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
         title = "{Mechanization of Separation in Generic Extensions}",
       journal = {arXiv e-prints},
      keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1},
          year = 2019,
         month = Jan,
           eid = {arXiv:1901.03313},
        volume = {1901.03313},
 archivePrefix = {arXiv},
        eprint = {1901.03313},
  primaryClass = {cs.LO},
        adsurl = {https://ui.adsabs.harvard.edu/\#abs/2019arXiv190103313G},
       adsnote = {Provided by the SAO/NASA Astrophysics Data System},
      abstract = {We mechanize, in the proof assistant Isabelle, a proof of the axiom-scheme of Separation in generic extensions of models of set theory by using the fundamental theorems of forcing. We also formalize the satisfaction of the axioms of Extensionality, Foundation, Union, and Powerset. The axiom of Infinity is likewise treated, under additional assumptions on the ground model. In order to achieve these goals, we extended Paulson's library on constructibility with renaming of variables for internalized formulas, improved results on definitions by recursion on well-founded relations, and sharpened hypotheses in his development of relativization and absoluteness.}
 }
 
 @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},
       journal = {arXiv e-prints},
      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{moschovakis1994notes,
+  title={Notes on Set Theory},
+  author={Moschovakis, Yiannis N.},
+  isbn={9783540941804},
+  lccn={93035825},
+  series={Springer Texts in Electrical Engineering},
+  year={1994},
+  publisher={Springer-Verlag}
+}
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,191 @@
 \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''
+two instances of separation and six 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
+that allow 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
+    cardinal successor function and ordertypes.
+    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}
+
+Finally, we had to repeat some material from \theory{Relative} in
+\session{ZF-Constructible} (in our theory \theory{M\_Basic\_No\_Repl})
+in order to eliminate one replacement instance appearing in the locale
+\texttt{M\_Basic}.
+
 % 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: