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,680 +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>
+    \<comment> \<open>Compare @{thm [source] "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>
+     @{thm [source] 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>
 
 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/Cofinality.thy b/thys/Delta_System_Lemma/Cofinality.thy
--- a/thys/Delta_System_Lemma/Cofinality.thy
+++ b/thys/Delta_System_Lemma/Cofinality.thy
@@ -1,1205 +1,1206 @@
 section\<open>Cofinality\label{sec:cofinality}\<close>
 
 theory Cofinality
   imports
     ZF_Library
 begin
 
 
 subsection\<open>Basic results and definitions\<close>
 
 text\<open>A set \<^term>\<open>X\<close> is \<^emph>\<open>cofinal\<close> in \<^term>\<open>A\<close> (with respect to the relation
     \<^term>\<open>r\<close>) if every element of \<^term>\<open>A\<close> is ``bounded
     above'' by some element of \<^term>\<open>X\<close>. Note that \<^term>\<open>X\<close> does not need 
     to be a subset of \<^term>\<open>A\<close>.\<close>
 definition
   cofinal :: "[i,i,i] \<Rightarrow> o" where
   "cofinal(X,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>X. \<langle>a,x\<rangle>\<in>r \<or> a = x"
 
 (*
 (* Alternative definitions *)
 definition
   cofinal_predic :: "[i,i,[i,i]\<Rightarrow>o] \<Rightarrow> o" where
   "cofinal_predic(X,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>X. r(a,x) \<or> a = x"
 
 definition
   f_cofinal :: "[i\<Rightarrow>i,i,i,i] \<Rightarrow> o" where
   "f_cofinal(f,C,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>C. \<langle>a,f(x)\<rangle>\<in>r \<or> a = f(x)"
 
 (* The next definition doesn't work if 0 is the top element of A.
    But it works for limit ordinals. *)
 definition
   cofinal_fun' :: "[i,i,i] \<Rightarrow> o" where
   "cofinal_fun'(f,A,r) == f_cofinal(\<lambda>x. f`x,domain(f),A, r)"
 *)
 
 text\<open>A function is cofinal if it range is.\<close>
 definition
   cofinal_fun :: "[i,i,i] \<Rightarrow> o" where
   "cofinal_fun(f,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>domain(f). \<langle>a,f`x\<rangle>\<in>r \<or> a = f`x"
 
 lemma cofinal_funI:
   assumes "\<And>a. a\<in>A \<Longrightarrow> \<exists>x\<in>domain(f). \<langle>a,f`x\<rangle>\<in>r \<or> a = f`x"
   shows "cofinal_fun(f,A,r)"
   using assms unfolding cofinal_fun_def by simp
 
 lemma cofinal_funD:
   assumes "cofinal_fun(f,A,r)" "a\<in>A"
   shows "\<exists>x\<in>domain(f). \<langle>a,f`x\<rangle>\<in>r \<or> a = f`x"
   using assms unfolding cofinal_fun_def by simp
 
 lemma cofinal_in_cofinal:
   assumes
     "trans(r)" "cofinal(Y,X,r)" "cofinal(X,A,r)"
   shows
     "cofinal(Y,A,r)"
   unfolding cofinal_def
 proof
   fix a
   assume "a\<in>A"
   moreover from \<open>cofinal(X,A,r)\<close>
   have "b\<in>A\<Longrightarrow>\<exists>x\<in>X. \<langle>b,x\<rangle>\<in>r \<or> b=x" for b
     unfolding cofinal_def by simp
   ultimately
   obtain y where "y\<in>X" "\<langle>a,y\<rangle>\<in>r \<or> a=y" by auto
   moreover from \<open>cofinal(Y,X,r)\<close>
   have "c\<in>X\<Longrightarrow>\<exists>y\<in>Y. \<langle>c,y\<rangle>\<in>r \<or> c=y" for c
     unfolding cofinal_def by simp
   ultimately
   obtain x where "x\<in>Y" "\<langle>y,x\<rangle>\<in>r \<or> y=x" by auto
   with \<open>a\<in>A\<close> \<open>y\<in>X\<close> \<open>\<langle>a,y\<rangle>\<in>r \<or> a=y\<close> \<open>trans(r)\<close>
   show "\<exists>x\<in>Y. \<langle>a,x\<rangle>\<in>r \<or> a=x" unfolding trans_def by auto
 qed
 
 lemma codomain_is_cofinal:
   assumes "cofinal_fun(f,A,r)" "f:C \<rightarrow> D"
   shows "cofinal(D,A,r)"
   unfolding cofinal_def
 proof
   fix b
   assume "b \<in> A"
   moreover from assms
   have "a\<in>A \<Longrightarrow> \<exists>x\<in>domain(f). \<langle>a, f ` x\<rangle> \<in> r \<or> a = f`x" for a
     unfolding cofinal_fun_def by simp
   ultimately
   obtain x where "x\<in>domain(f)" "\<langle>b, f ` x\<rangle> \<in> r \<or> b = f`x"
     by blast
   moreover from \<open>f:C \<rightarrow> D\<close>  \<open>x\<in>domain(f)\<close>
   have "f`x\<in>D"
     using domain_of_fun apply_rangeI by simp
   ultimately
   show  "\<exists>y\<in>D. \<langle>b, y\<rangle> \<in> r \<or> b = y" by auto
 qed
 
 lemma cofinal_range_iff_cofinal_fun:
   assumes "function(f)"
   shows "cofinal(range(f),A,r) \<longleftrightarrow> cofinal_fun(f,A,r)"
   unfolding cofinal_fun_def
 proof (intro iffI ballI)
   fix a
   assume "a\<in>A" \<open>cofinal(range(f),A,r)\<close>
   then
   obtain y where "y\<in>range(f)" "\<langle>a,y\<rangle> \<in> r \<or> a = y"
     unfolding cofinal_def by blast
   moreover from this
   obtain x where "\<langle>x,y\<rangle>\<in>f"
     unfolding range_def domain_def converse_def by blast
   moreover
   note \<open>function(f)\<close>
   ultimately
   have "\<langle>a, f ` x\<rangle> \<in> r \<or> a = f ` x"
     using function_apply_equality by blast
   with \<open>\<langle>x,y\<rangle>\<in>f\<close>
   show "\<exists>x\<in>domain(f). \<langle>a, f ` x\<rangle> \<in> r \<or> a = f ` x"  by blast
 next
   assume "\<forall>a\<in>A. \<exists>x\<in>domain(f). \<langle>a, f ` x\<rangle> \<in> r \<or> a = f ` x"
   with assms
   show "cofinal(range(f), A, r)"
     using function_apply_Pair[of f] unfolding cofinal_def by fast
 qed
 
 lemma cofinal_comp:
   assumes
     "f\<in> mono_map(C,s,D,r)" "cofinal_fun(f,D,r)" "h:B \<rightarrow> C"  "cofinal_fun(h,C,s)"
     "trans(r)"
   shows "cofinal_fun(f O h,D,r)"
   unfolding cofinal_fun_def
 proof
   fix a
   from \<open>f\<in> mono_map(C,s,D,r)\<close>
   have "f:C \<rightarrow> D"
     using mono_map_is_fun by simp
   with \<open>h:B \<rightarrow> C\<close>
   have "domain(f) = C" "domain(h) = B"
     using domain_of_fun by simp_all
   moreover
   assume "a \<in> D"
   moreover
   note \<open>cofinal_fun(f,D,r)\<close>
   ultimately
   obtain c where "c\<in>C"  "\<langle>a, f ` c\<rangle> \<in> r \<or> a = f ` c"
     unfolding cofinal_fun_def by blast
   with \<open>cofinal_fun(h,C,s)\<close> \<open>domain(h) = B\<close>
   obtain b where "b \<in> B"  "\<langle>c, h ` b\<rangle> \<in> s \<or> c = h ` b"
     unfolding cofinal_fun_def by blast
   moreover from this and \<open>h:B \<rightarrow> C\<close>
   have "h`b \<in> C" by simp
   moreover
   note \<open>f \<in> mono_map(C,s,D,r)\<close>  \<open>c\<in>C\<close>
   ultimately
   have "\<langle>f`c, f` (h ` b)\<rangle> \<in> r \<or> f`c = f` (h ` b)"
     unfolding mono_map_def by blast
   with \<open>\<langle>a, f ` c\<rangle> \<in> r \<or> a = f ` c\<close> \<open>trans(r)\<close> \<open>h:B \<rightarrow> C\<close> \<open>b\<in>B\<close>
   have "\<langle>a, (f O h) ` b\<rangle> \<in> r \<or> a = (f O h) ` b"
     using transD by auto
   moreover from \<open>h:B \<rightarrow> C\<close> \<open>domain(f) = C\<close> \<open>domain(h) = B\<close>
   have "domain(f O h) = B"
     using range_fun_subset_codomain by blast
   moreover
   note \<open>b\<in>B\<close>
   ultimately
   show "\<exists>x\<in>domain(f O h). \<langle>a, (f O h) ` x\<rangle> \<in> r \<or> a = (f O h) ` x"  by blast
 qed
 
 definition
   cf_fun :: "[i,i] \<Rightarrow> o" where
   "cf_fun(f,\<alpha>) \<equiv> cofinal_fun(f,\<alpha>,Memrel(\<alpha>))"
 
 lemma cf_funI[intro!]: "cofinal_fun(f,\<alpha>,Memrel(\<alpha>)) \<Longrightarrow> cf_fun(f,\<alpha>)"
   unfolding cf_fun_def by simp
 
 lemma cf_funD[dest!]: "cf_fun(f,\<alpha>) \<Longrightarrow> cofinal_fun(f,\<alpha>,Memrel(\<alpha>))"
   unfolding cf_fun_def by simp
 
 lemma cf_fun_comp:
   assumes
     "Ord(\<alpha>)" "f\<in> mono_map(C,s,\<alpha>,Memrel(\<alpha>))" "cf_fun(f,\<alpha>)"
     "h:B \<rightarrow> C" "cofinal_fun(h,C,s)"
   shows "cf_fun(f O h,\<alpha>)"
   using assms cofinal_comp[OF _ _ _ _ trans_Memrel] by auto
 
 definition
   cf :: "i\<Rightarrow>i" where
   "cf(\<gamma>) \<equiv> \<mu> \<beta>.  \<exists>A. A\<subseteq>\<gamma> \<and> cofinal(A,\<gamma>,Memrel(\<gamma>)) \<and> \<beta> = ordertype(A,Memrel(\<gamma>))"
 
 lemma Ord_cf [TC]: "Ord(cf(\<beta>))"
   unfolding cf_def using Ord_Least by simp
 
 lemma gamma_cofinal_gamma:
   assumes "Ord(\<gamma>)"
   shows "cofinal(\<gamma>,\<gamma>,Memrel(\<gamma>))"
   unfolding cofinal_def by auto
 
 lemma cf_is_ordertype:
   assumes "Ord(\<gamma>)"
   shows "\<exists>A. A\<subseteq>\<gamma> \<and> cofinal(A,\<gamma>,Memrel(\<gamma>)) \<and> cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     (is "?P(cf(\<gamma>))")
   using gamma_cofinal_gamma LeastI[of ?P \<gamma>] ordertype_Memrel[symmetric] assms
   unfolding cf_def by blast
 
 lemma cf_fun_succ':
   assumes "Ord(\<beta>)" "Ord(\<alpha>)" "f:\<alpha>\<rightarrow>succ(\<beta>)"
   shows "(\<exists>x\<in>\<alpha>. f`x=\<beta>) \<longleftrightarrow> cf_fun(f,succ(\<beta>))"
 proof (intro iffI)
   assume "(\<exists>x\<in>\<alpha>. f`x=\<beta>)"
   with assms
   show "cf_fun(f,succ(\<beta>))"
     using domain_of_fun[OF \<open>f:\<alpha>\<rightarrow>succ(\<beta>)\<close>]
     unfolding cf_fun_def cofinal_fun_def by auto
 next
   assume "cf_fun(f,succ(\<beta>))"
   with assms
   obtain x where "x\<in>\<alpha>" "\<langle>\<beta>,f`x\<rangle> \<in> Memrel(succ(\<beta>)) \<or> \<beta> = f ` x"
     using domain_of_fun[OF \<open>f:\<alpha>\<rightarrow>succ(\<beta>)\<close>]
     unfolding cf_fun_def cofinal_fun_def by auto
   moreover from \<open>Ord(\<beta>)\<close>
   have "\<langle>\<beta>,y\<rangle> \<notin> Memrel(succ(\<beta>))" for y
     using foundation unfolding Memrel_def by blast
   ultimately
   show "\<exists>x\<in>\<alpha>. f ` x = \<beta>" by blast
 qed
 
 lemma cf_fun_succ:
   "Ord(\<beta>) \<Longrightarrow> f:1\<rightarrow>succ(\<beta>) \<Longrightarrow> f`0=\<beta> \<Longrightarrow> cf_fun(f,succ(\<beta>))"
   using cf_fun_succ' by blast
 
 lemma ordertype_0_not_cofinal_succ:
   assumes "ordertype(A,Memrel(succ(i))) = 0"  "A\<subseteq>succ(i)" "Ord(i)"
   shows "\<not>cofinal(A,succ(i),Memrel(succ(i)))"
 proof
   have 1:"ordertype(A,Memrel(succ(i))) = ordertype(0,Memrel(0))"
     using \<open>ordertype(A,Memrel(succ(i))) = 0\<close> ordertype_0 by simp
   from  \<open>A\<subseteq>succ(i)\<close> \<open>Ord(i)\<close>
   have "\<exists>f. f \<in> \<langle>A, Memrel(succ(i))\<rangle> \<cong> \<langle>0, Memrel(0)\<rangle>"
     using   well_ord_Memrel well_ord_subset
       ordertype_eq_imp_ord_iso[OF 1] Ord_0  by blast
   then
   have "A=0"
     using  ord_iso_is_bij bij_imp_eqpoll eqpoll_0_is_0 by blast
   moreover
   assume "cofinal(A, succ(i), Memrel(succ(i)))"
   moreover
   note \<open>Ord(i)\<close>
   ultimately
   show "False"
     using not_mem_empty unfolding cofinal_def by auto
 qed
 
 text\<open>I thank Edwin Pacheco Rodríguez for the following lemma.\<close>
 lemma cf_succ:
   assumes "Ord(\<alpha>)"
   shows "cf(succ(\<alpha>)) = 1"
 proof -
   define f where "f \<equiv> {\<langle>0,\<alpha>\<rangle>}"
   then
   have  "f : 1\<rightarrow>succ(\<alpha>)" "f`0 = \<alpha>"
     using fun_extend3[of 0 0 "succ(\<alpha>)" 0 \<alpha>] singleton_0 by auto
   with assms
   have "cf_fun(f,succ(\<alpha>))"
     using cf_fun_succ unfolding cofinal_fun_def by simp
   from \<open>f:1\<rightarrow>succ(\<alpha>)\<close>
   have "0\<in>domain(f)" using domain_of_fun by simp
   define A where "A={f`0}"
   with \<open>cf_fun(f,succ(\<alpha>))\<close> \<open>0\<in>domain(f)\<close> \<open>f`0=\<alpha>\<close>
   have "cofinal(A,succ(\<alpha>),Memrel(succ(\<alpha>)))"
     unfolding cofinal_def cofinal_fun_def by simp
   moreover from  \<open>f`0=\<alpha>\<close> \<open>A={f`0}\<close>
   have "A \<subseteq> succ(\<alpha>)" unfolding succ_def  by auto
   moreover from \<open>Ord(\<alpha>)\<close> \<open>A\<subseteq> succ(\<alpha>)\<close>
   have "well_ord(A,Memrel(succ(\<alpha>)))"
     using Ord_succ well_ord_Memrel  well_ord_subset relation_Memrel by blast
   moreover from \<open>Ord(\<alpha>)\<close>
   have "\<not>(\<exists>A. A \<subseteq> succ(\<alpha>) \<and> cofinal(A, succ(\<alpha>), Memrel(succ(\<alpha>))) \<and> 0 = ordertype(A, Memrel(succ(\<alpha>))))"
     (is "\<not>?P(0)")
     using ordertype_0_not_cofinal_succ  unfolding cf_def  by auto
   moreover
   have "1 = ordertype(A,Memrel(succ(\<alpha>)))"
   proof -
     from \<open>A={f`0}\<close>
     have "A\<approx>1" using singleton_eqpoll_1 by simp
     with \<open>well_ord(A,Memrel(succ(\<alpha>)))\<close>
     show ?thesis using nat_1I ordertype_eq_n by simp
   qed
   ultimately
   show "cf(succ(\<alpha>)) = 1" using Ord_1  Least_equality[of ?P 1]
     unfolding cf_def by blast
 qed
 
 lemma cf_zero [simp]:
   "cf(0) = 0"
   unfolding cf_def cofinal_def using
     ordertype_0 subset_empty_iff Least_le[of _ 0] by auto
 
 lemma surj_is_cofinal: "f \<in> surj(\<delta>,\<gamma>) \<Longrightarrow> cf_fun(f,\<gamma>)"
   unfolding surj_def cofinal_fun_def cf_fun_def
   using domain_of_fun by force
 
 lemma cf_zero_iff: "Ord(\<alpha>) \<Longrightarrow> cf(\<alpha>) = 0 \<longleftrightarrow> \<alpha> = 0"
 proof (intro iffI)
   assume "\<alpha> = 0" "Ord(\<alpha>)"
   then
   show "cf(\<alpha>) = 0" using cf_zero by simp
 next
   assume "cf(\<alpha>) = 0" "Ord(\<alpha>)"
   moreover from this
   obtain A where "A\<subseteq>\<alpha>" "cf(\<alpha>) = ordertype(A,Memrel(\<alpha>))"
     "cofinal(A,\<alpha>,Memrel(\<alpha>))"
     using cf_is_ordertype by blast
   ultimately
   have "cofinal(0,\<alpha>,Memrel(\<alpha>))"
     using ordertype_zero_imp_zero[of A "Memrel(\<alpha>)"] by simp
   then
   show "\<alpha>=0"
     unfolding cofinal_def by blast
 qed
 
 \<comment> \<open>TODO: define Succ (predicate for successor ordinals)\<close>
 lemma cf_eq_one_iff:
   assumes "Ord(\<gamma>)"
   shows "cf(\<gamma>) = 1 \<longleftrightarrow> (\<exists>\<alpha>. Ord(\<alpha>) \<and> \<gamma>  = succ(\<alpha>))"
 proof (intro iffI)
   assume "\<exists>\<alpha>. Ord(\<alpha>) \<and> \<gamma>  = succ(\<alpha>)"
   then
   show "cf(\<gamma>) = 1" using cf_succ by auto
 next
   assume "cf(\<gamma>) = 1"
   moreover from assms
   obtain A where "A \<subseteq> \<gamma>" "cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     "cofinal(A,\<gamma>,Memrel(\<gamma>))"
     using cf_is_ordertype by blast
   ultimately
   have "ordertype(A,Memrel(\<gamma>)) = 1" by simp
   moreover
   define f where "f\<equiv>converse(ordermap(A,Memrel(\<gamma>)))"
   moreover from this \<open>ordertype(A,Memrel(\<gamma>)) = 1\<close> \<open>A \<subseteq> \<gamma>\<close> assms
   have "f \<in> surj(1,A)"
     using well_ord_subset[OF well_ord_Memrel, THEN ordermap_bij,
         THEN bij_converse_bij, of \<gamma> A] bij_is_surj
     by simp
   with \<open>cofinal(A,\<gamma>,Memrel(\<gamma>))\<close>
   have "\<forall>a\<in>\<gamma>. \<langle>a, f`0\<rangle> \<in> Memrel(\<gamma>) \<or> a = f`0"
     unfolding cofinal_def surj_def
     by auto
   with assms \<open>A \<subseteq> \<gamma>\<close> \<open>f \<in> surj(1,A)\<close>
   show "\<exists>\<alpha>. Ord(\<alpha>) \<and> \<gamma>  = succ(\<alpha>)"
     using Ord_has_max_imp_succ[of \<gamma> "f`0"]
       surj_is_fun[of f 1 A] apply_type[of f 1 "\<lambda>_.A" 0]
     unfolding lt_def
     by (auto intro:Ord_in_Ord)
 qed
 
 lemma ordertype_in_cf_imp_not_cofinal:
   assumes
     "ordertype(A,Memrel(\<gamma>)) \<in> cf(\<gamma>)"
     "A \<subseteq> \<gamma>"
   shows
     "\<not> cofinal(A,\<gamma>,Memrel(\<gamma>))"
 proof
   note \<open>A \<subseteq> \<gamma>\<close>
   moreover
   assume "cofinal(A,\<gamma>,Memrel(\<gamma>))"
   ultimately
   have "\<exists>B. B \<subseteq> \<gamma> \<and> cofinal(B, \<gamma>, Memrel(\<gamma>)) \<and>  ordertype(A,Memrel(\<gamma>)) = ordertype(B, Memrel(\<gamma>))"
     (is "?P(ordertype(A,_))")
     by blast
   moreover from assms
   have "ordertype(A,Memrel(\<gamma>)) < cf(\<gamma>)"
     using Ord_cf ltI by blast
   ultimately
   show "False"
     unfolding cf_def using less_LeastE[of ?P  "ordertype(A,Memrel(\<gamma>))"]
     by auto
 qed
 
 lemma cofinal_mono_map_cf:
   assumes "Ord(\<gamma>)"
   shows "\<exists>j \<in> mono_map(cf(\<gamma>), Memrel(cf(\<gamma>)), \<gamma>, Memrel(\<gamma>)) . cf_fun(j,\<gamma>)"
 proof -
   note assms
   moreover from this
   obtain A where "A \<subseteq> \<gamma>" "cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     "cofinal(A,\<gamma>,Memrel(\<gamma>))"
     using cf_is_ordertype by blast
   moreover
   define j where "j \<equiv> converse(ordermap(A,Memrel(\<gamma>)))"
   moreover from calculation
   have "j :cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma>"
     using ordertype_ord_iso[THEN ord_iso_sym,
         THEN ord_iso_is_mono_map, THEN mono_map_mono,
         of A "Memrel(\<gamma>)" \<gamma>] well_ord_Memrel[THEN well_ord_subset]
     by simp
   moreover from calculation
   have "j \<in> surj(cf(\<gamma>),A)"
     using well_ord_Memrel[THEN well_ord_subset, THEN ordertype_ord_iso,
         THEN ord_iso_sym, of \<gamma> A, THEN ord_iso_is_bij,
         THEN bij_is_surj]
     by simp
   with \<open>cofinal(A,\<gamma>,Memrel(\<gamma>))\<close>
   have "cf_fun(j,\<gamma>)"
     using cofinal_range_iff_cofinal_fun[of j \<gamma> "Memrel(\<gamma>)"]
       surj_range[of j "cf(\<gamma>)" A] surj_is_fun fun_is_function
     by fastforce
   with \<open>j \<in> mono_map(_,_,_,_)\<close>
   show ?thesis by auto
 qed
 
 
 subsection\<open>The factorization lemma\<close>
 
 text\<open>In this subsection we prove a factorization lemma for cofinal functions
 into ordinals, which shows that any cofinal function between ordinals can be
 ``decomposed'' in such a way that a commutative triangle of strictly increasing
 maps arises.
 
 The factorization lemma has a kind of
 fundamental character, in that the rest of the basic results on cofinality
 (for, instance, idempotence) follow easily from it, in a more algebraic way.
 
 This is a consequence that the proof encapsulates uses of transfinite
 recursion in the basic theory of cofinality; indeed, only one use is needed.
 In the setting of Isabelle/ZF, this is convenient since the machinery of
 recursion is pretty clumsy. On the downside, this way of presenting things 
 results in a longer proof of the factorization lemma. This approach was
 taken by the author in the notes \cite{apunte_st} for an introductory course
 in Set Theory.
 
 To organize the use of the hypotheses of the factorization lemma,
 we set up a locale containing all the relevant ingredients.
 \<close>
 locale cofinal_factor =
   fixes j \<delta> \<xi> \<gamma> f
   assumes j_mono: "j :\<xi> \<rightarrow>\<^sub>< \<gamma>"
     and     ords: "Ord(\<delta>)" "Ord(\<xi>)" "Limit(\<gamma>)"
     and   f_type: "f: \<delta> \<rightarrow> \<gamma>"
 begin
 
 text\<open>Here, \<^term>\<open>f\<close> is cofinal function from \<^term>\<open>\<delta>\<close> to \<^term>\<open>\<gamma>\<close>, and the
 ordinal \<^term>\<open>\<xi>\<close> is meant to be the cofinality of \<^term>\<open>\<gamma>\<close>. Hence, there exists
 an increasing map \<^term>\<open>j\<close> from  \<^term>\<open>\<xi>\<close> to  \<^term>\<open>\<gamma>\<close> by the last lemma.
 
 The main goal is to construct an increasing function \<^term>\<open>g:\<xi>\<rightarrow>\<delta>\<close> such that
 the composition \<^term>\<open>f O g\<close> is still cofinal but also increasing.\<close>
 
 definition
   factor_body :: "[i,i,i] \<Rightarrow> o" where
   "factor_body(\<beta>,h,x) \<equiv> (x\<in>\<delta> \<and> j`\<beta> \<le> f`x \<and> (\<forall>\<alpha><\<beta> . f`(h`\<alpha>) < f`x)) \<or> x=\<delta>"
 
 definition
   factor_rec :: "[i,i] \<Rightarrow> i" where
   "factor_rec(\<beta>,h) \<equiv>  \<mu> x. factor_body(\<beta>,h,x)"
 
 text\<open>\<^term>\<open>factor_rec\<close> is the inductive step for the definition by transfinite
 recursion of the \<^emph>\<open>factor\<close> function (called \<^term>\<open>g\<close> above), which in
 turn is obtained by minimizing the predicate \<^term>\<open>factor_body\<close>. Next we show
 that this predicate is monotonous.\<close>
 
 lemma factor_body_mono:
   assumes
     "\<beta>\<in>\<xi>" "\<alpha><\<beta>"
     "factor_body(\<beta>,\<lambda>x\<in>\<beta>. G(x),x)"
   shows
     "factor_body(\<alpha>,\<lambda>x\<in>\<alpha>. G(x),x)"
 proof -
   from \<open>\<alpha><\<beta>\<close>
   have "\<alpha>\<in>\<beta>" using ltD by simp
   moreover
   note \<open>\<beta>\<in>\<xi>\<close>
   moreover from calculation
   have "\<alpha>\<in>\<xi>" using ords ltD Ord_cf Ord_trans by blast
   ultimately
   have "j`\<alpha> \<in> j`\<beta>" using j_mono mono_map_increasing by blast
   moreover from \<open>\<beta>\<in>\<xi>\<close>
   have "j`\<beta>\<in>\<gamma>"
     using j_mono domain_of_fun apply_rangeI mono_map_is_fun by force
   moreover from this
   have "Ord(j`\<beta>)"
     using Ord_in_Ord ords Limit_is_Ord by auto
   ultimately
   have "j`\<alpha> \<le> j`\<beta>"  unfolding lt_def by blast
   then
   have "j`\<beta> \<le> f`\<theta> \<Longrightarrow> j`\<alpha> \<le> f`\<theta>" for \<theta> using le_trans by blast
   moreover
   have "f`((\<lambda>w\<in>\<alpha>. G(w))`y) < f`z" if "z\<in>\<delta>" "\<forall>x<\<beta>. f`((\<lambda>w\<in>\<beta>. G(w))`x) < f`z" "y<\<alpha>" for y z
   proof -
     note \<open>y<\<alpha>\<close>
     also
     note \<open>\<alpha><\<beta>\<close>
     finally
     have "y<\<beta>" by simp
     with \<open>\<forall>x<\<beta>. f`((\<lambda>w\<in>\<beta>. G(w))`x) < f`z\<close>
     have "f ` ((\<lambda>w\<in>\<beta>. G(w)) ` y) < f ` z" by simp
     moreover from \<open>y<\<alpha>\<close> \<open>y<\<beta>\<close>
     have "(\<lambda>w\<in>\<beta>. G(w)) ` y = (\<lambda>w\<in>\<alpha>. G(w)) ` y"
       using beta_if  by (auto dest:ltD)
     ultimately show ?thesis by simp
   qed
   moreover
   note \<open>factor_body(\<beta>,\<lambda>x\<in>\<beta>. G(x),x)\<close>
   ultimately
   show ?thesis
     unfolding factor_body_def by blast
 qed
 
 lemma factor_body_simp[simp]: "factor_body(\<alpha>,g,\<delta>)"
   unfolding factor_body_def by simp
 
 lemma factor_rec_mono:
   assumes
     "\<beta>\<in>\<xi>" "\<alpha><\<beta>"
   shows
     "factor_rec(\<alpha>,\<lambda>x\<in>\<alpha>. G(x)) \<le> factor_rec(\<beta>,\<lambda>x\<in>\<beta>. G(x))"
   unfolding factor_rec_def
   using assms ords factor_body_mono Least_antitone by simp
 
 text\<open>We now define the factor as higher-order function.
 Later it will be restricted to a set to obtain a bona fide function of
 type @{typ i}.\<close>
 definition
   factor :: "i \<Rightarrow> i" where
   "factor(\<beta>) \<equiv> transrec(\<beta>,factor_rec)"
 
 lemma factor_unfold:
   "factor(\<alpha>) = factor_rec(\<alpha>,\<lambda>x\<in>\<alpha>. factor(x))"
   using def_transrec[OF factor_def] .
 
 lemma factor_mono:
   assumes "\<beta>\<in>\<xi>" "\<alpha><\<beta>" "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>"
   shows "factor(\<alpha>) \<le> factor(\<beta>)"
 proof -
   have "factor(\<alpha>) = factor_rec(\<alpha>, \<lambda>x\<in>\<alpha>. factor(x))"
     using factor_unfold .
   also from assms and factor_rec_mono
   have "... \<le> factor_rec(\<beta>, \<lambda>x\<in>\<beta>. factor(x))"
     by simp
   also
   have "factor_rec(\<beta>, \<lambda>x\<in>\<beta>. factor(x)) = factor(\<beta>)"
     using def_transrec[OF factor_def, symmetric] .
   finally show ?thesis .
 qed
 
 text\<open>The factor satisfies the predicate body of the minimization.\<close>
 
 lemma factor_body_factor:
   "factor_body(\<alpha>,\<lambda>x\<in>\<alpha>. factor(x),factor(\<alpha>))"
   using ords factor_unfold[of \<alpha>]
     LeastI[of "factor_body(_,_)" \<delta>]
   unfolding factor_rec_def by simp
 
 lemma factor_type [TC]: "Ord(factor(\<alpha>))"
   using ords factor_unfold[of \<alpha>]
   unfolding factor_rec_def by simp
 
 text\<open>The value \<^term>\<open>\<delta>\<close> in \<^term>\<open>factor_body\<close> (and therefore, in
 \<^term>\<open>factor\<close>) is meant to be a ``default value''. Whenever it is not 
 attained, the factor function behaves as expected: It is increasing
 and its composition with \<^term>\<open>f\<close> also is.\<close>
 
 lemma f_factor_increasing:
   assumes "\<beta>\<in>\<xi>" "\<alpha><\<beta>" "factor(\<beta>)\<noteq>\<delta>"
   shows "f`factor(\<alpha>) < f`factor(\<beta>)"
 proof -
   from assms
   have "f ` ((\<lambda>x\<in>\<beta>. factor(x)) ` \<alpha>) < f ` factor(\<beta>)"
     using factor_unfold[of \<beta>] ords LeastI[of "factor_body(\<beta>,\<lambda>x\<in>\<beta>. factor(x))"]
     unfolding factor_rec_def factor_body_def
     by (auto simp del:beta_if)
   with \<open>\<alpha><\<beta>\<close>
   show ?thesis using ltD by auto
 qed
 
 lemma factor_increasing:
   assumes "\<beta>\<in>\<xi>" "\<alpha><\<beta>" "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>"
   shows "factor(\<alpha>)<factor(\<beta>)"
   using assms f_factor_increasing factor_mono by (force intro:le_neq_imp_lt)
 
 lemma factor_in_delta:
   assumes "factor(\<beta>) \<noteq> \<delta>"
   shows "factor(\<beta>) \<in> \<delta>"
   using assms factor_body_factor ords
   unfolding factor_body_def by auto
 
 text\<open>Finally, we define the (set) factor function as the restriction of
 factor to the ordinal  \<^term>\<open>\<xi>\<close>.\<close>
 
 definition
   fun_factor :: "i" where
   "fun_factor \<equiv> \<lambda>\<beta>\<in>\<xi>. factor(\<beta>)"
 
 lemma fun_factor_is_mono_map:
   assumes "\<And>\<beta>. \<beta> \<in> \<xi> \<Longrightarrow> factor(\<beta>) \<noteq> \<delta>"
   shows "fun_factor \<in> mono_map(\<xi>, Memrel(\<xi>), \<delta>, Memrel(\<delta>))"
   unfolding mono_map_def
 proof (intro CollectI ballI impI)
-  (* Proof that \<^term>\<open>fun_factor\<close> respects membership *)
+  text\<open>Proof that \<^term>\<open>fun_factor\<close> respects membership:\<close>
   fix \<alpha> \<beta>
   assume "\<alpha>\<in>\<xi>" "\<beta>\<in>\<xi>"
   moreover
   note assms
   moreover from calculation
   have "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>" "Ord(\<beta>)"
     using factor_in_delta Ord_in_Ord ords by auto
   moreover
   assume "\<langle>\<alpha>, \<beta>\<rangle> \<in> Memrel(\<xi>)"
   ultimately
   show "\<langle>fun_factor ` \<alpha>, fun_factor ` \<beta>\<rangle> \<in> Memrel(\<delta>)"
     unfolding fun_factor_def
     using ltI factor_increasing[THEN ltD] factor_in_delta
     by simp
 next
-  (* Proof of type *)
+  text\<open>Proof that it has the appropriate type:\<close>
   from assms
   show "fun_factor : \<xi> \<rightarrow> \<delta>"
     unfolding fun_factor_def
     using ltI lam_type factor_in_delta by simp
 qed
 
 lemma f_fun_factor_is_mono_map:
   assumes "\<And>\<beta>. \<beta> \<in> \<xi> \<Longrightarrow> factor(\<beta>) \<noteq> \<delta>"
   shows "f O fun_factor \<in> mono_map(\<xi>, Memrel(\<xi>), \<gamma>, Memrel(\<gamma>))"
   unfolding mono_map_def
   using f_type
 proof (intro CollectI ballI impI comp_fun[of _ _ \<delta>])
   from assms
   show "fun_factor : \<xi> \<rightarrow> \<delta>"
     using fun_factor_is_mono_map mono_map_is_fun by simp
-      (* Proof that f O ?g respects membership *)
+  text\<open>Proof that \<^term>\<open>f O fun_factor\<close> respects membership\<close>
   fix \<alpha> \<beta>
   assume "\<langle>\<alpha>, \<beta>\<rangle> \<in> Memrel(\<xi>)"
   then
   have "\<alpha><\<beta>"
     using Ord_in_Ord[of "\<xi>"] ltI ords by blast
   assume "\<alpha>\<in>\<xi>" "\<beta>\<in>\<xi>"
   moreover from this and assms
   have "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>" by auto
   moreover
   have "Ord(\<gamma>)" "\<gamma>\<noteq>0" using ords Limit_is_Ord by auto
   moreover
   note \<open>\<alpha><\<beta>\<close> \<open>fun_factor : \<xi> \<rightarrow> \<delta>\<close>
   ultimately
   show "\<langle>(f O fun_factor) ` \<alpha>, (f O fun_factor) ` \<beta>\<rangle> \<in> Memrel(\<gamma>)"
     using ltD[of "f ` factor(\<alpha>)" "f ` factor(\<beta>)"]
       f_factor_increasing apply_in_codomain_Ord f_type
     unfolding fun_factor_def by auto
 qed
 
-end (* cofinal_factor *)
+end \<comment> \<open>\<^locale>\<open>cofinal_factor\<close>\<close>
 
 text\<open>We state next the factorization lemma.\<close>
 
 lemma cofinal_fun_factorization:
   notes le_imp_subset [dest] lt_trans2 [trans]
   assumes
     "Ord(\<delta>)" "Limit(\<gamma>)" "f: \<delta> \<rightarrow> \<gamma>" "cf_fun(f,\<gamma>)"
   shows
     "\<exists>g \<in> cf(\<gamma>) \<rightarrow>\<^sub>< \<delta>.  f O g : cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma> \<and>
            cofinal_fun(f O g,\<gamma>,Memrel(\<gamma>))"
 proof -
   from \<open>Limit(\<gamma>)\<close>
   have "Ord(\<gamma>)" using Limit_is_Ord by simp
   then
   obtain j where "j :cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma>" "cf_fun(j,\<gamma>)"
     using cofinal_mono_map_cf by blast
   then
   have "domain(j) = cf(\<gamma>)"
     using domain_of_fun mono_map_is_fun by force
   from \<open>j \<in> _\<close> assms
   interpret cofinal_factor j \<delta> "cf(\<gamma>)"
     by (unfold_locales) (simp_all)
   text\<open>The core of the argument is to show that the factor function
   indeed maps into \<^term>\<open>\<delta>\<close>, therefore its values satisfy the first
   disjunct of \<^term>\<open>factor_body\<close>. This holds in turn because no
   restriction of the factor composed with \<^term>\<open>f\<close> to a proper initial
   segment of \<^term>\<open>cf(\<gamma>)\<close> can be cofinal in \<^term>\<open>\<gamma>\<close> by definition of
   cofinality. Hence there must be a witness that satisfies the first
   disjunct.\<close>
   have factor_not_delta: "factor(\<beta>)\<noteq>\<delta>" if "\<beta> \<in> cf(\<gamma>)" for \<beta>
     text\<open>For this, we induct on \<^term>\<open>\<beta>\<close> ranging over \<^term>\<open>cf(\<gamma>)\<close>.\<close>
   proof (induct \<beta> rule:Ord_induct[OF _ Ord_cf[of \<gamma>]])
     case 1 with that show ?case .
   next
     case (2 \<beta>)
     then
     have IH: "z\<in>\<beta> \<Longrightarrow> factor(z)\<noteq>\<delta>" for z by simp
     define h where "h \<equiv> \<lambda>x\<in>\<beta>. f`factor(x)"
     from IH
     have "z\<in>\<beta> \<Longrightarrow> factor(z) \<in> \<delta>" for z
       using factor_in_delta by blast
     with \<open>f:\<delta>\<rightarrow>\<gamma>\<close>
     have "h : \<beta> \<rightarrow> \<gamma>" unfolding h_def using apply_funtype lam_type by auto
     then
     have "h : \<beta> \<rightarrow>\<^sub>< \<gamma>"
       unfolding mono_map_def
     proof (intro CollectI ballI impI)
       fix x y
       assume "x\<in>\<beta>" "y\<in>\<beta>"
       moreover from this and IH
       have "factor(y) \<noteq> \<delta>" by simp
       moreover from calculation and \<open>h \<in> \<beta> \<rightarrow> \<gamma>\<close>
       have "h`x \<in> \<gamma>" "h`y \<in> \<gamma>" by simp_all
       moreover from \<open>\<beta>\<in>cf(\<gamma>)\<close> and \<open>y\<in>\<beta>\<close>
       have "y \<in> cf(\<gamma>)"
         using Ord_trans Ord_cf by blast
       moreover from this
       have "Ord(y)"
         using Ord_cf Ord_in_Ord by blast
       moreover
       assume "\<langle>x,y\<rangle> \<in> Memrel(\<beta>)"
       moreover from calculation
       have "x<y" by (blast intro:ltI)
       ultimately
       show "\<langle>h ` x, h ` y\<rangle> \<in> Memrel(\<gamma>)"
         unfolding h_def using f_factor_increasing ltD by (auto)
     qed
     with \<open>\<beta>\<in>cf(\<gamma>)\<close> \<open>Ord(\<gamma>)\<close>
     have "ordertype(h``\<beta>,Memrel(\<gamma>)) = \<beta>" (* Maybe should use range(h) *)
       using mono_map_ordertype_image[of \<beta>] Ord_cf Ord_in_Ord by blast
     also
     note \<open>\<beta> \<in>cf(\<gamma>)\<close>
     finally
     have "ordertype(h``\<beta>,Memrel(\<gamma>)) \<in> cf(\<gamma>)" by simp
     moreover from \<open>h \<in> \<beta> \<rightarrow> \<gamma>\<close>
     have "h``\<beta> \<subseteq> \<gamma>"
       using mono_map_is_fun Image_sub_codomain by blast
     ultimately
     have "\<not> cofinal(h``\<beta>,\<gamma>,Memrel(\<gamma>))"
       using ordertype_in_cf_imp_not_cofinal by simp
     then
     obtain \<alpha>_0 where "\<alpha>_0\<in>\<gamma>" "\<forall>x\<in>h `` \<beta>. \<not> \<langle>\<alpha>_0, x\<rangle> \<in> Memrel(\<gamma>) \<and> \<alpha>_0 \<noteq> x"
       unfolding cofinal_def by auto
     with \<open>Ord(\<gamma>)\<close> \<open>h``\<beta> \<subseteq> \<gamma>\<close>
     have "\<forall>x\<in>h `` \<beta>. x \<in> \<alpha>_0"
       using well_ord_Memrel[of \<gamma>] well_ord_is_linear[of \<gamma> "Memrel(\<gamma>)"]
       unfolding linear_def by blast
     from \<open>\<alpha>_0 \<in> \<gamma>\<close> \<open>j \<in> mono_map(_,_,\<gamma>,_)\<close> \<open>Ord(\<gamma>)\<close>
     have "j`\<beta> \<in> \<gamma>"
       using mono_map_is_fun apply_in_codomain_Ord by force
     with \<open>\<alpha>_0 \<in> \<gamma>\<close> \<open>Ord(\<gamma>)\<close>
     have "\<alpha>_0 \<union> j`\<beta> \<in> \<gamma>"
       using Un_least_mem_iff Ord_in_Ord by auto
     with \<open>cf_fun(f,\<gamma>)\<close>
     obtain \<theta> where "\<theta>\<in>domain(f)" "\<langle>\<alpha>_0 \<union> j`\<beta>, f ` \<theta>\<rangle> \<in> Memrel(\<gamma>) \<or>  \<alpha>_0 \<union> j`\<beta> = f ` \<theta>"
       by (auto simp add:cofinal_fun_def) blast
     moreover from this and \<open>f:\<delta>\<rightarrow>\<gamma>\<close>
     have "\<theta> \<in> \<delta>" using domain_of_fun by auto
     moreover
     note \<open>Ord(\<gamma>)\<close>
     moreover from this and \<open>f:\<delta>\<rightarrow>\<gamma>\<close>  \<open>\<alpha>_0 \<in> \<gamma>\<close>
     have "Ord(f`\<theta>)"
       using apply_in_codomain_Ord Ord_in_Ord by blast
     moreover from calculation and \<open>\<alpha>_0 \<in> \<gamma>\<close> and \<open>Ord(\<delta>)\<close> and \<open>j`\<beta> \<in> \<gamma>\<close>
     have "Ord(\<alpha>_0)" "Ord(j`\<beta>)" "Ord(\<theta>)"
       using Ord_in_Ord by auto
     moreover from \<open>\<forall>x\<in>h `` \<beta>. x \<in> \<alpha>_0\<close> \<open>Ord(\<alpha>_0)\<close> \<open>h:\<beta>\<rightarrow>\<gamma>\<close>
     have "x\<in>\<beta> \<Longrightarrow> h`x < \<alpha>_0" for x
       using fun_is_function[of h \<beta> "\<lambda>_. \<gamma>"]
         Image_subset_Ord_imp_lt domain_of_fun[of h \<beta> "\<lambda>_. \<gamma>"]
       by blast
     moreover
     have "x\<in>\<beta> \<Longrightarrow> h`x < f`\<theta>" for x
     proof -
       fix x
       assume "x\<in>\<beta>"
       with \<open>\<forall>x\<in>h `` \<beta>. x \<in> \<alpha>_0\<close> \<open>Ord(\<alpha>_0)\<close> \<open>h:\<beta>\<rightarrow>\<gamma>\<close>
       have "h`x < \<alpha>_0"
         using fun_is_function[of h \<beta> "\<lambda>_. \<gamma>"]
           Image_subset_Ord_imp_lt domain_of_fun[of h \<beta> "\<lambda>_. \<gamma>"]
         by blast
       also from \<open>\<langle>\<alpha>_0 \<union> _, f ` \<theta>\<rangle> \<in> Memrel(\<gamma>) \<or> \<alpha>_0 \<union> _= f ` \<theta>\<close>
         \<open>Ord(f`\<theta>)\<close> \<open>Ord(\<alpha>_0)\<close> \<open>Ord(j`\<beta>)\<close>
       have "\<alpha>_0 \<le> f`\<theta>"
         using Un_leD1[OF leI [OF ltI]] Un_leD1[OF le_eqI] by blast
       finally
       show "h`x < f`\<theta>" .
     qed
     ultimately
     have "factor_body(\<beta>,\<lambda>x\<in>\<beta>. factor(x),\<theta>)"
       unfolding h_def factor_body_def using ltD
       by (auto dest:Un_memD2 Un_leD2[OF le_eqI])
     with \<open>Ord(\<theta>)\<close>
     have "factor(\<beta>) \<le> \<theta>"
       using factor_unfold[of \<beta>] Least_le unfolding factor_rec_def by auto
     with \<open>\<theta>\<in>\<delta>\<close> \<open>Ord(\<delta>)\<close>
     have "factor(\<beta>) \<in> \<delta>"
       using leI[of \<theta>] ltI[of \<theta>]  by (auto dest:ltD)
     then
     show ?case by (auto elim:mem_irrefl)
   qed
   moreover
   have "cofinal_fun(f O fun_factor, \<gamma>, Memrel(\<gamma>))"
   proof (intro cofinal_funI)
     fix a
     assume "a \<in> \<gamma>"
     with \<open>cf_fun(j,\<gamma>)\<close> \<open>domain(j) = cf(\<gamma>)\<close>
     obtain x where "x\<in>cf(\<gamma>)" "a \<in> j`x \<or> a = j`x"
       by (auto simp add:cofinal_fun_def) blast
     with factor_not_delta
     have "x \<in> domain(f O fun_factor)"
       using f_fun_factor_is_mono_map mono_map_is_fun domain_of_fun by force
     moreover
     have "a \<in> (f O fun_factor) `x \<or> a = (f O fun_factor) `x"
     proof -
       from \<open>x\<in>cf(\<gamma>)\<close> factor_not_delta
       have "j ` x \<le> f ` factor(x)"
         using mem_not_refl factor_body_factor factor_in_delta
         unfolding factor_body_def by auto
       with \<open>a \<in> j`x \<or> a = j`x\<close>
       have "a \<in> f ` factor(x) \<or> a = f ` factor(x)"
         using ltD by blast
       with \<open>x\<in>cf(\<gamma>)\<close>
       show ?thesis using lam_funtype[of "cf(\<gamma>)" factor]
         unfolding fun_factor_def by auto
     qed
     moreover
     note \<open>a \<in> \<gamma>\<close>
     moreover from calculation and \<open>Ord(\<gamma>)\<close> and factor_not_delta
     have "(f O fun_factor) `x \<in> \<gamma>"
       using Limit_nonzero apply_in_codomain_Ord mono_map_is_fun[of "f O fun_factor"]
         f_fun_factor_is_mono_map by blast
     ultimately
     show "\<exists>x \<in> domain(f O fun_factor). \<langle>a, (f O fun_factor) ` x\<rangle> \<in> Memrel(\<gamma>)
                                        \<or> a = (f O fun_factor) `x"
       by blast
   qed
   ultimately
   show ?thesis
     using fun_factor_is_mono_map f_fun_factor_is_mono_map by blast
 qed
 
 text\<open>As a final observation in this part, we note that if the original
 cofinal map was increasing, then the factor function is also cofinal.\<close>
 lemma factor_is_cofinal:
   assumes
     "Ord(\<delta>)" "Ord(\<gamma>)"
     "f :\<delta> \<rightarrow>\<^sub>< \<gamma>"  "f O g \<in> mono_map(\<alpha>,r,\<gamma>,Memrel(\<gamma>))"
     "cofinal_fun(f O g,\<gamma>,Memrel(\<gamma>))" "g: \<alpha> \<rightarrow> \<delta>"
   shows
     "cf_fun(g,\<delta>)"
   unfolding cf_fun_def cofinal_fun_def
 proof
   fix a
   assume "a \<in> \<delta>"
   with \<open>f \<in> mono_map(\<delta>,_,\<gamma>,_)\<close>
   have "f`a \<in> \<gamma>"
     using mono_map_is_fun by force
   with \<open>cofinal_fun(f O g,\<gamma>,_)\<close>
   obtain y where "y\<in>\<alpha>"  "\<langle>f`a, (f O g) ` y\<rangle> \<in> Memrel(\<gamma>) \<or> f`a = (f O g) ` y"
     unfolding cofinal_fun_def using domain_of_fun[OF \<open>g:\<alpha> \<rightarrow> \<delta>\<close>] by blast
   with \<open>g:\<alpha> \<rightarrow> \<delta>\<close>
   have "\<langle>f`a, f ` (g ` y)\<rangle> \<in> Memrel(\<gamma>) \<or> f`a = f ` (g ` y)" "g`y \<in> \<delta>"
     using comp_fun_apply[of g \<alpha> \<delta> y f] by auto
   with assms(1-3) and \<open>a\<in>\<delta>\<close>
   have "\<langle>a, g ` y\<rangle> \<in> Memrel(\<delta>) \<or> a = g ` y"
     using Memrel_mono_map_reflects Memrel_mono_map_is_inj[of \<delta> f \<gamma> \<gamma>]
       inj_apply_equality[of f \<delta> \<gamma>]  by blast
   with \<open>y\<in>\<alpha>\<close>
   show "\<exists>x\<in>domain(g). \<langle>a, g ` x\<rangle> \<in> Memrel(\<delta>) \<or> a = g ` x"
     using domain_of_fun[OF \<open>g:\<alpha> \<rightarrow> \<delta>\<close>] by blast
 qed
 
 
 subsection\<open>Classical results on cofinalities\<close>
 
 text\<open>Now the rest of the results follow in a more algebraic way. The
 next proof one invokes a case analysis on whether the argument is zero,
 a successor ordinal or a limit one; the last case being the most
 relevant one and is immediate from the factorization lemma.\<close>
 
 lemma cf_le_domain_cofinal_fun:
   assumes
     "Ord(\<gamma>)" "Ord(\<delta>)" "f:\<delta> \<rightarrow> \<gamma>" "cf_fun(f,\<gamma>)"
   shows
     "cf(\<gamma>)\<le>\<delta>"
   using assms
 proof (cases rule:Ord_cases)
   case 0
   with \<open>Ord(\<delta>)\<close>
   show ?thesis using Ord_0_le by simp
 next
   case (succ \<gamma>)
   with assms
   obtain x where "x\<in>\<delta>" "f`x=\<gamma>" using cf_fun_succ' by blast
   then
   have "\<delta>\<noteq>0" by blast
   let ?f="{\<langle>0,f`x\<rangle>}"
   from \<open>f`x=\<gamma>\<close>
   have "?f:1\<rightarrow>succ(\<gamma>)"
     using singleton_0 singleton_fun[of 0 \<gamma>] singleton_subsetI fun_weaken_type by simp
   with \<open>Ord(\<gamma>)\<close>  \<open>f`x=\<gamma>\<close>
   have "cf(succ(\<gamma>)) = 1" using cf_succ by simp
   with \<open>\<delta>\<noteq>0\<close> succ
   show ?thesis using Ord_0_lt_iff succ_leI \<open>Ord(\<delta>)\<close> by simp
 next
   case (limit)
   with assms
   obtain g where "g :cf(\<gamma>) \<rightarrow>\<^sub>< \<delta>"
     using cofinal_fun_factorization by blast
   with assms
   show ?thesis using mono_map_imp_le by simp
 qed
 
 lemma cf_ordertype_cofinal:
   assumes
     "Limit(\<gamma>)" "A\<subseteq>\<gamma>" "cofinal(A,\<gamma>,Memrel(\<gamma>))"
   shows
     "cf(\<gamma>) = cf(ordertype(A,Memrel(\<gamma>)))"
 proof (intro le_anti_sym)
+  text\<open>We show the result by proving the two inequalities.\<close>
   from \<open>Limit(\<gamma>)\<close>
   have "Ord(\<gamma>)"
     using Limit_is_Ord by simp
   with \<open>A \<subseteq> \<gamma>\<close>
   have "well_ord(A,Memrel(\<gamma>))"
     using well_ord_Memrel well_ord_subset by blast
   then
   obtain f \<alpha> where "f:\<langle>\<alpha>, Memrel(\<alpha>)\<rangle> \<cong> \<langle>A,Memrel(\<gamma>)\<rangle>" "Ord(\<alpha>)" "\<alpha> = ordertype(A,Memrel(\<gamma>))"
     using ordertype_ord_iso Ord_ordertype ord_iso_sym by blast
   moreover from this
   have "f: \<alpha> \<rightarrow> A"
     using ord_iso_is_mono_map mono_map_is_fun[of f _ "Memrel(\<alpha>)"] by blast
   moreover from this
   have "function(f)"
     using fun_is_function by simp
   moreover from \<open>f:\<langle>\<alpha>, Memrel(\<alpha>)\<rangle> \<cong> \<langle>A,Memrel(\<gamma>)\<rangle>\<close>
   have "range(f) = A"
     using ord_iso_is_bij bij_is_surj surj_range by blast
   moreover note \<open>cofinal(A,\<gamma>,_)\<close>
   ultimately
   have "cf_fun(f,\<gamma>)"
     using cofinal_range_iff_cofinal_fun by blast
   moreover from \<open>Ord(\<alpha>)\<close>
   obtain h where "h :cf(\<alpha>) \<rightarrow>\<^sub>< \<alpha>" "cf_fun(h,\<alpha>)"
     using cofinal_mono_map_cf by blast
   moreover from \<open>Ord(\<gamma>)\<close>
   have "trans(Memrel(\<gamma>))"
     using trans_Memrel by simp
   moreover
   note \<open>A\<subseteq>\<gamma>\<close>
   ultimately
   have "cofinal_fun(f O h,\<gamma>,Memrel(\<gamma>))"
     using cofinal_comp ord_iso_is_mono_map[OF \<open>f:\<langle>\<alpha>,_\<rangle> \<cong> \<langle>A,_\<rangle>\<close>] mono_map_is_fun
       mono_map_mono by blast
   moreover from \<open>f:\<alpha>\<rightarrow>A\<close> \<open>A\<subseteq>\<gamma>\<close> \<open>h\<in>mono_map(cf(\<alpha>),_,\<alpha>,_)\<close>
   have "f O h : cf(\<alpha>) \<rightarrow> \<gamma>"
     using Pi_mono[of A \<gamma>] comp_fun  mono_map_is_fun by blast
   moreover
   note \<open>Ord(\<gamma>)\<close> \<open>Ord(\<alpha>)\<close> \<open>\<alpha> = ordertype(A,Memrel(\<gamma>))\<close>
   ultimately
   show "cf(\<gamma>) \<le> cf(ordertype(A,Memrel(\<gamma>)))"
     using cf_le_domain_cofinal_fun[of _ _ "f O h"]
     by (auto simp add:cf_fun_def)
-      (********************************************************)
+  text\<open>That finishes the first inequality. Now we go the other side.\<close>
   from \<open>f:\<langle>\<alpha>, _\<rangle> \<cong> \<langle>A,_\<rangle>\<close> \<open>A\<subseteq>\<gamma>\<close>
   have "f :\<alpha> \<rightarrow>\<^sub>< \<gamma>"
     using mono_map_mono[OF ord_iso_is_mono_map] by simp
   then
   have "f: \<alpha> \<rightarrow> \<gamma>"
     using mono_map_is_fun by simp
   with \<open>cf_fun(f,\<gamma>)\<close> \<open>Limit(\<gamma>)\<close> \<open>Ord(\<alpha>)\<close>
   obtain g where "g :cf(\<gamma>) \<rightarrow>\<^sub>< \<alpha>"
     "f O g :cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma>"
     "cofinal_fun(f O g,\<gamma>,Memrel(\<gamma>))"
     using cofinal_fun_factorization by blast
   moreover from this
   have "g:cf(\<gamma>)\<rightarrow>\<alpha>"
     using mono_map_is_fun by simp
   moreover
   note \<open>Ord(\<alpha>)\<close>
   moreover from calculation and \<open>f :\<alpha> \<rightarrow>\<^sub>< \<gamma>\<close> \<open>Ord(\<gamma>)\<close>
   have "cf_fun(g,\<alpha>)"
     using factor_is_cofinal by blast
   moreover
   note \<open>\<alpha> = ordertype(A,Memrel(\<gamma>))\<close>
   ultimately
   show "cf(ordertype(A,Memrel(\<gamma>))) \<le> cf(\<gamma>)"
     using cf_le_domain_cofinal_fun[OF _ Ord_cf mono_map_is_fun] by simp
 qed
 
 lemma cf_idemp:
   assumes "Limit(\<gamma>)"
   shows "cf(\<gamma>) = cf(cf(\<gamma>))"
 proof -
   from assms
   obtain A where "A\<subseteq>\<gamma>" "cofinal(A,\<gamma>,Memrel(\<gamma>))" "cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     using Limit_is_Ord cf_is_ordertype by blast
   with assms
   have "cf(\<gamma>) = cf(ordertype(A,Memrel(\<gamma>)))" using cf_ordertype_cofinal by simp
   also
   have "... = cf(cf(\<gamma>))"
     using \<open>cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))\<close> by simp
   finally
   show "cf(\<gamma>) = cf(cf(\<gamma>))"  .
 qed
 
 lemma cf_le_cardinal:
   assumes "Limit(\<gamma>)"
   shows "cf(\<gamma>) \<le> |\<gamma>|"
 proof -
   from assms
   have \<open>Ord(\<gamma>)\<close> using Limit_is_Ord by simp
   then
   obtain f where "f \<in> surj(|\<gamma>|,\<gamma>)"
     using Ord_cardinal_eqpoll unfolding eqpoll_def bij_def by blast
   with \<open>Ord(\<gamma>)\<close>
   show ?thesis
     using Card_is_Ord[OF Card_cardinal] surj_is_cofinal
       cf_le_domain_cofinal_fun[of \<gamma>] surj_is_fun by blast
 qed
 
 lemma regular_is_Card:
   notes le_imp_subset [dest]
   assumes "Limit(\<gamma>)" "\<gamma> = cf(\<gamma>)"
   shows "Card(\<gamma>)"
 proof -
   from assms
   have "|\<gamma>| \<subseteq> \<gamma>"
     using Limit_is_Ord Ord_cardinal_le by blast
   also from \<open>\<gamma> = cf(\<gamma>)\<close>
   have "\<gamma> \<subseteq> cf(\<gamma>)" by simp
   finally
   have "|\<gamma>| \<subseteq> cf(\<gamma>)" .
   with assms
   show ?thesis unfolding Card_def using cf_le_cardinal by force
 qed
 
 lemma Limit_cf: assumes "Limit(\<kappa>)" shows "Limit(cf(\<kappa>))"
   using Ord_cf[of \<kappa>, THEN Ord_cases]
-    \<comment> \<open>\<^term>\<open>cf(\<kappa>)\<close> being 0 or successor leads to contradiction\<close>
+    \<comment> \<open>\<^term>\<open>cf(\<kappa>)\<close> being $0$ or successor leads to contradiction\<close>
 proof (cases)
   case 1
   with \<open>Limit(\<kappa>)\<close>
   show ?thesis using cf_zero_iff Limit_is_Ord by simp
 next
   case (2 \<alpha>)
   moreover
   note \<open>Limit(\<kappa>)\<close>
   moreover from calculation
   have "cf(\<kappa>) = 1"
     using cf_idemp cf_succ by fastforce
   ultimately
   show ?thesis
     using succ_LimitE cf_eq_one_iff Limit_is_Ord
     by auto
 qed
 
 lemma InfCard_cf: "Limit(\<kappa>) \<Longrightarrow> InfCard(cf(\<kappa>))"
   using regular_is_Card cf_idemp Limit_cf nat_le_Limit Limit_cf
   unfolding InfCard_def by simp
 
 lemma cf_le_cf_fun:
   notes [dest] = Limit_is_Ord
   assumes "cf(\<kappa>) \<le> \<nu>" "Limit(\<kappa>)"
   shows "\<exists>f.  f:\<nu> \<rightarrow> \<kappa>  \<and>  cf_fun(f, \<kappa>)"
 proof -
   note assms
   moreover from this
   obtain h where h_cofinal_mono: "cf_fun(h,\<kappa>)"
     "h :cf(\<kappa>) \<rightarrow>\<^sub>< \<kappa>"
     "h : cf(\<kappa>) \<rightarrow> \<kappa>"
     using cofinal_mono_map_cf mono_map_is_fun by force
   moreover from calculation
   obtain g where "g \<in> inj(cf(\<kappa>), \<nu>)"
     using le_imp_lepoll by blast
   from this and calculation(2,3,5)
   obtain f where "f \<in> surj(\<nu>, cf(\<kappa>))" "f: \<nu> \<rightarrow> cf(\<kappa>)"
     using inj_imp_surj[OF _ Limit_has_0[THEN ltD]]
       surj_is_fun Limit_cf by blast
   moreover from this
   have "cf_fun(f,cf(\<kappa>))"
     using surj_is_cofinal by simp
   moreover
   note h_cofinal_mono \<open>Limit(\<kappa>)\<close>
   moreover from calculation
   have "cf_fun(h O f,\<kappa>)"
     using cf_fun_comp by blast
   moreover from calculation
   have "h O f \<in> \<nu> -> \<kappa>"
     using comp_fun by simp
   ultimately
   show ?thesis by blast
 qed
 
 lemma Limit_cofinal_fun_lt:
   notes [dest] = Limit_is_Ord
   assumes "Limit(\<kappa>)" "f: \<nu> \<rightarrow> \<kappa>" "cf_fun(f,\<kappa>)" "n\<in>\<kappa>"
   shows "\<exists>\<alpha>\<in>\<nu>. n < f`\<alpha>"
 proof -
   from \<open>Limit(\<kappa>)\<close> \<open>n\<in>\<kappa>\<close>
   have "succ(n) \<in> \<kappa>"
     using Limit_has_succ[OF _ ltI, THEN ltD] by auto
   moreover
   note \<open>f: \<nu> \<rightarrow> _\<close>
   moreover from this
   have "domain(f) = \<nu>"
     using domain_of_fun by simp
   moreover
   note \<open>cf_fun(f,\<kappa>)\<close>
   ultimately
   obtain \<alpha> where "\<alpha> \<in> \<nu>" "succ(n) \<in> f`\<alpha> \<or> succ(n) = f `\<alpha>"
     using cf_funD[THEN cofinal_funD] by blast
   moreover from this
   consider (1) "succ(n) \<in> f`\<alpha>" | (2) "succ(n) = f `\<alpha>"
     by blast
   then
   have "n < f`\<alpha>"
   proof (cases)
     case 1
     moreover
     have "n \<in> succ(n)" by simp
     moreover
     note \<open>Limit(\<kappa>)\<close> \<open>f: \<nu> \<rightarrow> _\<close> \<open>\<alpha> \<in> \<nu>\<close>
     moreover from this
     have "Ord(f ` \<alpha>)"
       using apply_type[of f \<nu> "\<lambda>_. \<kappa>", THEN [2] Ord_in_Ord]
       by blast
     ultimately
     show ?thesis
       using Ord_trans[of n "succ(n)" "f ` \<alpha>"] ltI  by blast
   next
     case 2
     have "n \<in> f ` \<alpha>" by (simp add:2[symmetric])
     with \<open>Limit(\<kappa>)\<close> \<open>f: \<nu> \<rightarrow> _\<close> \<open>\<alpha> \<in> \<nu>\<close>
     show ?thesis
       using ltI
         apply_type[of f \<nu> "\<lambda>_. \<kappa>", THEN [2] Ord_in_Ord]
       by blast
   qed
   ultimately
   show ?thesis by blast
 qed
 
 context
   includes Ord_dests Aleph_dests Aleph_intros Aleph_mem_dests mono_map_rules
 begin
 
 text\<open>We end this section by calculating the cofinality of Alephs, for
 the zero and limit case. The successor case depends on $\AC$.\<close>
 
 lemma cf_nat: "cf(\<omega>) = \<omega>"
   using Limit_nat[THEN InfCard_cf] cf_le_cardinal[of \<omega>]
     Card_nat[THEN Card_cardinal_eq] le_anti_sym
   unfolding InfCard_def by auto
 
 lemma cf_Aleph_zero: "cf(\<aleph>\<^bsub>0\<^esub>) = \<aleph>\<^bsub>0\<^esub>" 
   using cf_nat unfolding Aleph_def by simp
 
 lemma cf_Aleph_Limit:
   assumes "Limit(\<gamma>)"
   shows "cf(\<aleph>\<^bsub>\<gamma>\<^esub>) = cf(\<gamma>)" 
 proof -
   note \<open>Limit(\<gamma>)\<close>
   moreover from this
   have "(\<lambda>x\<in>\<gamma>. \<aleph>\<^bsub>x\<^esub>) : \<gamma> \<rightarrow> \<aleph>\<^bsub>\<gamma>\<^esub>" (is "?f : _ \<rightarrow> _")
     using lam_funtype[of _ Aleph] fun_weaken_type[of _ _ _ "\<aleph>\<^bsub>\<gamma>\<^esub>"] by blast
   moreover from \<open>Limit(\<gamma>)\<close>
   have "x \<in> y \<Longrightarrow> \<aleph>\<^bsub>x\<^esub> \<in> \<aleph>\<^bsub>y\<^esub>" if "x \<in> \<gamma>" "y \<in> \<gamma>" for x y
     using that Ord_in_Ord[of \<gamma>] Ord_trans[of _ _ \<gamma>] by blast
   ultimately
   have "?f \<in> mono_map(\<gamma>,Memrel(\<gamma>),\<aleph>\<^bsub>\<gamma>\<^esub>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>))"
     by auto
   with  \<open>Limit(\<gamma>)\<close> 
   have "?f \<in> \<langle>\<gamma>, Memrel(\<gamma>)\<rangle> \<cong> \<langle>?f``\<gamma>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)\<rangle>"
     using mono_map_imp_ord_iso_Memrel[of \<gamma> "\<aleph>\<^bsub>\<gamma>\<^esub>" ?f] 
       Card_Aleph (* Already an intro rule, but need it explicitly *)
     by blast
   then
   have "converse(?f) \<in> \<langle>?f``\<gamma>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)\<rangle> \<cong> \<langle>\<gamma>, Memrel(\<gamma>)\<rangle>"
     using ord_iso_sym by simp
   with \<open>Limit(\<gamma>)\<close>
   have "ordertype(?f``\<gamma>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)) = \<gamma>"
     using ordertype_eq[OF _ well_ord_Memrel]
     ordertype_Memrel by auto
   moreover from \<open>Limit(\<gamma>)\<close>
   have "cofinal(?f``\<gamma>, \<aleph>\<^bsub>\<gamma>\<^esub>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>))" 
     unfolding cofinal_def 
   proof (standard, intro ballI)
     fix a
     assume "a\<in>\<aleph>\<^bsub>\<gamma>\<^esub>" "\<aleph>\<^bsub>\<gamma>\<^esub> = (\<Union>i<\<gamma>. \<aleph>\<^bsub>i\<^esub>)"
     moreover from this
     obtain i where "i<\<gamma>" "a\<in>\<aleph>\<^bsub>i\<^esub>"
       by auto
     moreover from this and \<open>Limit(\<gamma>)\<close>
     have "Ord(i)" using ltD Ord_in_Ord by blast
     moreover from \<open>Limit(\<gamma>)\<close> and calculation
     have "succ(i) \<in> \<gamma>" using ltD by auto
     moreover from this and \<open>Ord(i)\<close>
     have "\<aleph>\<^bsub>i\<^esub> < \<aleph>\<^bsub>succ(i)\<^esub>" 
       by (auto) 
     ultimately
     have "\<langle>a,\<aleph>\<^bsub>i\<^esub>\<rangle> \<in> Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)"
       using ltD by (auto dest:Aleph_increasing)
     moreover from \<open>i<\<gamma>\<close>
     have "\<aleph>\<^bsub>i\<^esub> \<in> ?f``\<gamma>" 
       using ltD apply_in_image[OF \<open>?f : _ \<rightarrow> _\<close>] by auto
     ultimately
     show "\<exists>x\<in>?f `` \<gamma>. \<langle>a, x\<rangle> \<in> Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>) \<or> a = x" by blast
   qed
   moreover
   note \<open>?f: \<gamma> \<rightarrow> \<aleph>\<^bsub>\<gamma>\<^esub>\<close> \<open>Limit(\<gamma>)\<close>
   ultimately
   show "cf(\<aleph>\<^bsub>\<gamma>\<^esub>) =  cf(\<gamma>)"
     using cf_ordertype_cofinal[OF Limit_Aleph Image_sub_codomain, of \<gamma> ?f \<gamma> \<gamma> ] 
       Limit_is_Ord by simp 
 qed
 
-end (* includes *)
+end \<comment> \<open>includes\<close>
 
 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,1079 +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>
+  \<comment> \<open>almost the same proof as @{thm [source] 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>
+\<comment> \<open>Same proof as Paulson's @{thm [source] 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/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,488 +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
     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>
+    @{thm [source] 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_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(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_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
   with assms
   show ?thesis
     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(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,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 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' 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/Demonstrations.thy b/thys/Independence_CH/Demonstrations.thy
--- a/thys/Independence_CH/Demonstrations.thy
+++ b/thys/Independence_CH/Demonstrations.thy
@@ -1,168 +1,168 @@
 section\<open>Some demonstrations\<close>
 
 theory Demonstrations
   imports
     Definitions_Main
 begin
 
 text\<open>The following theory is only intended to explore some details of the
 formalization and to show the appearance of relevant internalized formulas.
 It is \<^bold>\<open>not\<close> intended as the entry point of the session. For that purpose,
 consult \<^theory>\<open>Independence_CH.Definitions_Main\<close>\<close>
 
 locale Demo = M_trivial + M_AC +
   fixes t\<^sub>1 t\<^sub>2
   assumes
     ts_in_nat[simp]: "t\<^sub>1\<in>\<omega>" "t\<^sub>2\<in>\<omega>"
     and
     power_infty: "power_ax(M)" "M(\<omega>)"
 begin
 
 text\<open>The next fake lemma is intended to explore the instances of the axiom
 schemes that are needed to build our forcing models. They are categorized as
 plain replacements (using \<^term>\<open>strong_replacement\<close>), “lambda-replacements”
 using a higher order function, replacements  to perform
 transfinite and general well-founded recursion (using \<^term>\<open>transrec_replacement\<close> and
 \<^term>\<open>wfrec_replacement\<close> respectively) and for the construction of fixpoints
 (using \<^term>\<open>iterates_replacement\<close>). Lastly, separations instances.\<close>
 
 lemma
   assumes
     sorried_replacements:
     "\<And>P. strong_replacement(M,P)"
     "\<And>F. lam_replacement(M,F)"
     "\<And>Q S. iterates_replacement(M,Q,S)"
     "\<And>Q S. wfrec_replacement(M,Q,S)"
     "\<And>Q S. transrec_replacement(M,Q,S)"
     and
     sorried_separations: "\<And>Q. separation(M,Q)"
   shows
     "M_master(M)"
   apply unfold_locales
                       apply
     (simp_all add:
       sorried_replacements(1-2)
       sorried_separations
       power_infty)
   oops
 
 \<comment> \<open>NOTE: Only for pretty-printing purposes, overrides previous
   fundamental notations\<close>
 no_notation mem (infixl \<open>\<in>\<close> 50)
 no_notation conj  (infixr \<open>\<and>\<close> 35)
 no_notation disj (infixr \<open>\<or>\<close> 30)
 no_notation iff (infixr \<open>\<longleftrightarrow>\<close> 25)
 no_notation imp (infixr \<open>\<longrightarrow>\<close> 25)
 no_notation not (\<open>\<not> _\<close> [40] 40)
 no_notation All (\<open>'(\<forall>_')\<close>)
 no_notation Ex (\<open>'(\<exists>_')\<close>)
 
 no_notation Member (\<open>\<cdot>_ \<in>/ _\<cdot>\<close>)
 no_notation Equal (\<open>\<cdot>_ =/ _\<cdot>\<close>)
 no_notation Nand (\<open>\<cdot>\<not>'(_ \<and>/ _')\<cdot>\<close>)
 no_notation And (\<open>\<cdot>_ \<and>/ _\<cdot>\<close>)
 no_notation Or (\<open>\<cdot>_ \<or>/ _\<cdot>\<close>)
 no_notation Iff (\<open>\<cdot>_ \<leftrightarrow>/ _\<cdot>\<close>)
 no_notation Implies (\<open>\<cdot>_ \<rightarrow>/ _\<cdot>\<close>)
 no_notation Neg (\<open>\<cdot>\<not>_\<cdot>\<close>)
 no_notation Forall (\<open>'(\<cdot>\<forall>(/_)\<cdot>')\<close>)
 no_notation Exists (\<open>'(\<cdot>\<exists>(/_)\<cdot>')\<close>)
 
 notation Member (infixl \<open>\<in>\<close> 50)
 notation Equal (infixl \<open>\<equiv>\<close> 50)
 notation Nand (\<open>\<not>'(_ \<and>/ _')\<close>)
 notation And  (infixr \<open>\<and>\<close> 35)
 notation Or (infixr \<open>\<or>\<close> 30)
 notation Iff (infixr \<open>\<longleftrightarrow>\<close> 25)
 notation Implies (infixr \<open>\<longrightarrow>\<close> 25)
 notation Neg (\<open>\<not> _\<close> [40] 40)
 notation Forall (\<open>'(\<forall>_')\<close>)
 notation Exists (\<open>'(\<exists>_')\<close>)
 
 lemma "forces(t\<^sub>1\<in>t\<^sub>2) = (0 \<in> 1 \<and> forces_mem_fm(1, 2, 0, t\<^sub>1+\<^sub>\<omega>4, t\<^sub>2+\<^sub>\<omega>4))"
   unfolding forces_def by simp
 
 (*
 \<comment> \<open>Prefix abbreviated notation\<close>
 notation Member (\<open>M\<close>)
 notation Equal (\<open>Eq\<close>)
 notation Nand (\<open>Na\<close>)
 notation And  (\<open>A\<close>)
 notation Or (\<open>O\<close>)
 notation Iff (\<open>If\<close>)
 notation Implies (\<open>Im\<close>)
 notation Neg (\<open>Ne\<close>)
 notation Forall (\<open>Fo\<close>)
 notation Exists (\<open>Ex\<close>)
 *)
 
 (* forces_mem_fm(1, 2, 0, t\<^sub>1+\<^sub>\<omega>4, t\<^sub>1+\<^sub>\<omega>4)
    = forces_mem_fm(1, 2, 0, succ(succ(succ(succ(t\<^sub>1)))), succ(succ(succ(succ(t\<^sub>2)))))
    = \<dots> *)
 
 definition forces_0_mem_1 where "forces_0_mem_1\<equiv>forces_mem_fm(1,2,0,t\<^sub>1+\<^sub>\<omega>4,t\<^sub>2+\<^sub>\<omega>4)"
 thm forces_0_mem_1_def[
     unfolded frc_at_fm_def ftype_fm_def
     name1_fm_def name2_fm_def snd_snd_fm_def hcomp_fm_def
     ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def
     is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
     is_If_fm_def least_fm_def Replace_fm_def Collect_fm_def
     fm_definitions,simplified]
-  (* NOTE: in view of the above, @{thm fm_definitions} might be incomplete *)
+  (* NOTE: in view of the above, @{thm [source] fm_definitions} might be incomplete *)
 
 named_theorems incr_bv_new_simps
 
 schematic_goal incr_bv_Neg(* [incr_bv_new_simps] *):
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow> incr_bv(Neg(\<phi>))`n = ?x"
   unfolding Neg_def by simp
 
 schematic_goal incr_bv_Exists [incr_bv_new_simps]:
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow> incr_bv(Exists(\<phi>))`n = ?x"
   unfolding Exists_def by (simp add: incr_bv_Neg)
 (*
 schematic_goal incr_bv_And [incr_bv_new_simps]:
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(And(\<phi>,\<psi>))`n = ?x"
   unfolding And_def by (simp add: incr_bv_Neg)
 
 schematic_goal incr_bv_Or [incr_bv_new_simps]:
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(Or(\<phi>,\<psi>))`n = ?x"
   unfolding Or_def by (simp add: incr_bv_Neg)
 
 schematic_goal incr_bv_Implies [incr_bv_new_simps]:
   "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(Implies(\<phi>,\<psi>))`n = ?x"
   unfolding Implies_def by (simp add: incr_bv_Neg)
 *)
 
 \<comment> \<open>The two renamings involved in the definition of \<^term>\<open>forces\<close> depend on
 the recursive function \<^term>\<open>incr_bv\<close>. Here we have an apparently
 exponential bottleneck, since all the propositional connectives (even \<^term>\<open>Neg\<close>)
 duplicate the appearances of \<^term>\<open>incr_bv\<close>.
 
 Not even the double negation of an atomic formula can be managed by the
 system (in version 2021-1).\<close>
 (* 
 
 schematic_goal "forces(\<not>\<not>0\<in>1) = ?x"
   unfolding forces_def Neg_def
    by (simp add:ren_forces_nand_def ren_forces_forall_def 
       frc_at_fm_def ftype_fm_def
       name1_fm_def name2_fm_def snd_snd_fm_def hcomp_fm_def
       ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def
       is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
       is_If_fm_def least_fm_def Collect_fm_def
       fm_definitions incr_bv_Neg incr_bv_Exists)
 (* exception Size raised (line 183 of "./basis/LibrarySupport.sml") *)
 
 *)
 
 (*
 declare is_ContHyp_fm_def[fm_definitions del]
 
 thm is_ContHyp_fm_def[unfolded is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
    is_If_fm_def least_fm_def Replace_fm_def Collect_fm_def
    fm_definitions, simplified] *)
 
 end \<comment> \<open>\<^locale>\<open>Demo\<close>\<close>
 
 
 end
\ No newline at end of file
diff --git a/thys/Independence_CH/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,1011 +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
+\<comment> \<open>same as @{thm [source] 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"
 
 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(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"
 
 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_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
\ No newline at end of file
diff --git a/thys/Transitive_Models/Aleph_Relative.thy b/thys/Transitive_Models/Aleph_Relative.thy
--- a/thys/Transitive_Models/Aleph_Relative.thy
+++ b/thys/Transitive_Models/Aleph_Relative.thy
@@ -1,464 +1,464 @@
 theory Aleph_Relative
   imports
     CardinalArith_Relative
 begin
 
 definition
   HAleph :: "[i,i] \<Rightarrow> i" where
   "HAleph(i,r) \<equiv> if(\<not>(Ord(i)),i,if(i=0, nat, if(\<not>Limit(i) \<and> i\<noteq>0,
                             csucc(r`( \<Union> i )),
                                    \<Union>j\<in>i. r`j)))"
 
 reldb_add functional "Limit" "Limit"
 relationalize "Limit" "is_Limit" external
 synthesize "is_Limit" from_definition
 arity_theorem for "is_Limit_fm"
 
 relativize functional "HAleph" "HAleph_rel"
 relationalize "HAleph_rel" "is_HAleph"
 
 synthesize "is_HAleph" from_definition assuming "nonempty"
 arity_theorem intermediate for "is_HAleph_fm"
 
 lemma arity_is_HAleph_fm_aux:
   assumes
     "i \<in> nat" "r \<in> nat"
     \<comment> \<open>NOTE: assumptions are \<^bold>\<open>not\<close> used, but if omitted, next lemma fails!\<close>
   shows
     "arity(Replace_fm(8 +\<^sub>\<omega> i, \<cdot>10 +\<^sub>\<omega> r`0 is 1\<cdot>, 3)) = 9 +\<^sub>\<omega> i \<union> pred(pred(11 +\<^sub>\<omega> r))"
   using arity_Replace_fm[of "\<cdot> (10+\<^sub>\<omega>r)`0 is 1\<cdot>" "8+\<^sub>\<omega>i" 3 "(11+\<^sub>\<omega>r) \<union> 1 \<union> 2"]
     ord_simp_union
   by (auto simp:arity)
 
 lemma arity_is_HAleph_fm[arity]:
   assumes
     "i \<in> nat" "r \<in> nat" "l \<in> nat"
   shows
     "arity(is_HAleph_fm(i, r, l)) =  succ(i) \<union> succ(l) \<union> succ(r)"
   using assms pred_Un arity_is_HAleph_fm_aux arity_is_HAleph_fm'
   by auto
 
 definition
   Aleph' :: "i => i"  where
   "Aleph'(a) == transrec(a,\<lambda>i r. HAleph(i,r))"
 
 relativize functional "Aleph'" "Aleph_rel"
 relationalize "Aleph_rel" "is_Aleph"
 
 txt\<open>The extra assumptions \<^term>\<open>a < length(env)\<close> and \<^term>\<open>c < length(env)\<close>
     in this schematic goal (and the following results on synthesis that
-    depend on it) are imposed by @{thm is_transrec_iff_sats}.\<close>
+    depend on it) are imposed by @{thm [source] is_transrec_iff_sats}.\<close>
 schematic_goal sats_is_Aleph_fm_auto:
   "a \<in> nat \<Longrightarrow> c \<in> nat \<Longrightarrow> env \<in> list(A) \<Longrightarrow>
   a < length(env) \<Longrightarrow> c < length(env) \<Longrightarrow> 0 \<in> A \<Longrightarrow>
   is_Aleph(##A, nth(a, env), nth(c, env)) \<longleftrightarrow> A, env \<Turnstile> ?fm(a, c)"
   unfolding is_Aleph_def
 proof (rule is_transrec_iff_sats, rule_tac [1] is_HAleph_iff_sats)
   fix a0 a1 a2 a3 a4 a5 a6 a7
   let ?env' = "Cons(a0, Cons(a1, Cons(a2, Cons(a3, Cons(a4, Cons(a5, Cons(a6, Cons(a7, env))))))))"
   show "nth(2, ?env') = a2"
     "nth(1, ?env') = a1"
     "nth(0, ?env') = a0"
     "nth(c, env) = nth(c, env)"
     by simp_all
 qed simp_all
 
 synthesize_notc "is_Aleph" from_schematic
 
 notation is_Aleph_fm (\<open>\<cdot>\<aleph>'(_') is _\<cdot>\<close>)
 
 lemma is_Aleph_fm_type [TC]: "a \<in> nat \<Longrightarrow> c \<in> nat \<Longrightarrow> is_Aleph_fm(a, c) \<in> formula"
   unfolding is_Aleph_fm_def by simp
 
 lemma sats_is_Aleph_fm:
   assumes "f\<in>nat" "r\<in>nat" "env \<in> list(A)" "0\<in>A" "f < length(env)" "r< length(env)"
   shows "is_Aleph(##A, nth(f, env), nth(r, env)) \<longleftrightarrow> A, env \<Turnstile> is_Aleph_fm(f,r)"
   using assms sats_is_Aleph_fm_auto unfolding is_Aleph_def is_Aleph_fm_def by simp
 
 lemma is_Aleph_iff_sats [iff_sats]:
   assumes
     "nth(f, env) = fa" "nth(r, env) = ra" "f < length(env)" "r< length(env)"
     "f \<in> nat" "r \<in> nat" "env \<in> list(A)" "0\<in>A"
   shows "is_Aleph(##A,fa,ra) \<longleftrightarrow> A, env \<Turnstile> is_Aleph_fm(f,r)"
   using assms sats_is_Aleph_fm[of f r env A] by simp
 
 arity_theorem for "is_Aleph_fm"
 
 lemma (in M_cardinal_arith_jump) is_Limit_iff:
   assumes "M(a)"
   shows "is_Limit(M,a) \<longleftrightarrow> Limit(a)"
   unfolding is_Limit_def Limit_def using lt_abs transM[OF ltD \<open>M(a)\<close>] assms
   by auto
 
 lemma HAleph_eq_Aleph_recursive:
   "Ord(i) \<Longrightarrow> HAleph(i,r) = (if i = 0 then nat
                 else if \<exists>j. i = succ(j) then csucc(r ` (THE j. i = succ(j))) else \<Union>j<i. r ` j)"
 proof -
   assume "Ord(i)"
   moreover from this
   have "i = succ(j) \<Longrightarrow> (\<Union>succ(j)) = j" for j
     using Ord_Union_succ_eq by simp
   moreover from \<open>Ord(i)\<close>
   have "(\<exists>j. i = succ(j)) \<longleftrightarrow> \<not>Limit(i) \<and> i \<noteq> 0"
     using Ord_cases_disj by auto
   ultimately
   show ?thesis
     unfolding HAleph_def OUnion_def
     by auto
 qed
 
 lemma Aleph'_eq_Aleph: "Ord(a) \<Longrightarrow> Aleph'(a) = Aleph(a)"
   unfolding Aleph'_def Aleph_def transrec2_def
   using HAleph_eq_Aleph_recursive
   by (intro transrec_equal_on_Ord) auto
 
 reldb_rem functional "Aleph'"
 reldb_rem relational "is_Aleph"
 reldb_add functional "Aleph" "Aleph_rel"
 reldb_add relational "Aleph" "is_Aleph"
 
 abbreviation
   Aleph_r :: "[i,i\<Rightarrow>o] \<Rightarrow> i" (\<open>\<aleph>\<^bsub>_\<^esub>\<^bsup>_\<^esup>\<close>) where
   "Aleph_r(a,M) \<equiv> Aleph_rel(M,a)"
 
 abbreviation
   Aleph_r_set :: "[i,i] \<Rightarrow> i" (\<open>\<aleph>\<^bsub>_\<^esub>\<^bsup>_\<^esup>\<close>) where
   "Aleph_r_set(a,M) \<equiv> Aleph_rel(##M,a)"
 
 lemma Aleph_rel_def': "Aleph_rel(M,a) \<equiv> transrec(a, \<lambda>i r. HAleph_rel(M, i, r))"
   unfolding Aleph_rel_def .
 
 lemma succ_mem_Limit: "Limit(j) \<Longrightarrow> i \<in> j \<Longrightarrow> succ(i) \<in> j"
   using Limit_has_succ[THEN ltD] ltI Limit_is_Ord by auto
 
 locale M_pre_aleph = M_eclose + M_cardinal_arith_jump +
   assumes
     haleph_transrec_replacement: "M(a) \<Longrightarrow> transrec_replacement(M,is_HAleph(M),a)"
 
 begin
 
 lemma aux_ex_Replace_funapply:
   assumes "M(a)" "M(f)"
   shows "\<exists>x[M]. is_Replace(M, a, \<lambda>j y. f ` j = y, x)"
 proof -
   have "{f`j . j\<in>a} = {y . j\<in>a , f ` j=y}"
     "{y . j\<in>a , f ` j=y} = {y . j\<in>a , y =f ` j}"
     by auto
   moreover
   note assms
   moreover from calculation
   have "x \<in> a \<Longrightarrow> y = f `x \<Longrightarrow> M(y)" for x y
     using transM[OF _ \<open>M(a)\<close>] by auto
   moreover from assms
   have "M({f`j . j\<in>a})"
     using transM[OF _ \<open>M(a)\<close>] RepFun_closed[OF apply_replacement] by simp
   ultimately
   have 2:"is_Replace(M, a, \<lambda>j y. y = f ` j, {f`j . j\<in>a})"
     using Replace_abs[of _ _ "\<lambda>j y. y = f ` j",OF \<open>M(a)\<close>,THEN iffD2]
     by auto
   with \<open>M({f`j . j\<in>a})\<close>
   show ?thesis
     using
       is_Replace_cong[of _ _ M "\<lambda>j y. y = f ` j" "\<lambda>j y. f ` j = y", THEN iffD1,OF _ _ _ 2]
     by auto
 qed
 
 lemma is_HAleph_zero:
   assumes "M(f)"
   shows "is_HAleph(M,0,f,res) \<longleftrightarrow> res = nat"
   unfolding is_HAleph_def
   using Ord_0 If_abs is_Limit_iff is_csucc_iff assms aux_ex_Replace_funapply
   by auto
 
 lemma is_HAleph_succ:
   assumes "M(f)" "M(x)" "Ord(x)" "M(res)"
   shows "is_HAleph(M,succ(x),f,res) \<longleftrightarrow> res = csucc_rel(M,f`x)"
   unfolding is_HAleph_def
   using assms is_Limit_iff is_csucc_iff aux_ex_Replace_funapply If_abs Ord_Union_succ_eq
   by simp
 
 lemma is_HAleph_limit:
   assumes "M(f)" "M(x)" "Limit(x)" "M(res)"
   shows "is_HAleph(M,x,f,res) \<longleftrightarrow> res = (\<Union>{y . i\<in>x ,M(i) \<and> M(y) \<and> y = f`i})"
 proof -
   from assms
   have "univalent(M, x, \<lambda>j y. y = f ` j  )"
     "(\<And>xa y. xa \<in> x \<Longrightarrow> f ` xa = y \<Longrightarrow> M(y))"
     "{y . x \<in> x, f ` x = y} = {y . i\<in>x ,M(i) \<and> M(y) \<and> y = f`i}"
     using univalent_triv[of M x "\<lambda>j .f ` j"] transM[OF _ \<open>M(x)\<close>]
     by auto
   moreover
   from this
   have "univalent(M, x, \<lambda>j y. f ` j = y )"
     by (rule_tac univalent_cong[of x x M " \<lambda>j y. y = f ` j" " \<lambda>j y. f ` j=y",THEN iffD1], auto)
   moreover
   from this
   have "univalent(M, x, \<lambda>j y. M(j) \<and> M(y) \<and> f ` j = y )"
     by auto
   ultimately
   show ?thesis
     unfolding is_HAleph_def
     using assms is_Limit_iff Limit_is_Ord zero_not_Limit If_abs is_csucc_iff
       Replace_abs apply_replacement
     by auto
 qed
 
 lemma is_HAleph_iff:
   assumes "M(a)" "M(f)" "M(res)"
   shows "is_HAleph(M, a, f, res) \<longleftrightarrow> res = HAleph_rel(M, a, f)"
 proof(cases "Ord(a)")
   case True
   note Ord_cases[OF \<open>Ord(a)\<close>]
   then
   show ?thesis
   proof(cases )
     case 1
     with True assms
     show ?thesis
       using is_HAleph_zero unfolding HAleph_rel_def
       by simp
   next
     case (2 j)
     with True assms
     show ?thesis
       using is_HAleph_succ Ord_Union_succ_eq
       unfolding HAleph_rel_def
       by simp
   next
     case 3
     with assms
     show ?thesis
       using is_HAleph_limit zero_not_Limit Limit_is_Ord
       unfolding HAleph_rel_def
       by auto
   qed
 next
   case False
   then
   have "\<not>Limit(a)" "a\<noteq>0" "\<And> x . Ord(x) \<Longrightarrow> a\<noteq>succ(x)"
     using Limit_is_Ord by auto
   with False
   show ?thesis
     unfolding is_HAleph_def HAleph_rel_def
     using assms is_Limit_iff If_abs is_csucc_iff aux_ex_Replace_funapply
     by auto
 qed
 
 lemma HAleph_rel_closed [intro,simp]:
   assumes "function(f)" "M(a)" "M(f)"
   shows "M(HAleph_rel(M,a,f))"
   unfolding HAleph_rel_def
   using assms apply_replacement
   by simp
 
 lemma Aleph_rel_closed[intro, simp]:
   assumes "Ord(a)" "M(a)"
   shows "M(Aleph_rel(M,a))"
 proof -
   have "relation2(M, is_HAleph(M), HAleph_rel(M))"
     unfolding relation2_def using is_HAleph_iff assms by simp
   moreover
   have "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(HAleph_rel(M, x, g))"
     using HAleph_rel_closed by simp
   moreover
   note assms
   ultimately
   show ?thesis
     unfolding Aleph_rel_def
     using transrec_closed[of "is_HAleph(M)" a "HAleph_rel(M)"]
       haleph_transrec_replacement  by simp
 qed
 
 lemma Aleph_rel_zero: "\<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup> = nat"
   using def_transrec [OF Aleph_rel_def',of _ 0]
   unfolding HAleph_rel_def by simp
 
 lemma Aleph_rel_succ: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>succ(\<alpha>)\<^esub>\<^bsup>M\<^esup> = (\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
   using Ord_Union_succ_eq
   by (subst def_transrec [OF Aleph_rel_def'])
     (simp add:HAleph_rel_def)
 
 lemma Aleph_rel_limit:
   assumes "Limit(\<alpha>)" "M(\<alpha>)"
   shows "\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> = \<Union>{\<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup> . j \<in> \<alpha>}"
 proof -
   note trans=transM[OF _ \<open>M(\<alpha>)\<close>]
   from \<open>M(\<alpha>)\<close>
   have "\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> = HAleph_rel(M, \<alpha>, \<lambda>x\<in>\<alpha>. \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)"
     using def_transrec [OF Aleph_rel_def',of M \<alpha>] by simp
   also
   have "... = \<Union>{a . j \<in> \<alpha>, M(a) \<and> a = \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>}"
     unfolding HAleph_rel_def
     using assms zero_not_Limit Limit_is_Ord trans by auto
   also
   have "... = \<Union>{\<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup> . j \<in> \<alpha>}"
     using Aleph_rel_closed[OF _ trans] Ord_in_Ord Limit_is_Ord[OF \<open>Limit(\<alpha>)\<close>] by auto
   finally
   show ?thesis .
 qed
 
 lemma is_Aleph_iff:
   assumes "Ord(a)" "M(a)" "M(res)"
   shows "is_Aleph(M, a, res) \<longleftrightarrow> res = \<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>"
 proof -
   have "relation2(M, is_HAleph(M), HAleph_rel(M))"
     unfolding relation2_def using is_HAleph_iff assms by simp
   moreover
   have "\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(HAleph_rel(M, x, g))"
     using HAleph_rel_closed by simp
   ultimately
   show ?thesis
     using assms transrec_abs haleph_transrec_replacement
     unfolding is_Aleph_def Aleph_rel_def
     by simp
 qed
 
 end \<comment> \<open>\<^locale>\<open>M_pre_aleph\<close>\<close>
 
 locale M_aleph = M_pre_aleph +
   assumes
     aleph_rel_separation: "Ord(x) \<Longrightarrow> M(x) \<Longrightarrow> separation(M, \<lambda>y. \<exists>z\<in>x. y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>)"
 begin
 
 lemma Aleph_rel_cont: "Limit(l) \<Longrightarrow> M(l) \<Longrightarrow> \<aleph>\<^bsub>l\<^esub>\<^bsup>M\<^esup> = (\<Union>i<l. \<aleph>\<^bsub>i\<^esub>\<^bsup>M\<^esup>)"
   using Limit_is_Ord Aleph_rel_limit
   by (simp add:OUnion_def)
 
 lemma Ord_Aleph_rel:
   assumes "Ord(a)"
   shows "M(a) \<Longrightarrow> Ord(\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>)"
   using \<open>Ord(a)\<close>
 proof(induct a rule:trans_induct3)
   case 0
   show ?case using Aleph_rel_zero by simp
 next
   case (succ x)
   with \<open>Ord(x)\<close>
   have "M(x)" "Ord(\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)" by simp_all
   with \<open>Ord(x)\<close>
   have "Ord(csucc_rel(M,\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>))"
     using Card_rel_is_Ord Card_rel_csucc_rel
     by simp
   with \<open>Ord(x)\<close> \<open>M(x)\<close>
   show ?case using Aleph_rel_succ by simp
 next
   case (limit x)
   note trans=transM[OF _ \<open>M(x)\<close>]
   from limit
   have "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> = (\<Union>i\<in>x. \<aleph>\<^bsub>i\<^esub>\<^bsup>M\<^esup>)"
     using Aleph_rel_cont OUnion_def Limit_is_Ord
     by auto
   with limit
   show ?case using Ord_UN trans by auto
 qed
 
 lemma Aleph_rel_increasing:
   assumes "a < b" and types: "M(a)" "M(b)"
   shows "\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"
 proof -
   { fix x
     from assms
     have "Ord(b)"
       by (blast intro: lt_Ord2)
     moreover
     assume "M(x)"
     moreover
     note \<open>M(b)\<close>
     ultimately
     have "x < b \<Longrightarrow> \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>"
     proof (induct b arbitrary: x rule: trans_induct3)
       case 0 thus ?case by simp
     next
       case (succ b)
       then
       show ?case
         using Card_rel_csucc_rel Ord_Aleph_rel Ord_Union_succ_eq lt_csucc_rel
           lt_trans[of _ "\<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>" "csucc\<^bsup>M\<^esup>(\<aleph>\<^bsub>b\<^esub>\<^bsup>M\<^esup>)"]
         by (subst (2) def_transrec[OF Aleph_rel_def'])
           (auto simp add: le_iff HAleph_rel_def)
     next
       case (limit l)
       then
       have sc: "succ(x) < l"
         by (blast intro: Limit_has_succ)
       then
       have "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> < (\<Union>j<l. \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>)"
         using limit Ord_Aleph_rel Ord_OUN
       proof(rule_tac OUN_upper_lt,blast intro: Card_rel_is_Ord ltD lt_Ord)
         from \<open>x<l\<close> \<open>Limit(l)\<close>
         have "Ord(x)"
           using Limit_is_Ord Ord_in_Ord
           by (auto dest!:ltD)
         with \<open>M(x)\<close>
         show "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>succ(x)\<^esub>\<^bsup>M\<^esup>"
           using Card_rel_csucc_rel Ord_Aleph_rel lt_csucc_rel
             ltD[THEN [2] Ord_in_Ord] succ_in_MI[OF \<open>M(x)\<close>]
             Aleph_rel_succ[of x]
           by (simp)
       next
         from \<open>M(l)\<close> \<open>Limit(l)\<close>
         show "Ord(\<Union>j<l. \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>)"
           using Ord_Aleph_rel lt_Ord Limit_is_Ord Ord_in_Ord
           by (rule_tac Ord_OUN)
             (auto dest:transM ltD intro!:Ord_Aleph_rel)
       qed
       then
       show ?case using limit Aleph_rel_cont by simp
     qed
   }
   with types assms
   show ?thesis by simp
 qed
 
 lemma Card_rel_Aleph_rel [simp, intro]:
   assumes "Ord(a)" and types: "M(a)" shows "Card\<^bsup>M\<^esup>(\<aleph>\<^bsub>a\<^esub>\<^bsup>M\<^esup>)"
   using assms
 proof (induct rule:trans_induct3)
   case 0
   then
   show ?case
     using Aleph_rel_zero Card_rel_nat by simp
 next
   case (succ x)
   then
   show ?case
     using Card_rel_csucc_rel Ord_Aleph_rel Aleph_rel_succ
     by simp
 next
   case (limit x)
   moreover from this
   have "Ord(x)"
     using Limit_is_Ord by simp
   from this
   have "{y . z \<in> x, M(y) \<and> M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y . z \<in> x, M(y) \<and> M(z) \<and> Ord(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>}"
     using Ord_in_Ord by simp
   moreover from \<open>Ord(x)\<close>
   have "{y . z \<in> x, M(y) \<and> M(z) \<and> Ord(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y . z \<in> x, M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>}"
     using Ord_in_Ord by blast
   moreover from \<open>Ord(x)\<close> \<open>M(x)\<close>
   have "{y . z \<in> x, M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} \<subseteq>  \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>"
     using Aleph_rel_increasing
     by (auto dest:ltD transM intro:ltI)
   with calculation
   have "{y . z \<in> x, M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y \<in> \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> . (\<exists>z \<in> x. y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>)}"
     by (blast dest:transM)
   with calculation
   have "{y . z \<in> x, M(y) \<and> M(z) \<and> y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>} = {y \<in> \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> . (\<exists>z \<in> x. y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>)}"
     by simp
   moreover from \<open>Ord(x)\<close> \<open>M(x)\<close>
   have "M({y \<in> \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> . (\<exists>z \<in> x. y = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>)})"
     using aleph_rel_separation
     by simp
   ultimately
   show ?case
     using Ord_Aleph_rel Card_nat Limit_is_Ord Card_relI
     by (subst def_transrec [OF Aleph_rel_def'])
       (auto simp add:HAleph_rel_def)
 qed
 
 lemmas nat_subset_Aleph_rel_1 =
   Ord_lt_subset[OF Ord_Aleph_rel[of 1] Aleph_rel_increasing[of 0 1,simplified],simplified]
 
 end \<comment> \<open>\<^locale>\<open>M_aleph\<close>\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Transitive_Models/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,1611 +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 "\<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)
 
 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
   by (simp add:absolut csquare_lam_eq_lam[unfolded csquare_lam_def])
 
 end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
 
 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>)
 
 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)
 
 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
 
 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
 
 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
 
 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
 
 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
 
 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>
 
 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>
 
 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
 
 \<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>
 (*
 reldb_add functional relational "Ord" "ordinal"
 *)
 
 relativize functional "ord_iso" "ord_iso_rel" external
 \<comment> \<open>The following corresponds to "relativize functional relational"\<close>
 relationalize "ord_iso_rel" "is_ord_iso"
 
 context M_pre_cardinal_arith
 begin
 
 is_iff_rel for "ord_iso"
   using bij_rel_iff
   unfolding is_ord_iso_def ord_iso_rel_def
   by simp
 
 rel_closed for "ord_iso"
   using ord_iso_separation unfolding ord_iso_rel_def
   by simp
 
 end \<comment> \<open>\<^locale>\<open>M_pre_cardinal_arith\<close>\<close>
 
 synthesize "is_ord_iso" from_definition assuming "nonempty"
 
 lemma 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:"
     (\<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 = \<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 = \<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 . \<langle>x,y\<rangle>\<in>r \<Longrightarrow> x\<in>A"
     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>r\<in>Pow(A\<times>A)\<close>
   show ?thesis
     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)
     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,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)" "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 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(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"
 
 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
     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
     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
 
 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 -
   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 "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 1:"lam_replacement(M, \<lambda>x . {snd(p) . p \<in> lam_jump_cardinal_body(x)})"
     using lam_replacement_cong
     by auto
   ultimately
   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
 
 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)})"
   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,
         THEN bij_converse_bij])
    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>
+    \<comment> \<open>Note the weakened hypothesis @{thm [source] 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)
   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)
   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)
   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
       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)
   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)
   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)
   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_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"]
       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)"],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)
   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)
 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)
   using def_Pow_rel
     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)
   using Memrel_closed
      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\<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_closed
     by simp
   ultimately
   show "M(jump_cardinal_rel(M,K))"
     by simp
 qed
 
 (*The proof by contradiction: the bijection f yields a wellordering of X
   whose ordertype is jump_cardinal_rel(K).  *)
 lemma Card_rel_jump_cardinal_rel_lemma:
   "[| well_ord(X,r);  r \<subseteq> K * K;  X \<subseteq> K;
          f \<in> bij(ordertype(X,r), jump_cardinal_rel(M,K));
          M(X); M(r); M(K); M(f) |]
       ==> jump_cardinal_rel(M,K) \<in> jump_cardinal_rel(M,K)"
   apply (subgoal_tac "f O ordermap (X,r) \<in> bij (X, jump_cardinal_rel (M,K))")
    prefer 2 apply (blast intro: comp_bij ordermap_bij)
   apply (rule jump_cardinal_rel_iff_old [THEN iffD2],simp+)
   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]
       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 (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)+
   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)+
   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 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)
   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,436 +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
     lam_replacement_identity lam_replacement_hcomp2[of _ _ minimum]
   by simp
 
 lemmas surj_imp_inj_replacement4 = lam_replacement_minimum_vimage[unfolded lam_replacement_def]
 
 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>
+    \<comment> \<open>The next assumption is required by @{thm [source] 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_Relative.thy b/thys/Transitive_Models/Cardinal_Relative.thy
--- a/thys/Transitive_Models/Cardinal_Relative.thy
+++ b/thys/Transitive_Models/Cardinal_Relative.thy
@@ -1,1487 +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))"
 
 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_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
 
 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:
   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] 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, 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
 
 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 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 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
 
 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)
 
 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 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)
 
 \<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: 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
+absoluteness results (@{thm [source] 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
 
 \<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]
 
 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)
     \<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)
     \<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>
+bijections of finite sets (cf. @{thm [source] lesspoll_rel_succ_imp_lepoll_rel}.\<close>
 
 lemma Finite_abs[simp]:
   assumes "M(A)"
   shows "Finite_rel(M,A) \<longleftrightarrow> Finite(A)"
   unfolding Finite_rel_def Finite_def
 proof (simp, intro iffI)
   assume "\<exists>n\<in>nat. A \<approx>\<^bsup>M\<^esup> n"
   then
   obtain n where "A \<approx>\<^bsup>M\<^esup> n" "n\<in>nat" by blast
   with assms
   show "\<exists>n\<in>nat. A \<approx> n"
     unfolding eqpoll_def using nat_into_M by (auto simp add:def_eqpoll_rel)
 next
   fix n
   assume "\<exists>n\<in>nat. A \<approx> n"
   then
   obtain n where "A \<approx> n" "n\<in>nat" by blast
   moreover from this
   obtain f where "f \<in> bij(A,n)" unfolding eqpoll_def by auto
   moreover
   note assms
   moreover from calculation
   have "converse(f) \<in> n\<rightarrow>A"  using bij_is_fun by simp
   moreover from calculation
   have "M(converse(f))" using transM[of _ "n\<rightarrow>A"] by simp
   moreover from calculation
   have "M(f)" using bij_is_fun
       fun_is_rel[of "f" A "\<lambda>_. n", THEN converse_converse]
       converse_closed[of "converse(f)"] by simp
   ultimately
   show "\<exists>n\<in>nat. A \<approx>\<^bsup>M\<^esup> n"
     by (force dest:nat_into_M simp add:def_eqpoll_rel)
 qed
 
 \<comment> \<open>From the next result, the relative versions of
-@{thm Finite_Fin_lemma} and @{thm Fin_lemma} should follow\<close>
+@{thm [source] Finite_Fin_lemma} and @{thm [source] Fin_lemma} should follow\<close>
 
 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
\ 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,638 +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>)
 
 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
   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>
+text\<open>The next "def\_" result really corresponds to @{thm [source] 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>
 
 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>
 
 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>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 transM[of _ A]
       Pi_assumptions is_Sigfun_abs
     unfolding is_Sigma_def by simp
 qed
 
 lemma Sigma_closed[intro,simp]: "M(Sigma(A,B))"
 proof -
   have "(\<Union>x\<in>A. Sigfun(x, B)) = \<Union>{z . x \<in> A, z = Sigfun(x, B)}"
     by auto
   then
   show ?thesis
     using Sigma_Sigfun[of A B] transM[of _ A] Sigfun_closed Pi_assumptions
     by simp
 qed
 
 lemmas trans_Sigma_closed[trans_closed] = transM[OF _ Sigma_closed]
 
 end \<comment> \<open>\<^locale>\<open>M_Pi_assumptions\<close>\<close>
 
 subsection\<open>Discipline for \<^term>\<open>Pi\<close>\<close>
 
 definition \<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>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>
 
 
 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_Function.thy b/thys/Transitive_Models/Discipline_Function.thy
--- a/thys/Transitive_Models/Discipline_Function.thy
+++ b/thys/Transitive_Models/Discipline_Function.thy
@@ -1,928 +1,928 @@
 section\<open>Basic relativization of function spaces\<close>
 
 theory Discipline_Function
   imports
     Arities
 begin
 
 subsection\<open>Discipline for \<^term>\<open>fst\<close> and \<^term>\<open>snd\<close>\<close>
 
 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
 
 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>
 
 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>
 
 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.
+    @{thm [source] exI allI} to @{thm [source] 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>
+    @{thm [source] 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>
 
 subsection\<open>Discipline for \<^term>\<open>inj\<close>\<close>
 
 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>
 
 
 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>
 
 subsection\<open>Discipline for \<^term>\<open>surj\<close>\<close>
 
 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>
 
 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>
+text\<open>Note: @{thm [source] 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"
 
 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>
 
 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
 
 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>
 
 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
 
 \<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>
 
 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/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,2508 +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
+of separation and six instances of lambda replacements (ie, replacement of
+the form $\lambda x y.\ y=\langle x, f(x) \rangle$) and 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"
   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"
   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 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 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 minimum_in_Union:
   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_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_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)))"
 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
+\<comment> \<open>This lemma is similar to @{thm [source] strong_lam_replacement_imp_strong_replacement}
+and @{thm [source] 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_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)))"
   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 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>)"
   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
   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
         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_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\<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(_)"] 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 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 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] transM[of _ "g(_)"] rep_closed
         lam_replacement_product[OF lam_replacement_fst]
         lam_replacement_hcomp[OF lam_replacement_snd]
       by simp
     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} = {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_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 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(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 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
 
 \<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]
   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 ?thesis
     by(rule_tac lam_replacement_cong,auto,subst eq[symmetric],rule_tac comp_closed,auto)
 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
 
 \<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_product
 lam_replacement_snd lam_replacement_hcomp lam_replacement_sing_fun
    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
        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. (\<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_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)"
   shows "lam_replacement(M, drSR_Y(B,D,A))"
   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)"
   shows "M(drSR_Y(B,D,A,f))"
   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.  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
     by simp_all
   then
   show ?thesis
     unfolding dC_F_def
     using assms lam_replacement_Collect'[of A "\<lambda> d x . domain(x) = d"]
       separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant]
     by simp
   qed
 
 lemma dCF_closed:
   assumes "M(A)" "M(f)"
   shows "M(dC_F(A,f))"
   unfolding dC_F_def
   using assms lam_replacement_Collect'[of A "\<lambda> d x . domain(x) = d"]
     separation_eq[OF _ lam_replacement_domain _ lam_replacement_constant]
   by simp
 
 lemma lam_replacement_Collect_ball_Pair:
   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 "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:
   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
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,363 +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>
 
 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
 
 \<comment> \<open>We obtain this lemmas as a consequence of the previous one;
-alternatively it can be obtained using @{thm Ordinal.Memrel_type}\<close>
+alternatively it can be obtained using @{thm [source] Ordinal.Memrel_type}\<close>
 lemma field_Memrel : "field(Memrel(A)) \<subseteq> A"
   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>
+\<comment> \<open>Next theorem is very similar to @{thm [source] 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/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,1077 +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 \<^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>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 that Card_rel_is_Ord leI Card_rel_le_iff[of \<kappa> L]
     by (rule_tac ccontr, auto dest:not_lt_imp_le) (fast dest: le_imp_not_lt)
   with hips
   show "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (|\<kappa>|\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
     using Ord_cardinal_rel_le[THEN lt_trans1] Card_rel_csucc_rel
     unfolding csucc_rel_def
     by (rule_tac Least_antitone) (assumption, auto simp add:assms)
 qed
 
 lemma (in M_cardinal_arith_jump) csucc_rel_le_mono:
   assumes "\<kappa> \<le> \<nu>" "M(\<kappa>)" "M(\<nu>)"
   shows "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<nu>\<^sup>+)\<^bsup>M\<^esup>"
 proof (cases "\<kappa> = \<nu>")
   case True
   with assms
   show ?thesis using Card_rel_csucc_rel [THEN Card_rel_is_Ord] by simp
 next
   case False
   with assms
   have "\<kappa> < \<nu>" using le_neq_imp_lt by simp
   show ?thesis \<comment> \<open>by way of contradiction\<close>
   proof (rule ccontr)
     assume "\<not> (\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<nu>\<^sup>+)\<^bsup>M\<^esup>"
     with assms
     have "(\<nu>\<^sup>+)\<^bsup>M\<^esup> < (\<kappa>\<^sup>+)\<^bsup>M\<^esup>"
       using Card_rel_csucc_rel[THEN Card_rel_is_Ord] le_Ord2 lt_Ord
       by (intro not_le_iff_lt[THEN iffD1]) auto
     with assms
     have "(\<nu>\<^sup>+)\<^bsup>M\<^esup> \<le> |\<kappa>|\<^bsup>M\<^esup>"
       using le_Ord2[THEN Card_rel_csucc_rel, of \<kappa> \<nu>]
         Card_rel_lt_csucc_rel_iff[of "(\<nu>\<^sup>+)\<^bsup>M\<^esup>" "|\<kappa>|\<^bsup>M\<^esup>", THEN iffD1]
         csucc_rel_cardinal_rel[OF lt_Ord] leI[of "(\<nu>\<^sup>+)\<^bsup>M\<^esup>" "(\<kappa>\<^sup>+)\<^bsup>M\<^esup>"]
       by simp
     with assms
     have "(\<nu>\<^sup>+)\<^bsup>M\<^esup> \<le> \<kappa>"
       using Ord_cardinal_rel_le[OF lt_Ord] le_trans by auto
     with assms
     have "\<nu> < \<kappa>"
       using csucc_rel_basic le_Ord2[THEN Card_rel_csucc_rel, of \<kappa> \<nu>] Card_rel_is_Ord
         le_Ord2
       by (rule_tac j="(\<nu>\<^sup>+)\<^bsup>M\<^esup>" in lt_trans2) simp_all
     with \<open>\<kappa> < \<nu>\<close>
     show "False" using le_imp_not_lt leI by blast
   qed
 qed
 
 lemma (in M_cardinal_AC) cardinal_rel_succ_not_0:   "|A|\<^bsup>M\<^esup> = succ(n) \<Longrightarrow> M(A) \<Longrightarrow> M(n) \<Longrightarrow> A \<noteq> 0"
   by auto
 
 (* "Finite_to_one(X,Y) \<equiv> {f:X\<rightarrow>Y. \<forall>y\<in>Y. Finite({x\<in>X . f`x = y})}" *)
 reldb_add functional "Finite" "Finite" \<comment> \<open>wrongly done? Finite is absolute\<close>
 relativize functional "Finite_to_one" "Finite_to_one_rel" external
 (* reldb_add relational "Finite" "is_Finite" *) \<comment> \<open>don't have \<^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})"
 proof -
   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>
+\<comment> \<open>Same as @{thm [source] 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>
 
 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\<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>
+  \<comment> \<open>Copy-paste from @{thm [source] 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
   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
   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_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