diff --git a/thys/Independence_CH/Absolute_Versions.thy b/thys/Independence_CH/Absolute_Versions.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Absolute_Versions.thy
@@ -0,0 +1,148 @@
+section\<open>From $M$ to $\calV$\<close>
+
+theory Absolute_Versions
+  imports
+    CH
+    ZF.Cardinal_AC
+begin
+
+subsection\<open>Locales of a class \<^term>\<open>M\<close> hold in \<^term>\<open>\<V>\<close>\<close>
+
+interpretation V: M_trivial \<V>
+  using Union_ax_absolute upair_ax_absolute
+  by unfold_locales auto
+
+lemmas bad_simps = V.nonempty V.Forall_in_M_iff V.Inl_in_M_iff V.Inr_in_M_iff
+  V.succ_in_M_iff V.singleton_in_M_iff V.Equal_in_M_iff V.Member_in_M_iff V.Nand_in_M_iff
+  V.Cons_in_M_iff V.pair_in_M_iff V.upair_in_M_iff
+
+lemmas bad_M_trivial_simps[simp del] = V.Forall_in_M_iff V.Equal_in_M_iff
+  V.nonempty
+
+lemmas bad_M_trivial_rules[rule del] =  V.pair_in_MI V.singleton_in_MI V.pair_in_MD V.nat_into_M
+  V.depth_closed V.length_closed V.nat_case_closed V.separation_closed
+  V.Un_closed V.strong_replacement_closed V.nonempty
+
+interpretation V:M_basic \<V>
+  using power_ax_absolute separation_absolute replacement_absolute
+  by unfold_locales auto
+
+interpretation V:M_eclose \<V>
+  by unfold_locales (auto intro:separation_absolute replacement_absolute
+      simp:iterates_replacement_def wfrec_replacement_def)
+
+lemmas bad_M_basic_rules[simp del, rule del] =
+  V.cartprod_closed V.finite_funspace_closed V.converse_closed
+  V.list_case'_closed V.pred_closed
+
+interpretation V:M_cardinal_arith \<V>
+  by unfold_locales (auto intro:separation_absolute replacement_absolute
+      simp add:iterates_replacement_def wfrec_replacement_def lam_replacement_def)
+
+lemmas bad_M_cardinals_rules[simp del, rule del] =
+  V.iterates_closed V.M_nat V.trancl_closed V.rvimage_closed
+
+interpretation V:M_cardinal_arith_jump \<V>
+  by unfold_locales (auto intro:separation_absolute replacement_absolute
+      simp:wfrec_replacement_def)
+
+lemma choice_ax_Universe: "choice_ax(\<V>)"
+proof -
+  {
+    fix x
+    obtain f where "f \<in> surj(|x|,x)"
+      using cardinal_eqpoll unfolding eqpoll_def bij_def by fast
+    moreover
+    have "Ord(|x|)" by simp
+    ultimately
+    have "\<exists>a. Ord(a) \<and> (\<exists>f. f \<in> surj(a,x))"
+      by fast
+  }
+  then
+  show ?thesis  unfolding choice_ax_def rall_def rex_def
+    by simp
+qed
+
+interpretation V:M_master \<V>
+  using choice_ax_Universe
+  by unfold_locales (auto intro:separation_absolute replacement_absolute
+      simp:lam_replacement_def transrec_replacement_def wfrec_replacement_def
+      is_wfrec_def M_is_recfun_def)
+
+named_theorems V_simps
+
+\<comment> \<open>To work systematically, ASCII versions of "\_absolute" theorems as
+    those below are preferable.\<close>
+lemma eqpoll_rel_absolute[V_simps]: "x \<approx>\<^bsup>\<V>\<^esup> y \<longleftrightarrow> x \<approx> y"
+  unfolding eqpoll_def using V.def_eqpoll_rel by auto
+
+lemma cardinal_rel_absolute[V_simps]: "|x|\<^bsup>\<V>\<^esup> = |x|"
+  unfolding cardinal_def cardinal_rel_def by (simp add:V_simps)
+
+lemma Card_rel_absolute[V_simps]:"Card\<^bsup>\<V>\<^esup>(a) \<longleftrightarrow> Card(a)"
+  unfolding Card_rel_def Card_def by (simp add:V_simps)
+
+lemma csucc_rel_absolute[V_simps]:"(a\<^sup>+)\<^bsup>\<V>\<^esup> = a\<^sup>+"
+  unfolding csucc_rel_def csucc_def by (simp add:V_simps)
+
+lemma function_space_rel_absolute[V_simps]:"x \<rightarrow>\<^bsup>\<V>\<^esup> y = x \<rightarrow> y"
+  using V.function_space_rel_char by (simp add:V_simps)
+
+lemma cexp_rel_absolute[V_simps]:"x\<^bsup>\<up>y,\<V>\<^esup> = x\<^bsup>\<up>y\<^esup>"
+  unfolding cexp_rel_def cexp_def by (simp add:V_simps)
+
+lemma HAleph_rel_absolute[V_simps]:"HAleph_rel(\<V>,a,b) = HAleph(a,b)"
+  unfolding HAleph_rel_def HAleph_def by (auto simp add:V_simps)
+
+lemma Aleph_rel_absolute[V_simps]: "Ord(x) \<Longrightarrow> \<aleph>\<^bsub>x\<^esub>\<^bsup>\<V>\<^esup> = \<aleph>\<^bsub>x\<^esub>"
+proof -
+  assume "Ord(x)"
+  have "\<aleph>\<^bsub>x\<^esub>\<^bsup>\<V>\<^esup> = transrec(x, \<lambda>a b. HAleph_rel(\<V>,a,b))"
+    unfolding Aleph_rel_def by simp
+  also
+  have "\<dots> = transrec(x, HAleph)"
+    by (simp add:V_simps)
+  also from \<open>Ord(x)\<close>
+  have "\<dots> = \<aleph>\<^bsub>x\<^esub>"
+    using Aleph'_eq_Aleph unfolding Aleph'_def by simp
+  finally
+  show ?thesis .
+qed
+
+txt\<open>Example of absolute lemmas obtained from the relative versions.
+    Note the \<^emph>\<open>only\<close> declarations\<close>
+lemma Ord_cardinal_idem': "Ord(A) \<Longrightarrow> ||A|| = |A|"
+  using V.Ord_cardinal_rel_idem by (simp only:V_simps)
+
+lemma Aleph_succ': "Ord(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>succ(\<alpha>)\<^esub> = \<aleph>\<^bsub>\<alpha>\<^esub>\<^sup>+"
+  using V.Aleph_rel_succ by (simp only:V_simps)
+
+txt\<open>These two results are new, first obtained in relative form
+    (not ported).\<close>
+lemma csucc_cardinal:
+  assumes "Ord(\<kappa>)" shows "|\<kappa>|\<^sup>+ = \<kappa>\<^sup>+"
+  using assms V.csucc_rel_cardinal_rel by (simp add:V_simps)
+
+lemma csucc_le_mono:
+  assumes "\<kappa> \<le> \<nu>"  shows "\<kappa>\<^sup>+ \<le> \<nu>\<^sup>+"
+  using assms V.csucc_rel_le_mono by (simp add:V_simps)
+
+txt\<open>Example of transferring results from a transitive model to \<^term>\<open>\<V>\<close>\<close>
+lemma (in M_Perm) eqpoll_rel_transfer_absolute:
+  assumes "M(A)" "M(B)" "A \<approx>\<^bsup>M\<^esup> B"
+  shows "A \<approx> B"
+proof -
+  interpret M_N_Perm M \<V>
+    by (unfold_locales, simp only:V_simps)
+  from assms
+  show ?thesis using eqpoll_rel_transfer
+    by (simp only:V_simps)
+qed
+
+txt\<open>The “relationalized” $\CH$ with respect to \<^term>\<open>\<V>\<close> corresponds
+    to the real $\CH$.\<close>
+lemma is_ContHyp_iff_CH: "is_ContHyp(\<V>) \<longleftrightarrow> ContHyp"
+  using V.is_ContHyp_iff
+  by (auto simp add:ContHyp_rel_def ContHyp_def V_simps)
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/CH.thy b/thys/Independence_CH/CH.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/CH.thy
@@ -0,0 +1,529 @@
+section\<open>Forcing extension satisfying the Continuum Hypothesis\<close>
+
+theory CH
+  imports
+    Kappa_Closed_Notions
+    Cohen_Posets_Relative
+begin
+
+context M_ctm3_AC
+begin
+
+declare Fn_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]
+declare Fnle_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]
+
+abbreviation
+  Coll :: "i" where
+  "Coll \<equiv> Fn\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
+
+abbreviation
+  Colleq :: "i" where
+  "Colleq \<equiv> Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
+
+lemma Coll_in_M[intro,simp]: "Coll \<in> M" by simp
+
+lemma Colleq_refl : "refl(Coll,Colleq)"
+  unfolding Fnle_rel_def Fnlerel_def refl_def
+  using RrelI by simp
+
+subsection\<open>Collapse forcing is sufficiently closed\<close>
+
+\<comment> \<open>Kunen IV.7.14, only for \<^term>\<open>\<aleph>\<^bsub>1\<^esub>\<close>\<close>
+lemma succ_omega_closed_Coll: "succ(\<omega>)-closed\<^bsup>M\<^esup>(Coll,Colleq)"
+proof -
+  \<comment> \<open>Case for finite sequences\<close>
+  have "n\<in>\<omega> \<Longrightarrow> \<forall>f \<in> n \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)).
+          \<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> n \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq)" for n
+  proof (induct rule:nat_induct)
+    case 0
+    then
+    show ?case
+      using zero_lt_Aleph_rel1 zero_in_Fn_rel
+      by (auto simp del:setclass_iff) (rule bexI[OF _ zero_in_M], auto)
+  next
+    case (succ x)
+    then
+    have "\<forall>f\<in>succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)). \<forall>\<alpha> \<in> succ(x). \<langle>f`x, f ` \<alpha>\<rangle> \<in> Colleq"
+    proof(intro ballI)
+      fix f \<alpha>
+      assume "f\<in>succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))" "\<alpha>\<in>succ(x)"
+      moreover from \<open>x\<in>\<omega>\<close> this
+      have "f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))"
+        using mono_seqspace_rel_char nat_into_M
+        by simp
+      moreover from calculation succ
+      consider "\<alpha>\<in>x" | "\<alpha>=x"
+        by auto
+      then
+      show "\<langle>f`x, f ` \<alpha>\<rangle> \<in> Colleq"
+      proof(cases)
+        case 1
+        then
+        have "\<langle>\<alpha>, x\<rangle> \<in> Memrel(succ(x))" "x\<in>succ(x)" "\<alpha>\<in>succ(x)"
+          by auto
+        with \<open>f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))\<close>
+        show ?thesis
+          using mono_mapD(2)[OF _ \<open>\<alpha>\<in>succ(x)\<close> _ \<open>\<langle>\<alpha>, x\<rangle> \<in> Memrel(succ(x))\<close>]
+          unfolding mono_seqspace_def
+          by auto
+      next
+        case 2
+        with \<open>f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))\<close>
+        show ?thesis
+          using Colleq_refl mono_seqspace_is_fun[THEN apply_type]
+          unfolding refl_def
+          by simp
+      qed
+    qed
+    moreover
+    note \<open>x\<in>\<omega>\<close>
+    moreover from this
+    have "f`x \<in> Coll" if "f: succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))" for f
+      using that mono_seqspace_rel_char[simplified, of "succ(x)" Coll "converse(Colleq)"]
+        nat_into_M[simplified] mono_seqspace_is_fun[of "converse(Colleq)"]
+      by (intro apply_type[of _ "succ(x)"]) (auto simp del:setclass_iff)
+    ultimately
+    show ?case
+      using transM[of _ Coll]
+      by (auto dest:transM simp del:setclass_iff, rule_tac x="f`x" in bexI)
+        (auto simp del:setclass_iff, simp)
+  qed
+  moreover
+    \<comment> \<open>Interesting case: Countably infinite sequences.\<close>
+  have "\<forall>f\<in>M. f \<in> \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)) \<longrightarrow>
+                  (\<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq))"
+  proof(intro ballI impI)
+    fix f
+    let ?G="f``\<omega>"
+    assume "f\<in>M" "f \<in> \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))"
+    moreover from this
+    have "f\<in>\<omega> \<^sub><\<rightarrow> (Coll,converse(Colleq))" "f\<in>\<omega> \<rightarrow> Coll"
+      using mono_seqspace_rel_char mono_mapD(2) nat_in_M
+      by auto
+    moreover from this
+    have "countable\<^bsup>M\<^esup>(f`x)" if "x\<in>\<omega>" for x
+      using that Fn_rel_is_function countable_iff_lesspoll_rel_Aleph_rel_one
+      by auto
+    moreover from calculation
+    have "?G \<in> M" "f\<subseteq>\<omega>\<times>Coll"
+      using nat_in_M image_closed Pi_iff
+      by simp_all
+    moreover from calculation
+    have 1:"\<exists>d\<in>?G. d \<supseteq> h \<and> d \<supseteq> g" if "h \<in> ?G" "g \<in> ?G" for h g
+    proof -
+      from calculation
+      have "?G={f`x . x\<in>\<omega>}"
+        using  image_function[of f \<omega>] Pi_iff domain_of_fun
+        by auto
+      from \<open>?G=_\<close> that
+      obtain m n where eq:"h=f`m" "g=f`n" "n\<in>\<omega>" "m\<in>\<omega>"
+        by auto
+      then
+      have "m\<union>n\<in>\<omega>" "m\<le>m\<union>n" "n\<le>m\<union>n"
+        using Un_upper1_le Un_upper2_le nat_into_Ord by simp_all
+      with calculation eq \<open>?G=_\<close>
+      have "f`(m\<union>n)\<in>?G" "f`(m\<union>n) \<supseteq> h" "f`(m\<union>n) \<supseteq> g"
+        using Fnle_relD mono_map_lt_le_is_mono converse_refl[OF Colleq_refl]
+        by auto
+      then
+      show ?thesis
+        by auto
+    qed
+    moreover from calculation
+    have "?G \<subseteq> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
+      using subset_trans[OF image_subset[OF \<open>f\<subseteq>_\<close>,of \<omega>] Fn_rel_subset_PFun_rel]
+      by simp
+    moreover
+    have "\<Union> ?G \<in> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
+      using pfun_Un_filter_closed'[OF \<open>?G\<subseteq>_\<close> 1]  \<open>?G\<in>M\<close>
+      by simp
+    moreover from calculation
+    have "\<Union>?G \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
+      using countable_fun_imp_countable_image[of f]
+        mem_function_space_rel_abs[simplified,OF nat_in_M Coll_in_M \<open>f\<in>M\<close>]
+        countableI[OF lepoll_rel_refl]
+        countable_iff_lesspoll_rel_Aleph_rel_one[of "\<Union>?G"]
+      by auto
+    moreover from calculation
+    have "\<Union>?G\<in>Coll"
+      unfolding Fn_rel_def
+      by simp
+    moreover from calculation
+    have "\<Union>?G \<supseteq> f ` \<alpha> " if "\<alpha>\<in>\<omega>" for \<alpha>
+      using that image_function[OF fun_is_function] domain_of_fun
+      by auto
+    ultimately
+    show "\<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq)"
+      using Fn_rel_is_function Fnle_relI
+      by auto
+  qed
+  ultimately
+  show ?thesis
+    unfolding kappa_closed_rel_def by (auto elim!:leE dest:ltD)
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_ctm3_AC\<close>\<close>
+
+locale collapse_generic4 = G_generic4_AC "Fn\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" "Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" 0
+
+sublocale collapse_generic4 \<subseteq> forcing_notion "Coll" "Colleq" 0
+  using zero_lt_Aleph_rel1 by unfold_locales
+
+context collapse_generic4
+begin
+
+notation Leq (infixl "\<preceq>" 50)
+notation Incompatible (infixl "\<bottom>" 50)
+notation GenExt_at_P ("_[_]" [71,1])
+
+abbreviation
+  f_G :: "i" (\<open>f\<^bsub>G\<^esub>\<close>) where
+  "f\<^bsub>G\<^esub> \<equiv> \<Union>G"
+
+lemma f_G_in_MG[simp]:
+  shows "f\<^bsub>G\<^esub> \<in> M[G]"
+  using G_in_MG by simp
+
+abbreviation
+  dom_dense :: "i\<Rightarrow>i" where
+  "dom_dense(x) \<equiv> { p\<in>Coll . x \<in> domain(p) }"
+
+lemma Coll_into_countable_rel: "p \<in> Coll \<Longrightarrow> countable\<^bsup>M\<^esup>(p)"
+proof -
+  assume "p\<in>Coll"
+  then
+  have "p \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "p\<in>M"
+    using Fn_rel_is_function by simp_all
+  moreover from this
+  have "p \<lesssim>\<^bsup>M\<^esup> \<omega>"
+    using lesspoll_rel_Aleph_rel_succ[of 0] Aleph_rel_zero
+    by simp
+  ultimately
+  show ?thesis
+    using countableI eqpoll_rel_imp_lepoll_rel eqpoll_rel_sym cardinal_rel_eqpoll_rel
+    by simp
+qed
+
+(* TODO: Should be more general, cf. @{thm add_generic.dense_dom_dense} *)
+lemma dense_dom_dense: "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> dense(dom_dense(x))"
+proof
+  fix p
+  assume "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "p \<in> Coll"
+  show "\<exists>d\<in>dom_dense(x). d \<preceq> p"
+  proof (cases "x \<in> domain(p)")
+    case True
+    with \<open>x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>p \<in> Coll\<close>
+    show ?thesis using refl_leq by auto
+  next
+    case False
+    note \<open>p \<in> Coll\<close>
+    moreover from this and False and \<open>x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close>
+    have "cons(\<langle>x,\<lambda>n\<in>\<omega>. 0\<rangle>, p) \<in> Coll" "x\<in>M"
+      using function_space_rel_char
+        function_space_rel_closed lam_replacement_constant
+        lam_replacement_iff_lam_closed InfCard_rel_Aleph_rel
+      by (auto intro!: cons_in_Fn_rel dest:transM intro:function_space_nonempty)
+    ultimately
+    show ?thesis
+      using Fn_relD by blast
+  qed
+qed
+
+lemma dom_dense_closed[intro,simp]: "x\<in>M \<Longrightarrow> dom_dense(x) \<in> M"
+  using separation_in_domain[of x]
+  by simp
+
+lemma domain_f_G: assumes "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
+  shows "x \<in> domain(f\<^bsub>G\<^esub>)"
+proof -
+  from assms
+  have "dense(dom_dense(x))" "x\<in>M"
+    using dense_dom_dense transitivity[OF _
+        Aleph_rel_closed[of 1,THEN setclass_iff[THEN iffD1]]]
+    by simp_all
+  with assms
+  obtain p where "p\<in>dom_dense(x)" "p\<in>G"
+    using generic[THEN M_generic_denseD, of "dom_dense(x)"]
+    by auto
+  then
+  show "x \<in> domain(f\<^bsub>G\<^esub>)" by blast
+qed
+
+lemma rex_mono : assumes "\<exists> d \<in> A . P(d)" "A\<subseteq>B"
+  shows "\<exists> d \<in> B. P(d)"
+  using assms by auto
+
+lemma Un_filter_is_function:
+  assumes "filter(G)"
+  shows "function(\<Union>G)"
+proof -
+  have "Coll \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
+    using Fn_rel_subset_PFun_rel
+    by simp
+  moreover
+  have "\<exists> d \<in> Coll. d \<supseteq> f \<and> d \<supseteq> g" if "f\<in>G" "g\<in>G" for f g
+    using filter_imp_compat[OF assms \<open>f\<in>G\<close> \<open>g\<in>G\<close>] filterD[OF assms]
+    unfolding compat_def compat_in_def
+    by auto
+  ultimately
+  have "\<exists>d \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2). d \<supseteq> f \<and> d \<supseteq> g" if "f\<in>G" "g\<in>G" for f g
+    using rex_mono[of Coll] that by simp
+  moreover
+  have "G\<subseteq>Coll"
+    using assms
+    unfolding filter_def
+    by simp
+  moreover from this
+  have "G \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
+    using assms  unfolding Fn_rel_def
+    by auto
+  ultimately
+  show ?thesis
+    using pfun_Un_filter_closed[of G]
+    by simp
+qed
+
+lemma f_G_funtype:
+  shows "f\<^bsub>G\<^esub> : \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
+proof -
+  have "x \<in> B \<Longrightarrow> B \<in> G \<Longrightarrow> x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<times> (\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)" for B x
+  proof -
+    assume "x\<in>B" "B\<in>G"
+    moreover from this
+    have "x \<in> M[G]"
+      by (auto dest!:generic_dests ext.transM)
+        (intro generic_simps(2)[of Coll], simp)
+    moreover from calculation
+    have "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<times> (\<omega> \<rightarrow> 2)"
+      using Fn_rel_subset_Pow[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2",
+          OF _ _ function_space_rel_closed] function_space_rel_char
+      by (auto dest!:generic_dests)
+    moreover from this
+    obtain z w where "x=\<langle>z,w\<rangle>" "z\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "w:\<omega> \<rightarrow> 2" by auto
+    moreover from calculation
+    have "w \<in> M[G]" by (auto dest:ext.transM)
+    ultimately
+    show ?thesis using ext.function_space_rel_char by auto
+  qed
+  moreover
+  have "function(f\<^bsub>G\<^esub>)"
+    using Un_filter_is_function generic
+    unfolding M_generic_def by fast
+  ultimately
+  show ?thesis
+    using generic domain_f_G unfolding Pi_def by auto
+qed
+
+abbreviation
+  surj_dense :: "i\<Rightarrow>i" where
+  "surj_dense(x) \<equiv> { p\<in>Coll . x \<in> range(p) }"
+
+(* TODO: write general versions of this for \<^term>\<open>Fn\<^bsup>M\<^esup>(\<kappa>,I,J)\<close> *)
+lemma dense_surj_dense:
+  assumes "x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
+  shows "dense(surj_dense(x))"
+proof
+  fix p
+  assume "p \<in> Coll"
+  then
+  have "countable\<^bsup>M\<^esup>(p)" using Coll_into_countable_rel by simp
+  show "\<exists>d\<in>surj_dense(x). d \<preceq> p"
+  proof -
+    from \<open>p \<in> Coll\<close>
+    have "domain(p) \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "p\<in>M"
+      using transM[of _ Coll] domain_of_fun
+      by (auto del:Fn_relD dest!:Fn_relD del:domainE)
+    moreover from \<open>countable\<^bsup>M\<^esup>(p)\<close>
+    have "domain(p) \<subseteq> {fst(x) . x \<in> p }" by (auto intro!: rev_bexI)
+    moreover from calculation
+    have "{ fst(x) . x \<in> p } \<in> M"
+      using lam_replacement_fst[THEN lam_replacement_imp_strong_replacement]
+      by (auto simp flip:setclass_iff intro!:RepFun_closed dest:transM)
+    moreover from calculation and \<open>countable\<^bsup>M\<^esup>(p)\<close>
+    have "countable\<^bsup>M\<^esup>({fst(x) . x \<in> p })"
+      using cardinal_rel_RepFun_le lam_replacement_fst
+        countable_rel_iff_cardinal_rel_le_nat[THEN iffD1, THEN [2] le_trans, of _ p]
+      by (rule_tac countable_rel_iff_cardinal_rel_le_nat[THEN iffD2]) simp_all
+    moreover from calculation
+    have "countable\<^bsup>M\<^esup>(domain(p))"
+      using uncountable_rel_not_subset_countable_rel[of "{fst(x) . x \<in> p }" "domain(p)"]
+      by auto
+    ultimately
+    obtain \<alpha> where "\<alpha> \<notin> domain(p)" "\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
+      using lt_cardinal_rel_imp_not_subset[of "domain(p)" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"]
+        Ord_Aleph_rel countable_iff_le_rel_Aleph_rel_one[THEN iffD1,
+          THEN lesspoll_cardinal_lt_rel, of "domain(p)"]
+        cardinal_rel_idem by auto
+    moreover note assms
+    moreover from calculation and \<open>p \<in> Coll\<close>
+    have "cons(\<langle>\<alpha>,x\<rangle>, p) \<in> Coll" "x\<in>M" "cons(\<langle>\<alpha>,x\<rangle>, p) \<preceq> p"
+      using InfCard_rel_Aleph_rel
+      by (auto del:Fnle_relI intro!: cons_in_Fn_rel Fnle_relI dest:transM)
+    ultimately
+    show ?thesis by blast
+  qed
+qed
+
+lemma surj_dense_closed[intro,simp]:
+  "x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2 \<Longrightarrow> surj_dense(x) \<in> M"
+  using separation_in_range transM[of x] by simp
+
+lemma reals_sub_image_f_G:
+  assumes "x\<in>\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
+  shows "\<exists>\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>. f\<^bsub>G\<^esub> ` \<alpha> = x"
+proof -
+  from assms
+  have "dense(surj_dense(x))" using dense_surj_dense by simp
+  with \<open>x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2\<close>
+  obtain p where "p\<in>surj_dense(x)" "p\<in>G"
+    using generic[THEN M_generic_denseD, of "surj_dense(x)"]
+    by blast
+  then
+  show ?thesis
+    using succ_omega_closed_Coll f_G_funtype function_apply_equality[of _ x f_G]
+      succ_omega_closed_imp_no_new_reals[symmetric]
+    by (auto, rule_tac bexI) (auto simp:Pi_def)
+qed
+
+lemma f_G_surj_Aleph_rel1_reals: "f\<^bsub>G\<^esub> \<in> surj\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
+  using Aleph_rel_sub_closed
+proof (intro ext.mem_surj_abs[THEN iffD2])
+  show "f\<^bsub>G\<^esub> \<in> surj(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
+    unfolding surj_def
+  proof (intro ballI CollectI impI)
+    show "f\<^bsub>G\<^esub> \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
+      using f_G_funtype G_in_MG ext.nat_into_M f_G_in_MG by simp
+    fix x
+    assume "x \<in> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
+    then
+    show "\<exists>\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>. f\<^bsub>G\<^esub> ` \<alpha> = x"
+      using reals_sub_image_f_G succ_omega_closed_Coll
+        f_G_funtype succ_omega_closed_imp_no_new_reals by simp
+  qed
+qed simp_all
+
+lemma continuum_rel_le_Aleph1_extension:
+  includes G_generic1_lemmas
+  shows "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
+proof -
+  have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "Ord(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)"
+    using Card_rel_is_Ord by auto
+  moreover from this
+  have "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2 \<lesssim>\<^bsup>M[G]\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
+    using ext.surj_rel_implies_inj_rel[OF f_G_surj_Aleph_rel1_reals]
+      f_G_in_MG unfolding lepoll_rel_def by auto
+  with \<open>Ord(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close>
+  have "|\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2|\<^bsup>M[G]\<^esup> \<le> |\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>|\<^bsup>M[G]\<^esup>"
+    using  M_subset_MG[OF one_in_G, OF generic] Aleph_rel_closed[of 1]
+    by (rule_tac ext.lepoll_rel_imp_cardinal_rel_le) simp_all
+  ultimately
+  have "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> |\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>|\<^bsup>M[G]\<^esup>"
+    using ext.lepoll_rel_imp_cardinal_rel_le[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"]
+      ext.Aleph_rel_zero succ_omega_closed_Coll
+      succ_omega_closed_imp_Aleph_1_preserved
+    unfolding cexp_rel_def by simp
+  then
+  show "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>" by simp
+qed
+
+theorem CH: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
+  using continuum_rel_le_Aleph1_extension ext.Aleph_rel_succ[of 0]
+    ext.Aleph_rel_zero ext.csucc_rel_le[of "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>" \<omega>]
+    ext.Card_rel_cexp_rel ext.cantor_cexp_rel[of \<omega>] ext.Card_rel_nat
+    le_anti_sym
+  by auto
+
+end \<comment> \<open>\<^locale>\<open>collapse_generic4\<close>\<close>
+
+subsection\<open>Models of fragments of $\ZFC + \CH$\<close>
+
+theorem ctm_of_CH:
+  assumes
+    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
+    "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
+  shows
+    "\<exists>N.
+      M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>} \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
+      (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
+proof -
+  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
+  interpret M_ZFC4 M
+    using M_satT_overhead_imp_M_ZF4 by simp
+  from \<open>Transset(M)\<close>
+  interpret M_ZFC4_trans M
+    using M_satT_imp_M_ZF4
+    by unfold_locales
+  from \<open>M \<approx> \<omega>\<close>
+  obtain enum where "enum \<in> bij(\<omega>,M)"
+    using eqpoll_sym unfolding eqpoll_def by blast
+  then
+  interpret M_ctm3_AC M enum by unfold_locales
+  interpret forcing_data1 "Coll" "Colleq" 0 M enum
+    using zero_in_Fn_rel[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
+      zero_top_Fn_rel[of _ "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
+      preorder_on_Fnle_rel[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
+      zero_lt_Aleph_rel1
+    by unfold_locales simp_all
+  obtain G where "M_generic(G)"
+    using generic_filter_existence[OF one_in_P]
+    by auto
+  moreover from this
+  interpret collapse_generic4 M enum G by unfold_locales
+  have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
+    using CH .
+  then
+  have "M[G], [] \<Turnstile> \<cdot>CH\<cdot>"
+    using ext.is_ContHyp_iff
+    by (simp add:ContHyp_rel_def)
+  then
+  have "M[G] \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>}"
+    using ext.M_satT_ZC by auto
+  moreover
+  have "Transset(M[G])" using Transset_MG .
+  moreover
+  have "M \<subseteq> M[G]" using M_subset_MG[OF one_in_G] generic by simp
+  moreover
+  note \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
+  ultimately
+  show ?thesis
+    using Ord_MG_iff MG_eqpoll_nat satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
+    by (rule_tac x="M[G]" in exI,blast)
+qed
+
+corollary ctm_ZFC_imp_ctm_CH:
+  assumes
+    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZFC"
+  shows
+    "\<exists>N.
+      M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>} \<and>
+      (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
+proof -
+  from assms
+  have "\<exists>N.
+      M \<subseteq> N \<and>
+        N \<approx> \<omega> \<and>
+        Transset(N) \<and>
+        N \<Turnstile> ZC \<and> N \<Turnstile> {\<cdot>CH\<cdot>} \<and> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
+    using ctm_of_CH[of M formula] satT_ZFC_imp_satT_ZC[of M]
+      satT_mono[OF _ ground_repl_fm_sub_ZFC, of M]
+      satT_mono[OF _ ZF_replacement_overhead_sub_ZFC, of M]
+      satT_mono[OF _ ZF_replacement_fms_sub_ZFC, of M]
+    by (simp add: satT_Un_iff)
+  then
+  obtain N where "N \<Turnstile> ZC" "N \<Turnstile> {\<cdot>CH\<cdot>}" "N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula}"
+    "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
+    by auto
+  moreover from this
+  have "N \<Turnstile> ZFC"
+    using satT_ZC_ZF_replacement_imp_satT_ZFC
+    by auto
+  moreover from this and \<open>N \<Turnstile> {\<cdot>CH\<cdot>}\<close>
+  have "N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>}"
+    using satT_ZC_ZF_replacement_imp_satT_ZFC
+    by auto
+  ultimately
+  show ?thesis
+    by auto
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Cardinal_Preservation.thy b/thys/Independence_CH/Cardinal_Preservation.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Cardinal_Preservation.thy
@@ -0,0 +1,523 @@
+section\<open>Preservation of cardinals in generic extensions\<close>
+
+theory Cardinal_Preservation
+  imports
+    Forcing_Main
+begin
+
+context forcing_notion
+begin
+
+definition
+  antichain :: "i\<Rightarrow>o" where
+  "antichain(A) \<equiv> A\<subseteq>P \<and> (\<forall>p\<in>A. \<forall>q\<in>A. p \<noteq> q \<longrightarrow> p \<bottom> q)"
+
+definition
+  ccc :: "o" where
+  "ccc \<equiv> \<forall>A. antichain(A) \<longrightarrow> |A| \<le> \<omega>"
+
+end \<comment> \<open>\<^locale>\<open>forcing_notion\<close>\<close>
+
+context forcing_data1
+
+begin
+abbreviation
+  antichain_r' :: "i \<Rightarrow> o" where
+  "antichain_r'(A) \<equiv> antichain_rel(##M,P,leq,A)"
+
+lemma antichain_abs' [absolut]:
+  "\<lbrakk> A\<in>M \<rbrakk> \<Longrightarrow> antichain_r'(A) \<longleftrightarrow> antichain(A)"
+  unfolding antichain_rel_def antichain_def compat_def
+  using P_in_M leq_in_M transitivity[of _ A]
+  by (auto simp add:absolut)
+
+lemma (in forcing_notion) Incompatible_imp_not_eq: "\<lbrakk> p \<bottom> q; p\<in>P; q\<in>P \<rbrakk>\<Longrightarrow> p \<noteq> q"
+  using refl_leq by blast
+
+lemma inconsistent_imp_incompatible:
+  assumes "p \<tturnstile> \<phi> env" "q \<tturnstile> Neg(\<phi>) env" "p\<in>P" "q\<in>P"
+    "arity(\<phi>) \<le> length(env)" "\<phi> \<in> formula" "env \<in> list(M)"
+  shows "p \<bottom> q"
+proof
+  assume "compat(p,q)"
+  then
+  obtain d where "d \<preceq> p" "d \<preceq> q" "d \<in> P" by blast
+  moreover
+  note assms
+  moreover from calculation
+  have "d \<tturnstile> \<phi> env" "d \<tturnstile> Neg(\<phi>) env"
+    using strengthening_lemma by simp_all
+  ultimately
+  show "False"
+    using Forces_Neg[of d env \<phi>] refl_leq P_in_M
+    by (auto dest:transM; drule_tac bspec; auto dest:transM)
+qed
+
+notation check (\<open>_\<^sup>v\<close> [101] 100)
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+locale G_generic2 = G_generic1 + forcing_data2
+locale G_generic2_AC = G_generic1_AC + G_generic2 + M_ctm2_AC
+
+locale G_generic3 = G_generic2 + forcing_data3
+locale G_generic3_AC = G_generic2_AC + G_generic3
+
+locale G_generic4 = G_generic3 + forcing_data4
+locale G_generic4_AC = G_generic3_AC + G_generic4
+
+sublocale G_generic4_AC \<subseteq> ext:M_ZFC3_trans "M[G]"
+  using ground_replacements4 replacement_assm_MG
+  by unfold_locales simp_all
+
+lemma (in forcing_data1) forces_neq_apply_imp_incompatible:
+  assumes
+    "p \<tturnstile> \<cdot>0`1 is 2\<cdot> [f,a,b\<^sup>v]"
+    "q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f,a,b'\<^sup>v]"
+    "b \<noteq> b'"
+    \<comment> \<open>More general version: taking general names
+       \<^term>\<open>b\<^sup>v\<close> and \<^term>\<open>b'\<^sup>v\<close>, satisfying
+       \<^term>\<open>p \<tturnstile> \<cdot>\<not>\<cdot>0 = 1\<cdot>\<cdot> [b\<^sup>v, b'\<^sup>v]\<close> and
+       \<^term>\<open>q \<tturnstile> \<cdot>\<not>\<cdot>0 = 1\<cdot>\<cdot> [b\<^sup>v, b'\<^sup>v]\<close>.\<close>
+    and
+    types:"f\<in>M" "a\<in>M" "b\<in>M" "b'\<in>M" "p\<in>P" "q\<in>P"
+  shows
+    "p \<bottom> q"
+proof -
+  {
+    fix G
+    assume "M_generic(G)"
+    then
+    interpret G_generic1 _ _ _ _ _ G by unfold_locales
+    include G_generic1_lemmas
+      (* NOTE: might be useful to have a locale containg two \<open>M_ZF1_trans\<close>
+         instances, one for \<^term>\<open>M\<close> and one for \<^term>\<open>M[G]\<close> *)
+    assume "q\<in>G"
+    with assms \<open>M_generic(G)\<close>
+    have "M[G], map(val(P,G),[f,a,b'\<^sup>v]) \<Turnstile> \<cdot>0`1 is 2\<cdot>"
+      using truth_lemma[of "\<cdot>0`1 is 2\<cdot>" G "[f,a,b'\<^sup>v]"]
+      by (auto simp add:ord_simp_union arity_fun_apply_fm
+          fun_apply_type)
+    with \<open>b \<noteq> b'\<close> types
+    have "M[G], map(val(P,G),[f,a,b\<^sup>v]) \<Turnstile> \<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot>"
+      using GenExtI by auto
+  }
+  with types
+  have "q \<tturnstile> \<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot> [f,a,b\<^sup>v]"
+    using definition_of_forcing[where \<phi>="\<cdot>\<not>\<cdot>0`1 is 2\<cdot>\<cdot>" ] check_in_M
+    by (auto simp add:ord_simp_union arity_fun_apply_fm)
+  with \<open>p \<tturnstile> \<cdot>0`1 is 2\<cdot> [f,a,b\<^sup>v]\<close> and types
+  show "p \<bottom> q"
+    using check_in_M inconsistent_imp_incompatible
+    by (simp add:ord_simp_union arity_fun_apply_fm fun_apply_type)
+qed
+
+context M_ctm3_AC
+begin
+
+\<comment> \<open>Simplifying simp rules (because of the occurrence of "\#\#")\<close>
+lemmas sharp_simps = Card_rel_Union Card_rel_cardinal_rel Collect_abs
+  Cons_abs Cons_in_M_iff Diff_closed Equal_abs Equal_in_M_iff Finite_abs
+  Forall_abs Forall_in_M_iff Inl_abs Inl_in_M_iff Inr_abs Inr_in_M_iff
+  Int_closed Inter_abs Inter_closed M_nat Member_abs Member_in_M_iff
+  Memrel_closed Nand_abs Nand_in_M_iff Nil_abs Nil_in_M Ord_cardinal_rel
+  Pow_rel_closed Un_closed Union_abs Union_closed and_abs and_closed
+  apply_abs apply_closed bij_rel_closed bijection_abs bool_of_o_abs
+  bool_of_o_closed cadd_rel_0 cadd_rel_closed cardinal_rel_0_iff_0
+  cardinal_rel_closed cardinal_rel_idem cartprod_abs cartprod_closed
+  cmult_rel_0 cmult_rel_1 cmult_rel_closed comp_closed composition_abs
+  cons_abs cons_closed converse_abs converse_closed csquare_lam_closed
+  csquare_rel_closed depth_closed domain_abs domain_closed eclose_abs
+  eclose_closed empty_abs field_abs field_closed finite_funspace_closed
+  finite_ordinal_abs formula_N_abs formula_N_closed formula_abs
+  formula_case_abs formula_case_closed formula_closed
+  formula_functor_abs fst_closed function_abs function_space_rel_closed
+  hd_abs image_abs image_closed inj_rel_closed injection_abs inter_abs
+  irreflexive_abs is_depth_apply_abs is_eclose_n_abs is_funspace_abs
+  iterates_closed length_abs length_closed lepoll_rel_refl
+  limit_ordinal_abs linear_rel_abs list_N_abs list_N_closed list_abs
+  list_case'_closed list_case_abs list_closed list_functor_abs
+  mem_bij_abs mem_eclose_abs mem_inj_abs mem_list_abs membership_abs
+  minimum_closed nat_case_abs nat_case_closed nonempty not_abs
+  not_closed nth_abs number1_abs number2_abs number3_abs omega_abs
+  or_abs or_closed order_isomorphism_abs ordermap_closed
+  ordertype_closed ordinal_abs pair_abs pair_in_M_iff powerset_abs
+  pred_closed pred_set_abs quasilist_abs quasinat_abs radd_closed
+  rall_abs range_abs range_closed relation_abs restrict_closed
+  restriction_abs rex_abs rmult_closed rtrancl_abs rtrancl_closed
+  rvimage_closed separation_closed setdiff_abs singleton_abs
+  singleton_in_M_iff snd_closed strong_replacement_closed subset_abs
+  succ_in_M_iff successor_abs successor_ordinal_abs sum_abs sum_closed
+  surj_rel_closed surjection_abs tl_abs trancl_abs trancl_closed
+  transitive_rel_abs transitive_set_abs typed_function_abs union_abs
+  upair_abs upair_in_M_iff vimage_abs vimage_closed well_ord_abs
+  mem_formula_abs nth_closed Aleph_rel_closed csucc_rel_closed
+  Card_rel_Aleph_rel
+
+declare sharp_simps[simp del, simplified setclass_iff, simp]
+
+lemmas sharp_intros = nat_into_M Aleph_rel_closed Card_rel_Aleph_rel
+
+declare sharp_intros[rule del, simplified setclass_iff, intro]
+
+end \<comment> \<open>\<^locale>\<open>M_ctm3_AC\<close>\<close>
+
+context G_generic4_AC begin
+
+context
+  includes G_generic1_lemmas
+begin
+
+lemmas mg_sharp_simps = ext.Card_rel_Union ext.Card_rel_cardinal_rel
+  ext.Collect_abs ext.Cons_abs ext.Cons_in_M_iff ext.Diff_closed
+  ext.Equal_abs ext.Equal_in_M_iff ext.Finite_abs ext.Forall_abs
+  ext.Forall_in_M_iff ext.Inl_abs ext.Inl_in_M_iff ext.Inr_abs
+  ext.Inr_in_M_iff ext.Int_closed ext.Inter_abs ext.Inter_closed
+  ext.M_nat ext.Member_abs ext.Member_in_M_iff ext.Memrel_closed
+  ext.Nand_abs ext.Nand_in_M_iff ext.Nil_abs ext.Nil_in_M
+  ext.Ord_cardinal_rel ext.Pow_rel_closed ext.Un_closed
+  ext.Union_abs ext.Union_closed ext.and_abs ext.and_closed
+  ext.apply_abs ext.apply_closed ext.bij_rel_closed
+  ext.bijection_abs ext.bool_of_o_abs ext.bool_of_o_closed
+  ext.cadd_rel_0 ext.cadd_rel_closed ext.cardinal_rel_0_iff_0
+  ext.cardinal_rel_closed ext.cardinal_rel_idem ext.cartprod_abs
+  ext.cartprod_closed ext.cmult_rel_0 ext.cmult_rel_1
+  ext.cmult_rel_closed ext.comp_closed ext.composition_abs
+  ext.cons_abs ext.cons_closed ext.converse_abs ext.converse_closed
+  ext.csquare_lam_closed ext.csquare_rel_closed ext.depth_closed
+  ext.domain_abs ext.domain_closed ext.eclose_abs ext.eclose_closed
+  ext.empty_abs ext.field_abs ext.field_closed
+  ext.finite_funspace_closed ext.finite_ordinal_abs ext.formula_N_abs
+  ext.formula_N_closed ext.formula_abs ext.formula_case_abs
+  ext.formula_case_closed ext.formula_closed ext.formula_functor_abs
+  ext.fst_closed ext.function_abs ext.function_space_rel_closed
+  ext.hd_abs ext.image_abs ext.image_closed ext.inj_rel_closed
+  ext.injection_abs ext.inter_abs ext.irreflexive_abs
+  ext.is_depth_apply_abs ext.is_eclose_n_abs ext.is_funspace_abs
+  ext.iterates_closed ext.length_abs ext.length_closed
+  ext.lepoll_rel_refl ext.limit_ordinal_abs ext.linear_rel_abs
+  ext.list_N_abs ext.list_N_closed ext.list_abs
+  ext.list_case'_closed ext.list_case_abs ext.list_closed
+  ext.list_functor_abs ext.mem_bij_abs ext.mem_eclose_abs
+  ext.mem_inj_abs ext.mem_list_abs ext.membership_abs
+  ext.nat_case_abs ext.nat_case_closed
+  ext.nonempty ext.not_abs ext.not_closed ext.nth_abs
+  ext.number1_abs ext.number2_abs ext.number3_abs ext.omega_abs
+  ext.or_abs ext.or_closed ext.order_isomorphism_abs
+  ext.ordermap_closed ext.ordertype_closed ext.ordinal_abs
+  ext.pair_abs ext.pair_in_M_iff ext.powerset_abs ext.pred_closed
+  ext.pred_set_abs ext.quasilist_abs ext.quasinat_abs
+  ext.radd_closed ext.rall_abs ext.range_abs ext.range_closed
+  ext.relation_abs ext.restrict_closed ext.restriction_abs
+  ext.rex_abs ext.rmult_closed ext.rtrancl_abs ext.rtrancl_closed
+  ext.rvimage_closed ext.separation_closed ext.setdiff_abs
+  ext.singleton_abs ext.singleton_in_M_iff ext.snd_closed
+  ext.strong_replacement_closed ext.subset_abs ext.succ_in_M_iff
+  ext.successor_abs ext.successor_ordinal_abs ext.sum_abs
+  ext.sum_closed ext.surj_rel_closed ext.surjection_abs ext.tl_abs
+  ext.trancl_abs ext.trancl_closed ext.transitive_rel_abs
+  ext.transitive_set_abs ext.typed_function_abs ext.union_abs
+  ext.upair_abs ext.upair_in_M_iff ext.vimage_abs ext.vimage_closed
+  ext.well_ord_abs ext.mem_formula_abs ext.nth_closed ext.Aleph_rel_closed
+  ext.csucc_rel_closed ext.Card_rel_Aleph_rel
+
+\<comment> \<open>The following was motivated by the fact that
+    @{thm ext.apply_closed} did not simplify appropriately.\<close>
+declare mg_sharp_simps[simp del, simplified setclass_iff, simp]
+
+lemmas mg_sharp_intros = ext.nat_into_M ext.Aleph_rel_closed
+  ext.Card_rel_Aleph_rel
+
+declare mg_sharp_intros[rule del, simplified setclass_iff, intro]
+
+\<comment> \<open>Kunen IV.2.31\<close>
+lemma forces_below_filter:
+  assumes "M[G], map(val(P,G),env) \<Turnstile> \<phi>" "p \<in> G"
+    "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>
+
+\<comment> \<open>This definition has the arguments in the expected order by most of the lemmas:
+first the parameters, the only argument in the penultimate place and the result in
+the last place.\<close>
+definition check_fm' where
+  "check_fm'(ofm,arg,res) \<equiv> check_fm(arg,ofm,res)"
+
+lemma ccc_fun_closed_lemma_aux:
+  assumes "f_dot\<in>M" "p\<in>M" "a\<in>M" "b\<in>M"
+  shows "{q \<in> P . q \<preceq> p \<and> (M, [q, P, leq, \<one>, f_dot, a\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))} \<in> M"
+proof -
+  have "\<cdot>0`1 is 2\<cdot> \<in> formula" "arity(\<cdot>0`1 is 2\<cdot> ) = 3"
+    using arity_fun_apply_fm union_abs1
+    by simp_all
+  then
+  show ?thesis
+    using separation_forces[where env="[f_dot, a\<^sup>v, b\<^sup>v]" and \<phi>="\<cdot>0`1 is 2\<cdot>",simplified]
+      assms G_subset_M[THEN subsetD] generic one_in_M P_in_M
+      separation_in lam_replacement_constant lam_replacement_identity
+      lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] leq_in_M check_in_M
+      separation_conj separation_forces
+    by simp_all
+qed
+
+lemma ccc_fun_closed_lemma_aux2:
+  assumes "B\<in>M" "f_dot\<in>M" "p\<in>M" "a\<in>M"
+  shows "(##M)(\<lambda>b\<in>B. {q \<in> P . q \<preceq> p \<and> (M, [q, P, leq, \<one>, f_dot, a\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))})"
+proof -
+  have "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, \<tau>, fst(fst(z))\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
+    if "\<tau>\<in>M" for \<tau>
+  proof -
+    let ?f_fm="snd_fm(1,0)"
+    let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(fst_fm,fst_fm),2,0)"
+    note types = assms leq_in_M P_in_M one_in_M
+    have "arity(forces(\<cdot>0`1 is 2\<cdot> )) \<le> 7"
+      using arity_fun_apply_fm union_abs1 arity_forces[of "\<cdot>0`1 is 2\<cdot> "]
+      by simp
+    moreover
+    have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
+      using ord_simp_union
+      unfolding hcomp_fm_def check_fm'_def
+      by (simp_all add:arity)
+    ultimately
+    show ?thesis
+      using separation_sat_after_function types that sats_fst_fm
+        snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M fst_abs
+      unfolding hcomp_fm_def check_fm'_def
+      by simp
+  qed
+  then
+  show ?thesis
+    using lam_replacement_imp_lam_closed lam_replacement_Collect
+      separation_conj separation_in separation_forces separation_ball separation_iff'
+      lam_replacement_Pair[THEN [5] lam_replacement_hcomp2] lam_replacement_identity
+      lam_replacement_constant lam_replacement_snd lam_replacement_fst lam_replacement_hcomp
+      ccc_fun_closed_lemma_aux arity_fun_apply_fm union_abs1
+      transitivity[of _ B] leq_in_M assms
+    by simp
+qed
+
+lemma ccc_fun_closed_lemma:
+  assumes "A\<in>M" "B\<in>M" "f_dot\<in>M" "p\<in>M"
+  shows "(\<lambda>a\<in>A. {b\<in>B. \<exists>q\<in>P. q \<preceq> p \<and> (q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v])}) \<in> M"
+proof -
+  have "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, fst(fst(fst(z)))\<^sup>v, snd(fst(z))\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
+  proof -
+    note types = assms leq_in_M P_in_M one_in_M
+    let ?f_fm="snd_fm(1,0)"
+    let ?g="\<lambda>z . fst(fst(fst(z)))\<^sup>v"
+    let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)),2,0)"
+    let ?h_fm="hcomp_fm(check_fm'(7),hcomp_fm(snd_fm,fst_fm),3,0)"
+    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 check_fm'_def
+      by (simp_all add:arity)
+    ultimately
+    show ?thesis
+      using separation_sat_after_function3 assms types sats_check_fm check_abs check_in_M
+        fst_abs snd_abs
+      unfolding hcomp_fm_def check_fm'_def
+      by simp
+  qed
+  moreover
+  have  "separation(##M, \<lambda>z. M, [snd(z), P, leq, \<one>, f_dot, \<tau>, fst(z)\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))"
+    if "\<tau>\<in>M" for \<tau>
+  proof -
+    let ?f_fm="snd_fm(1,0)"
+    let ?g_fm="hcomp_fm(check_fm'(6),fst_fm,2,0)"
+    note types = assms leq_in_M P_in_M one_in_M
+    have "arity(forces(\<cdot>0`1 is 2\<cdot> )) \<le> 7"
+      using arity_forces[of "\<cdot>0`1 is 2\<cdot> "] arity_fun_apply_fm union_abs1
+      by simp
+    moreover
+    have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
+      using ord_simp_union
+      unfolding hcomp_fm_def check_fm'_def
+      by (simp_all add:arity)
+    ultimately
+    show ?thesis
+      using separation_sat_after_function assms types that fst_abs
+        snd_abs types sats_check_fm check_abs check_in_M
+      unfolding hcomp_fm_def check_fm'_def
+      by simp
+  qed
+  ultimately
+  show ?thesis
+    using lam_replacement_imp_lam_closed lam_replacement_Collect
+      lam_replacement_constant lam_replacement_identity lam_replacement_snd lam_replacement_fst
+      lam_replacement_hcomp lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+      separation_conj separation_in  separation_ball separation_bex separation_iff'
+      transitivity[of _ A] leq_in_M assms
+    by simp
+qed
+
+\<comment> \<open>Kunen IV.3.5\<close>
+lemma ccc_fun_approximation_lemma:
+  notes le_trans[trans]
+  assumes "ccc\<^bsup>M\<^esup>(P,leq)" "A\<in>M" "B\<in>M" "f\<in>M[G]" "f : A \<rightarrow> B"
+  shows
+    "\<exists>F\<in>M. F : A \<rightarrow> Pow\<^bsup>M\<^esup>(B) \<and> (\<forall>a\<in>A. f`a \<in> F`a \<and> |F`a|\<^bsup>M\<^esup> \<le> \<omega>)"
+proof -
+  from \<open>f\<in>M[G]\<close>
+  obtain f_dot where "f = val(P,G,f_dot)" "f_dot\<in>M" using GenExtD by force
+  with assms
+  obtain p where "p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]" "p\<in>G" "p\<in>M"
+    using transitivity[OF M_genericD P_in_M]
+      generic truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[f_dot, A\<^sup>v, B\<^sup>v]"]
+    by (auto simp add:ord_simp_union arity_typed_function_fm
+        \<comment> \<open>NOTE: type-checking is not performed here by the Simplifier\<close>
+        typed_function_type)
+  define F where "F\<equiv>\<lambda>a\<in>A. {b\<in>B. \<exists>q\<in>P. q \<preceq> p \<and> (q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v])}"
+  from assms \<open>f_dot\<in>_\<close> \<open>p\<in>M\<close>
+  have "F \<in> M"
+    unfolding F_def using ccc_fun_closed_lemma by simp
+  moreover from calculation
+  have "f`a \<in> F`a" if "a \<in> A" for a
+  proof -
+    note \<open>f: A \<rightarrow> B\<close> \<open>a \<in> A\<close>
+    moreover from this
+    have "f ` a \<in> B" by simp
+    moreover
+    note \<open>f\<in>M[G]\<close> \<open>A\<in>M\<close>
+    moreover from calculation
+    have "M[G], [f, a, f`a] \<Turnstile> \<cdot>0`1 is 2\<cdot>"
+      by (auto dest:transM)
+    moreover
+    note \<open>B\<in>M\<close> \<open>f = val(P,G,f_dot)\<close>
+    moreover from calculation
+    have "a\<in>M" "val(P,G, f_dot)`a\<in>M"
+      by (auto dest:transM)
+    moreover
+    note \<open>f_dot\<in>M\<close> \<open>p\<in>G\<close>
+    ultimately
+    obtain q where "q \<preceq> p" "q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, (f`a)\<^sup>v]" "q\<in>G"
+      using forces_below_filter[of "\<cdot>0`1 is 2\<cdot>" "[f_dot, a\<^sup>v, (f`a)\<^sup>v]" p]
+      by (auto simp add: ord_simp_union arity_fun_apply_fm
+          fun_apply_type)
+    with \<open>f`a \<in> B\<close>
+    have "f`a \<in> {b\<in>B . \<exists>q\<in>P. q \<preceq> p \<and> q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]}"
+      by blast
+    with \<open>a\<in>A\<close>
+    show ?thesis unfolding F_def by simp
+  qed
+  moreover
+  have "|F`a|\<^bsup>M\<^esup> \<le> \<omega> \<and> F`a\<in>M" if "a \<in> A" for a
+  proof -
+    let ?Q="\<lambda>b. {q\<in>P. q \<preceq> p \<and> (q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v])}"
+    from \<open>F \<in> M\<close> \<open>a\<in>A\<close> \<open>A\<in>M\<close>
+    have "F`a \<in> M" "a\<in>M"
+      using transitivity[OF _ \<open>A\<in>M\<close>] by simp_all
+    moreover
+    have 2:"\<And>x. x\<in>F`a \<Longrightarrow> x\<in>M"
+      using transitivity[OF _ \<open>F`a\<in>M\<close>] by simp
+    moreover
+    have 3:"\<And>x. x\<in>F`a \<Longrightarrow> (##M)(?Q(x))"
+      using ccc_fun_closed_lemma_aux[OF \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close> 2] transitivity[of _ "F`a"]
+      by simp
+    moreover
+    have 4:"lam_replacement(##M,\<lambda>b. {q \<in> P . q \<preceq> p \<and> (M, [q, P, leq, \<one>, f_dot, a\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))})"
+      using ccc_fun_closed_lemma_aux2[OF _ \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close>]
+        lam_replacement_iff_lam_closed[THEN iffD2]
+        ccc_fun_closed_lemma_aux[OF  \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close>]
+      by simp
+    ultimately
+    interpret M_Pi_assumptions_choice "##M" "F`a" ?Q
+      using Pi_replacement1[OF _ 3] lam_replacement_Sigfun[OF 4]
+        lam_replacement_imp_strong_replacement
+        ccc_fun_closed_lemma_aux[OF \<open>f_dot\<in>M\<close> \<open>p\<in>M\<close> \<open>a\<in>M\<close>]
+        lam_replacement_hcomp2[OF lam_replacement_constant 4 _ _
+          lam_replacement_minimum,unfolded lam_replacement_def]
+      by unfold_locales simp_all
+    from \<open>F`a \<in> M\<close>
+    interpret M_Pi_assumptions2 "##M" "F`a" ?Q "\<lambda>_ . P"
+      using P_in_M lam_replacement_imp_strong_replacement[OF
+          lam_replacement_Sigfun[OF lam_replacement_constant]]
+        Pi_replacement1 transM[of _ "F`a"]
+      by unfold_locales simp_all
+    from \<open>p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]\<close> \<open>a\<in>A\<close>
+    have "\<exists>y. y \<in> ?Q(b)" if "b \<in> F`a" for b
+      using that unfolding F_def by auto
+    then
+    obtain q where "q \<in> Pi\<^bsup>M\<^esup>(F`a,?Q)" "q\<in>M" using AC_Pi_rel by auto
+    moreover
+    note \<open>F`a \<in> M\<close>
+    moreover from calculation
+    have "q : F`a \<rightarrow>\<^bsup>M\<^esup> P"
+      using Pi_rel_weaken_type def_function_space_rel by auto
+    moreover from calculation
+    have "q : F`a \<rightarrow> range(q)" "q : F`a \<rightarrow> P" "q : F`a \<rightarrow>\<^bsup>M\<^esup> range(q)"
+      using mem_function_space_rel_abs range_of_fun by simp_all
+    moreover
+    have "q`b \<bottom> q`c" if "b \<in> F`a" "c \<in> F`a" "b \<noteq> c"
+      \<comment> \<open>For the next step, if the premise \<^term>\<open>b \<noteq> c\<close> is first,
+        the proof breaks down badly\<close>
+      for b c
+    proof -
+      from \<open>b \<in> F`a\<close> \<open>c \<in> F`a\<close> \<open>q \<in> Pi\<^bsup>M\<^esup>(F`a,?Q)\<close> \<open>q\<in>M\<close>
+      have "q`b \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]"
+        "q`c \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, c\<^sup>v]"
+        using mem_Pi_rel_abs[of q] apply_type[of _ _  ?Q]
+        by simp_all
+      with \<open>b \<noteq> c\<close> \<open>q : F`a \<rightarrow> P\<close> \<open>a\<in>A\<close> \<open>b\<in>_\<close> \<open>c\<in>_\<close>
+        \<open>A\<in>M\<close> \<open>f_dot\<in>M\<close> \<open>F`a\<in>M\<close>
+      show ?thesis
+        using forces_neq_apply_imp_incompatible
+          transitivity[of _ A] transitivity[of _ "F`a"]
+        by auto
+    qed
+    moreover from calculation
+    have "antichain(range(q))"
+      using Pi_range_eq[of _  _ "\<lambda>_ . P"]
+      unfolding antichain_def by auto
+    moreover from this and \<open>q\<in>M\<close>
+    have "antichain_r'(range(q))"
+      by (simp add:absolut)
+    moreover from calculation
+    have "q`b \<noteq> q`c" if "b \<noteq> c" "b \<in> F`a" "c \<in> F`a" for b c
+      using that Incompatible_imp_not_eq apply_type
+        mem_function_space_rel_abs by simp
+    ultimately
+    have "q \<in> inj\<^bsup>M\<^esup>(F`a,range(q))"
+      using def_inj_rel by auto
+    with \<open>F`a \<in> M\<close> \<open>q\<in>M\<close>
+    have "|F`a|\<^bsup>M\<^esup> \<le> |range(q)|\<^bsup>M\<^esup>"
+      using def_lepoll_rel
+      by (rule_tac lepoll_rel_imp_cardinal_rel_le) auto
+    also from \<open>antichain_r'(range(q))\<close> \<open>ccc\<^bsup>M\<^esup>(P,leq)\<close> \<open>q\<in>M\<close>
+    have "|range(q)|\<^bsup>M\<^esup> \<le> \<omega>"
+      using def_ccc_rel by simp
+    finally
+    show ?thesis using \<open>F`a\<in>M\<close> by auto
+  qed
+  moreover from this
+  have "F`a\<in>M" if "a\<in>A" for a
+    using that by simp
+  moreover from this \<open>B\<in>M\<close>
+  have "F : A \<rightarrow> Pow\<^bsup>M\<^esup>(B)"
+    using Pow_rel_char
+    unfolding F_def by (rule_tac lam_type) auto
+  ultimately
+  show ?thesis by auto
+qed
+
+end \<comment> \<open>G\_generic1\_lemmas bundle\<close>
+
+end \<comment> \<open>\<^locale>\<open>G_generic4_AC\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Choice_Axiom.thy b/thys/Independence_CH/Choice_Axiom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Choice_Axiom.thy
@@ -0,0 +1,355 @@
+section\<open>The Axiom of Choice in $M[G]$\<close>
+
+theory Choice_Axiom
+  imports
+    Powerset_Axiom
+    Extensionality_Axiom
+    Foundation_Axiom
+    Replacement_Axiom
+    Infinity_Axiom
+begin
+
+definition
+  induced_surj :: "i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>i" where
+  "induced_surj(f,a,e) \<equiv> f-``(range(f)-a)\<times>{e} \<union> restrict(f,f-``a)"
+
+lemma domain_induced_surj: "domain(induced_surj(f,a,e)) = domain(f)"
+  unfolding induced_surj_def using domain_restrict domain_of_prod by auto
+
+lemma range_restrict_vimage:
+  assumes "function(f)"
+  shows "range(restrict(f,f-``a)) \<subseteq> a"
+proof
+  from assms
+  have "function(restrict(f,f-``a))"
+    using function_restrictI by simp
+  fix y
+  assume "y \<in> range(restrict(f,f-``a))"
+  then
+  obtain x where "\<langle>x,y\<rangle> \<in> restrict(f,f-``a)"  "x \<in> f-``a" "x\<in>domain(f)"
+    using domain_restrict domainI[of _ _ "restrict(f,f-``a)"] by auto
+  moreover
+  note \<open>function(restrict(f,f-``a))\<close>
+  ultimately
+  have "y = restrict(f,f-``a)`x"
+    using function_apply_equality by blast
+  also from \<open>x \<in> f-``a\<close>
+  have "restrict(f,f-``a)`x = f`x"
+    by simp
+  finally
+  have "y = f`x" .
+  moreover from assms \<open>x\<in>domain(f)\<close>
+  have "\<langle>x,f`x\<rangle> \<in> f"
+    using function_apply_Pair by auto
+  moreover
+  note assms \<open>x \<in> f-``a\<close>
+  ultimately
+  show "y\<in>a"
+    using function_image_vimage[of f a] by auto
+qed
+
+lemma induced_surj_type:
+  assumes "function(f)" (* "relation(f)" (* a function can contain non-pairs *) *)
+  shows
+    "induced_surj(f,a,e): domain(f) \<rightarrow> {e} \<union> a"
+    and
+    "x \<in> f-``a \<Longrightarrow> induced_surj(f,a,e)`x = f`x"
+proof -
+  let ?f1="f-``(range(f)-a) \<times> {e}" and ?f2="restrict(f, f-``a)"
+  have "domain(?f2) = domain(f) \<inter> f-``a"
+    using domain_restrict by simp
+  moreover from assms
+  have "domain(?f1) = f-``(range(f))-f-``a"
+    using domain_of_prod function_vimage_Diff by simp
+  ultimately
+  have "domain(?f1) \<inter> domain(?f2) = 0"
+    by auto
+  moreover
+  have "function(?f1)" "relation(?f1)" "range(?f1) \<subseteq> {e}"
+    unfolding function_def relation_def range_def by auto
+  moreover from this and assms
+  have "?f1: domain(?f1) \<rightarrow> range(?f1)"
+    using function_imp_Pi by simp
+  moreover from assms
+  have "?f2: domain(?f2) \<rightarrow> range(?f2)"
+    using function_imp_Pi[of "restrict(f, f -`` a)"] function_restrictI by simp
+  moreover from assms
+  have "range(?f2) \<subseteq> a"
+    using range_restrict_vimage by simp
+  ultimately
+  have "induced_surj(f,a,e): domain(?f1) \<union> domain(?f2) \<rightarrow> {e} \<union> a"
+    unfolding induced_surj_def using fun_is_function fun_disjoint_Un fun_weaken_type by simp
+  moreover
+  have "domain(?f1) \<union> domain(?f2) = domain(f)"
+    using domain_restrict domain_of_prod by auto
+  ultimately
+  show "induced_surj(f,a,e): domain(f) \<rightarrow> {e} \<union> a"
+    by simp
+  assume "x \<in> f-``a"
+  then
+  have "?f2`x = f`x"
+    using restrict by simp
+  moreover from \<open>x \<in> f-``a\<close> \<open>domain(?f1) = _\<close>
+  have "x \<notin> domain(?f1)"
+    by simp
+  ultimately
+  show "induced_surj(f,a,e)`x = f`x"
+    unfolding induced_surj_def using fun_disjoint_apply2[of x ?f1 ?f2] by simp
+qed
+
+lemma induced_surj_is_surj :
+  assumes
+    "e\<in>a" "function(f)" "domain(f) = \<alpha>" "\<And>y. y \<in> a \<Longrightarrow> \<exists>x\<in>\<alpha>. f ` x = y"
+  shows "induced_surj(f,a,e) \<in> surj(\<alpha>,a)"
+  unfolding surj_def
+proof (intro CollectI ballI)
+  from assms
+  show "induced_surj(f,a,e): \<alpha> \<rightarrow> a"
+    using induced_surj_type[of f a e] cons_eq cons_absorb by simp
+  fix y
+  assume "y \<in> a"
+  with assms
+  have "\<exists>x\<in>\<alpha>. f ` x = y"
+    by simp
+  then
+  obtain x where "x\<in>\<alpha>" "f ` x = y" by auto
+  with \<open>y\<in>a\<close> assms
+  have "x\<in>f-``a"
+    using vimage_iff function_apply_Pair[of f x] by auto
+  with \<open>f ` x = y\<close> assms
+  have "induced_surj(f, a, e) ` x = y"
+    using induced_surj_type by simp
+  with \<open>x\<in>\<alpha>\<close> show
+    "\<exists>x\<in>\<alpha>. induced_surj(f, a, e) ` x = y" by auto
+qed
+
+context G_generic1
+begin
+
+lemma upair_name_abs :
+  assumes "x\<in>M" "y\<in>M" "z\<in>M" "o\<in>M"
+  shows "is_upair_name(##M,x,y,o,z) \<longleftrightarrow> z = upair_name(x,y,o)"
+  unfolding is_upair_name_def upair_name_def
+  using assms zero_in_M pair_in_M_iff Upair_eq_cons
+  by simp
+
+lemma upair_name_closed :
+  "\<lbrakk> x\<in>M; y\<in>M ; o\<in>M\<rbrakk> \<Longrightarrow> upair_name(x,y,o)\<in>M"
+  unfolding upair_name_def
+  using upair_in_M_iff pair_in_M_iff Upair_eq_cons
+  by simp
+
+lemma opair_name_abs :
+  assumes "x\<in>M" "y\<in>M" "z\<in>M" "o\<in>M"
+  shows "is_opair_name(##M,x,y,o,z) \<longleftrightarrow> z = opair_name(x,y,o)"
+  unfolding is_opair_name_def opair_name_def
+  using assms upair_name_abs upair_name_closed
+  by simp
+
+lemma opair_name_closed :
+  "\<lbrakk> x\<in>M; y\<in>M ; o\<in>M \<rbrakk> \<Longrightarrow> opair_name(x,y,o)\<in>M"
+  unfolding opair_name_def
+  using upair_name_closed by simp
+
+lemma val_upair_name : "val(P,G,upair_name(\<tau>,\<rho>,\<one>)) = {val(P,G,\<tau>),val(P,G,\<rho>)}"
+  unfolding upair_name_def
+  using val_Upair Upair_eq_cons generic one_in_G one_in_P
+  by simp
+
+lemma val_opair_name : "val(P,G,opair_name(\<tau>,\<rho>,\<one>)) = \<langle>val(P,G,\<tau>),val(P,G,\<rho>)\<rangle>"
+  unfolding opair_name_def Pair_def
+  using val_upair_name by simp
+
+lemma val_RepFun_one: "val(P,G,{\<langle>f(x),\<one>\<rangle> . x\<in>a}) = {val(P,G,f(x)) . x\<in>a}"
+proof -
+  let ?A = "{f(x) . x \<in> a}"
+  let ?Q = "\<lambda>\<langle>x,p\<rangle> . p = \<one>"
+  have "\<one> \<in> P\<inter>G" using generic one_in_G one_in_P by simp
+  have "{\<langle>f(x),\<one>\<rangle> . x \<in> a} = {t \<in> ?A \<times> P . ?Q(t)}"
+    using one_in_P by force
+  then
+  have "val(P,G,{\<langle>f(x),\<one>\<rangle>  . x \<in> a}) = val(P,G,{t \<in> ?A \<times> P . ?Q(t)})"
+    by simp
+  also
+  have "... = {z . t \<in> ?A , (\<exists>p\<in>P\<inter>G . ?Q(\<langle>t,p\<rangle>)) \<and> z= val(P,G,t)}"
+    using val_of_name_alt by simp
+  also
+  have "... = {val(P,G,t) . t \<in> ?A }"
+    using \<open>\<one>\<in>P\<inter>G\<close> by force
+  also
+  have "... = {val(P,G,f(x)) . x \<in> a}"
+    by auto
+  finally
+  show ?thesis
+    by simp
+qed
+
+\<comment> \<open>NOTE: The following bundled additions to the simpset might be of
+    use later on, perhaps add them globally to some appropriate
+    locale.\<close>
+lemmas generic_simps = generic[THEN one_in_G, THEN valcheck, OF one_in_P]
+  generic[THEN one_in_G, THEN M_subset_MG, THEN subsetD]
+  check_in_M GenExtI P_in_M
+lemmas generic_dests = M_genericD[OF generic] M_generic_compatD[OF generic]
+
+bundle G_generic1_lemmas = generic_simps[simp] generic_dests[dest]
+
+end\<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+subsection\<open>$M[G]$ is a transitive model of ZF\<close>
+
+sublocale G_generic1 \<subseteq> ext:M_Z_trans "M[G]"
+  using Transset_MG generic pairing_in_MG Union_MG
+    extensionality_in_MG power_in_MG foundation_in_MG
+    replacement_assm_MG separation_in_MG infinity_in_MG
+    replacement_ax1 by unfold_locales
+
+context G_generic1
+begin
+
+lemma opname_check_abs :
+  assumes "s\<in>M" "x\<in>M" "y\<in>M"
+  shows "is_opname_check(##M,\<one>,s,x,y) \<longleftrightarrow> y = opair_name(check(x),s`x,\<one>)"
+  unfolding is_opname_check_def
+  using assms check_abs check_in_M opair_name_abs apply_abs apply_closed one_in_M
+  by simp
+
+lemma repl_opname_check :
+  assumes "A\<in>M" "f\<in>M"
+  shows "{opair_name(check(x),f`x,\<one>). x\<in>A}\<in>M"
+proof -
+  have "arity(is_opname_check_fm(3,2,0,1))= 4"
+    using arity_is_opname_check_fm
+    by (simp add:ord_simp_union arity)
+  moreover
+  have "opair_name(check(x), f ` x,\<one>)\<in>M" if "x\<in>A" for x
+    using assms opair_name_closed apply_closed transitivity check_in_M one_in_M that
+    by simp
+  ultimately
+  show ?thesis
+    using assms opname_check_abs[of f] is_opname_check_iff_sats
+      one_in_M zero_in_M transitivity
+      Replace_relativized_in_M[of "is_opname_check_fm(3,2,0,1)"
+        "[f,\<one>]" _ "is_opname_check(##M,\<one>,f)"] replacement_ax1(14)
+    by simp
+qed
+
+theorem choice_in_MG:
+  assumes "choice_ax(##M)"
+  shows "choice_ax(##M[G])"
+proof -
+  {
+    fix a
+    assume "a\<in>M[G]"
+    then
+    obtain \<tau> where "\<tau>\<in>M" "val(P,G,\<tau>) = a"
+      using GenExt_def by auto
+    with \<open>\<tau>\<in>M\<close>
+    have "domain(\<tau>)\<in>M"
+      using domain_closed by simp
+    then
+    obtain s \<alpha> where "s\<in>surj(\<alpha>,domain(\<tau>))" "Ord(\<alpha>)" "s\<in>M" "\<alpha>\<in>M"
+      using assms choice_ax_abs
+      by auto
+    then
+    have "\<alpha>\<in>M[G]"
+      using M_subset_MG generic one_in_G subsetD
+      by blast
+    let ?A="domain(\<tau>)\<times>P"
+    let ?g = "{opair_name(check(\<beta>),s`\<beta>,\<one>). \<beta>\<in>\<alpha>}"
+    have "?g \<in> M"
+      using \<open>s\<in>M\<close> \<open>\<alpha>\<in>M\<close> repl_opname_check
+      by simp
+    let ?f_dot="{\<langle>opair_name(check(\<beta>),s`\<beta>,\<one>),\<one>\<rangle>. \<beta>\<in>\<alpha>}"
+    have "?f_dot = ?g \<times> {\<one>}" by blast
+    define f where
+      "f \<equiv> val(P,G,?f_dot)"
+    from \<open>?g\<in>M\<close> \<open>?f_dot = ?g\<times>{\<one>}\<close>
+    have "?f_dot\<in>M"
+      using cartprod_closed singleton_closed one_in_M
+      by simp
+    then
+    have "f \<in> M[G]"
+      unfolding f_def
+      by (blast intro:GenExtI)
+    have "f = {val(P,G,opair_name(check(\<beta>),s`\<beta>,\<one>)) . \<beta>\<in>\<alpha>}"
+      unfolding f_def
+      using val_RepFun_one
+      by simp
+    also
+    have "... = {\<langle>\<beta>,val(P,G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}"
+      using val_opair_name valcheck generic one_in_G one_in_P
+      by simp
+    finally
+    have "f = {\<langle>\<beta>,val(P,G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}" .
+    then
+    have 1: "domain(f) = \<alpha>" "function(f)"
+      unfolding function_def by auto
+    have 2: "y \<in> a \<Longrightarrow> \<exists>x\<in>\<alpha>. f ` x = y" for y
+    proof -
+      fix y
+      assume
+        "y \<in> a"
+      with \<open>val(P,G,\<tau>) = a\<close>
+      obtain \<sigma> where  "\<sigma>\<in>domain(\<tau>)" "val(P,G,\<sigma>) = y"
+        using elem_of_val[of y _ \<tau>]
+        by blast
+      with \<open>s\<in>surj(\<alpha>,domain(\<tau>))\<close>
+      obtain \<beta> where "\<beta>\<in>\<alpha>" "s`\<beta> = \<sigma>"
+        unfolding surj_def
+        by auto
+      with \<open>val(P,G,\<sigma>) = y\<close>
+      have "val(P,G,s`\<beta>) = y"
+        by simp
+      with \<open>f = {\<langle>\<beta>,val(P,G,s`\<beta>)\<rangle> . \<beta>\<in>\<alpha>}\<close> \<open>\<beta>\<in>\<alpha>\<close>
+      have "\<langle>\<beta>,y\<rangle>\<in>f"
+        by auto
+      with \<open>function(f)\<close>
+      have "f`\<beta> = y"
+        using function_apply_equality by simp
+      with \<open>\<beta>\<in>\<alpha>\<close> show
+        "\<exists>\<beta>\<in>\<alpha>. f ` \<beta> = y"
+        by auto
+    qed
+    then
+    have "\<exists>\<alpha>\<in>(M[G]). \<exists>f'\<in>(M[G]). Ord(\<alpha>) \<and> f' \<in> surj(\<alpha>,a)"
+    proof (cases "a=0")
+      case True
+      then
+      show ?thesis
+        unfolding surj_def
+        using zero_in_MG
+        by auto
+    next
+      case False
+      with \<open>a\<in>M[G]\<close>
+      obtain e where "e\<in>a" "e\<in>M[G]"
+        using transitivity_MG
+        by blast
+      with 1 and 2
+      have "induced_surj(f,a,e) \<in> surj(\<alpha>,a)"
+        using induced_surj_is_surj by simp
+      moreover from \<open>f\<in>M[G]\<close> \<open>a\<in>M[G]\<close> \<open>e\<in>M[G]\<close>
+      have "induced_surj(f,a,e) \<in> M[G]"
+        unfolding induced_surj_def
+        by (simp flip: setclass_iff)
+      moreover
+      note \<open>\<alpha>\<in>M[G]\<close> \<open>Ord(\<alpha>)\<close>
+      ultimately
+      show ?thesis
+        by auto
+    qed
+  }
+  then
+  show ?thesis
+    using ext.choice_ax_abs
+    by simp
+qed
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+sublocale G_generic1_AC \<subseteq> ext:M_ZC_basic "M[G]"
+  using choice_ax choice_in_MG
+  by unfold_locales
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Cohen_Posets_Relative.thy b/thys/Independence_CH/Cohen_Posets_Relative.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Cohen_Posets_Relative.thy
@@ -0,0 +1,658 @@
+section\<open>Cohen forcing notions\<close>
+
+theory Cohen_Posets_Relative
+  imports
+    Forcing_Notions
+    Transitive_Models.Delta_System_Relative
+    Transitive_Models.Partial_Functions_Relative
+begin
+
+locale cohen_data =
+  fixes \<kappa> I J::i
+  assumes zero_lt_kappa: "0<\<kappa>"
+begin
+
+lemmas zero_lesspoll_kappa = zero_lesspoll[OF zero_lt_kappa]
+
+end \<comment> \<open>\<^locale>\<open>cohen_data\<close>\<close>
+
+locale add_reals = cohen_data nat _ 2
+
+subsection\<open>Combinatorial results on Cohen posets\<close>
+
+sublocale cohen_data \<subseteq> forcing_notion "Fn(\<kappa>,I,J)" "Fnle(\<kappa>,I,J)" 0
+proof
+  show "0 \<in> Fn(\<kappa>, I, J)"
+    using zero_lt_kappa zero_in_Fn by simp
+  then
+  show "\<forall>p\<in>Fn(\<kappa>, I, J). \<langle>p, 0\<rangle> \<in> Fnle(\<kappa>, I, J)"
+    unfolding preorder_on_def refl_def trans_on_def
+    by auto
+next
+  show "preorder_on(Fn(\<kappa>, I, J), Fnle(\<kappa>, I, J))"
+    unfolding preorder_on_def refl_def trans_on_def
+    by blast
+qed
+
+context cohen_data
+begin
+
+lemma compat_imp_Un_is_function:
+  assumes "G \<subseteq> Fn(\<kappa>, I, J)" "\<And>p q. p \<in> G \<Longrightarrow> q \<in> G \<Longrightarrow> compat(p,q)"
+  shows "function(\<Union>G)"
+  unfolding function_def
+proof (intro allI ballI impI)
+  fix x y y'
+  assume "\<langle>x, y\<rangle> \<in> \<Union>G" "\<langle>x, y'\<rangle> \<in> \<Union>G"
+  then
+  obtain p q where "\<langle>x, y\<rangle> \<in> p" "\<langle>x, y'\<rangle> \<in> q" "p \<in> G" "q \<in> G"
+    by auto
+  moreover from this and assms
+  obtain r where "r \<in> Fn(\<kappa>, I, J)" "r \<supseteq> p" "r \<supseteq> q"
+    using compatD[of p q] by force
+  moreover from this
+  have "function(r)"
+    using Fn_is_function by simp
+  ultimately
+  show "y = y'"
+    unfolding function_def by fastforce
+qed
+
+(* MOVE THIS to an appropriate place *)
+lemma filter_subset_notion: "filter(G) \<Longrightarrow> G \<subseteq> Fn(\<kappa>, I, J)"
+  unfolding filter_def by simp
+
+lemma Un_filter_is_function: "filter(G) \<Longrightarrow> function(\<Union>G)"
+  using compat_imp_Un_is_function filter_imp_compat[of G]
+    filter_subset_notion
+  by simp
+
+end \<comment> \<open>\<^locale>\<open>cohen_data\<close>\<close>
+
+locale M_cohen = M_delta +
+  assumes
+    countable_lepoll_assms2:
+    "M(A') \<Longrightarrow> M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. {p \<in> A . domain(p) = a}, b, f, i)\<rangle>)"
+    and
+    countable_lepoll_assms3:
+    "M(A) \<Longrightarrow> M(f) \<Longrightarrow> M(b) \<Longrightarrow> M(D) \<Longrightarrow> M(r') \<Longrightarrow> M(A')\<Longrightarrow>
+        separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(drSR_Y(r', D, A), b, f, i)\<rangle>)"
+
+context M_cardinal_library
+begin
+
+lemma lesspoll_nat_imp_lesspoll_rel:
+  assumes "A \<prec> \<omega>" "M(A)"
+  shows "A \<prec>\<^bsup>M\<^esup> \<omega>"
+proof -
+  note assms
+  moreover from this
+  obtain f n where "f\<in>bij\<^bsup>M\<^esup>(A,n)" "n\<in>\<omega>" "A \<approx>\<^bsup>M\<^esup> n"
+    using lesspoll_nat_is_Finite Finite_rel_def[of M A]
+    by auto
+  moreover from calculation
+  have "A \<lesssim>\<^bsup>M\<^esup> \<omega>"
+    using lesspoll_nat_is_Finite Infinite_imp_nats_lepoll_rel[of \<omega> n]
+      nat_not_Finite eq_lepoll_rel_trans[of A n \<omega>]
+    by auto
+  moreover from calculation
+  have "\<not> g \<in> bij\<^bsup>M\<^esup>(A,\<omega>)" for g
+    using mem_bij_rel unfolding lesspoll_def by auto
+  ultimately
+  show ?thesis
+    unfolding lesspoll_rel_def
+    by auto
+qed
+
+lemma Finite_imp_lesspoll_rel_nat:
+  assumes "Finite(A)" "M(A)"
+  shows "A \<prec>\<^bsup>M\<^esup> \<omega>"
+  using Finite_imp_lesspoll_nat assms lesspoll_nat_imp_lesspoll_rel
+  by auto
+
+lemma InfCard_rel_lesspoll_rel_Un:
+  includes Ord_dests
+  assumes "InfCard_rel(M,\<kappa>)" "A \<prec>\<^bsup>M\<^esup> \<kappa>" "B \<prec>\<^bsup>M\<^esup> \<kappa>"
+    and types: "M(\<kappa>)" "M(A)" "M(B)"
+  shows "A \<union> B \<prec>\<^bsup>M\<^esup> \<kappa>"
+proof -
+  from assms
+  have "|A|\<^bsup>M\<^esup> < \<kappa>" "|B|\<^bsup>M\<^esup> < \<kappa>"
+    using lesspoll_rel_cardinal_rel_lt InfCard_rel_is_Card_rel
+    by auto
+  show ?thesis
+  proof (cases "Finite(A) \<and> Finite(B)")
+    case True
+    with assms
+    show ?thesis
+      using lesspoll_rel_trans2[OF _ le_imp_lepoll_rel, of _ nat \<kappa>]
+        Finite_imp_lesspoll_rel_nat[OF Finite_Un]
+      unfolding InfCard_rel_def
+      by simp
+  next
+    case False
+    with types
+    have "InfCard_rel(M,max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>))"
+      using Infinite_InfCard_rel_cardinal_rel InfCard_rel_is_Card_rel
+        le_trans[of nat] not_le_iff_lt[THEN iffD1, THEN leI, of "|A|\<^bsup>M\<^esup>" "|B|\<^bsup>M\<^esup>"]
+      unfolding max_def InfCard_rel_def
+      by auto
+    with \<open>M(A)\<close> \<open>M(B)\<close>
+    have "|A \<union> B|\<^bsup>M\<^esup> \<le> max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>)"
+      using cardinal_rel_Un_le[of "max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>)" A B]
+        not_le_iff_lt[THEN iffD1, THEN leI, of "|A|\<^bsup>M\<^esup>" "|B|\<^bsup>M\<^esup>" ]
+      unfolding max_def
+      by simp
+    moreover from \<open>|A|\<^bsup>M\<^esup> < \<kappa>\<close> \<open>|B|\<^bsup>M\<^esup> < \<kappa>\<close>
+    have "max(|A|\<^bsup>M\<^esup>,|B|\<^bsup>M\<^esup>) < \<kappa>"
+      unfolding max_def
+      by simp
+    ultimately
+    have "|A \<union> B|\<^bsup>M\<^esup> <  \<kappa>"
+      using lt_trans1
+      by blast
+    moreover
+    note \<open>InfCard_rel(M,\<kappa>)\<close>
+    moreover from calculation types
+    have "|A \<union> B|\<^bsup>M\<^esup> \<prec>\<^bsup>M\<^esup> \<kappa>"
+      using lt_Card_rel_imp_lesspoll_rel InfCard_rel_is_Card_rel
+      by simp
+    ultimately
+    show ?thesis
+      using cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[of "A \<union> B" "|A \<union> B|\<^bsup>M\<^esup>" \<kappa>]
+        eqpoll_rel_sym types
+      by simp
+  qed
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_cardinal_library\<close>\<close>
+
+lemma (in M_cohen) Fn_rel_unionI:
+  assumes "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "q\<in>Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
+    "M(\<kappa>)" "M(I)" "M(J)" "domain(p) \<inter> domain(q) = 0"
+  shows "p\<union>q \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
+proof -
+  note assms
+  moreover from calculation
+  have "p \<prec>\<^bsup>M\<^esup> \<kappa>" "q \<prec>\<^bsup>M\<^esup> \<kappa>" "M(p)" "M(q)"
+    using Fn_rel_is_function by simp_all
+  moreover from calculation
+  have "p\<union>q \<prec>\<^bsup>M\<^esup> \<kappa>"
+    using eqpoll_rel_sym cardinal_rel_eqpoll_rel InfCard_rel_lesspoll_rel_Un
+    by simp_all
+  ultimately
+  show ?thesis
+    unfolding Fn_rel_def
+    using pfun_unionI cardinal_rel_eqpoll_rel eq_lesspoll_rel_trans[OF _ \<open>p\<union>q \<prec>\<^bsup>M\<^esup> _\<close>]
+    by auto
+qed
+
+lemma (in M_cohen) restrict_eq_imp_compat_rel:
+  assumes "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "q \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)" "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(J)" "M(\<kappa>)"
+    "restrict(p, domain(p) \<inter> domain(q)) = restrict(q, domain(p) \<inter> domain(q))"
+  shows "p \<union> q \<in> Fn\<^bsup>M\<^esup>(\<kappa>, I, J)"
+proof -
+  note assms
+  moreover from calculation
+  have "p \<prec>\<^bsup>M\<^esup> \<kappa>" "q \<prec>\<^bsup>M\<^esup> \<kappa>" "M(p)" "M(q)"
+    using Fn_rel_is_function by simp_all
+  moreover from calculation
+  have "p\<union>q \<prec>\<^bsup>M\<^esup> \<kappa>"
+    using InfCard_rel_lesspoll_rel_Un cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym]
+    by auto
+  ultimately
+  show ?thesis
+    unfolding Fn_rel_def
+    using pfun_restrict_eq_imp_compat cardinal_rel_eqpoll_rel
+      eq_lesspoll_rel_trans[OF _ \<open>p\<union>q \<prec>\<^bsup>M\<^esup> _\<close>]
+    by auto
+qed
+
+lemma (in M_cohen) InfCard_rel_imp_n_lesspoll_rel :
+  assumes "InfCard\<^bsup>M\<^esup>(\<kappa>)" "M(\<kappa>)" "n\<in>\<omega>"
+  shows "n \<prec>\<^bsup>M\<^esup> \<kappa>"
+proof -
+  note assms
+  moreover from this
+  have "n \<prec>\<^bsup>M\<^esup> \<omega>"
+    using n_lesspoll_rel_nat by simp
+  ultimately
+  show ?thesis
+    using lesspoll_rel_trans2 Infinite_iff_lepoll_rel_nat InfCard_rel_imp_Infinite nat_into_M
+    by simp
+qed
+
+lemma (in M_cohen) cons_in_Fn_rel:
+  assumes "x \<notin> domain(p)" "p \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)" "x \<in> I" "j \<in> J" "InfCard\<^bsup>M\<^esup>(\<kappa>)"
+    "M(\<kappa>)" "M(I)" "M(J)"
+  shows "cons(\<langle>x,j\<rangle>, p) \<in> Fn\<^bsup>M\<^esup>(\<kappa>,I,J)"
+  using assms cons_eq Fn_rel_unionI[OF Fn_rel_singletonI[of x I j J] \<open>p\<in>_\<close>]
+    InfCard_rel_imp_n_lesspoll_rel
+  by auto
+
+lemma (in M_library) Fnle_rel_Aleph_rel1_closed[intro,simp]:
+  "M(Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2))"
+  by simp
+
+locale M_add_reals = M_cohen + add_reals
+begin
+
+lemmas zero_lesspoll_rel_kappa = zero_lesspoll_rel[OF zero_lt_kappa]
+
+end \<comment> \<open>\<^locale>\<open>M_add_reals\<close>\<close>
+
+(* MOVE THIS to some appropriate place. Notice that in Forcing_Notions
+we don't import anything relative. *)
+relativize relational "compat_in" "is_compat_in" external
+synthesize "compat_in" from_definition "is_compat_in" assuming "nonempty"
+context
+  notes Un_assoc[simp] Un_trasposition_aux2[simp]
+begin
+arity_theorem for "compat_in_fm"
+end
+
+lemma (in M_trivial) compat_in_abs[absolut]:
+  assumes
+    "M(A)" "M(r)" "M(p)" "M(q)"
+  shows
+    "is_compat_in(M,A,r,p,q) \<longleftrightarrow> compat_in(A,r,p,q)"
+  using assms unfolding is_compat_in_def compat_in_def by simp
+
+definition
+  antichain :: "i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
+  "antichain(P,leq,A) \<equiv> A\<subseteq>P \<and> (\<forall>p\<in>A. \<forall>q\<in>A. p\<noteq>q \<longrightarrow> \<not>compat_in(P,leq,p,q))"
+
+relativize relational  "antichain" "antichain_rel"
+definition
+  ccc :: "i \<Rightarrow> i \<Rightarrow> o" where
+  "ccc(P,leq) \<equiv> \<forall>A. antichain(P,leq,A) \<longrightarrow> |A| \<le> nat"
+
+abbreviation
+  antichain_rel_abbr :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" (\<open>antichain\<^bsup>_\<^esup>'(_,_,_')\<close>) where
+  "antichain\<^bsup>M\<^esup>(P,leq,A) \<equiv> antichain_rel(M,P,leq,A)"
+
+abbreviation
+  antichain_r_set :: "[i,i,i,i] \<Rightarrow> o" (\<open>antichain\<^bsup>_\<^esup>'(_,_,_')\<close>) where
+  "antichain\<^bsup>M\<^esup>(P,leq,A) \<equiv> antichain_rel(##M,P,leq,A)"
+
+context M_trivial
+begin
+
+lemma antichain_abs [absolut]:
+  "\<lbrakk> M(A); M(P); M(leq) \<rbrakk> \<Longrightarrow> antichain\<^bsup>M\<^esup>(P,leq,A) \<longleftrightarrow> antichain(P,leq,A)"
+  unfolding antichain_rel_def antichain_def by (simp add:absolut)
+
+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
+
+relativize relational "ccc" "ccc_rel"
+
+abbreviation
+  ccc_rel_abbr :: "[i\<Rightarrow>o,i,i]\<Rightarrow>o" (\<open>ccc\<^bsup>_\<^esup>'(_,_')\<close>) where
+  "ccc_rel_abbr(M) \<equiv> ccc_rel(M)"
+
+abbreviation
+  ccc_r_set :: "[i,i,i]\<Rightarrow>o" (\<open>ccc\<^bsup>_\<^esup>'(_,_')\<close>) where
+  "ccc_r_set(M) \<equiv> ccc_rel(##M)"
+
+context M_cardinals
+begin
+
+lemma def_ccc_rel:
+  shows
+    "ccc\<^bsup>M\<^esup>(P,leq) \<longleftrightarrow> (\<forall>A[M]. antichain\<^bsup>M\<^esup>(P,leq,A) \<longrightarrow> |A|\<^bsup>M\<^esup> \<le> \<omega>)"
+  using is_cardinal_iff
+  unfolding ccc_rel_def by (simp add:absolut)
+
+end \<comment> \<open>\<^locale>\<open>M_cardinals\<close>\<close>
+
+context M_FiniteFun
+begin
+
+lemma Fnle_nat_closed[intro,simp]:
+  assumes "M(I)" "M(J)"
+  shows "M(Fnle(\<omega>,I,J))"
+  unfolding Fnle_def Fnlerel_def Rrel_def
+  using supset_separation FiniteFun_closed Fn_nat_eq_FiniteFun assms by simp
+
+lemma Fn_nat_closed:
+  assumes "M(A)" "M(B)" shows "M(Fn(\<omega>,A,B))"
+  using assms Fn_nat_eq_FiniteFun
+  by simp
+
+end \<comment> \<open>\<^locale>\<open>M_FiniteFun\<close>\<close>
+
+context M_add_reals
+begin
+
+lemma lam_replacement_drSR_Y: "M(A) \<Longrightarrow> M(D) \<Longrightarrow> M(r') \<Longrightarrow> lam_replacement(M, drSR_Y(r',D,A))"
+  using lam_replacement_drSR_Y
+  by simp
+
+lemma (in M_trans) mem_F_bound3:
+  fixes F A
+  defines "F \<equiv> dC_F"
+  shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> {domain(x). x\<in>A})"
+  using apply_0 unfolding F_def
+  by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
+
+lemma ccc_rel_Fn_nat:
+  assumes "M(I)"
+  shows "ccc\<^bsup>M\<^esup>(Fn(nat,I,2), Fnle(nat,I,2))"
+proof -
+  have repFun_dom_closed:"M({domain(p) . p \<in> A})" if "M(A)" for A
+    using RepFun_closed domain_replacement_simp transM[OF _ \<open>M(A)\<close>] that
+    by auto
+  from assms
+  have "M(Fn(nat,I,2))" using Fn_nat_eq_FiniteFun by simp
+  {
+    fix A
+    assume "\<not> |A|\<^bsup>M\<^esup> \<le> nat" "M(A)" "A \<subseteq> Fn(nat, I, 2)"
+    moreover from this
+    have "countable_rel(M,{p\<in>A. domain(p) = d})" if "M(d)" for d
+    proof (cases "d\<prec>\<^bsup>M\<^esup>nat \<and> d \<subseteq> I")
+      case True
+      with \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(A)\<close>
+      have "{p \<in> A . domain(p) = d} \<subseteq> d \<rightarrow>\<^bsup>M\<^esup> 2"
+        using domain_of_fun function_space_rel_char[of _ 2]
+        by (auto,subgoal_tac "M(domain(x))",simp_all add:transM[of _ A],force)
+      moreover from True \<open>M(d)\<close>
+      have "Finite(d \<rightarrow>\<^bsup>M\<^esup> 2)"
+        using Finite_Pi[THEN [2] subset_Finite, of _ d "\<lambda>_. 2"]
+          lesspoll_rel_nat_is_Finite_rel function_space_rel_char[of _ 2]
+        by auto
+      moreover from \<open>M(d)\<close>
+      have "M(d \<rightarrow>\<^bsup>M\<^esup> 2)"
+        by simp
+      moreover from \<open>M(A)\<close>
+      have "M({p \<in> A . domain(p) = d})"
+        using separation_closed domain_eq_separation[OF \<open>M(d)\<close>] by simp
+      ultimately
+      show ?thesis using subset_Finite[of _ "d\<rightarrow>\<^bsup>M\<^esup>2" ]
+        by (auto intro!:Finite_imp_countable_rel)
+    next
+      case False
+      with \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(A)\<close>
+      have "domain(p) \<noteq> d" if "p\<in>A" for p
+      proof -
+        note False that \<open>M(A)\<close>
+        moreover from this
+        obtain d' where "d' \<subseteq> I" "p\<in>d' \<rightarrow> 2" "d' \<prec> \<omega>"
+          using FnD[OF subsetD[OF \<open>A\<subseteq>_\<close> \<open>p\<in>A\<close>]]
+          by auto
+        moreover from this
+        have "p \<approx> d'" "domain(p) = d'"
+          using function_eqpoll Pi_iff
+          by auto
+        ultimately
+        show ?thesis
+          using lesspoll_nat_imp_lesspoll_rel transM[of p]
+          by auto
+      qed
+      then
+      show ?thesis
+        using empty_lepoll_relI by auto
+    qed
+    have 2:"M(x) \<Longrightarrow> x \<in> dC_F(X, i) \<Longrightarrow> M(i)" for x X i
+      unfolding dC_F_def
+      by auto
+    moreover
+    have "uncountable_rel(M,{domain(p) . p \<in> A})"
+    proof
+      interpret M_replacement_lepoll M dC_F
+        using lam_replacement_dC_F domain_eq_separation lam_replacement_inj_rel
+        unfolding dC_F_def
+      proof(unfold_locales,simp_all)
+        fix X b f
+        assume "M(X)" "M(b)" "M(f)"
+        with 2[of X]
+        show "lam_replacement(M, \<lambda>x. \<mu> i. x \<in> if_range_F_else_F(\<lambda>d. {p \<in> X . domain(p) = d}, b, f, i))"
+          using lam_replacement_dC_F domain_eq_separation
+            mem_F_bound3 countable_lepoll_assms2 repFun_dom_closed
+          by (rule_tac lam_Least_assumption_general[where U="\<lambda>_. {domain(x). x\<in>X}"],auto)
+      qed (auto)
+      have "\<exists>a\<in>A. x = domain(a) \<Longrightarrow> M(dC_F(A,x))" for x
+        using \<open>M(A)\<close> transM[OF _ \<open>M(A)\<close>] by (auto)
+      moreover
+      have "w \<in> A \<and> domain(w) = x \<Longrightarrow> M(x)" for w x
+        using transM[OF _ \<open>M(A)\<close>] by auto
+      ultimately
+      interpret M_cardinal_UN_lepoll _ "dC_F(A)" "{domain(p). p\<in>A}"
+        using lam_replacement_dC_F lam_replacement_inj_rel \<open>M(A)\<close>
+          lepoll_assumptions domain_eq_separation
+          countable_lepoll_assms2 repFun_dom_closed
+          lepoll_assumptions1[OF \<open>M(A)\<close> repFun_dom_closed[OF \<open>M(A)\<close>]]
+        apply(unfold_locales)
+        by(simp_all del:if_range_F_else_F_def,
+            rule_tac lam_Least_assumption_general[where U="\<lambda>_. {domain(x). x\<in>A}"])
+          (auto simp del:if_range_F_else_F_def simp add:dC_F_def)
+      from \<open>A \<subseteq> Fn(nat, I, 2)\<close>
+      have x:"(\<Union>d\<in>{domain(p) . p \<in> A}. {p\<in>A. domain(p) = d}) = A"
+        by auto
+      moreover
+      assume "countable_rel(M,{domain(p) . p \<in> A})"
+      moreover
+      note \<open>\<And>d. M(d) \<Longrightarrow> countable_rel(M,{p\<in>A. domain(p) = d})\<close>
+      moreover from \<open>M(A)\<close>
+      have "p\<in>A \<Longrightarrow> M(domain(p))" for p
+        by (auto dest: transM)
+      ultimately
+      have "countable_rel(M,A)"
+        using countable_rel_imp_countable_rel_UN
+        unfolding dC_F_def
+        by auto
+      with \<open>\<not> |A|\<^bsup>M\<^esup> \<le> nat\<close> \<open>M(A)\<close>
+      show False
+        using countable_rel_iff_cardinal_rel_le_nat by simp
+    qed
+    moreover from \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(A)\<close>
+    have "p \<in> A \<Longrightarrow> Finite(domain(p))" for p
+      using lesspoll_rel_nat_is_Finite_rel[of "domain(p)"]
+        lesspoll_nat_imp_lesspoll_rel[of "domain(p)"]
+        domain_of_fun[of p _ "\<lambda>_. 2"] by (auto dest:transM)
+    moreover
+    note repFun_dom_closed[OF \<open>M(A)\<close>]
+    ultimately
+    obtain D where "delta_system(D)" "D \<subseteq> {domain(p) . p \<in> A}" "D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "M(D)"
+      using delta_system_uncountable_rel[of "{domain(p) . p \<in> A}"] by auto
+    then
+    have delta:"\<forall>d1\<in>D. \<forall>d2\<in>D. d1 \<noteq> d2 \<longrightarrow> d1 \<inter> d2 = \<Inter>D"
+      using delta_system_root_eq_Inter
+      by simp
+    moreover from \<open>D \<approx>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>\<close> \<open>M(D)\<close>
+    have "uncountable_rel(M,D)"
+      using uncountable_rel_iff_subset_eqpoll_rel_Aleph_rel1 by auto
+    moreover from this and \<open>D \<subseteq> {domain(p) . p \<in> A}\<close>
+    obtain p1 where "p1 \<in> A" "domain(p1) \<in> D"
+      using uncountable_rel_not_empty[of D] by blast
+    moreover from this and \<open>p1 \<in> A \<Longrightarrow> Finite(domain(p1))\<close>
+    have "Finite(domain(p1))"
+      using Finite_domain by simp
+    moreover
+    define r where "r \<equiv> \<Inter>D"
+    moreover from \<open>M(D)\<close>
+    have "M(r)" "M(r\<times>2)"
+      unfolding r_def by simp_all
+    ultimately
+    have "Finite(r)" using subset_Finite[of "r" "domain(p1)"]
+      by auto
+    have "countable_rel(M,{restrict(p,r) . p\<in>A})"
+    proof -
+      note \<open>M(Fn(nat, I, 2))\<close> \<open>M(r)\<close>
+      moreover from this
+      have "f\<in>Fn(nat, I, 2) \<Longrightarrow> M(restrict(f,r))" for f
+        by (blast dest: transM)
+      ultimately
+      have "f\<in>Fn(nat, I, 2) \<Longrightarrow> restrict(f,r) \<in> Pow_rel(M,r \<times> 2)" for f
+        using restrict_subset_Sigma[of f _ "\<lambda>_. 2" r] Pow_rel_char
+        by (auto del:FnD dest!:FnD simp: Pi_def) (auto dest:transM)
+      with \<open>A \<subseteq> Fn(nat, I, 2)\<close>
+      have "{restrict(f,r) . f \<in> A } \<subseteq> Pow_rel(M,r \<times> 2)"
+        by fast
+      moreover from \<open>M(A)\<close> \<open>M(r)\<close>
+      have "M({restrict(f,r) . f \<in> A })"
+        using RepFun_closed restrict_strong_replacement transM[OF _ \<open>M(A)\<close>] by auto
+      moreover
+      note \<open>Finite(r)\<close> \<open>M(r)\<close>
+      ultimately
+      show ?thesis
+        using Finite_Sigma[THEN Finite_Pow_rel, of r "\<lambda>_. 2"]
+        by (intro Finite_imp_countable_rel) (auto intro:subset_Finite)
+    qed
+    moreover from \<open>M(A)\<close> \<open>M(D)\<close>
+    have "M({p\<in>A. domain(p) \<in> D})"
+      using domain_mem_separation by simp
+    have "uncountable_rel(M,{p\<in>A. domain(p) \<in> D})" (is "uncountable_rel(M,?X)")
+    proof
+      from \<open>D \<subseteq> {domain(p) . p \<in> A}\<close>
+      have "(\<lambda>p\<in>?X. domain(p)) \<in> surj(?X, D)"
+        using lam_type unfolding surj_def by auto
+      moreover from \<open>M(A)\<close> \<open>M(?X)\<close>
+      have "M(\<lambda>p\<in>?X. domain(p))"
+        using lam_closed[OF domain_replacement \<open>M(?X)\<close>] transM[OF _ \<open>M(?X)\<close>] by simp
+      moreover
+      note \<open>M(?X)\<close> \<open>M(D)\<close>
+      moreover from calculation
+      have surjection:"(\<lambda>p\<in>?X. domain(p)) \<in> surj\<^bsup>M\<^esup>(?X, D)"
+        using surj_rel_char by simp
+      moreover
+      assume "countable_rel(M,?X)"
+      moreover
+      note \<open>uncountable_rel(M,D)\<close>
+      ultimately
+      show False
+        using surj_rel_countable_rel[OF _ surjection] by auto
+    qed
+    moreover
+    have "D = (\<Union>f\<in>Pow_rel(M,r\<times>2) . {y . p\<in>A, restrict(p,r) = f \<and> y=domain(p) \<and> domain(p) \<in> D})"
+    proof -
+      {
+        fix z
+        assume "z \<in> D"
+        with \<open>M(D)\<close>
+        have \<open>M(z)\<close> by (auto dest:transM)
+        from \<open>z\<in>D\<close> \<open>D \<subseteq> _\<close> \<open>M(A)\<close>
+        obtain p  where "domain(p) = z" "p \<in> A" "M(p)"
+          by (auto dest:transM)
+        moreover from \<open>A \<subseteq> Fn(nat, I, 2)\<close> \<open>M(z)\<close> and this
+        have "p \<in> z \<rightarrow>\<^bsup>M\<^esup> 2"
+          using domain_of_fun function_space_rel_char by (auto del:FnD dest!:FnD)
+        moreover from this \<open>M(z)\<close>
+        have "p \<in> z \<rightarrow> 2"
+          using domain_of_fun function_space_rel_char by (auto)
+        moreover from this \<open>M(r)\<close>
+        have "restrict(p,r) \<subseteq> r \<times> 2"
+          using function_restrictI[of p r] fun_is_function[of p z "\<lambda>_. 2"]
+            restrict_subset_Sigma[of p z "\<lambda>_. 2" r] function_space_rel_char
+          by (auto simp:Pi_def)
+        moreover from \<open>M(p)\<close> \<open>M(r)\<close>
+        have "M(restrict(p,r))" by simp
+        moreover
+        note \<open>M(r)\<close>
+        ultimately
+        have "\<exists>p\<in>A.  restrict(p,r) \<in> Pow_rel(M,r\<times>2) \<and> domain(p) = z"
+          using Pow_rel_char by auto
+      }
+      then
+      show ?thesis
+        by (intro equalityI) (force)+
+    qed
+    from \<open>M(D)\<close>\<open>M(r)\<close>
+    have "M({y . p\<in>A, restrict(p,r) = f \<and> y=domain(p) \<and> domain(p) \<in> D})" (is "M(?Y(A,f))")
+      if "M(f)" "M(A)" for f A
+      using drSR_Y_closed[unfolded drSR_Y_def] that
+      by simp
+    then
+    obtain f where "uncountable_rel(M,?Y(A,f))" "M(f)"
+    proof -
+      have 1:"M(i)"
+        if "M(B)" "M(x)"
+          "x \<in> {y . x \<in> B, restrict(x, r) = i \<and> y = domain(x) \<and> domain(x) \<in> D}"
+        for B x i
+        using that \<open>M(r)\<close>
+        by (auto dest:transM)
+      note \<open>M(r)\<close>
+      moreover from this
+      have "M(Pow\<^bsup>M\<^esup>(r \<times> 2))" by simp
+      moreover
+      note \<open>M(A)\<close> \<open>\<And>f A. M(f) \<Longrightarrow> M(A) \<Longrightarrow> M(?Y(A,f))\<close> \<open>M(D)\<close>
+      moreover from calculation
+      interpret M_replacement_lepoll M "drSR_Y(r,D)"
+        using countable_lepoll_assms3 lam_replacement_inj_rel lam_replacement_drSR_Y
+          drSR_Y_closed lam_Least_assumption_drSR_Y
+        by (unfold_locales,simp_all add:drSR_Y_def,rule_tac 1,simp_all)
+      from calculation
+      have "x \<in> Pow\<^bsup>M\<^esup>(r \<times> 2) \<Longrightarrow> M(drSR_Y(r, D, A, x))" for x
+        unfolding drSR_Y_def by (auto dest:transM)
+      ultimately
+      interpret M_cardinal_UN_lepoll _ "?Y(A)" "Pow_rel(M,r\<times>2)"
+        using countable_lepoll_assms3 lam_replacement_drSR_Y
+          lepoll_assumptions[where S="Pow_rel(M,r\<times>2)", unfolded lepoll_assumptions_defs]
+          lam_Least_assumption_drSR_Y[unfolded drSR_Y_def]
+        unfolding drSR_Y_def
+        apply unfold_locales
+                        apply (simp_all add:lam_replacement_inj_rel del: if_range_F_else_F_def,rule_tac 1,simp_all)
+        by ((fastforce dest:transM[OF _ \<open>M(A)\<close>])+)
+      {
+        from \<open>Finite(r)\<close> \<open>M(r)\<close>
+        have "countable_rel(M,Pow_rel(M,r\<times>2))"
+          using Finite_Sigma[THEN Finite_Pow_rel] Finite_imp_countable_rel
+          by simp
+        moreover
+        assume "M(f) \<Longrightarrow> countable_rel(M,?Y(A,f))" for f
+        moreover
+        note \<open>D = (\<Union>f\<in>Pow_rel(M,r\<times>2) .?Y(A,f))\<close> \<open>M(r)\<close>
+        moreover
+        note \<open>uncountable_rel(M,D)\<close>
+        ultimately
+        have "False"
+          using countable_rel_imp_countable_rel_UN by (auto dest: transM)
+      }
+      with that
+      show ?thesis
+        by auto
+    qed
+    moreover from this \<open>M(A)\<close> and \<open>M(f) \<Longrightarrow> M(A) \<Longrightarrow> M(?Y(A,f))\<close>
+    have "M(?Y(A,f))"
+      by blast
+    ultimately
+    obtain j where "j \<in> inj_rel(M,nat, ?Y(A,f))" "M(j)"
+      using uncountable_rel_iff_nat_lt_cardinal_rel[THEN iffD1, THEN leI,
+          THEN cardinal_rel_le_imp_lepoll_rel, THEN lepoll_relD]
+      by auto
+    with \<open>M(?Y(A,f))\<close>
+    have "j`0 \<noteq> j`1" "j`0 \<in> ?Y(A,f)" "j`1 \<in> ?Y(A,f)"
+      using inj_is_fun[THEN apply_type, of j nat "?Y(A,f)"]
+        inj_rel_char
+      unfolding inj_def by auto
+    then
+    obtain p q where "domain(p) \<noteq> domain(q)" "p \<in> A" "q \<in> A"
+      "domain(p) \<in> D" "domain(q) \<in> D"
+      "restrict(p,r) = restrict(q,r)" by auto
+    moreover from this and delta
+    have "domain(p) \<inter> domain(q) = r"
+      unfolding r_def by simp
+    moreover
+    note \<open>A \<subseteq> Fn(nat, I, 2)\<close> Fn_nat_abs[OF \<open>M(I)\<close> nat_into_M[of 2],simplified]
+    moreover from calculation
+    have "p \<in> Fn\<^bsup>M\<^esup>(nat, I, 2)" "q \<in> Fn\<^bsup>M\<^esup>(nat, I, 2)"
+      by auto
+    moreover from calculation
+    have "p \<union> q \<in> Fn(nat, I, 2)"
+      using restrict_eq_imp_compat_rel InfCard_rel_nat
+      by simp
+    ultimately
+    have "\<exists>p\<in>A. \<exists>q\<in>A. p \<noteq> q \<and> compat_in(Fn(nat, I, 2), Fnle(nat, I, 2), p, q)"
+      unfolding compat_in_def
+      by (rule_tac bexI[of _ p], rule_tac bexI[of _ q]) blast
+  }
+  moreover from assms
+  have "M(Fnle(\<omega>,I,2))"
+    by simp
+  moreover note \<open>M(Fn(\<omega>,I,2))\<close>
+  ultimately
+  show ?thesis using def_ccc_rel by (auto simp:absolut antichain_def) fastforce
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_add_reals\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Definitions_Main.thy b/thys/Independence_CH/Definitions_Main.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Definitions_Main.thy
@@ -0,0 +1,610 @@
+section\<open>Main definitions of the development\label{sec:main-definitions}\<close>
+
+theory Definitions_Main
+  imports
+    Absolute_Versions
+begin
+
+text\<open>This theory gathers the main definitions of the Forcing session.
+
+It might be considered as the bare minimum reading requisite to
+trust that our development indeed formalizes the theory of
+forcing. This should be mathematically clear since this is the
+only known method for obtaining proper extensions of ctms while
+preserving the ordinals.
+
+The main theorem of this session and all of its relevant definitions
+appear in Section~\ref{sec:def-main-forcing}. The reader trusting
+all the libraries in which our development is based, might jump
+directly there. But in case one wants to dive deeper, the following
+sections treat some basic concepts in the ZF logic
+(Section~\ref{sec:def-main-ZF})  and in the
+ZF-Constructible library (Section~\ref{sec:def-main-relative})
+on which our definitions are built.
+\<close>
+
+declare [[show_question_marks=false]]
+
+subsection\<open>ZF\label{sec:def-main-ZF}\<close>
+
+text\<open>For the basic logic ZF we restrict ourselves to just a few
+concepts.\<close>
+
+thm bij_def[unfolded inj_def surj_def]
+text\<open>@{thm [display] bij_def[unfolded inj_def surj_def]}\<close>
+(*
+  bij(A, B) \<equiv> {f \<in> A \<rightarrow> B . \<forall>w\<in>A. \<forall>x\<in>A. f ` w = f ` x \<longrightarrow> w = x}
+               \<inter> {f \<in> A \<rightarrow> B . \<forall>y\<in>B. \<exists>x\<in>A. f ` x = y}
+*)
+
+thm eqpoll_def
+text\<open>@{thm [display] eqpoll_def}\<close>
+(*
+  A \<approx> B \<equiv> \<exists>f. f \<in> bij(A, B)
+*)
+
+thm Transset_def
+text\<open>@{thm [display] Transset_def}\<close>
+(*
+  Transset(i) \<equiv> \<forall>x\<in>i. x \<subseteq> i
+*)
+
+thm Ord_def
+text\<open>@{thm [display] Ord_def}\<close>
+(*
+  Ord(i) \<equiv> Transset(i) \<and> (\<forall>x\<in>i. Transset(x))
+*)
+
+thm lt_def le_iff
+text\<open>@{thm [display] lt_def le_iff}\<close>
+(*
+  i < j \<equiv> i \<in> j \<and> Ord(j)
+  i \<le> j \<longleftrightarrow> i < j \<or> i = j \<and> Ord(j)
+*)
+
+text\<open>With the concepts of empty set and successor in place,\<close>
+lemma empty_def': "\<forall>x. x \<notin> 0" by simp
+lemma succ_def': "succ(i) = i \<union> {i}" by blast
+
+text\<open>we can define the set of natural numbers \<^term>\<open>\<omega>\<close>. In the
+sources, it is  defined as a fixpoint, but here we just write
+its characterization as the first limit ordinal.\<close>
+thm Limit_nat[unfolded Limit_def] nat_le_Limit[unfolded Limit_def]
+text\<open>@{thm [display] Limit_nat[unfolded Limit_def]
+ nat_le_Limit[unfolded Limit_def]}\<close>
+(*
+  Ord(\<omega>) \<and> 0 < \<omega> \<and> (\<forall>y. y < \<omega> \<longrightarrow> succ(y) < \<omega>)
+  Ord(i) \<and> 0 < i \<and> (\<forall>y. y < i \<longrightarrow> succ(y) < i) \<Longrightarrow> \<omega> \<le> i
+*)
+
+text\<open>Then, addition and predecessor are inductively characterized
+as follows:\<close>
+thm add_0_right add_succ_right pred_0 pred_succ_eq
+text\<open>@{thm [display] add_succ_right add_0_right pred_0 pred_succ_eq}\<close>
+(*
+  m \<in> \<omega> \<Longrightarrow> m +\<^sub>\<omega> 0 = m
+  m +\<^sub>\<omega> succ(n) = succ(m +\<^sub>\<omega> n)
+
+  pred(0) = 0
+  pred(succ(y)) = y
+*)
+
+text\<open>Lists on a set \<^term>\<open>A\<close> can be characterized by being
+recursively generated from the empty list \<^term>\<open>[]\<close> and the
+operation \<^term>\<open>Cons\<close> that adds a new element to the left end;
+the induction theorem for them shows that the characterization is
+“complete”.\<close>
+
+thm Nil Cons list.induct
+text\<open>@{thm [display] Nil Cons list.induct }\<close>
+(*
+  [] \<in> list(A)
+  a \<in> A \<Longrightarrow> l \<in> list(A) \<Longrightarrow> Cons(a, l) \<in> list(A)
+  x \<in> list(A) \<Longrightarrow> P([]) \<Longrightarrow> (\<And>a l. a \<in> A \<Longrightarrow> l \<in> list(A) \<Longrightarrow> P(l) \<Longrightarrow> P(Cons(a, l))) \<Longrightarrow> P(x)
+*)
+
+text\<open>Length, concatenation, and \<^term>\<open>n\<close>th element of lists are
+recursively characterized as follows.\<close>
+thm length.simps app.simps nth_0 nth_Cons
+text\<open>@{thm [display] length.simps app.simps nth_0 nth_Cons}\<close>
+(*
+  length([]) = 0
+  length(Cons(a, l)) = succ(length(l))
+
+  [] @ ys = ys
+  Cons(a, l) @ ys = Cons(a, l @ ys)
+
+  nth(0, Cons(a, l)) = a
+  n \<in> \<omega> \<Longrightarrow> nth(succ(n), Cons(a, l)) = nth(n, l)
+*)
+txt\<open>We have the usual Haskell-like notation for iterated applications
+of \<^term>\<open>Cons\<close>:\<close>
+lemma Cons_app: "[a,b,c] = Cons(a,Cons(b,Cons(c,[])))" ..
+
+txt\<open>Relative quantifiers restrict the range of the bound variable to a
+class \<^term>\<open>M\<close> of type \<^typ>\<open>i\<Rightarrow>o\<close>; that is, a truth-valued function with
+set arguments.\<close>
+lemma "\<forall>x[M]. P(x) \<equiv> \<forall>x. M(x) \<longrightarrow> P(x)"
+      "\<exists>x[M]. P(x) \<equiv> \<exists>x. M(x) \<and> P(x)"
+  unfolding rall_def rex_def .
+
+txt\<open>Finally, a set can be viewed (“cast”) as a class using the
+following function of type \<^typ>\<open>i\<Rightarrow>(i\<Rightarrow>o)\<close>.\<close>
+thm setclass_iff
+text\<open>@{thm [display] setclass_iff}\<close>
+(*
+  (##A)(x) \<longleftrightarrow> x \<in> A
+*)
+
+subsection\<open>Relative concepts\label{sec:def-main-relative}\<close>
+txt\<open>A list of relative concepts (mostly from the ZF-Constructible
+    library) follows next.\<close>
+
+thm big_union_def
+text\<open>@{thm [display] big_union_def}\<close>
+(*
+  big_union(M, A, z) \<equiv> \<forall>x[M]. x \<in> z \<longleftrightarrow> (\<exists>y[M]. y \<in> A \<and> x \<in> y)
+*)
+
+thm upair_def
+text\<open>@{thm [display] upair_def}\<close>
+(*
+  upair(M, a, b, z) \<equiv> a \<in> z \<and> b \<in> z \<and> (\<forall>x[M]. x \<in> z \<longrightarrow> x = a \<or> x = b)
+*)
+
+thm pair_def
+text\<open>@{thm [display] pair_def}\<close>
+(*
+  pair(M, a, b, z) \<equiv> \<exists>x[M]. upair(M, a, a, x) \<and>
+                        (\<exists>y[M]. upair(M, a, b, y) \<and> upair(M, x, y, z))
+*)
+
+thm successor_def[unfolded is_cons_def union_def]
+text\<open>@{thm [display] successor_def[unfolded is_cons_def union_def]}\<close>
+(*
+  successor(M, a, z) \<equiv> \<exists>x[M]. upair(M, a, a, x) \<and> (\<forall>xa[M]. xa \<in> z \<longleftrightarrow> xa \<in> x \<or> xa \<in> a)
+*)
+
+thm empty_def
+text\<open>@{thm [display] empty_def}\<close>
+(*
+  empty(M, z) \<equiv> \<forall>x[M]. x \<notin> z
+*)
+
+thm transitive_set_def[unfolded subset_def]
+text\<open>@{thm [display] transitive_set_def[unfolded subset_def]}\<close>
+(*
+  transitive_set(M, a) \<equiv> \<forall>x[M]. x \<in> a \<longrightarrow> (\<forall>xa[M]. xa \<in> x \<longrightarrow> xa \<in> a)
+*)
+
+
+thm ordinal_def
+text\<open>@{thm [display] ordinal_def}\<close>
+(*
+  ordinal(M, a) \<equiv> transitive_set(M, a) \<and> (\<forall>x[M]. x \<in> a \<longrightarrow>
+                                              transitive_set(M, x))
+*)
+
+thm image_def
+text\<open>@{thm [display] image_def}\<close>
+(*
+  image(M, r, A, z) \<equiv> \<forall>y[M]. y \<in> z \<longleftrightarrow>
+                (\<exists>w[M]. w \<in> r \<and> (\<exists>x[M]. x \<in> A \<and> pair(M, x, y, w)))
+*)
+
+thm fun_apply_def
+text\<open>@{thm [display] fun_apply_def}\<close>
+(*
+  fun_apply(M, f, x, y) \<equiv> \<exists>xs[M]. \<exists>fxs[M]. upair(M, x, x, xs) \<and>
+                       image(M, f, xs, fxs) \<and> big_union(M, fxs, y)
+*)
+
+thm is_function_def
+text\<open>@{thm [display] is_function_def}\<close>
+(*
+  is_function(M, r) \<equiv> \<forall>x[M]. \<forall>y[M]. \<forall>y'[M]. \<forall>p[M]. \<forall>p'[M].
+       pair(M, x, y, p) \<longrightarrow> pair(M, x, y', p') \<longrightarrow> p \<in> r \<longrightarrow> p' \<in> r \<longrightarrow> y = y'
+*)
+
+thm is_relation_def
+text\<open>@{thm [display] is_relation_def}\<close>
+(*
+  is_relation(M, r) \<equiv> \<forall>z[M]. z \<in> r \<longrightarrow> (\<exists>x[M]. \<exists>y[M]. pair(M, x, y, z))
+*)
+
+thm is_domain_def
+text\<open>@{thm [display] is_domain_def}\<close>
+(*
+  is_domain(M, r, z) \<equiv> \<forall>x[M]. x \<in> z \<longleftrightarrow>
+                        (\<exists>w[M]. w \<in> r \<and> (\<exists>y[M]. pair(M, x, y, w)))
+*)
+
+thm typed_function_def
+text\<open>@{thm [display] typed_function_def}\<close>
+(*
+  typed_function(M, A, B, r) \<equiv> is_function(M, r) \<and> is_relation(M, r) \<and>
+                                is_domain(M, r, A) \<and>
+            (\<forall>u[M]. u \<in> r \<longrightarrow> (\<forall>x[M]. \<forall>y[M]. pair(M, x, y, u) \<longrightarrow> y \<in> B))
+*)
+
+thm is_function_space_def[unfolded is_funspace_def]
+  function_space_rel_def surjection_def
+text\<open>@{thm [display] is_function_space_def[unfolded is_funspace_def]
+  function_space_rel_def surjection_def}\<close>
+(*
+  is_function_space(M, A, B, fs) \<equiv>
+  M(fs) \<and> (\<forall>f[M]. f \<in> fs \<longleftrightarrow> typed_function(M, A, B, f))
+
+  A \<rightarrow>\<^bsup>M\<^esup> B \<equiv> THE d. is_function_space(M, A, B, d)
+
+  surjection(M, A, B, f) \<equiv>
+  typed_function(M, A, B, f) \<and>
+  (\<forall>y[M]. y \<in> B \<longrightarrow> (\<exists>x[M]. x \<in> A \<and> is_apply(M, f, x, y)))
+*)
+
+
+txt\<open>Relative version of the $\ZFC$ axioms\<close>
+thm extensionality_def
+text\<open>@{thm [display] extensionality_def}\<close>
+(*
+  extensionality(M) \<equiv> \<forall>x[M]. \<forall>y[M]. (\<forall>z[M]. z \<in> x \<longleftrightarrow> z \<in> y) \<longrightarrow> x = y
+*)
+
+thm foundation_ax_def
+text\<open>@{thm [display] foundation_ax_def}\<close>
+(*
+  foundation_ax(M) \<equiv> \<forall>x[M]. (\<exists>y[M]. y \<in> x) \<longrightarrow> (\<exists>y[M]. y \<in> x \<and> \<not> (\<exists>z[M]. z \<in> x \<and> z \<in> y))
+*)
+
+thm upair_ax_def
+text\<open>@{thm [display] upair_ax_def}\<close>
+(*
+  upair_ax(M) \<equiv> \<forall>x[M]. \<forall>y[M]. \<exists>z[M]. upair(M, x, y, z)
+*)
+
+thm Union_ax_def
+text\<open>@{thm [display] Union_ax_def}\<close>
+(*
+  Union_ax(M) \<equiv> \<forall>x[M]. \<exists>z[M]. \<forall>xa[M]. xa \<in> z \<longleftrightarrow> (\<exists>y[M]. y \<in> x \<and> xa \<in> y)
+*)
+
+thm power_ax_def[unfolded powerset_def subset_def]
+text\<open>@{thm [display] power_ax_def[unfolded powerset_def subset_def]}\<close>
+(*
+  power_ax(M) \<equiv> \<forall>x[M]. \<exists>z[M]. \<forall>xa[M]. xa \<in> z \<longleftrightarrow> (\<forall>xb[M]. xb \<in> xa \<longrightarrow> xb \<in> x)
+*)
+
+thm infinity_ax_def
+text\<open>@{thm [display] infinity_ax_def}\<close>
+(*
+  infinity_ax(M) \<equiv> \<exists>I[M]. (\<exists>z[M]. empty(M, z) \<and> z \<in> I) \<and> (\<forall>y[M]. y \<in> I \<longrightarrow>
+                        (\<exists>sy[M]. successor(M, y, sy) \<and> sy \<in> I))
+*)
+
+thm choice_ax_def
+text\<open>@{thm [display] choice_ax_def}\<close>
+(*
+  choice_ax(M) \<equiv> \<forall>x[M]. \<exists>a[M]. \<exists>f[M]. ordinal(M, a) \<and> surjection(M, a, x, f)
+*)
+
+thm separation_def
+text\<open>@{thm [display] separation_def}\<close>
+(*
+  separation(M, P) \<equiv> \<forall>z[M]. \<exists>y[M]. \<forall>x[M]. x \<in> y \<longleftrightarrow> x \<in> z \<and> P(x)
+*)
+
+thm univalent_def
+text\<open>@{thm [display] univalent_def}\<close>
+(*
+  univalent(M, A, P) \<equiv> \<forall>x[M]. x \<in> A \<longrightarrow>
+                          (\<forall>y[M]. \<forall>z[M]. P(x, y) \<and> P(x, z) \<longrightarrow> y = z)
+*)
+
+thm strong_replacement_def
+text\<open>@{thm [display] strong_replacement_def}\<close>
+(*
+  strong_replacement(M, P) \<equiv> \<forall>A[M]. univalent(M, A, P) \<longrightarrow>
+       (\<exists>Y[M]. \<forall>b[M]. b \<in> Y \<longleftrightarrow> (\<exists>x[M]. x \<in> A \<and> P(x, b)))
+*)
+
+text\<open>Internalized formulas\<close>
+
+txt\<open>“Codes” for formulas (as sets) are constructed from natural
+numbers using \<^term>\<open>Member\<close>, \<^term>\<open>Equal\<close>, \<^term>\<open>Nand\<close>,
+and \<^term>\<open>Forall\<close>.\<close>
+
+thm Member Equal Nand Forall formula.induct
+text\<open>@{thm [display] Member Equal Nand Forall formula.induct}\<close>
+(*
+  x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> \<cdot>x \<in> y\<cdot> \<in> formula
+  x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> \<cdot>x = y\<cdot> \<in> formula
+  p \<in> formula \<Longrightarrow> q \<in> formula \<Longrightarrow> \<cdot>\<not>(p \<and> q)\<cdot> \<in> formula
+  p \<in> formula \<Longrightarrow> (\<forall>p) \<in> formula
+
+  x \<in> formula \<Longrightarrow>
+  (\<And>x y. x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> P(\<cdot>x \<in> y\<cdot>)) \<Longrightarrow>
+  (\<And>x y. x \<in> \<omega> \<Longrightarrow> y \<in> \<omega> \<Longrightarrow> P(\<cdot>x = y\<cdot>)) \<Longrightarrow>
+  (\<And>p q. p \<in> formula \<Longrightarrow> P(p) \<Longrightarrow> q \<in> formula \<Longrightarrow> P(q) \<Longrightarrow> P(\<cdot>\<not>(p \<and> q)\<cdot>)) \<Longrightarrow>
+  (\<And>p. p \<in> formula \<Longrightarrow> P(p) \<Longrightarrow> P((\<forall>p))) \<Longrightarrow> P(x)
+*)
+
+txt\<open>Definitions for the other connectives and the internal existential
+quantifier are also provided. For instance, negation:\<close>
+thm Neg_def
+text\<open>@{thm [display] Neg_def}\<close>
+
+thm arity.simps
+text\<open>@{thm [display] arity.simps}\<close>
+(*
+  arity(\<cdot>x \<in> y\<cdot>) = succ(x) \<union> succ(y)
+  arity(\<cdot>x = y\<cdot>) = succ(x) \<union> succ(y)
+  arity(\<cdot>\<not>(p \<and> q)\<cdot>) = arity(p) \<union> arity(q)
+  arity((\<forall>p)) = pred(arity(p))
+*)
+
+txt\<open>We have the satisfaction relation between $\in$-models and
+    first order formulas (given a “environment” list representing
+    the assignment of free variables),\<close>
+thm mem_iff_sats equal_iff_sats sats_Nand_iff sats_Forall_iff
+text\<open>@{thm [display] mem_iff_sats equal_iff_sats sats_Nand_iff sats_Forall_iff}\<close>
+(*
+  nth(i, env) = x \<Longrightarrow> nth(j, env) = y \<Longrightarrow> env \<in> list(A) \<Longrightarrow> x \<in> y \<longleftrightarrow> A, env \<Turnstile> \<cdot>i \<in> j\<cdot>
+  nth(i, env) = x \<Longrightarrow> nth(j, env) = y \<Longrightarrow> env \<in> list(A) \<Longrightarrow> x = y \<longleftrightarrow> A, env \<Turnstile> \<cdot>i = j\<cdot>
+  env \<in> list(A) \<Longrightarrow> (A, env \<Turnstile> \<cdot>\<not>(p \<and> q)\<cdot>) \<longleftrightarrow> \<not> ((A, env \<Turnstile> p) \<and> (A, env \<Turnstile> q))
+  env \<in> list(A) \<Longrightarrow> (A, env \<Turnstile> (\<cdot>\<forall>p\<cdot>)) \<longleftrightarrow> (\<forall>x\<in>A. A, Cons(x, env) \<Turnstile> p)*)
+
+txt\<open>as well as the satisfaction of an arbitrary set of sentences.\<close>
+thm satT_def
+text\<open>@{thm [display] satT_def}\<close>
+(*
+  A \<Turnstile> \<Phi>  \<equiv>  \<forall>\<phi>\<in>\<Phi>. A, [] \<Turnstile> \<phi>
+*)
+
+txt\<open>The internalized (viz. as elements of the set \<^term>\<open>formula\<close>)
+    version of the axioms follow next.\<close>
+
+thm ZF_union_iff_sats ZF_power_iff_sats ZF_pairing_iff_sats
+  ZF_foundation_iff_sats ZF_extensionality_iff_sats
+  ZF_infinity_iff_sats sats_ZF_separation_fm_iff
+  sats_ZF_replacement_fm_iff ZF_choice_iff_sats
+text\<open>@{thm [display] ZF_union_iff_sats ZF_power_iff_sats
+  ZF_pairing_iff_sats
+  ZF_foundation_iff_sats ZF_extensionality_iff_sats
+  ZF_infinity_iff_sats sats_ZF_separation_fm_iff
+  sats_ZF_replacement_fm_iff ZF_choice_iff_sats}\<close>
+(*
+  Union_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Union Ax\<cdot>
+  power_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Powerset Ax\<cdot>
+  upair_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Pairing\<cdot>
+  foundation_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Foundation\<cdot>
+  extensionality(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Extensionality\<cdot>
+  infinity_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>Infinity\<cdot>
+
+  \<phi> \<in> formula \<Longrightarrow>
+  (M, [] \<Turnstile> \<cdot>Separation(\<phi>)\<cdot>) \<longleftrightarrow>
+  (\<forall>env\<in>list(M).
+      arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<longrightarrow> separation(##M, \<lambda>x. M, [x] @ env \<Turnstile> \<phi>))
+
+  \<phi> \<in> formula \<Longrightarrow>
+  (M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>) \<longleftrightarrow>
+  (\<forall>env\<in>list(M).
+      arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
+      strong_replacement(##M, \<lambda>x y. M, [x, y] @ env \<Turnstile> \<phi>))
+
+  choice_ax(##A) \<longleftrightarrow> A, [] \<Turnstile> \<cdot>AC\<cdot>
+*)
+
+thm ZF_fin_def ZF_schemes_def Zermelo_fms_def ZC_def ZF_def ZFC_def
+text\<open>@{thm [display] ZF_fin_def ZF_schemes_def Zermelo_fms_def ZC_def ZF_def
+  ZFC_def}\<close>
+(*
+  ZF_fin \<equiv> {\<cdot>Extensionality\<cdot>, \<cdot>Foundation\<cdot>, \<cdot>Pairing\<cdot>, \<cdot>Union Ax\<cdot>, \<cdot>Infinity\<cdot>, \<cdot>Powerset Ax\<cdot>}
+  ZF_schemes \<equiv> {\<cdot>Separation(p)\<cdot> . p \<in> formula} \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> formula}
+  \<cdot>Z\<cdot> \<equiv> ZF_fin \<union> {\<cdot>Separation(p)\<cdot> . p \<in> formula}
+  ZC \<equiv> \<cdot>Z\<cdot> \<union> {\<cdot>AC\<cdot>}
+  ZF \<equiv> ZF_schemes \<union> ZF_fin
+  ZFC \<equiv> ZF \<union> {\<cdot>AC\<cdot>}
+*)
+
+subsection\<open>Relativization of infinitary arithmetic\<close>
+
+txt\<open>In order to state the defining property of the relative
+    equipotence relation, we work under the assumptions of the
+    locale \<^term>\<open>M_cardinals\<close>. They comprise a finite set
+    of instances of Separation and Replacement to prove
+    closure properties of the transitive class \<^term>\<open>M\<close>.\<close>
+
+lemma (in M_cardinals) eqpoll_def':
+  assumes "M(A)" "M(B)" shows "A \<approx>\<^bsup>M\<^esup> B \<longleftrightarrow> (\<exists>f[M]. f \<in> bij(A,B))"
+  using assms unfolding eqpoll_rel_def by auto
+
+txt\<open>Below, $\mu$ denotes the minimum operator on the ordinals.\<close>
+lemma cardinalities_defs:
+  fixes M::"i\<Rightarrow>o"
+  shows
+    "|A|\<^bsup>M\<^esup> \<equiv> \<mu> i. M(i) \<and> i \<approx>\<^bsup>M\<^esup> A"
+    "Card\<^bsup>M\<^esup>(\<alpha>) \<equiv> \<alpha> = |\<alpha>|\<^bsup>M\<^esup>"
+    "\<kappa>\<^bsup>\<up>\<nu>,M\<^esup> \<equiv> |\<nu> \<rightarrow>\<^bsup>M\<^esup> \<kappa>|\<^bsup>M\<^esup>"
+    "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<equiv> \<mu> x. M(x) \<and> Card\<^bsup>M\<^esup>(x) \<and> \<kappa> < x"
+  unfolding cardinal_rel_def cexp_rel_def
+    csucc_rel_def Card_rel_def .
+
+context M_aleph
+begin
+
+txt\<open>As in the previous Lemma @{thm [source] eqpoll_def'}, we are now under
+    the assumptions of the locale \<^term>\<open>M_aleph\<close>. The axiom instances
+    included are sufficient to state and prove the defining
+    properties of the relativized \<^term>\<open>Aleph\<close> function
+    (in particular, the required ability to perform transfinite recursions).\<close>
+
+thm Aleph_rel_zero Aleph_rel_succ Aleph_rel_limit
+text\<open>@{thm [display] Aleph_rel_zero Aleph_rel_succ Aleph_rel_limit}\<close>
+(*
+  \<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup> = \<omega>
+  Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>succ(\<alpha>)\<^esub>\<^bsup>M\<^esup> = (\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup>
+  Limit(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> = (\<Union>j\<in>\<alpha>. \<aleph>\<^bsub>j\<^esub>\<^bsup>M\<^esup>)
+*)
+
+end \<comment> \<open>\<^locale>\<open>M_aleph\<close>\<close>
+
+lemma ContHyp_rel_def':
+  fixes N::"i\<Rightarrow>o"
+  shows
+    "CH\<^bsup>N\<^esup> \<equiv> \<aleph>\<^bsub>1\<^esub>\<^bsup>N\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>N\<^esup>,N\<^esup>"
+  unfolding ContHyp_rel_def .
+
+txt\<open>Under appropriate hypothesis (this time, from the locale \<^term>\<open>M_master\<close>),
+   \<^term>\<open>CH\<^bsup>M\<^esup>\<close> is equivalent to its fully relational version \<^term>\<open>is_ContHyp\<close>.
+    As a sanity check, we see that if the transitive class is indeed \<^term>\<open>\<V>\<close>,
+    we recover the original $\CH$.\<close>
+
+thm M_master.is_ContHyp_iff is_ContHyp_iff_CH[unfolded ContHyp_def]
+text\<open>@{thm [display] M_master.is_ContHyp_iff
+    is_ContHyp_iff_CH[unfolded ContHyp_def]}\<close>
+(*
+  M_master(M) \<Longrightarrow> is_ContHyp(M) \<longleftrightarrow> CH\<^bsup>M\<^esup>
+  is_ContHyp(\<V>) \<longleftrightarrow> \<aleph>\<^bsub>1\<^esub> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^esup>
+*)
+
+txt\<open>In turn, the fully relational version evaluated on a nonempty
+    transitive \<^term>\<open>A\<close> is equivalent to the satisfaction of the
+    first-order formula \<^term>\<open>\<cdot>CH\<cdot>\<close>.\<close>
+thm is_ContHyp_iff_sats
+text\<open>@{thm [display] is_ContHyp_iff_sats}\<close>
+(*
+  env \<in> list(A) \<Longrightarrow> 0 \<in> A \<Longrightarrow> is_ContHyp(##A) \<longleftrightarrow> A, env \<Turnstile> \<cdot>CH\<cdot>
+*)
+
+
+subsection\<open>Forcing \label{sec:def-main-forcing}\<close>
+
+txt\<open>Our first milestone was to obtain a proper extension using forcing.
+It's original proof didn't required the previous developments involving
+the relativization of material on cardinal arithmetic. Now it is
+derived from a stronger result, namely @{thm [source] extensions_of_ctms}
+below.\<close>
+
+thm extensions_of_ctms_ZF
+text\<open>@{thm [display] extensions_of_ctms_ZF}\<close>
+(*
+  M \<approx> \<omega> \<Longrightarrow>
+  Transset(M) \<Longrightarrow>
+  M \<Turnstile> ZF \<Longrightarrow>
+  \<exists>N. M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZF \<and> M \<noteq> N \<and>
+    (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N) \<and> ((M, [] \<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N \<Turnstile> ZFC)
+*)
+
+txt\<open>We can finally state our main results, namely, the existence of models
+for $\ZFC + \CH$ and $\ZFC + \neg\CH$ under the assumption of a ctm of $\ZFC$.\<close>
+
+thm ctm_ZFC_imp_ctm_not_CH
+text\<open>@{thm [display] ctm_ZFC_imp_ctm_not_CH}\<close>
+(*
+  M \<approx> \<omega> \<Longrightarrow>
+  Transset(M) \<Longrightarrow>
+  M \<Turnstile> ZFC \<Longrightarrow>
+  \<exists>N. M \<subseteq> N \<and>
+    N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<and>
+    (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
+*)
+
+thm ctm_ZFC_imp_ctm_CH
+text\<open>@{thm [display] ctm_ZFC_imp_ctm_CH}\<close>
+(*
+  M \<approx> \<omega> \<Longrightarrow>
+  Transset(M) \<Longrightarrow>
+  M \<Turnstile> ZFC \<Longrightarrow>
+  \<exists>N. M \<subseteq> N \<and>
+      N \<approx> \<omega> \<and>
+      Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
+*)
+
+txt\<open>These results can be strengthened by enumerating four finite sets of
+replacement instances which are sufficient to develop forcing and for
+the construction of the aforementioned models: \<^term>\<open>instances1_fms\<close>
+through \<^term>\<open>instances4_fms\<close>, which are then collected into
+\<^term>\<open>overhead\<close>. For example, we have:\<close>
+
+thm instances1_fms_def
+text\<open>@{thm [display] instances1_fms_def}\<close>
+(*
+instances1_fms \<equiv>
+{ wfrec_Hfrc_at_fm, list_repl1_intf_fm, list_repl2_intf_fm,
+ formula_repl2_intf_fm, eclose_repl2_intf_fm, powapply_repl_fm,
+ phrank_repl_fm, wfrec_rank_fm, trans_repl_HVFrom_fm, wfrec_Hcheck_fm,
+ repl_PHcheck_fm, check_replacement_fm, G_dot_in_M_fm, repl_opname_check_fm,
+ tl_repl_intf_fm, formula_repl1_intf_fm, eclose_repl1_intf_fm }
+*)
+
+thm overhead_def
+text\<open>@{thm [display] overhead_def}\<close>
+(*
+overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances3_fms \<union> instances4_fms
+*)
+
+thm extensions_of_ctms
+text\<open>@{thm [display] extensions_of_ctms}\<close>
+(*
+M \<approx> \<omega> \<Longrightarrow>
+Transset(M) \<Longrightarrow>
+M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms} \<Longrightarrow>
+\<Phi> \<subseteq> formula \<Longrightarrow>
+M \<Turnstile> {\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>} \<Longrightarrow>
+\<exists>N. M \<subseteq> N \<and>
+    N \<approx> \<omega> \<and>
+    Transset(N) \<and>
+    M \<noteq> N \<and>
+    (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N) \<and>
+    ((M, [] \<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and>
+    N \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}
+*)
+
+thm ctm_of_not_CH
+text\<open>@{thm [display] ctm_of_not_CH}\<close>
+(*
+M \<approx> \<omega> \<Longrightarrow>
+Transset(M) \<Longrightarrow>
+M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<Longrightarrow>
+\<Phi> \<subseteq> formula \<Longrightarrow>
+M \<Turnstile> {\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>} \<Longrightarrow>
+\<exists>N. M \<subseteq> N \<and>
+    N \<approx> \<omega> \<and>
+    Transset(N) \<and>
+    N \<Turnstile> ZC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
+    (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)*)
+
+thm ctm_of_CH
+text\<open>@{thm [display] ctm_of_CH}\<close>
+(*
+M \<approx> \<omega> \<Longrightarrow>
+Transset(M) \<Longrightarrow>
+M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<Longrightarrow>
+\<Phi> \<subseteq> formula \<Longrightarrow>
+M \<Turnstile> {\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>} \<Longrightarrow>
+\<exists>N. M \<subseteq> N \<and>
+    N \<approx> \<omega> \<and>
+    Transset(N) \<and>
+    N \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>} \<union> {\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
+    (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)
+*)
+
+txt\<open>In the above three statements, the function \<^term>\<open>ground_repl_fm\<close>
+takes an element \<^term>\<open>\<phi>\<close>of \<^term>\<open>formula\<close> and returns the
+replacement instance in the ground model that produces the
+\<^term>\<open>\<phi>\<close>-replacement instance in the generic extension. The next
+result is stated in the context \<^locale>\<open>G_generic1\<close>, which assumes
+the existence of a generic filter.\<close>
+
+context G_generic1
+begin
+
+thm sats_ground_repl_fm_imp_sats_ZF_replacement_fm
+text\<open>@{thm [display] sats_ground_repl_fm_imp_sats_ZF_replacement_fm}\<close>
+(*
+\<phi> \<in> formula \<Longrightarrow> M, [] \<Turnstile> \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> \<Longrightarrow> M[G], [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>
+*)
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Demonstrations.thy b/thys/Independence_CH/Demonstrations.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Demonstrations.thy
@@ -0,0 +1,166 @@
+section\<open>Some demonstrations\<close>
+
+theory Demonstrations
+  imports
+    Definitions_Main
+begin
+
+txt\<open>The following theory is only intended to explore some details of the
+formalization and to show the appearance of relevant internalized formulas.
+It is \<^bold>\<open>not\<close> intended as the entry point of the session. For that purpose,
+consult \<^theory>\<open>Independence_CH.Definitions_Main\<close>\<close>
+
+locale Demo = M_trivial + M_AC +
+  fixes t\<^sub>1 t\<^sub>2
+  assumes
+    ts_in_nat[simp]: "t\<^sub>1\<in>\<omega>" "t\<^sub>2\<in>\<omega>"
+    and
+    power_infty: "power_ax(M)" "M(\<omega>)"
+begin
+
+txt\<open>The next fake lemma is intended to explore the instances of the axiom
+schemes that are needed to build our forcing models. They are categorized as
+plain replacements (using \<^term>\<open>strong_replacement\<close>), “lambda-replacements” with
+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 *)
+
+named_theorems incr_bv_new_simps
+
+schematic_goal incr_bv_Neg(* [incr_bv_new_simps] *):
+  "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow> incr_bv(Neg(\<phi>))`n = ?x"
+  unfolding Neg_def by simp
+
+schematic_goal incr_bv_Exists [incr_bv_new_simps]:
+  "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow> incr_bv(Exists(\<phi>))`n = ?x"
+  unfolding Exists_def by (simp add: incr_bv_Neg)
+(*
+schematic_goal incr_bv_And [incr_bv_new_simps]:
+  "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(And(\<phi>,\<psi>))`n = ?x"
+  unfolding And_def by (simp add: incr_bv_Neg)
+
+schematic_goal incr_bv_Or [incr_bv_new_simps]:
+  "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(Or(\<phi>,\<psi>))`n = ?x"
+  unfolding Or_def by (simp add: incr_bv_Neg)
+
+schematic_goal incr_bv_Implies [incr_bv_new_simps]:
+  "mem(n,\<omega>) \<Longrightarrow> mem(\<phi>,formula) \<Longrightarrow>mem(\<psi>,formula)\<Longrightarrow> incr_bv(Implies(\<phi>,\<psi>))`n = ?x"
+  unfolding Implies_def by (simp add: incr_bv_Neg)
+*)
+
+\<comment> \<open>The two renamings involved in the definition of \<^term>\<open>forces\<close> depend on
+the recursive function \<^term>\<open>incr_bv\<close>. Here we have an apparently
+exponential bottleneck, since all the propositional connectives (even \<^term>\<open>Neg\<close>)
+duplicate the appearances of \<^term>\<open>incr_bv\<close>.
+
+Not even the double negation of an atomic formula can be managed by the system.\<close>
+(* 
+
+schematic_goal "forces(\<not>\<not>0\<in>1) = ?x"
+  unfolding forces_def Neg_def
+   by (simp add:ren_forces_nand_def ren_forces_forall_def 
+      frc_at_fm_def ftype_fm_def
+      name1_fm_def name2_fm_def snd_snd_fm_def hcomp_fm_def
+      ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def
+      is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
+      is_If_fm_def least_fm_def Collect_fm_def
+      fm_definitions incr_bv_Neg incr_bv_Exists)
+(* exception Size raised (line 183 of "./basis/LibrarySupport.sml") *)
+
+*)
+
+(*
+declare is_ContHyp_fm_def[fm_definitions del]
+
+thm is_ContHyp_fm_def[unfolded is_eclose_fm_def mem_eclose_fm_def eclose_n_fm_def
+   is_If_fm_def least_fm_def Replace_fm_def Collect_fm_def
+   fm_definitions, simplified] *)
+
+end \<comment> \<open>\<^locale>\<open>Demo\<close>\<close>
+
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Edrel.thy b/thys/Independence_CH/Edrel.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Edrel.thy
@@ -0,0 +1,257 @@
+theory Edrel
+  imports
+    Transitive_Models.ZF_Miscellanea
+    Transitive_Models.Recursion_Thms
+
+begin
+
+subsection\<open>The well-founded relation \<^term>\<open>ed\<close>\<close>
+
+lemma eclose_sing : "x \<in> eclose(a) \<Longrightarrow> x \<in> eclose({a})"
+  using subsetD[OF mem_eclose_subset]
+  by simp
+
+lemma ecloseE :
+  assumes  "x \<in> eclose(A)"
+  shows  "x \<in> A \<or> (\<exists> B \<in> A . x \<in> eclose(B))"
+  using assms
+proof (induct rule:eclose_induct_down)
+  case (1 y)
+  then
+  show ?case
+    using arg_into_eclose by auto
+next
+  case (2 y z)
+  from \<open>y \<in> A \<or> (\<exists>B\<in>A. y \<in> eclose(B))\<close>
+  consider (inA) "y \<in> A" | (exB) "(\<exists>B\<in>A. y \<in> eclose(B))"
+    by auto
+  then show ?case
+  proof (cases)
+    case inA
+    then
+    show ?thesis using 2 arg_into_eclose by auto
+  next
+    case exB
+    then obtain B where "y \<in> eclose(B)" "B\<in>A"
+      by auto
+    then
+    show ?thesis using 2 ecloseD[of y B z] by auto
+  qed
+qed
+
+lemma eclose_singE : "x \<in> eclose({a}) \<Longrightarrow> x = a \<or> x \<in> eclose(a)"
+  by(blast dest: ecloseE)
+
+lemma in_eclose_sing :
+  assumes "x \<in> eclose({a})" "a \<in> eclose(z)"
+  shows "x \<in> eclose({z})"
+proof -
+  from \<open>x\<in>eclose({a})\<close>
+  consider "x=a" | "x\<in>eclose(a)"
+    using eclose_singE by auto
+  then
+  show ?thesis
+    using eclose_sing mem_eclose_trans assms
+    by (cases, auto)
+qed
+
+lemma in_dom_in_eclose :
+  assumes "x \<in> domain(z)"
+  shows "x \<in> eclose(z)"
+proof -
+  from assms
+  obtain y where "\<langle>x,y\<rangle> \<in> z"
+    unfolding domain_def by auto
+  then
+  show ?thesis
+    unfolding Pair_def
+    using ecloseD[of "{x,x}"] ecloseD[of "{{x,x},{x,y}}"] arg_into_eclose
+    by auto
+qed
+
+text\<open>term\<open>ed\<close> is the well-founded relation on which \<^term>\<open>val\<close> is defined.\<close>
+definition
+  ed :: "[i,i] \<Rightarrow> o" where
+  "ed(x,y) \<equiv> x \<in> domain(y)"
+
+definition
+  edrel :: "i \<Rightarrow> i" where
+  "edrel(A) \<equiv> Rrel(ed,A)"
+
+lemma edI[intro!]: "t\<in>domain(x) \<Longrightarrow> ed(t,x)"
+  unfolding ed_def .
+
+lemma edD[dest!]: "ed(t,x) \<Longrightarrow> t\<in>domain(x)"
+  unfolding ed_def .
+
+lemma rank_ed:
+  assumes "ed(y,x)"
+  shows "succ(rank(y)) \<le> rank(x)"
+proof
+  from assms
+  obtain p where "\<langle>y,p\<rangle>\<in>x" by auto
+  moreover
+  obtain s where "y\<in>s" "s\<in>\<langle>y,p\<rangle>" unfolding Pair_def by auto
+  ultimately
+  have "rank(y) < rank(s)" "rank(s) < rank(\<langle>y,p\<rangle>)" "rank(\<langle>y,p\<rangle>) < rank(x)"
+    using rank_lt by blast+
+  then
+  show "rank(y) < rank(x)"
+    using lt_trans by blast
+qed
+
+lemma edrel_dest [dest]: "x \<in> edrel(A) \<Longrightarrow> \<exists> a\<in> A. \<exists> b \<in> A. x =\<langle>a,b\<rangle>"
+  by(auto simp add:ed_def edrel_def Rrel_def)
+
+lemma edrelD : "x \<in> edrel(A) \<Longrightarrow> \<exists> a\<in> A. \<exists> b \<in> A. x =\<langle>a,b\<rangle> \<and> a \<in> domain(b)"
+  by(auto simp add:ed_def edrel_def Rrel_def)
+
+lemma edrelI [intro!]: "x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x \<in> domain(y) \<Longrightarrow> \<langle>x,y\<rangle>\<in>edrel(A)"
+  by (simp add:ed_def edrel_def Rrel_def)
+
+lemma edrel_trans: "Transset(A) \<Longrightarrow> y\<in>A \<Longrightarrow> x \<in> domain(y) \<Longrightarrow> \<langle>x,y\<rangle>\<in>edrel(A)"
+  by (rule edrelI, auto simp add:Transset_def domain_def Pair_def)
+
+lemma domain_trans: "Transset(A) \<Longrightarrow> y\<in>A \<Longrightarrow> x \<in> domain(y) \<Longrightarrow> x\<in>A"
+  by (auto simp add: Transset_def domain_def Pair_def)
+
+lemma relation_edrel : "relation(edrel(A))"
+  by(auto simp add: relation_def)
+
+lemma field_edrel : "field(edrel(A))\<subseteq>A"
+  by blast
+
+lemma edrel_sub_memrel: "edrel(A) \<subseteq> trancl(Memrel(eclose(A)))"
+proof
+  let
+    ?r="trancl(Memrel(eclose(A)))"
+  fix z
+  assume "z\<in>edrel(A)"
+  then
+  obtain x y where "x\<in>A" "y\<in>A" "z=\<langle>x,y\<rangle>" "x\<in>domain(y)"
+    using edrelD
+    by blast
+  moreover from this
+  obtain u v where "x\<in>u" "u\<in>v" "v\<in>y"
+    unfolding domain_def Pair_def by auto
+  moreover from calculation
+  have "x\<in>eclose(A)" "y\<in>eclose(A)" "y\<subseteq>eclose(A)"
+    using arg_into_eclose Transset_eclose[unfolded Transset_def]
+    by simp_all
+  moreover from calculation
+  have "v\<in>eclose(A)"
+    by auto
+  moreover from calculation
+  have "u\<in>eclose(A)"
+    using Transset_eclose[unfolded Transset_def]
+    by auto
+  moreover from calculation
+  have"\<langle>x,u\<rangle>\<in>?r" "\<langle>u,v\<rangle>\<in>?r" "\<langle>v,y\<rangle>\<in>?r"
+    by (auto simp add: r_into_trancl)
+  moreover from this
+  have "\<langle>x,y\<rangle>\<in>?r"
+    using trancl_trans[OF _ trancl_trans[of _ v _ y]]
+    by simp
+  ultimately
+  show "z\<in>?r"
+    by simp
+qed
+
+lemma wf_edrel : "wf(edrel(A))"
+  using wf_subset [of "trancl(Memrel(eclose(A)))"] edrel_sub_memrel
+    wf_trancl wf_Memrel
+  by auto
+
+lemma ed_induction:
+  assumes "\<And>x. \<lbrakk>\<And>y.  ed(y,x) \<Longrightarrow> Q(y) \<rbrakk> \<Longrightarrow> Q(x)"
+  shows "Q(a)"
+proof(induct rule: wf_induct2[OF wf_edrel[of "eclose({a})"] ,of a "eclose({a})"])
+  case 1
+  then show ?case using arg_into_eclose by simp
+next
+  case 2
+  then show ?case using field_edrel .
+next
+  case (3 x)
+  then
+  show ?case
+    using assms[of x] edrelI domain_trans[OF Transset_eclose 3(1)] by blast
+qed
+
+lemma dom_under_edrel_eclose: "edrel(eclose({x})) -`` {x} = domain(x)"
+proof(intro equalityI)
+  show "edrel(eclose({x})) -`` {x} \<subseteq> domain(x)"
+    unfolding edrel_def Rrel_def ed_def
+    by auto
+next
+  show "domain(x) \<subseteq> edrel(eclose({x})) -`` {x}"
+    unfolding edrel_def Rrel_def
+    using in_dom_in_eclose eclose_sing arg_into_eclose
+    by blast
+qed
+
+lemma ed_eclose : "\<langle>y,z\<rangle> \<in> edrel(A) \<Longrightarrow> y \<in> eclose(z)"
+  by(drule edrelD,auto simp add:domain_def in_dom_in_eclose)
+
+lemma tr_edrel_eclose : "\<langle>y,z\<rangle> \<in> edrel(eclose({x}))^+ \<Longrightarrow> y \<in> eclose(z)"
+  by(rule trancl_induct,(simp add: ed_eclose mem_eclose_trans)+)
+
+lemma restrict_edrel_eq :
+  assumes "z \<in> domain(x)"
+  shows "edrel(eclose({x})) \<inter> eclose({z})\<times>eclose({z}) = edrel(eclose({z}))"
+proof(intro equalityI subsetI)
+  let ?ec="\<lambda> y . edrel(eclose({y}))"
+  let ?ez="eclose({z})"
+  let ?rr="?ec(x) \<inter> ?ez \<times> ?ez"
+  fix y
+  assume "y \<in> ?rr"
+  then
+  obtain a b where "\<langle>a,b\<rangle> \<in> ?rr" "a \<in> ?ez" "b \<in> ?ez" "\<langle>a,b\<rangle> \<in> ?ec(x)" "y=\<langle>a,b\<rangle>"
+    by blast
+  moreover from this
+  have "a \<in> domain(b)"
+    using edrelD by blast
+  ultimately
+  show "y \<in> edrel(eclose({z}))"
+    by blast
+next
+  let ?ec="\<lambda> y . edrel(eclose({y}))"
+  let ?ez="eclose({z})"
+  let ?rr="?ec(x) \<inter> ?ez \<times> ?ez"
+  fix y
+  assume "y \<in> edrel(?ez)"
+  then
+  obtain a b where "a \<in> ?ez" "b \<in> ?ez" "y=\<langle>a,b\<rangle>" "a \<in> domain(b)"
+    using edrelD by blast
+  moreover
+  from this assms
+  have "z \<in> eclose(x)"
+    using in_dom_in_eclose by simp
+  moreover
+  from assms calculation
+  have "a \<in> eclose({x})" "b \<in> eclose({x})"
+    using in_eclose_sing by simp_all
+  moreover from calculation
+  have "\<langle>a,b\<rangle> \<in> edrel(eclose({x}))"
+    by blast
+  ultimately
+  show "y \<in> ?rr"
+    by simp
+qed
+
+lemma tr_edrel_subset :
+  assumes "z \<in> domain(x)"
+  shows   "tr_down(edrel(eclose({x})),z) \<subseteq> eclose({z})"
+proof(intro subsetI)
+  let ?r="\<lambda> x . edrel(eclose({x}))"
+  fix y
+  assume "y \<in> tr_down(?r(x),z)"
+  then
+  have "\<langle>y,z\<rangle> \<in> ?r(x)^+"
+    using tr_downD by simp
+  with assms
+  show "y \<in> eclose({z})"
+    using tr_edrel_eclose eclose_sing by simp
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Extensionality_Axiom.thy b/thys/Independence_CH/Extensionality_Axiom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Extensionality_Axiom.thy
@@ -0,0 +1,29 @@
+section\<open>The Axiom of Extensionality in $M[G]$\<close>
+
+theory Extensionality_Axiom
+  imports
+    Names
+begin
+
+context forcing_data1
+begin
+
+lemma extensionality_in_MG : "extensionality(##(M[G]))"
+  unfolding extensionality_def
+proof(clarsimp)
+  fix x y
+  assume "x\<in>M[G]" "y\<in>M[G]" "(\<forall>w\<in>M[G] . w \<in> x \<longleftrightarrow> w \<in> y)"
+  moreover from this
+  have "z\<in>x \<longleftrightarrow> z\<in>M[G] \<and> z\<in>y" for z
+    using transitivity_MG by auto
+  moreover from calculation
+  have "z\<in>M[G] \<and> z\<in>x \<longleftrightarrow> z\<in>y" for z
+    using transitivity_MG by auto
+  ultimately
+  show "x=y"
+    by auto
+qed
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<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
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Fm_Definitions.thy
@@ -0,0 +1,1017 @@
+section\<open>Concepts involved in instances of Replacement\<close>
+theory Fm_Definitions
+  imports
+    Transitive_Models.Renaming_Auto
+    Transitive_Models.Aleph_Relative
+    FrecR_Arities
+begin
+
+txt\<open>In this theory we put every concept that should be synthesized in a formula
+to have an instance of replacement.
+
+The automatic synthesis of a concept /foo/ requires that every concept used to
+define /foo/ is already synthesized. We try to use our meta-programs to synthesize
+concepts: given the absolute concept /foo/ we relativize in relational form
+obtaining /is\_foo/ and the we synthesize the formula /is\_foo\_fm/.
+The meta-program that synthesizes formulas also produce satisfactions lemmas.
+
+Having one file to collect every formula needed for replacements breaks
+the reading flow: we need to introduce the concept in this theory in order
+to use the meta-programs; moreover there are some concepts for which we prove
+here the satisfaction lemmas manually, while for others we prove them
+on its theory.
+\<close>
+
+declare arity_subset_fm [simp del] arity_ordinal_fm[simp del, arity] arity_transset_fm[simp del]
+  FOL_arities[simp del]
+
+txt\<open>Formulas for particular replacement instances\<close>
+
+text\<open>Now we introduce some definitions used in the definition of check; which
+is defined by well-founded recursion using replacement in the recursive call.\<close>
+
+\<comment> \<open>The well-founded relation for defining check.\<close>
+definition
+  rcheck :: "i \<Rightarrow> i" where
+  "rcheck(x) \<equiv> Memrel(eclose({x}))^+"
+
+relativize "rcheck" "is_rcheck"
+synthesize "is_rcheck" from_definition
+arity_theorem for "is_rcheck_fm"
+
+\<comment> \<open>The function used for the replacement.\<close>
+definition
+  PHcheck :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
+  "PHcheck(M,o,f,y,p) \<equiv> M(p) \<and> (\<exists>fy[M]. fun_apply(M,f,y,fy) \<and> pair(M,fy,o,p))"
+
+synthesize "PHcheck" from_definition assuming "nonempty"
+arity_theorem for "PHcheck_fm"
+
+\<comment> \<open>The recursive call for check. We could use the meta-program relationalize for
+this; but it makes some proofs more involved.\<close>
+definition
+  is_Hcheck :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
+  "is_Hcheck(M,o,z,f,hc)  \<equiv> is_Replace(M,z,PHcheck(M,o,f),hc)"
+
+synthesize "is_Hcheck" from_definition assuming "nonempty"
+
+lemma arity_is_Hcheck_fm:
+  assumes "m\<in>nat" "n\<in>nat" "p\<in>nat" "o\<in>nat"
+  shows "arity(is_Hcheck_fm(m,n,p,o)) = succ(o) \<union> succ(n) \<union> succ(p) \<union> succ(m) "
+  unfolding is_Hcheck_fm_def
+  using assms arity_Replace_fm[rule_format,OF PHcheck_fm_type _ _ _ arity_PHcheck_fm]
+    pred_Un_distrib Un_assoc Un_nat_type
+  by simp
+
+\<comment> \<open>The relational version of check is hand-made because our automatic tool
+does not handle \<^term>\<open>wfrec\<close>.\<close>
+definition
+  is_check :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
+  "is_check(M,o,x,z) \<equiv> \<exists>rch[M]. is_rcheck(M,x,rch) \<and>
+      is_wfrec(M,is_Hcheck(M,o),rch,x,z)"
+
+\<comment> \<open>Finally, we internalize the formula.\<close>
+definition
+  check_fm :: "[i,i,i] \<Rightarrow> i" where
+  "check_fm(x,o,z) \<equiv> Exists(And(is_rcheck_fm(1+\<^sub>\<omega>x,0),
+                      is_wfrec_fm(is_Hcheck_fm(6+\<^sub>\<omega>o,2,1,0),0,1+\<^sub>\<omega>x,1+\<^sub>\<omega>z)))"
+
+lemma check_fm_type[TC]: "x\<in>nat \<Longrightarrow> o\<in>nat \<Longrightarrow> z\<in>nat \<Longrightarrow> check_fm(x,o,z) \<in> formula"
+  by (simp add:check_fm_def)
+
+lemma sats_check_fm :
+  assumes
+    "o\<in>nat" "x\<in>nat" "z\<in>nat" "env\<in>list(M)" "0\<in>M"
+  shows
+    "(M , env \<Turnstile> check_fm(x,o,z)) \<longleftrightarrow> is_check(##M,nth(o,env),nth(x,env),nth(z,env))"
+proof -
+  have sats_is_Hcheck_fm:
+    "\<And>a0 a1 a2 a3 a4 a6. \<lbrakk> a0\<in>M; a1\<in>M; a2\<in>M; a3\<in>M; a4\<in>M;a6 \<in>M\<rbrakk> \<Longrightarrow>
+         is_Hcheck(##M,a6,a2, a1, a0) \<longleftrightarrow>
+         (M , [a0,a1,a2,a3,a4,r,a6]@env \<Turnstile> is_Hcheck_fm(6,2,1,0))" if "r\<in>M" for r
+    using that assms
+    by simp
+  then
+  have "(M , [r]@env \<Turnstile> is_wfrec_fm(is_Hcheck_fm(6+\<^sub>\<omega>o,2,1,0),0,1+\<^sub>\<omega>x,1+\<^sub>\<omega>z))
+        \<longleftrightarrow> is_wfrec(##M,is_Hcheck(##M,nth(o,env)),r,nth(x,env),nth(z,env))"
+    if "r\<in>M" for r
+    using that assms is_wfrec_iff_sats'[symmetric]
+    by simp
+  then
+  show ?thesis
+    unfolding is_check_def check_fm_def
+    using assms is_rcheck_iff_sats[symmetric]
+    by simp
+qed
+
+lemma iff_sats_check_fm[iff_sats] :
+  assumes
+    "nth(o, env) = oa" "nth(x, env) = xa" "nth(z, env) = za" "o \<in> nat" "x \<in> nat" "z \<in> nat" "env \<in> list(A)" "0 \<in> A"
+  shows "is_check(##A, oa,xa, za) \<longleftrightarrow> A, env \<Turnstile> check_fm(x,o, z)"
+  using assms sats_check_fm[symmetric]
+  by auto
+
+lemma arity_check_fm[arity]:
+  assumes "m\<in>nat" "n\<in>nat" "o\<in>nat"
+  shows "arity(check_fm(m,n,o)) = succ(o) \<union> succ(n) \<union> succ(m) "
+  unfolding check_fm_def
+  using assms arity_is_wfrec_fm[rule_format,OF _ _ _ _ _ arity_is_Hcheck_fm]
+    pred_Un_distrib Un_assoc arity_tran_closure_fm
+  by (auto simp add:arity)
+
+notation check_fm (\<open>\<cdot>_\<^sup>v_ is _\<cdot>\<close>)
+
+subsection\<open>Names for forcing the Axiom of Choice.\<close>
+definition
+  upair_name :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
+  "upair_name(\<tau>,\<rho>,on) \<equiv> Upair(\<langle>\<tau>,on\<rangle>,\<langle>\<rho>,on\<rangle>)"
+
+relativize "upair_name" "is_upair_name"
+synthesize "upair_name" from_definition "is_upair_name"
+arity_theorem for "upair_name_fm"
+
+definition
+  opair_name :: "i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i" where
+  "opair_name(\<tau>,\<rho>,on) \<equiv> upair_name(upair_name(\<tau>,\<tau>,on),upair_name(\<tau>,\<rho>,on),on)"
+
+relativize "opair_name" "is_opair_name"
+synthesize "opair_name" from_definition "is_opair_name"
+arity_theorem for "opair_name_fm"
+
+definition
+  is_opname_check :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
+  "is_opname_check(M,on,s,x,y) \<equiv> \<exists>chx[M]. \<exists>sx[M]. is_check(M,on,x,chx) \<and>
+        fun_apply(M,s,x,sx) \<and> is_opair_name(M,chx,sx,on,y)"
+
+synthesize "is_opname_check" from_definition assuming "nonempty"
+arity_theorem for "is_opname_check_fm"
+
+\<comment> \<open>The pair of elements belongs to some set. The intended set is the preorder.\<close>
+definition
+  is_leq :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
+  "is_leq(A,l,q,p) \<equiv> \<exists>qp[A]. (pair(A,q,p,qp) \<and> qp\<in>l)"
+
+synthesize "is_leq" from_definition assuming "nonempty"
+arity_theorem for "is_leq_fm"
+
+abbreviation
+  fm_leq :: "[i,i,i] \<Rightarrow> i" (\<open>\<cdot>_\<preceq>\<^bsup>_\<^esup>_\<cdot>\<close>) where
+  "fm_leq(A,l,B) \<equiv> is_leq_fm(l,A,B)"
+
+subsection\<open>Formulas used to prove some generic instances.\<close>
+
+definition \<rho>_repl :: "i\<Rightarrow>i" where
+  "\<rho>_repl(l) \<equiv> rsum({\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>}, id(l), 2, 3, l)"
+
+lemma f_type : "{\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>} \<in> 2 \<rightarrow> 3"
+  using Pi_iff unfolding function_def by auto
+
+\<comment> \<open>thm\<open>Internalize.sum_type\<close> clashes with thm\<open>Renaming.sum_type\<close>.\<close>
+hide_fact Internalize.sum_type
+
+lemma ren_type :
+  assumes "l\<in>nat"
+  shows "\<rho>_repl(l) : 2+\<^sub>\<omega>l \<rightarrow> 3+\<^sub>\<omega>l"
+  using sum_type[of 2 3 l l "{\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>}" "id(l)"] f_type assms id_type
+  unfolding \<rho>_repl_def by auto
+
+definition Lambda_in_M_fm where [simp]:"Lambda_in_M_fm(\<phi>,len) \<equiv>
+  \<cdot>(\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and>
+   ren(\<phi>) ` (2 +\<^sub>\<omega> len) ` (3 +\<^sub>\<omega> len) ` \<rho>_repl(len) \<cdot>\<cdot>) \<and> \<cdot>0 \<in> len +\<^sub>\<omega> 2\<cdot>\<cdot>"
+
+lemma Lambda_in_M_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> len\<in>nat \<Longrightarrow> Lambda_in_M_fm(\<phi>,len) \<in>formula"
+  using ren_tc[of \<phi> "2+\<^sub>\<omega>len" "3+\<^sub>\<omega>len" "\<rho>_repl(len)"] ren_type
+  unfolding Lambda_in_M_fm_def
+  by simp
+
+definition \<rho>_pair_repl :: "i\<Rightarrow>i" where
+  "\<rho>_pair_repl(l) \<equiv> rsum({\<langle>0, 0\<rangle>, \<langle>1, 1\<rangle>, \<langle>2, 3\<rangle>}, id(l), 3, 4, l)"
+
+definition LambdaPair_in_M_fm where "LambdaPair_in_M_fm(\<phi>,len) \<equiv>
+  \<cdot>(\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and>
+             ren((\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>fst(2) is 0\<cdot> \<and> \<cdot>\<cdot>snd(2) is 1\<cdot> \<and> ren(\<phi>) ` (3 +\<^sub>\<omega> len) ` (4 +\<^sub>\<omega> len) ` \<rho>_pair_repl(len) \<cdot>\<cdot>\<cdot>)\<cdot>)) ` (2 +\<^sub>\<omega> len) `
+             (3 +\<^sub>\<omega> len) `
+             \<rho>_repl(len) \<cdot>\<cdot>) \<and>
+          \<cdot>0 \<in> len +\<^sub>\<omega> 2\<cdot>\<cdot> "
+
+lemma f_type' : "{\<langle>0,0 \<rangle>, \<langle>1, 1\<rangle>, \<langle>2, 3\<rangle>} \<in> 3 \<rightarrow> 4"
+  using Pi_iff unfolding function_def by auto
+
+lemma ren_type' :
+  assumes "l\<in>nat"
+  shows "\<rho>_pair_repl(l) : 3+\<^sub>\<omega>l \<rightarrow> 4+\<^sub>\<omega>l"
+  using sum_type[of 3 4 l l "{\<langle>0, 0\<rangle>, \<langle>1, 1\<rangle>, \<langle>2, 3\<rangle>}" "id(l)"] f_type' assms id_type
+  unfolding \<rho>_pair_repl_def by auto
+
+lemma LambdaPair_in_M_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> len\<in>nat \<Longrightarrow> LambdaPair_in_M_fm(\<phi>,len) \<in>formula"
+  using ren_tc[OF _ _ _ ren_type',of \<phi> "len"] Lambda_in_M_fm_type
+  unfolding LambdaPair_in_M_fm_def
+  by simp
+
+subsection\<open>The relation \<^term>\<open>frecrel\<close>\<close>
+
+definition
+  frecrelP :: "[i\<Rightarrow>o,i] \<Rightarrow> o" where
+  "frecrelP(M,xy) \<equiv> (\<exists>x[M]. \<exists>y[M]. pair(M,x,y,xy) \<and> is_frecR(M,x,y))"
+
+synthesize "frecrelP" from_definition
+arity_theorem for "frecrelP_fm"
+
+definition
+  is_frecrel :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
+  "is_frecrel(M,A,r) \<equiv> \<exists>A2[M]. cartprod(M,A,A,A2) \<and> is_Collect(M,A2, frecrelP(M) ,r)"
+
+synthesize "frecrel" from_definition "is_frecrel"
+arity_theorem for "frecrel_fm"
+
+definition
+  names_below :: "i \<Rightarrow> i \<Rightarrow> i" where
+  "names_below(P,x) \<equiv> 2\<times>ecloseN(x)\<times>ecloseN(x)\<times>P"
+
+lemma names_belowsD:
+  assumes "x \<in> names_below(P,z)"
+  obtains f n1 n2 p where
+    "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
+  using assms unfolding names_below_def by auto
+
+synthesize "number2" from_definition
+
+lemma number2_iff :
+  "(A)(c) \<Longrightarrow> number2(A,c) \<longleftrightarrow> (\<exists>b[A]. \<exists>a[A]. successor(A, b, c) \<and> successor(A, a, b) \<and> empty(A, a))"
+  unfolding number2_def number1_def by auto
+arity_theorem for "number2_fm"
+
+reldb_add "ecloseN" "is_ecloseN"
+relativize "names_below" "is_names_below"
+synthesize "is_names_below" from_definition
+arity_theorem for "is_names_below_fm"
+
+definition
+  is_tuple :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "is_tuple(M,z,t1,t2,p,t) \<equiv> \<exists>t1t2p[M]. \<exists>t2p[M]. pair(M,t2,p,t2p) \<and> pair(M,t1,t2p,t1t2p) \<and>
+                                                  pair(M,z,t1t2p,t)"
+
+synthesize "is_tuple" from_definition
+arity_theorem for "is_tuple_fm"
+
+subsection\<open>Definition of Forces\<close>
+
+subsubsection\<open>Definition of \<^term>\<open>forces\<close> for equality and membership\<close>
+text\<open>$p\forces \tau = \theta$ if every $q\leqslant p$ both $q\forces \sigma \in \tau$
+and $q\forces \sigma \in \theta$ for every $\sigma \in \dom(\tau)\cup \dom(\theta)$.\<close>
+definition
+  eq_case :: "[i,i,i,i,i,i] \<Rightarrow> o" where
+  "eq_case(\<tau>,\<theta>,p,P,leq,f) \<equiv> \<forall>\<sigma>. \<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<longrightarrow>
+      (\<forall>q. q\<in>P \<and> \<langle>q,p\<rangle>\<in>leq \<longrightarrow> (f`\<langle>1,\<sigma>,\<tau>,q\<rangle>=1  \<longleftrightarrow> f`\<langle>1,\<sigma>,\<theta>,q\<rangle> =1))"
+
+relativize "eq_case" "is_eq_case"
+synthesize "eq_case" from_definition "is_eq_case"
+
+text\<open>$p\forces \tau \in \theta$ if for every $v\leqslant p$
+  there exists $q$, $r$, and $\sigma$ such that
+  $v\leqslant q$, $q\leqslant r$, $\langle \sigma,r\rangle \in \tau$, and
+  $q\forces \pi = \sigma$.\<close>
+definition
+  mem_case :: "[i,i,i,i,i,i] \<Rightarrow> o" where
+  "mem_case(\<tau>,\<theta>,p,P,leq,f) \<equiv> \<forall>v\<in>P. \<langle>v,p\<rangle>\<in>leq \<longrightarrow>
+    (\<exists>q. \<exists>\<sigma>. \<exists>r. r\<in>P \<and> q\<in>P \<and> \<langle>q,v\<rangle>\<in>leq \<and> \<langle>\<sigma>,r\<rangle> \<in> \<theta> \<and> \<langle>q,r\<rangle>\<in>leq \<and>  f`\<langle>0,\<tau>,\<sigma>,q\<rangle> = 1)"
+
+relativize "mem_case" "is_mem_case"
+synthesize "mem_case" from_definition "is_mem_case"
+arity_theorem intermediate for "eq_case_fm"
+lemma arity_eq_case_fm[arity]:
+  assumes
+    "n1\<in>nat" "n2\<in>nat" "p\<in>nat" "P\<in>nat" "leq\<in>nat" "f\<in>nat"
+  shows
+    "arity(eq_case_fm(n1,n2,p,P,leq,f)) =
+    succ(n1) \<union> succ(n2) \<union> succ(p) \<union> succ(P) \<union> succ(leq) \<union> succ(f)"
+  using assms arity_eq_case_fm'
+  by auto
+
+arity_theorem intermediate for "mem_case_fm"
+lemma arity_mem_case_fm[arity] :
+  assumes
+    "n1\<in>nat" "n2\<in>nat" "p\<in>nat" "P\<in>nat" "leq\<in>nat" "f\<in>nat"
+  shows
+    "arity(mem_case_fm(n1,n2,p,P,leq,f)) =
+    succ(n1) \<union> succ(n2) \<union> succ(p) \<union> succ(P) \<union> succ(leq) \<union> succ(f)"
+  using assms arity_mem_case_fm'
+  by auto
+
+definition
+  Hfrc :: "[i,i,i,i] \<Rightarrow> o" where
+  "Hfrc(P,leq,fnnc,f) \<equiv> \<exists>ft. \<exists>\<tau>. \<exists>\<theta>. \<exists>p. p\<in>P \<and> fnnc = \<langle>ft,\<tau>,\<theta>,p\<rangle> \<and>
+     (  ft = 0 \<and>  eq_case(\<tau>,\<theta>,p,P,leq,f)
+      \<or> ft = 1 \<and> mem_case(\<tau>,\<theta>,p,P,leq,f))"
+
+relativize "Hfrc" "is_Hfrc"
+synthesize "Hfrc" from_definition "is_Hfrc"
+
+definition
+  is_Hfrc_at :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "is_Hfrc_at(M,P,leq,fnnc,f,b) \<equiv>
+            (empty(M,b) \<and> \<not> is_Hfrc(M,P,leq,fnnc,f))
+          \<or> (number1(M,b) \<and> is_Hfrc(M,P,leq,fnnc,f))"
+
+synthesize "Hfrc_at" from_definition "is_Hfrc_at"
+arity_theorem intermediate for "Hfrc_fm"
+
+lemma arity_Hfrc_fm[arity] :
+  assumes
+    "P\<in>nat" "leq\<in>nat" "fnnc\<in>nat" "f\<in>nat"
+  shows
+    "arity(Hfrc_fm(P,leq,fnnc,f)) = succ(P) \<union> succ(leq) \<union> succ(fnnc) \<union> succ(f)"
+  using assms arity_Hfrc_fm'
+  by auto
+
+arity_theorem for "Hfrc_at_fm"
+
+subsubsection\<open>The well-founded relation \<^term>\<open>forcerel\<close>\<close>
+definition
+  forcerel :: "i \<Rightarrow> i \<Rightarrow> i" where
+  "forcerel(P,x) \<equiv> frecrel(names_below(P,x))^+"
+
+definition
+  is_forcerel :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
+  "is_forcerel(M,P,x,z) \<equiv> \<exists>r[M]. \<exists>nb[M]. tran_closure(M,r,z) \<and>
+                        (is_names_below(M,P,x,nb) \<and> is_frecrel(M,nb,r))"
+synthesize "is_forcerel" from_definition
+arity_theorem for "is_forcerel_fm"
+
+subsection\<open>\<^term>\<open>frc_at\<close>, forcing for atomic formulas\<close>
+definition
+  frc_at :: "[i,i,i] \<Rightarrow> i" where
+  "frc_at(P,leq,fnnc) \<equiv> wfrec(frecrel(names_below(P,fnnc)),fnnc,
+                              \<lambda>x f. bool_of_o(Hfrc(P,leq,x,f)))"
+
+\<comment> \<open>The relational form is defined manually because it uses \<^term>\<open>wfrec\<close>.\<close>
+definition
+  is_frc_at :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
+  "is_frc_at(M,P,leq,x,z) \<equiv> \<exists>r[M]. is_forcerel(M,P,x,r) \<and>
+                                    is_wfrec(M,is_Hfrc_at(M,P,leq),r,x,z)"
+
+definition
+  frc_at_fm :: "[i,i,i,i] \<Rightarrow> i" where
+  "frc_at_fm(p,l,x,z) \<equiv> Exists(And(is_forcerel_fm(succ(p),succ(x),0),
+          is_wfrec_fm(Hfrc_at_fm(6+\<^sub>\<omega>p,6+\<^sub>\<omega>l,2,1,0),0,succ(x),succ(z))))"
+
+lemma frc_at_fm_type [TC] :
+  "\<lbrakk>p\<in>nat;l\<in>nat;x\<in>nat;z\<in>nat\<rbrakk> \<Longrightarrow> frc_at_fm(p,l,x,z)\<in>formula"
+  unfolding frc_at_fm_def by simp
+
+lemma arity_frc_at_fm[arity] :
+  assumes "p\<in>nat" "l\<in>nat" "x\<in>nat" "z\<in>nat"
+  shows "arity(frc_at_fm(p,l,x,z)) = succ(p) \<union> succ(l) \<union> succ(x) \<union> succ(z)"
+proof -
+  let ?\<phi> = "Hfrc_at_fm(6 +\<^sub>\<omega> p, 6 +\<^sub>\<omega> l, 2, 1, 0)"
+  note assms
+  moreover from this
+  have  "arity(?\<phi>) = (7+\<^sub>\<omega>p) \<union> (7+\<^sub>\<omega>l)" "?\<phi> \<in> formula"
+    using arity_Hfrc_at_fm ord_simp_union
+    by auto
+  moreover from calculation
+  have "arity(is_wfrec_fm(?\<phi>, 0, succ(x), succ(z))) = 2+\<^sub>\<omega>p \<union> (2+\<^sub>\<omega>l) \<union> (2+\<^sub>\<omega>x) \<union> (2+\<^sub>\<omega>z)"
+    using arity_is_wfrec_fm[OF \<open>?\<phi>\<in>_\<close> _ _ _ _ \<open>arity(?\<phi>) = _\<close>] pred_Un_distrib pred_succ_eq
+      union_abs1
+    by auto
+  moreover from assms
+  have "arity(is_forcerel_fm(succ(p),succ(x),0)) = 2+\<^sub>\<omega>p \<union> (2+\<^sub>\<omega>x)"
+    using arity_is_forcerel_fm ord_simp_union
+    by auto
+  ultimately
+  show ?thesis
+    unfolding frc_at_fm_def
+    using arity_is_forcerel_fm pred_Un_distrib
+    by (auto simp:FOL_arities)
+qed
+
+lemma sats_frc_at_fm :
+  assumes
+    "p\<in>nat" "l\<in>nat" "i\<in>nat" "j\<in>nat" "env\<in>list(A)" "i < length(env)" "j < length(env)"
+  shows
+    "(A , env \<Turnstile> frc_at_fm(p,l,i,j)) \<longleftrightarrow>
+     is_frc_at(##A,nth(p,env),nth(l,env),nth(i,env),nth(j,env))"
+proof -
+  {
+    fix r pp ll
+    assume "r\<in>A"
+    have "is_Hfrc_at(##A,nth(p,env),nth(l,env),a2, a1, a0) \<longleftrightarrow>
+         (A, [a0,a1,a2,a3,a4,r]@env \<Turnstile> Hfrc_at_fm(6+\<^sub>\<omega>p,6+\<^sub>\<omega>l,2,1,0))"
+      if "a0\<in>A" "a1\<in>A" "a2\<in>A" "a3\<in>A" "a4\<in>A" for a0 a1 a2 a3 a4
+      using  that assms \<open>r\<in>A\<close>
+        Hfrc_at_iff_sats[of "6+\<^sub>\<omega>p" "6+\<^sub>\<omega>l" 2 1 0 "[a0,a1,a2,a3,a4,r]@env" A]  by simp
+    with \<open>r\<in>A\<close>
+    have "(A,[r]@env \<Turnstile> is_wfrec_fm(Hfrc_at_fm(6+\<^sub>\<omega>p, 6+\<^sub>\<omega>l,2,1,0),0, i+\<^sub>\<omega>1, j+\<^sub>\<omega>1)) \<longleftrightarrow>
+         is_wfrec(##A, is_Hfrc_at(##A, nth(p,env), nth(l,env)), r,nth(i, env), nth(j, env))"
+      using assms sats_is_wfrec_fm
+      by simp
+  }
+  moreover
+  have "(A, Cons(r, env) \<Turnstile> is_forcerel_fm(succ(p), succ(i), 0)) \<longleftrightarrow>
+        is_forcerel(##A,nth(p,env),nth(i,env),r)" if "r\<in>A" for r
+    using assms sats_is_forcerel_fm that
+    by simp
+  ultimately
+  show ?thesis
+    unfolding is_frc_at_def frc_at_fm_def
+    using assms
+    by simp
+qed
+
+lemma frc_at_fm_iff_sats:
+  assumes "nth(i,env) = w" "nth(j,env) = x" "nth(k,env) = y" "nth(l,env) = z"
+    "i \<in> nat" "j \<in> nat" "k \<in> nat" "l\<in>nat" "env \<in> list(A)" "k<length(env)" "l<length(env)"
+  shows "is_frc_at(##A, w, x, y,z) \<longleftrightarrow> (A , env \<Turnstile> frc_at_fm(i,j,k,l))"
+  using assms sats_frc_at_fm
+  by simp
+
+declare frc_at_fm_iff_sats [iff_sats]
+
+definition
+  forces_eq' :: "[i,i,i,i,i] \<Rightarrow> o" where
+  "forces_eq'(P,l,p,t1,t2) \<equiv> frc_at(P,l,\<langle>0,t1,t2,p\<rangle>) = 1"
+
+definition
+  forces_mem' :: "[i,i,i,i,i] \<Rightarrow> o" where
+  "forces_mem'(P,l,p,t1,t2) \<equiv> frc_at(P,l,\<langle>1,t1,t2,p\<rangle>) = 1"
+
+definition
+  forces_neq' :: "[i,i,i,i,i] \<Rightarrow> o" where
+  "forces_neq'(P,l,p,t1,t2) \<equiv> \<not> (\<exists>q\<in>P. \<langle>q,p\<rangle>\<in>l \<and> forces_eq'(P,l,q,t1,t2))"
+
+definition
+  forces_nmem' :: "[i,i,i,i,i] \<Rightarrow> o" where
+  "forces_nmem'(P,l,p,t1,t2) \<equiv> \<not> (\<exists>q\<in>P. \<langle>q,p\<rangle>\<in>l \<and> forces_mem'(P,l,q,t1,t2))"
+
+\<comment> \<open>The following definitions are explicitly defined to avoid the expansion
+of concepts.\<close>
+definition
+  is_forces_eq' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "is_forces_eq'(M,P,l,p,t1,t2) \<equiv> \<exists>o[M]. \<exists>z[M]. \<exists>t[M]. number1(M,o) \<and> empty(M,z) \<and>
+                                is_tuple(M,z,t1,t2,p,t) \<and> is_frc_at(M,P,l,t,o)"
+
+definition
+  is_forces_mem' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "is_forces_mem'(M,P,l,p,t1,t2) \<equiv> \<exists>o[M]. \<exists>t[M]. number1(M,o) \<and>
+                                is_tuple(M,o,t1,t2,p,t) \<and> is_frc_at(M,P,l,t,o)"
+
+definition
+  is_forces_neq' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "is_forces_neq'(M,P,l,p,t1,t2) \<equiv>
+      \<not> (\<exists>q[M]. q\<in>P \<and> (\<exists>qp[M]. pair(M,q,p,qp) \<and> qp\<in>l \<and> is_forces_eq'(M,P,l,q,t1,t2)))"
+
+definition
+  is_forces_nmem' :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "is_forces_nmem'(M,P,l,p,t1,t2) \<equiv>
+      \<not> (\<exists>q[M]. \<exists>qp[M]. q\<in>P \<and> pair(M,q,p,qp) \<and> qp\<in>l \<and> is_forces_mem'(M,P,l,q,t1,t2))"
+
+synthesize "forces_eq" from_definition "is_forces_eq'"
+synthesize "forces_mem" from_definition "is_forces_mem'"
+synthesize "forces_neq" from_definition "is_forces_neq'" assuming "nonempty"
+synthesize "forces_nmem" from_definition "is_forces_nmem'" assuming "nonempty"
+
+context
+  notes Un_assoc[simp] Un_trasposition_aux2[simp]
+begin
+arity_theorem for "forces_eq_fm"
+arity_theorem for "forces_mem_fm"
+arity_theorem for "forces_neq_fm"
+arity_theorem for "forces_nmem_fm"
+end
+
+subsection\<open>Forcing for general formulas\<close>
+
+definition
+  ren_forces_nand :: "i\<Rightarrow>i" where
+  "ren_forces_nand(\<phi>) \<equiv> Exists(And(Equal(0,1),iterates(\<lambda>p. incr_bv(p)`1 , 2, \<phi>)))"
+
+lemma ren_forces_nand_type[TC] :
+  "\<phi>\<in>formula \<Longrightarrow> ren_forces_nand(\<phi>) \<in>formula"
+  unfolding ren_forces_nand_def
+  by simp
+
+lemma arity_ren_forces_nand :
+  assumes "\<phi>\<in>formula"
+  shows "arity(ren_forces_nand(\<phi>)) \<le> succ(arity(\<phi>))"
+proof -
+  consider (lt) "1<arity(\<phi>)" | (ge) "\<not> 1 < arity(\<phi>)"
+    by auto
+  then
+  show ?thesis
+  proof cases
+    case lt
+    with \<open>\<phi>\<in>_\<close>
+    have "2 < succ(arity(\<phi>))" "2<arity(\<phi>)+\<^sub>\<omega>2"
+      using succ_ltI by auto
+    with \<open>\<phi>\<in>_\<close>
+    have "arity(iterates(\<lambda>p. incr_bv(p)`1,2,\<phi>)) = 2+\<^sub>\<omega>arity(\<phi>)"
+      using arity_incr_bv_lemma lt
+      by auto
+    with \<open>\<phi>\<in>_\<close>
+    show ?thesis
+      unfolding ren_forces_nand_def
+      using lt pred_Un_distrib union_abs1 Un_assoc[symmetric] Un_le_compat
+      by (simp add:FOL_arities)
+  next
+    case ge
+    with \<open>\<phi>\<in>_\<close>
+    have "arity(\<phi>) \<le> 1" "pred(arity(\<phi>)) \<le> 1"
+      using not_lt_iff_le le_trans[OF le_pred]
+      by simp_all
+    with \<open>\<phi>\<in>_\<close>
+    have "arity(iterates(\<lambda>p. incr_bv(p)`1,2,\<phi>)) = (arity(\<phi>))"
+      using arity_incr_bv_lemma ge
+      by simp
+    with \<open>arity(\<phi>) \<le> 1\<close> \<open>\<phi>\<in>_\<close> \<open>pred(_) \<le> 1\<close>
+    show ?thesis
+      unfolding ren_forces_nand_def
+      using  pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
+      by (simp add:FOL_arities)
+  qed
+qed
+
+lemma sats_ren_forces_nand:
+  "[q,P,leq,o,p] @ env \<in> list(M) \<Longrightarrow> \<phi>\<in>formula \<Longrightarrow>
+   (M, [q,p,P,leq,o] @ env \<Turnstile> ren_forces_nand(\<phi>)) \<longleftrightarrow> (M, [q,P,leq,o] @ env \<Turnstile> \<phi>)"
+  unfolding ren_forces_nand_def
+  using sats_incr_bv_iff [of _ _ M _ "[q]"]
+  by simp
+
+
+definition
+  ren_forces_forall :: "i\<Rightarrow>i" where
+  "ren_forces_forall(\<phi>) \<equiv>
+      Exists(Exists(Exists(Exists(Exists(
+        And(Equal(0,6),And(Equal(1,7),And(Equal(2,8),And(Equal(3,9),
+        And(Equal(4,5),iterates(\<lambda>p. incr_bv(p)`5 , 5, \<phi>)))))))))))"
+
+lemma arity_ren_forces_all :
+  assumes "\<phi>\<in>formula"
+  shows "arity(ren_forces_forall(\<phi>)) = 5 \<union> arity(\<phi>)"
+proof -
+  consider (lt) "5<arity(\<phi>)" | (ge) "\<not> 5 < arity(\<phi>)"
+    by auto
+  then
+  show ?thesis
+  proof cases
+    case lt
+    with \<open>\<phi>\<in>_\<close>
+    have "5 < succ(arity(\<phi>))" "5<arity(\<phi>)+\<^sub>\<omega>2"  "5<arity(\<phi>)+\<^sub>\<omega>3"  "5<arity(\<phi>)+\<^sub>\<omega>4"
+      using succ_ltI by auto
+    with \<open>\<phi>\<in>_\<close>
+    have "arity(iterates(\<lambda>p. incr_bv(p)`5,5,\<phi>)) = 5+\<^sub>\<omega>arity(\<phi>)"
+      using arity_incr_bv_lemma lt
+      by simp
+    with \<open>\<phi>\<in>_\<close>
+    show ?thesis
+      unfolding ren_forces_forall_def
+      using pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
+      by (simp add:FOL_arities)
+  next
+    case ge
+    with \<open>\<phi>\<in>_\<close>
+    have "arity(\<phi>) \<le> 5" "pred^5(arity(\<phi>)) \<le> 5"
+      using not_lt_iff_le le_trans[OF le_pred]
+      by simp_all
+    with \<open>\<phi>\<in>_\<close>
+    have "arity(iterates(\<lambda>p. incr_bv(p)`5,5,\<phi>)) = arity(\<phi>)"
+      using arity_incr_bv_lemma ge
+      by simp
+    with \<open>arity(\<phi>) \<le> 5\<close> \<open>\<phi>\<in>_\<close> \<open>pred^5(_) \<le> 5\<close>
+    show ?thesis
+      unfolding ren_forces_forall_def
+      using  pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
+      by (simp add:FOL_arities)
+  qed
+qed
+
+lemma ren_forces_forall_type[TC] :
+  "\<phi>\<in>formula \<Longrightarrow> ren_forces_forall(\<phi>) \<in>formula"
+  unfolding ren_forces_forall_def by simp
+
+lemma sats_ren_forces_forall :
+  "[x,P,leq,o,p] @ env \<in> list(M) \<Longrightarrow> \<phi>\<in>formula \<Longrightarrow>
+    (M, [x,p,P,leq,o] @ env \<Turnstile> ren_forces_forall(\<phi>)) \<longleftrightarrow> (M, [p,P,leq,o,x] @ env \<Turnstile> \<phi>)"
+  unfolding ren_forces_forall_def
+  using sats_incr_bv_iff [of _ _ M _ "[p,P,leq,o,x]"]
+  by simp
+
+subsubsection\<open>The primitive recursion\<close>
+
+consts forces' :: "i\<Rightarrow>i"
+primrec
+  "forces'(Member(x,y)) = forces_mem_fm(1,2,0,x+\<^sub>\<omega>4,y+\<^sub>\<omega>4)"
+  "forces'(Equal(x,y))  = forces_eq_fm(1,2,0,x+\<^sub>\<omega>4,y+\<^sub>\<omega>4)"
+  "forces'(Nand(p,q))   =
+        Neg(Exists(And(Member(0,2),And(is_leq_fm(3,0,1),And(ren_forces_nand(forces'(p)),
+                                         ren_forces_nand(forces'(q)))))))"
+  "forces'(Forall(p))   = Forall(ren_forces_forall(forces'(p)))"
+
+
+definition
+  forces :: "i\<Rightarrow>i" where
+  "forces(\<phi>) \<equiv> And(Member(0,1),forces'(\<phi>))"
+
+lemma forces'_type [TC]:  "\<phi>\<in>formula \<Longrightarrow> forces'(\<phi>) \<in> formula"
+  by (induct \<phi> set:formula; simp)
+
+lemma forces_type[TC] : "\<phi>\<in>formula \<Longrightarrow> forces(\<phi>) \<in> formula"
+  unfolding forces_def by simp
+
+subsection\<open>The arity of \<^term>\<open>forces\<close>\<close>
+
+lemma arity_forces_at:
+  assumes  "x \<in> nat" "y \<in> nat"
+  shows "arity(forces(Member(x, y))) = (succ(x) \<union> succ(y)) +\<^sub>\<omega> 4"
+    "arity(forces(Equal(x, y))) = (succ(x) \<union> succ(y)) +\<^sub>\<omega> 4"
+  unfolding forces_def
+  using assms arity_forces_mem_fm arity_forces_eq_fm succ_Un_distrib ord_simp_union
+  by (auto simp:FOL_arities,(rule_tac le_anti_sym,simp_all,(rule_tac not_le_anti_sym,simp_all))+)
+
+lemma arity_forces':
+  assumes "\<phi>\<in>formula"
+  shows "arity(forces'(\<phi>)) \<le> arity(\<phi>) +\<^sub>\<omega> 4"
+  using assms
+proof (induct set:formula)
+  case (Member x y)
+  then
+  show ?case
+    using arity_forces_mem_fm succ_Un_distrib ord_simp_union leI not_le_iff_lt
+    by simp
+next
+  case (Equal x y)
+  then
+  show ?case
+    using arity_forces_eq_fm succ_Un_distrib ord_simp_union leI not_le_iff_lt
+    by simp
+next
+  case (Nand \<phi> \<psi>)
+  let ?\<phi>' = "ren_forces_nand(forces'(\<phi>))"
+  let ?\<psi>' = "ren_forces_nand(forces'(\<psi>))"
+  have "arity(is_leq_fm(3, 0, 1)) = 4"
+    using arity_is_leq_fm succ_Un_distrib ord_simp_union
+    by simp
+  have "3 \<le> (4+\<^sub>\<omega>arity(\<phi>)) \<union> (4+\<^sub>\<omega>arity(\<psi>))" (is "_ \<le> ?rhs")
+    using ord_simp_union by simp
+  from \<open>\<phi>\<in>_\<close> Nand
+  have "pred(arity(?\<phi>')) \<le> ?rhs"  "pred(arity(?\<psi>')) \<le> ?rhs"
+  proof -
+    from \<open>\<phi>\<in>_\<close> \<open>\<psi>\<in>_\<close>
+    have A:"pred(arity(?\<phi>')) \<le> arity(forces'(\<phi>))"
+      "pred(arity(?\<psi>')) \<le> arity(forces'(\<psi>))"
+      using pred_mono[OF _  arity_ren_forces_nand] pred_succ_eq
+      by simp_all
+    from Nand
+    have "3 \<union> arity(forces'(\<phi>)) \<le> arity(\<phi>) +\<^sub>\<omega> 4"
+      "3 \<union> arity(forces'(\<psi>)) \<le> arity(\<psi>) +\<^sub>\<omega> 4"
+      using Un_le by simp_all
+    with Nand
+    show "pred(arity(?\<phi>')) \<le> ?rhs"
+      "pred(arity(?\<psi>')) \<le> ?rhs"
+      using le_trans[OF A(1)] le_trans[OF A(2)] le_Un_iff
+      by simp_all
+  qed
+  with Nand \<open>_=4\<close>
+  show ?case
+    using pred_Un_distrib Un_assoc[symmetric] succ_Un_distrib union_abs1 Un_leI3[OF \<open>3 \<le> ?rhs\<close>]
+    by (simp add:FOL_arities)
+next
+  case (Forall \<phi>)
+  let ?\<phi>' = "ren_forces_forall(forces'(\<phi>))"
+  show ?case
+  proof (cases "arity(\<phi>) = 0")
+    case True
+    with Forall
+    show ?thesis
+    proof -
+      from Forall True
+      have "arity(forces'(\<phi>)) \<le> 5"
+        using le_trans[of _ 4 5] by auto
+      with \<open>\<phi>\<in>_\<close>
+      have "arity(?\<phi>') \<le> 5"
+        using arity_ren_forces_all[OF forces'_type[OF \<open>\<phi>\<in>_\<close>]] union_abs2
+        by auto
+      with Forall True
+      show ?thesis
+        using pred_mono[OF _ \<open>arity(?\<phi>') \<le> 5\<close>]
+        by simp
+    qed
+  next
+    case False
+    with Forall
+    show ?thesis
+    proof -
+      from Forall False
+      have "arity(?\<phi>') = 5 \<union> arity(forces'(\<phi>))"
+        "arity(forces'(\<phi>)) \<le> 5 +\<^sub>\<omega> arity(\<phi>)"
+        "4 \<le> 3+\<^sub>\<omega>arity(\<phi>)"
+        using Ord_0_lt arity_ren_forces_all
+          le_trans[OF _ add_le_mono[of 4 5, OF _ le_refl]]
+        by auto
+      with \<open>\<phi>\<in>_\<close>
+      have "5 \<union> arity(forces'(\<phi>)) \<le> 5+\<^sub>\<omega>arity(\<phi>)"
+        using ord_simp_union by auto
+      with \<open>\<phi>\<in>_\<close> \<open>arity(?\<phi>') = 5 \<union> _\<close>
+      show ?thesis
+        using pred_Un_distrib succ_pred_eq[OF _ \<open>arity(\<phi>)\<noteq>0\<close>]
+          pred_mono[OF _ Forall(2)] Un_le[OF \<open>4\<le>3+\<^sub>\<omega>arity(\<phi>)\<close>]
+        by simp
+    qed
+  qed
+qed
+
+lemma arity_forces :
+  assumes "\<phi>\<in>formula"
+  shows "arity(forces(\<phi>)) \<le> 4+\<^sub>\<omega>arity(\<phi>)"
+  unfolding forces_def
+  using assms arity_forces' le_trans ord_simp_union FOL_arities by auto
+
+lemma arity_forces_le :
+  assumes "\<phi>\<in>formula" "n\<in>nat" "arity(\<phi>) \<le> n"
+  shows "arity(forces(\<phi>)) \<le> 4+\<^sub>\<omega>n"
+  using assms le_trans[OF _ add_le_mono[OF le_refl[of 5] \<open>arity(\<phi>)\<le>_\<close>]] arity_forces
+  by auto
+
+definition rename_split_fm where
+  "rename_split_fm(\<phi>) \<equiv> (\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>snd(9) is 0\<cdot> \<and> \<cdot>\<cdot>fst(9) is 4\<cdot> \<and> \<cdot>\<cdot>1=11\<cdot> \<and>
+    \<cdot>\<cdot>2=12\<cdot> \<and> \<cdot>\<cdot>3=13\<cdot> \<and> \<cdot>\<cdot>5=7\<cdot> \<and>
+    (\<lambda>p. incr_bv(p)`6)^8(forces(\<phi>)) \<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)"
+
+lemma rename_split_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> rename_split_fm(\<phi>)\<in>formula"
+  unfolding rename_split_fm_def by simp
+
+schematic_goal arity_rename_split_fm: "\<phi>\<in>formula \<Longrightarrow> arity(rename_split_fm(\<phi>)) = ?m"
+  using arity_forces[of \<phi>] forces_type unfolding rename_split_fm_def
+  by (simp add:arity Un_assoc[symmetric] union_abs1)
+
+lemma arity_rename_split_fm_le:
+  assumes "\<phi>\<in>formula"
+  shows "arity(rename_split_fm(\<phi>)) \<le> 8 \<union> (6 +\<^sub>\<omega> arity(\<phi>))"
+proof -
+  from assms
+  have arity_forces_6: "\<not> 1 < arity(\<phi>) \<Longrightarrow> 6 \<le> n \<Longrightarrow> arity(forces(\<phi>)) \<le> n" for n
+    using le_trans lt_trans[of _ 5 n] not_lt_iff_le[of 1 "arity(\<phi>)"]
+    by (auto intro!:le_trans[OF arity_forces])
+  have pred1_arity_forces: "\<not> 1 < arity(\<phi>) \<Longrightarrow> pred^n(arity(forces(\<phi>))) \<le> 8" if "n\<in>nat" for n
+    using that pred_le[of 7] le_succ[THEN [2] le_trans] arity_forces_6
+    by (induct rule:nat_induct) auto
+  have arity_forces_le_succ6: "pred^n(arity(forces(\<phi>))) \<le> succ(succ(succ(succ(succ(succ(arity(\<phi>)))))))"
+    if "n\<in>nat" for n
+    using that assms arity_forces[of \<phi>, THEN le_trans,
+        OF _ le_succ, THEN le_trans, OF _ _ le_succ] le_trans[OF pred_le[OF _ le_succ]]
+    by (induct rule:nat_induct) auto
+  note trivial_arities = arity_forces_6
+    arity_forces_le_succ6[of 1, simplified] arity_forces_le_succ6[of 2, simplified]
+    arity_forces_le_succ6[of 3, simplified] arity_forces_le_succ6[of 4, simplified]
+    arity_forces_le_succ6[of 5, simplified] arity_forces_le_succ6[of 6, simplified]
+    pred1_arity_forces[of 1, simplified] pred1_arity_forces[of 2, simplified]
+    pred1_arity_forces[of 3, simplified] pred1_arity_forces[of 4, simplified]
+    pred1_arity_forces[of 5, simplified] pred1_arity_forces[of 6, simplified]
+  show ?thesis
+    using assms arity_forces[of \<phi>] arity_forces[of \<phi>, THEN le_trans, OF _ le_succ]
+      arity_forces[of \<phi>, THEN le_trans, OF _ le_succ, THEN le_trans, OF _ _ le_succ]
+    unfolding rename_split_fm_def
+    by (simp add:arity Un_assoc[symmetric] union_abs1 arity_forces[of \<phi>] forces_type)
+      ((subst arity_incr_bv_lemma; auto simp: arity ord_simp_union forces_type trivial_arities)+)
+qed
+
+definition body_ground_repl_fm where
+  "body_ground_repl_fm(\<phi>) \<equiv> (\<cdot>\<exists>(\<cdot>\<exists>\<cdot>is_Vset_fm(2, 0) \<and> \<cdot>\<cdot>1 \<in> 0\<cdot> \<and> rename_split_fm(\<phi>) \<cdot>\<cdot>\<cdot>)\<cdot>)"
+
+lemma body_ground_repl_fm_type[TC]: "\<phi>\<in>formula \<Longrightarrow> body_ground_repl_fm(\<phi>)\<in>formula"
+  unfolding body_ground_repl_fm_def by simp
+
+lemma arity_body_ground_repl_fm_le:
+  notes le_trans[trans]
+  assumes "\<phi>\<in>formula"
+  shows "arity(body_ground_repl_fm(\<phi>)) \<le> 6 \<union> (arity(\<phi>) +\<^sub>\<omega> 4)"
+proof -
+  from \<open>\<phi>\<in>formula\<close>
+  have ineq: "n \<union> pred(pred(arity(rename_split_fm(\<phi>))))
+    \<le> m \<union> pred(pred(8 \<union> (arity(\<phi>) +\<^sub>\<omega>6 )))" if "n \<le> m" "n\<in>nat" "m\<in>nat" for n m
+    using that arity_rename_split_fm_le[of \<phi>, THEN [2] pred_mono, THEN [2] pred_mono,
+        THEN [2] Un_mono[THEN subset_imp_le, OF _ le_imp_subset]] le_imp_subset
+    by auto
+  moreover
+  have eq1: "pred(pred(pred(4 \<union> 2 \<union> pred(pred(pred(
+    pred(pred(pred(pred(pred(9 \<union> 1 \<union> 3 \<union> 2))))))))))) = 1"
+    by (auto simp:pred_Un_distrib)
+  ultimately
+  have "pred(pred(pred(4 \<union> 2 \<union> pred(pred(pred(
+    pred(pred(pred(pred(pred(9 \<union> 1 \<union> 3 \<union> 2))))))))))) \<union>
+    pred(pred(arity(rename_split_fm(\<phi>)))) \<le>
+    1 \<union> pred(pred(8 \<union> (arity(\<phi>) +\<^sub>\<omega>6 )))"
+    by auto
+  also from \<open>\<phi>\<in>formula\<close>
+  have "1 \<union> pred(pred(8 \<union> (arity(\<phi>) +\<^sub>\<omega>6 ))) \<le> 6 \<union> (4+\<^sub>\<omega>arity(\<phi>))"
+    by (auto simp:pred_Un_distrib Un_assoc[symmetric] ord_simp_union)
+  finally
+  show ?thesis
+    using  \<open>\<phi>\<in>formula\<close> unfolding body_ground_repl_fm_def
+    by (simp add:arity pred_Un_distrib, subst arity_transrec_fm[of "is_HVfrom_fm(8,2,1,0)" 3 1])
+      (simp add:arity pred_Un_distrib,simp_all,
+        auto simp add:eq1 arity_is_HVfrom_fm[of 8 2 1 0])
+qed
+
+definition ground_repl_fm where
+  "ground_repl_fm(\<phi>) \<equiv> least_fm(body_ground_repl_fm(\<phi>), 1)"
+
+lemma ground_repl_fm_type[TC]:
+  "\<phi>\<in>formula \<Longrightarrow> ground_repl_fm(\<phi>) \<in> formula"
+  unfolding ground_repl_fm_def by simp
+
+lemma arity_ground_repl_fm:
+  assumes "\<phi>\<in>formula"
+  shows "arity(ground_repl_fm(\<phi>)) \<le> 5 \<union> (3 +\<^sub>\<omega> arity(\<phi>))"
+proof -
+  from assms
+  have "pred(arity(body_ground_repl_fm(\<phi>))) \<le> 5 \<union> (3 +\<^sub>\<omega> arity(\<phi>))"
+    using arity_body_ground_repl_fm_le pred_mono succ_Un_distrib
+    by (rule_tac pred_le) auto
+  with assms
+  have "2 \<union> pred(arity(body_ground_repl_fm(\<phi>))) \<le> 5 \<union> (3 +\<^sub>\<omega> arity(\<phi>))"
+    using Un_le le_Un_iff by auto
+  then
+  show ?thesis
+    using assms arity_forces arity_body_ground_repl_fm_le
+    unfolding least_fm_def ground_repl_fm_def
+    apply (auto simp add:arity Un_assoc[symmetric])
+    apply (simp add: pred_Un Un_assoc, simp add: Un_assoc[symmetric] union_abs1 pred_Un)
+    by(simp only: Un_commute, subst Un_commute, simp add:ord_simp_union,force)
+qed
+
+simple_rename "ren_F" src "[x_P, x_leq, x_o, x_f, y_c, x_bc, p, x, b]"
+  tgt "[x_bc, y_c,b,x, x_P, x_leq, x_o, x_f, p]"
+
+simple_rename "ren_G" src "[x,x_P, x_leq, x_one, x_f,x_p,y,x_B]"
+  tgt "[x,y,x_P, x_leq, x_one, x_f,x_p,x_B]"
+
+simple_rename "ren_F_aux" src "[q,x_P, x_leq, x_one, f_dot, x_a, x_bc,x_p,x_b]"
+  tgt "[x_bc, q, x_b, x_P, x_leq, x_one, f_dot,x_a,x_p]"
+
+simple_rename "ren_G_aux" src "[ x_b, x_P, x_leq, x_one, f_dot,x_a,x_p,y]"
+  tgt "[ x_b, y, x_P, x_leq, x_one, f_dot,x_a,x_p]"
+
+definition ccc_fun_closed_lemma_aux2_fm where [simp]:
+  "ccc_fun_closed_lemma_aux2_fm \<equiv> ren(Collect_fm(1, (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> ren(\<cdot>\<cdot>0\<preceq>\<^bsup>2\<^esup>7\<cdot>
+  \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot> ) ` 9 ` 9 ` ren_F_aux_fn\<cdot>\<cdot>), 7)) ` 8 ` 8 ` ren_G_aux_fn"
+
+lemma ccc_fun_closed_lemma_aux2_fm_type [TC] :
+  "ccc_fun_closed_lemma_aux2_fm \<in> formula"
+proof -
+  let ?\<psi>="\<cdot>\<cdot>0\<preceq>\<^bsup>2\<^esup>7\<cdot>  \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot> "
+  let ?G="(\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> ren(?\<psi>) ` 9 ` 9 ` ren_F_aux_fn\<cdot>\<cdot>)"
+  have "ren(?\<psi>)`9`9`ren_F_aux_fn \<in> formula"
+    using ren_tc ren_F_aux_thm check_fm_type is_leq_fm_type ren_F_aux_fn_def pred_le
+    by simp_all
+  then
+  show ?thesis
+    using ren_tc ren_G_aux_thm ren_G_aux_fn_def
+    by simp
+qed
+
+definition ccc_fun_closed_lemma_fm where [simp]:
+  "ccc_fun_closed_lemma_fm \<equiv> ren(Collect_fm(7, (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v6 is 0\<cdot> \<and>
+   ren((\<cdot>\<exists>\<cdot>\<cdot>0 \<in> 1\<cdot> \<and> \<cdot>\<cdot>0\<preceq>\<^bsup>2\<^esup>7\<cdot> \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot>\<cdot>\<cdot>)) ` 9 ` 9 ` ren_F_fn\<cdot>\<cdot>)\<cdot>\<cdot>), 6))
+   ` 8 ` 8 ` ren_G_fn"
+
+lemma ccc_fun_closed_lemma_fm_type [TC] :
+  "ccc_fun_closed_lemma_fm \<in> formula"
+proof -
+  let ?\<psi>="(\<cdot>\<exists>\<cdot>\<cdot>0 \<in> 1\<cdot> \<and> \<cdot> \<cdot>0 \<preceq>\<^bsup>2\<^esup> 7\<cdot> \<and> forces(\<cdot>0`1 is 2\<cdot> ) \<cdot>\<cdot>\<cdot>)"
+  let ?G="(\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v5 is 0\<cdot> \<and> (\<cdot>\<exists>\<cdot>\<cdot>2\<^sup>v6 is 0\<cdot> \<and> ren(?\<psi>) ` 9 ` 9 ` ren_F_fn\<cdot>\<cdot>)\<cdot>\<cdot>)"
+  have "ren(?\<psi>)`9`9`ren_F_fn \<in> formula"
+    using ren_tc ren_F_thm check_fm_type is_leq_fm_type ren_F_fn_def pred_le
+    by simp_all
+  then
+  show ?thesis
+    using ren_tc ren_G_thm ren_G_fn_def
+    by simp
+qed
+
+definition is_order_body
+  where "is_order_body(M,X,x,z) \<equiv> \<exists>A[M]. cartprod(M,X,X,A) \<and> subset(M,x,A) \<and> M(z) \<and> M(x) \<and>
+           is_well_ord(M,X, x) \<and> is_ordertype(M,X, x,z)"
+
+synthesize "is_order_body" from_definition assuming "nonempty"
+
+definition omap_wfrec_body where
+  "omap_wfrec_body(A,r) \<equiv> (\<cdot>\<exists>\<cdot>image_fm(2, 0, 1) \<and> pred_set_fm(9+\<^sub>\<omega>A, 3,9+\<^sub>\<omega>r, 0) \<cdot>\<cdot>)"
+
+lemma type_omap_wfrec_body_fm :"A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> omap_wfrec_body(A,r)\<in>formula"
+  unfolding omap_wfrec_body_def by simp
+
+lemma arity_omap_wfrec_aux : "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> arity(omap_wfrec_body(A,r)) = (9+\<^sub>\<omega>A) \<union> (9+\<^sub>\<omega>r)"
+  unfolding omap_wfrec_body_def
+  using arity_image_fm arity_pred_set_fm pred_Un_distrib union_abs2[of 3] union_abs1
+  by (simp add:FOL_arities, auto simp add:Un_assoc[symmetric] union_abs1)
+
+lemma arity_omap_wfrec: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>
+  arity(is_wfrec_fm(omap_wfrec_body(A,r),r+\<^sub>\<omega>3, 1, 0)) = (4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)"
+  using Arities.arity_is_wfrec_fm[OF _ _ _ _ _ arity_omap_wfrec_aux,of A r "3+\<^sub>\<omega>r" 1 0]
+    pred_Un_distrib union_abs1 union_abs2 type_omap_wfrec_body_fm
+  by auto
+
+lemma arity_isordermap: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
+   arity(is_ordermap_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
+  unfolding is_ordermap_fm_def
+  using arity_lambda_fm[where i="(4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)",OF _ _ _ _ arity_omap_wfrec,
+      unfolded omap_wfrec_body_def] pred_Un_distrib union_abs1
+  by auto
+
+
+lemma arity_is_ordertype: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
+   arity(is_ordertype_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
+  unfolding is_ordertype_fm_def
+  using arity_isordermap arity_image_fm pred_Un_distrib FOL_arities
+  by auto
+
+arity_theorem for "is_order_body_fm"
+
+lemma arity_is_order_body: "arity(is_order_body_fm(2,0,1)) = 3"
+  using arity_is_order_body_fm arity_is_ordertype ord_simp_union
+  by (simp add:FOL_arities)
+
+definition H_order_pred where
+  "H_order_pred(A,r) \<equiv>  \<lambda>x f . f `` Order.pred(A, x, r)"
+
+relationalize "H_order_pred" "is_H_order_pred"
+
+synthesize "is_H_order_pred" from_definition assuming "nonempty"
+
+definition order_pred_wfrec_body where
+  "order_pred_wfrec_body(M,A,r,z,x) \<equiv> \<exists>y[M].
+                pair(M, x, y, z) \<and>
+                (\<exists>f[M].
+                    (\<forall>z[M].
+                        z \<in> f \<longleftrightarrow>
+                        (\<exists>xa[M].
+                            \<exists>y[M].
+                               \<exists>xaa[M].
+                                  \<exists>sx[M].
+                                     \<exists>r_sx[M].
+                                        \<exists>f_r_sx[M].
+                                           pair(M, xa, y, z) \<and>
+                                           pair(M, xa, x, xaa) \<and>
+                                           upair(M, xa, xa, sx) \<and>
+                                           pre_image(M, r, sx, r_sx) \<and>
+                                           restriction(M, f, r_sx, f_r_sx) \<and>
+                                           xaa \<in> r \<and> (\<exists>a[M]. image(M, f_r_sx, a, y) \<and> pred_set(M, A, xa, r, a)))) \<and>
+                    (\<exists>a[M]. image(M, f, a, y) \<and> pred_set(M, A, x, r, a)))"
+
+
+synthesize "order_pred_wfrec_body" from_definition
+arity_theorem for "order_pred_wfrec_body_fm"
+
+definition replacement_is_order_body_fm where "replacement_is_order_body_fm \<equiv> is_order_body_fm(2,0,1)"
+definition wfrec_replacement_order_pred_fm where "wfrec_replacement_order_pred_fm \<equiv> order_pred_wfrec_body_fm(3,2,1,0)"
+definition replacement_is_jump_cardinal_body_fm where "replacement_is_jump_cardinal_body_fm \<equiv> is_jump_cardinal_body'_fm(0,1)"
+definition replacement_is_aleph_fm where "replacement_is_aleph_fm \<equiv> \<cdot>\<cdot>0 is ordinal\<cdot> \<and> \<cdot>\<aleph>(0) is 1\<cdot>\<cdot>"
+
+definition
+  funspace_succ_rep_intf where
+  "funspace_succ_rep_intf \<equiv> \<lambda>p z n. \<exists>f b. p = <f,b> & z = {cons(<n,b>, f)}"
+
+relativize functional "funspace_succ_rep_intf" "funspace_succ_rep_intf_rel"
+
+\<comment> \<open>The definition obtained next uses \<^term>\<open>is_cons\<close> instead of \<^term>\<open>upair\<close>
+  as in Paulson's \<^file>\<open>~~/src/ZF/Constructible/Relative.thy\<close>.\<close>
+relationalize "funspace_succ_rep_intf_rel" "is_funspace_succ_rep_intf"
+
+synthesize "is_funspace_succ_rep_intf" from_definition
+
+arity_theorem for "is_funspace_succ_rep_intf_fm"
+
+definition
+  PHrank :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
+  "PHrank(M,f,y,z) \<equiv> (\<exists>fy[M]. fun_apply(M,f,y,fy) \<and> successor(M,fy,z))"
+
+synthesize "PHrank" from_definition assuming "nonempty"
+
+definition wfrec_Hfrc_at_fm where "wfrec_Hfrc_at_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(Hfrc_at_fm(8, 9, 2, 1, 0), 5, 1, 0) \<cdot>\<cdot>)"
+definition list_repl1_intf_fm where "list_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(list_functor_fm(13, 1, 0), 10, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
+definition list_repl2_intf_fm where "list_repl2_intf_fm \<equiv> \<cdot>\<cdot>0 \<in> 4\<cdot> \<and> is_iterates_fm(list_functor_fm(13, 1, 0), 3, 0, 1) \<cdot>"
+definition formula_repl2_intf_fm where "formula_repl2_intf_fm \<equiv> \<cdot>\<cdot>0 \<in> 3\<cdot> \<and> is_iterates_fm(formula_functor_fm(1, 0), 2, 0, 1) \<cdot>"
+definition eclose_repl2_intf_fm where "eclose_repl2_intf_fm \<equiv> \<cdot>\<cdot>0 \<in> 3\<cdot> \<and> is_iterates_fm(\<cdot>\<Union>1 is 0\<cdot>, 2, 0, 1) \<cdot>"
+definition powapply_repl_fm where "powapply_repl_fm \<equiv> is_Powapply_fm(2,0,1)"
+definition phrank_repl_fm where "phrank_repl_fm \<equiv> PHrank_fm(2,0,1)"
+definition wfrec_rank_fm where "wfrec_rank_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(is_Hrank_fm(2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
+definition trans_repl_HVFrom_fm where "trans_repl_HVFrom_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(is_HVfrom_fm(8, 2, 1, 0), 4, 1, 0) \<cdot>\<cdot>)"
+definition wfrec_Hcheck_fm where "wfrec_Hcheck_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(is_Hcheck_fm(8, 2, 1, 0), 4, 1, 0) \<cdot>\<cdot>) "
+definition repl_PHcheck_fm where "repl_PHcheck_fm \<equiv> PHcheck_fm(2,3,0,1)"
+definition check_replacement_fm where "check_replacement_fm \<equiv> \<cdot>check_fm(0,2,1) \<and> \<cdot>0 \<in> 3\<cdot>\<cdot>"
+definition G_dot_in_M_fm where "G_dot_in_M_fm \<equiv>  \<cdot>(\<cdot>\<exists>\<cdot>\<cdot>1\<^sup>v3 is 0\<cdot> \<and> pair_fm(0, 1, 2) \<cdot>\<cdot>) \<and> \<cdot>0 \<in> 3\<cdot>\<cdot>"
+definition repl_opname_check_fm where "repl_opname_check_fm \<equiv> \<cdot>is_opname_check_fm(3,2,0,1) \<and> \<cdot>0 \<in> 4\<cdot>\<cdot>"
+definition tl_repl_intf_fm where "tl_repl_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(tl_fm(1,0), 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
+definition formula_repl1_intf_fm where "formula_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(formula_functor_fm(1,0), 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
+definition eclose_repl1_intf_fm where "eclose_repl1_intf_fm \<equiv> (\<cdot>\<exists>\<cdot>pair_fm(1, 0, 2) \<and> is_wfrec_fm(iterates_MH_fm(big_union_fm(1,0), 9, 2, 1, 0), 3, 1, 0) \<cdot>\<cdot>)"
+
+definition replacement_assm where
+  "replacement_assm(M,env,\<phi>) \<equiv> \<phi> \<in> formula \<longrightarrow> env \<in> list(M) \<longrightarrow>
+  arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
+    strong_replacement(##M,\<lambda>x y. (M , [x,y]@env \<Turnstile> \<phi>))"
+
+definition ground_replacement_assm where
+  "ground_replacement_assm(M,env,\<phi>) \<equiv> replacement_assm(M,env,ground_repl_fm(\<phi>))"
+
+end
diff --git a/thys/Independence_CH/Forces_Definition.thy b/thys/Independence_CH/Forces_Definition.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Forces_Definition.thy
@@ -0,0 +1,858 @@
+section\<open>The definition of \<^term>\<open>forces\<close>\<close>
+
+theory Forces_Definition
+  imports
+    Forcing_Data
+begin
+
+text\<open>This is the core of our development.\<close>
+
+subsection\<open>The relation \<^term>\<open>frecrel\<close>\<close>
+
+lemma names_belowsD:
+  assumes "x \<in> names_below(P,z)"
+  obtains f n1 n2 p where
+    "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
+  using assms unfolding names_below_def by auto
+
+context forcing_data1
+begin
+
+(* Absoluteness of components *)
+lemma ftype_abs:
+  "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_ftype(##M,x,y) \<longleftrightarrow> y = ftype(x)"
+  unfolding ftype_def  is_ftype_def by (simp add:absolut)
+
+lemma name1_abs:
+  "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_name1(##M,x,y) \<longleftrightarrow> y = name1(x)"
+  unfolding name1_def is_name1_def
+  by (rule is_hcomp_abs[OF fst_abs],simp_all add: fst_snd_closed[simplified] absolut)
+
+lemma snd_snd_abs:
+  "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_snd_snd(##M,x,y) \<longleftrightarrow> y = snd(snd(x))"
+  unfolding is_snd_snd_def
+  by (rule is_hcomp_abs[OF snd_abs],
+      simp_all add: conjunct2[OF fst_snd_closed,simplified] absolut)
+
+lemma name2_abs:
+  "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_name2(##M,x,y) \<longleftrightarrow> y = name2(x)"
+  unfolding name2_def is_name2_def
+  by (rule is_hcomp_abs[OF fst_abs snd_snd_abs],simp_all add:absolut conjunct2[OF fst_snd_closed,simplified])
+
+lemma cond_of_abs:
+  "\<lbrakk>x\<in>M; y\<in>M \<rbrakk> \<Longrightarrow> is_cond_of(##M,x,y) \<longleftrightarrow> y = cond_of(x)"
+  unfolding cond_of_def is_cond_of_def
+  by (rule is_hcomp_abs[OF snd_abs snd_snd_abs];simp_all add:fst_snd_closed[simplified])
+
+lemma tuple_abs:
+  "\<lbrakk>z\<in>M;t1\<in>M;t2\<in>M;p\<in>M;t\<in>M\<rbrakk> \<Longrightarrow>
+   is_tuple(##M,z,t1,t2,p,t) \<longleftrightarrow> t = \<langle>z,t1,t2,p\<rangle>"
+  unfolding is_tuple_def using pair_in_M_iff by simp
+
+lemmas components_abs = ftype_abs name1_abs name2_abs cond_of_abs
+  tuple_abs
+
+lemma comp_in_M:
+  "p \<preceq> q \<Longrightarrow> p\<in>M"
+  "p \<preceq> q \<Longrightarrow> q\<in>M"
+  using leq_in_M transitivity[of _ leq] pair_in_M_iff by auto
+
+(* Absoluteness of Hfrc *)
+
+lemma eq_case_abs [simp]:
+  assumes "t1\<in>M" "t2\<in>M" "p\<in>M" "f\<in>M"
+  shows "is_eq_case(##M,t1,t2,p,P,leq,f) \<longleftrightarrow> eq_case(t1,t2,p,P,leq,f)"
+proof -
+  have "q \<preceq> p \<Longrightarrow> q\<in>M" for q
+    using comp_in_M by simp
+  moreover
+  have "\<langle>s,y\<rangle>\<in>t \<Longrightarrow> s\<in>domain(t)" if "t\<in>M" for s y t
+    using that unfolding domain_def by auto
+  ultimately
+  have
+    "(\<forall>s\<in>M. s \<in> domain(t1) \<or> s \<in> domain(t2) \<longrightarrow> (\<forall>q\<in>M. q\<in>P \<and> q \<preceq> p \<longrightarrow>
+                              (f ` \<langle>1, s, t1, q\<rangle> =1 \<longleftrightarrow> f ` \<langle>1, s, t2, q\<rangle>=1))) \<longleftrightarrow>
+    (\<forall>s. s \<in> domain(t1) \<or> s \<in> domain(t2) \<longrightarrow> (\<forall>q. q\<in>P \<and> q \<preceq> p \<longrightarrow>
+                                  (f ` \<langle>1, s, t1, q\<rangle> =1 \<longleftrightarrow> f ` \<langle>1, s, t2, q\<rangle>=1)))"
+    using assms domain_trans[OF trans_M,of t1] domain_trans[OF trans_M,of t2]
+    by auto
+  then
+  show ?thesis
+    unfolding eq_case_def is_eq_case_def
+    using assms pair_in_M_iff nat_into_M domain_closed apply_closed leq_in_M zero_in_M Un_closed
+    by (simp add:components_abs)
+qed
+
+lemma mem_case_abs [simp]:
+  assumes "t1\<in>M" "t2\<in>M" "p\<in>M" "f\<in>M"
+  shows "is_mem_case(##M,t1,t2,p,P,leq,f) \<longleftrightarrow> mem_case(t1,t2,p,P,leq,f)"
+proof
+  {
+    fix v
+    assume "v\<in>P" "v \<preceq> p" "is_mem_case(##M,t1,t2,p,P,leq,f)"
+    moreover
+    from this
+    have "v\<in>M" "\<langle>v,p\<rangle> \<in> M" "(##M)(v)"
+      using transitivity[OF _ P_in_M,of v] transitivity[OF _ leq_in_M]
+      by simp_all
+    moreover
+    from calculation assms
+    obtain q r s where
+      "r \<in> P \<and> q \<in> P \<and> \<langle>q, v\<rangle> \<in> M \<and> \<langle>s, r\<rangle> \<in> M \<and> \<langle>q, r\<rangle> \<in> M \<and> 0 \<in> M \<and>
+       \<langle>0, t1, s, q\<rangle> \<in> M \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
+      unfolding is_mem_case_def by (auto simp add:components_abs)
+    then
+    have "\<exists>q s r. r \<in> P \<and> q \<in> P \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
+      by auto
+  }
+  then
+  show "mem_case(t1, t2, p, P, leq, f)" if "is_mem_case(##M, t1, t2, p, P, leq, f)"
+    unfolding mem_case_def using that assms by auto
+next
+  { fix v
+    assume "v \<in> M" "v \<in> P" "\<langle>v, p\<rangle> \<in> M" "v \<preceq> p" "mem_case(t1, t2, p, P, leq, f)"
+    moreover
+    from this
+    obtain q s r where "r \<in> P \<and> q \<in> P \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
+      unfolding mem_case_def by auto
+    moreover
+    from this \<open>t2\<in>M\<close>
+    have "r\<in>M" "q\<in>M" "s\<in>M" "r \<in> P \<and> q \<in> P \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
+      using transitivity domainI[of s r] P_in_M domain_closed
+      by auto
+    moreover
+    note \<open>t1\<in>M\<close>
+    ultimately
+    have "\<exists>q\<in>M . \<exists>s\<in>M. \<exists>r\<in>M.
+         r \<in> P \<and> q \<in> P \<and> \<langle>q, v\<rangle> \<in> M \<and> \<langle>s, r\<rangle> \<in> M \<and> \<langle>q, r\<rangle> \<in> M \<and> 0 \<in> M \<and>
+         \<langle>0, t1, s, q\<rangle> \<in> M \<and> q \<preceq> v \<and> \<langle>s, r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> f ` \<langle>0, t1, s, q\<rangle> = 1"
+      using pair_in_M_iff zero_in_M by auto
+  }
+  then
+  show "is_mem_case(##M, t1, t2, p, P, leq, f)" if "mem_case(t1, t2, p, P, leq, f)"
+    unfolding is_mem_case_def
+    using assms that zero_in_M pair_in_M_iff apply_closed nat_into_M
+    by (auto simp add:components_abs)
+qed
+
+lemma Hfrc_abs:
+  "\<lbrakk>fnnc\<in>M; f\<in>M\<rbrakk> \<Longrightarrow>
+   is_Hfrc(##M,P,leq,fnnc,f) \<longleftrightarrow> Hfrc(P,leq,fnnc,f)"
+  unfolding is_Hfrc_def Hfrc_def using pair_in_M_iff zero_in_M
+  by (auto simp add:components_abs)
+
+lemma Hfrc_at_abs:
+  "\<lbrakk>fnnc\<in>M; f\<in>M ; z\<in>M\<rbrakk> \<Longrightarrow>
+   is_Hfrc_at(##M,P,leq,fnnc,f,z) \<longleftrightarrow>  z = bool_of_o(Hfrc(P,leq,fnnc,f)) "
+  unfolding is_Hfrc_at_def using Hfrc_abs
+  by auto
+
+lemma components_closed :
+  "x\<in>M \<Longrightarrow> (##M)(ftype(x))"
+  "x\<in>M \<Longrightarrow> (##M)(name1(x))"
+  "x\<in>M \<Longrightarrow> (##M)(name2(x))"
+  "x\<in>M \<Longrightarrow> (##M)(cond_of(x))"
+  unfolding ftype_def name1_def name2_def cond_of_def using fst_snd_closed by simp_all
+
+lemma ecloseN_closed:
+  "(##M)(A) \<Longrightarrow> (##M)(ecloseN(A))"
+  "(##M)(A) \<Longrightarrow> (##M)(eclose_n(name1,A))"
+  "(##M)(A) \<Longrightarrow> (##M)(eclose_n(name2,A))"
+  unfolding ecloseN_def eclose_n_def
+  using components_closed eclose_closed singleton_closed Un_closed by auto
+
+lemma eclose_n_abs :
+  assumes "x\<in>M" "ec\<in>M"
+  shows "is_eclose_n(##M,is_name1,ec,x) \<longleftrightarrow> ec = eclose_n(name1,x)"
+    "is_eclose_n(##M,is_name2,ec,x) \<longleftrightarrow> ec = eclose_n(name2,x)"
+  unfolding is_eclose_n_def eclose_n_def
+  using assms name1_abs name2_abs eclose_abs singleton_closed components_closed
+  by auto
+
+
+lemma ecloseN_abs :
+  "\<lbrakk>x\<in>M;ec\<in>M\<rbrakk> \<Longrightarrow> is_ecloseN(##M,x,ec) \<longleftrightarrow> ec = ecloseN(x)"
+  unfolding is_ecloseN_def ecloseN_def
+  using eclose_n_abs Un_closed union_abs ecloseN_closed
+  by auto
+
+lemma frecR_abs :
+  "x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> frecR(x,y) \<longleftrightarrow> is_frecR(##M,x,y)"
+  unfolding frecR_def is_frecR_def
+  using zero_in_M domain_closed Un_closed components_closed nat_into_M
+  by (auto simp add: components_abs)
+
+lemma frecrelP_abs :
+  "z\<in>M \<Longrightarrow> frecrelP(##M,z) \<longleftrightarrow> (\<exists>x y. z = \<langle>x,y\<rangle> \<and> frecR(x,y))"
+  using pair_in_M_iff frecR_abs unfolding frecrelP_def by auto
+
+lemma frecrel_abs:
+  assumes "A\<in>M" "r\<in>M"
+  shows "is_frecrel(##M,A,r) \<longleftrightarrow>  r = frecrel(A)"
+proof -
+  from \<open>A\<in>M\<close>
+  have "z\<in>M" if "z\<in>A\<times>A" for z
+    using cartprod_closed transitivity that by simp
+  then
+  have "Collect(A\<times>A,frecrelP(##M)) = Collect(A\<times>A,\<lambda>z. (\<exists>x y. z = \<langle>x,y\<rangle> \<and> frecR(x,y)))"
+    using Collect_cong[of "A\<times>A" "A\<times>A" "frecrelP(##M)"] assms frecrelP_abs by simp
+  with assms
+  show ?thesis
+    unfolding is_frecrel_def def_frecrel using cartprod_closed
+    by simp
+qed
+
+lemma frecrel_closed:
+  assumes "x\<in>M"
+  shows "frecrel(x)\<in>M"
+proof -
+  have "Collect(x\<times>x,\<lambda>z. (\<exists>x y. z = \<langle>x,y\<rangle> \<and> frecR(x,y)))\<in>M"
+    using Collect_in_M[of "frecrelP_fm(0)" "[]"] arity_frecrelP_fm sats_frecrelP_fm
+      frecrelP_abs \<open>x\<in>M\<close> cartprod_closed
+    by simp
+  then
+  show ?thesis
+    unfolding frecrel_def Rrel_def frecrelP_def by simp
+qed
+
+lemma field_frecrel : "field(frecrel(names_below(P,x))) \<subseteq> names_below(P,x)"
+  unfolding frecrel_def
+  using field_Rrel by simp
+
+lemma forcerelD : "uv \<in> forcerel(P,x) \<Longrightarrow> uv\<in> names_below(P,x) \<times> names_below(P,x)"
+  unfolding forcerel_def
+  using trancl_type field_frecrel by blast
+
+lemma wf_forcerel :
+  "wf(forcerel(P,x))"
+  unfolding forcerel_def using wf_trancl wf_frecrel .
+
+lemma restrict_trancl_forcerel:
+  assumes "frecR(w,y)"
+  shows "restrict(f,frecrel(names_below(P,x))-``{y})`w
+       = restrict(f,forcerel(P,x)-``{y})`w"
+  unfolding forcerel_def frecrel_def using assms restrict_trancl_Rrel[of frecR]
+  by simp
+
+lemma names_belowI :
+  assumes "frecR(\<langle>ft,n1,n2,p\<rangle>,\<langle>a,b,c,d\<rangle>)" "p\<in>P"
+  shows "\<langle>ft,n1,n2,p\<rangle> \<in> names_below(P,\<langle>a,b,c,d\<rangle>)" (is "?x \<in> names_below(_,?y)")
+proof -
+  from assms
+  have "ft \<in> 2" "a \<in> 2"
+    unfolding frecR_def by (auto simp add:components_simp)
+  from assms
+  consider (e) "n1 \<in> domain(b) \<union> domain(c) \<and> (n2 = b \<or> n2 =c)"
+    | (m) "n1 = b \<and> n2 \<in> domain(c)"
+    unfolding frecR_def by (auto simp add:components_simp)
+  then show ?thesis
+  proof cases
+    case e
+    then
+    have "n1 \<in> eclose(b) \<or> n1 \<in> eclose(c)"
+      using Un_iff in_dom_in_eclose by auto
+    with e
+    have "n1 \<in> ecloseN(?y)" "n2 \<in> ecloseN(?y)"
+      using ecloseNI components_in_eclose by auto
+    with \<open>ft\<in>2\<close> \<open>p\<in>P\<close>
+    show ?thesis
+      unfolding names_below_def by  auto
+  next
+    case m
+    then
+    have "n1 \<in> ecloseN(?y)" "n2 \<in> ecloseN(?y)"
+      using mem_eclose_trans  ecloseNI
+        in_dom_in_eclose components_in_eclose by auto
+    with \<open>ft\<in>2\<close> \<open>p\<in>P\<close>
+    show ?thesis
+      unfolding names_below_def
+      by auto
+  qed
+qed
+
+lemma names_below_tr :
+  assumes "x\<in> names_below(P,y)" "y\<in> names_below(P,z)"
+  shows "x\<in> names_below(P,z)"
+proof -
+  let ?A="\<lambda>y . names_below(P,y)"
+  note assms
+  moreover from this
+  obtain fx x1 x2 px where "x = \<langle>fx,x1,x2,px\<rangle>" "fx\<in>2" "x1\<in>ecloseN(y)" "x2\<in>ecloseN(y)" "px\<in>P"
+    unfolding names_below_def by auto
+  moreover from calculation
+  obtain fy y1 y2 py where "y = \<langle>fy,y1,y2,py\<rangle>" "fy\<in>2" "y1\<in>ecloseN(z)" "y2\<in>ecloseN(z)" "py\<in>P"
+    unfolding names_below_def by auto
+  moreover from calculation
+  have "x1\<in>ecloseN(z)" "x2\<in>ecloseN(z)"
+    using ecloseN_mono names_simp by auto
+  ultimately
+  have "x\<in>?A(z)"
+    unfolding names_below_def by simp
+  then
+  show ?thesis using subsetI by simp
+qed
+
+lemma arg_into_names_below2 :
+  assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
+  shows  "x \<in> names_below(P,y)"
+proof -
+  from assms
+  have "x\<in>names_below(P,z)" "y\<in>names_below(P,z)" "frecR(x,y)"
+    unfolding frecrel_def Rrel_def
+    by auto
+  obtain f n1 n2 p where "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
+    using \<open>x\<in>names_below(P,z)\<close>
+    unfolding names_below_def by auto
+  moreover
+  obtain fy m1 m2 q where "q\<in>P" "y = \<langle>fy,m1,m2,q\<rangle>"
+    using \<open>y\<in>names_below(P,z)\<close>
+    unfolding names_below_def by auto
+  moreover
+  note \<open>frecR(x,y)\<close>
+  ultimately
+  show ?thesis
+    using names_belowI by simp
+qed
+
+lemma arg_into_names_below :
+  assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
+  shows  "x \<in> names_below(P,x)"
+proof -
+  from assms
+  have "x\<in>names_below(P,z)"
+    unfolding frecrel_def Rrel_def
+    by auto
+  from \<open>x\<in>names_below(P,z)\<close>
+  obtain f n1 n2 p where
+    "x = \<langle>f,n1,n2,p\<rangle>" "f\<in>2" "n1\<in>ecloseN(z)" "n2\<in>ecloseN(z)" "p\<in>P"
+    unfolding names_below_def by auto
+  then
+  have "n1\<in>ecloseN(x)" "n2\<in>ecloseN(x)"
+    using components_in_eclose by simp_all
+  with \<open>f\<in>2\<close> \<open>p\<in>P\<close> \<open>x = \<langle>f,n1,n2,p\<rangle>\<close>
+  show ?thesis
+    unfolding names_below_def by simp
+qed
+
+lemma forcerel_arg_into_names_below :
+  assumes "\<langle>x,y\<rangle> \<in> forcerel(P,z)"
+  shows  "x \<in> names_below(P,x)"
+  using assms
+  unfolding forcerel_def
+  by(rule trancl_induct;auto simp add: arg_into_names_below)
+
+lemma names_below_mono :
+  assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
+  shows "names_below(P,x) \<subseteq> names_below(P,y)"
+proof -
+  from assms
+  have "x\<in>names_below(P,y)"
+    using arg_into_names_below2 by simp
+  then
+  show ?thesis
+    using names_below_tr subsetI by simp
+qed
+
+lemma frecrel_mono :
+  assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
+  shows "frecrel(names_below(P,x)) \<subseteq> frecrel(names_below(P,y))"
+  unfolding frecrel_def
+  using Rrel_mono names_below_mono assms by simp
+
+lemma forcerel_mono2 :
+  assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P,z))"
+  shows "forcerel(P,x) \<subseteq> forcerel(P,y)"
+  unfolding forcerel_def
+  using trancl_mono frecrel_mono assms by simp
+
+lemma forcerel_mono_aux :
+  assumes "\<langle>x,y\<rangle> \<in> frecrel(names_below(P, w))^+"
+  shows "forcerel(P,x) \<subseteq> forcerel(P,y)"
+  using assms
+  by (rule trancl_induct,simp_all add: subset_trans forcerel_mono2)
+
+lemma forcerel_mono :
+  assumes "\<langle>x,y\<rangle> \<in> forcerel(P,z)"
+  shows "forcerel(P,x) \<subseteq> forcerel(P,y)"
+  using forcerel_mono_aux assms unfolding forcerel_def by simp
+
+lemma forcerel_eq_aux: "x \<in> names_below(P, w) \<Longrightarrow> \<langle>x,y\<rangle> \<in> forcerel(P,z) \<Longrightarrow>
+  (y \<in> names_below(P, w) \<longrightarrow> \<langle>x,y\<rangle> \<in> forcerel(P,w))"
+  unfolding forcerel_def
+proof(rule_tac a=x and b=y and P="\<lambda> y . y \<in> names_below(P, w) \<longrightarrow> \<langle>x,y\<rangle> \<in> frecrel(names_below(P,w))^+" in trancl_induct,simp)
+  let ?A="\<lambda> a . names_below(P, a)"
+  let ?R="\<lambda> a . frecrel(?A(a))"
+  let ?fR="\<lambda> a .forcerel(a)"
+  show "u\<in>?A(w) \<longrightarrow> \<langle>x,u\<rangle>\<in>?R(w)^+" if "x\<in>?A(w)" "\<langle>x,y\<rangle>\<in>?R(z)^+" "\<langle>x,u\<rangle>\<in>?R(z)"  for  u
+    using that frecrelD frecrelI r_into_trancl
+    unfolding names_below_def by simp
+  {
+    fix u v
+    assume "x \<in> ?A(w)"
+      "\<langle>x, y\<rangle> \<in> ?R(z)^+"
+      "\<langle>x, u\<rangle> \<in> ?R(z)^+"
+      "\<langle>u, v\<rangle> \<in> ?R(z)"
+      "u \<in> ?A(w) \<Longrightarrow> \<langle>x, u\<rangle> \<in> ?R(w)^+"
+    then
+    have "v \<in> ?A(w) \<Longrightarrow> \<langle>x, v\<rangle> \<in> ?R(w)^+"
+    proof -
+      assume "v \<in>?A(w)"
+      from \<open>\<langle>u,v\<rangle>\<in>_\<close>
+      have "u\<in>?A(v)"
+        using arg_into_names_below2 by simp
+      with \<open>v \<in>?A(w)\<close>
+      have "u\<in>?A(w)"
+        using names_below_tr by simp
+      with \<open>v\<in>_\<close> \<open>\<langle>u,v\<rangle>\<in>_\<close>
+      have "\<langle>u,v\<rangle>\<in> ?R(w)"
+        using frecrelD frecrelI r_into_trancl unfolding names_below_def by simp
+      with \<open>u \<in> ?A(w) \<Longrightarrow> \<langle>x, u\<rangle> \<in> ?R(w)^+\<close> \<open>u\<in>?A(w)\<close>
+      have "\<langle>x, u\<rangle> \<in> ?R(w)^+"
+        by simp
+      with \<open>\<langle>u,v\<rangle>\<in> ?R(w)\<close>
+      show "\<langle>x,v\<rangle>\<in> ?R(w)^+" using trancl_trans r_into_trancl
+        by simp
+    qed
+  }
+  then
+  show "v \<in> ?A(w) \<longrightarrow> \<langle>x, v\<rangle> \<in> ?R(w)^+"
+    if "x \<in> ?A(w)"
+      "\<langle>x, y\<rangle> \<in> ?R(z)^+"
+      "\<langle>x, u\<rangle> \<in> ?R(z)^+"
+      "\<langle>u, v\<rangle> \<in> ?R(z)"
+      "u \<in> ?A(w) \<longrightarrow> \<langle>x, u\<rangle> \<in> ?R(w)^+" for u v
+    using that
+    by simp
+qed
+
+lemma forcerel_eq :
+  assumes "\<langle>z,x\<rangle> \<in> forcerel(P,x)"
+  shows "forcerel(P,z) = forcerel(P,x) \<inter> names_below(P,z)\<times>names_below(P,z)"
+  using assms forcerel_eq_aux forcerelD forcerel_mono[of z x x] subsetI
+  by auto
+
+lemma forcerel_below_aux :
+  assumes "\<langle>z,x\<rangle> \<in> forcerel(P,x)" "\<langle>u,z\<rangle> \<in> forcerel(P,x)"
+  shows "u \<in> names_below(P,z)"
+  using assms(2)
+  unfolding forcerel_def
+proof(rule trancl_induct)
+  show  "u \<in> names_below(P,y)" if " \<langle>u, y\<rangle> \<in> frecrel(names_below(P, x))" for y
+    using that vimage_singleton_iff arg_into_names_below2 by simp
+next
+  show "u \<in> names_below(P,z)"
+    if "\<langle>u, y\<rangle> \<in> frecrel(names_below(P, x))^+"
+      "\<langle>y, z\<rangle> \<in> frecrel(names_below(P, x))"
+      "u \<in> names_below(P, y)"
+    for y z
+    using that arg_into_names_below2[of y z x] names_below_tr by simp
+qed
+
+lemma forcerel_below :
+  assumes "\<langle>z,x\<rangle> \<in> forcerel(P,x)"
+  shows "forcerel(P,x) -`` {z} \<subseteq> names_below(P,z)"
+  using vimage_singleton_iff assms forcerel_below_aux by auto
+
+lemma relation_forcerel :
+  shows "relation(forcerel(P,z))" "trans(forcerel(P,z))"
+  unfolding forcerel_def using relation_trancl trans_trancl by simp_all
+
+lemma Hfrc_restrict_trancl: "bool_of_o(Hfrc(P, leq, y, restrict(f,frecrel(names_below(P,x))-``{y})))
+         = bool_of_o(Hfrc(P, leq, y, restrict(f,(frecrel(names_below(P,x))^+)-``{y})))"
+  unfolding Hfrc_def bool_of_o_def eq_case_def mem_case_def
+  using restrict_trancl_forcerel frecRI1 frecRI2 frecRI3
+  unfolding forcerel_def
+  by simp
+
+(* Recursive definition of forces for atomic formulas using a transitive relation *)
+lemma frc_at_trancl: "frc_at(P,leq,z) = wfrec(forcerel(P,z),z,\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f)))"
+  unfolding frc_at_def forcerel_def using wf_eq_trancl Hfrc_restrict_trancl by simp
+
+lemma forcerelI1 :
+  assumes "n1 \<in> domain(b) \<or> n1 \<in> domain(c)" "p\<in>P" "d\<in>P"
+  shows "\<langle>\<langle>1, n1, b, p\<rangle>, \<langle>0,b,c,d\<rangle>\<rangle>\<in> forcerel(P,\<langle>0,b,c,d\<rangle>)"
+proof -
+  let ?x="\<langle>1, n1, b, p\<rangle>"
+  let ?y="\<langle>0,b,c,d\<rangle>"
+  from assms
+  have "frecR(?x,?y)"
+    using frecRI1 by simp
+  then
+  have "?x\<in>names_below(P,?y)" "?y \<in> names_below(P,?y)"
+    using names_belowI  assms components_in_eclose
+    unfolding names_below_def by auto
+  with \<open>frecR(?x,?y)\<close>
+  show ?thesis
+    unfolding forcerel_def frecrel_def
+    using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
+    by auto
+qed
+
+lemma forcerelI2 :
+  assumes "n1 \<in> domain(b) \<or> n1 \<in> domain(c)" "p\<in>P" "d\<in>P"
+  shows "\<langle>\<langle>1, n1, c, p\<rangle>, \<langle>0,b,c,d\<rangle>\<rangle>\<in> forcerel(P,\<langle>0,b,c,d\<rangle>)"
+proof -
+  let ?x="\<langle>1, n1, c, p\<rangle>"
+  let ?y="\<langle>0,b,c,d\<rangle>"
+  note assms
+  moreover from this
+  have "frecR(?x,?y)"
+    using frecRI2 by simp
+  moreover from calculation
+  have "?x\<in>names_below(P,?y)" "?y \<in> names_below(P,?y)"
+    using names_belowI components_in_eclose
+    unfolding names_below_def by auto
+  ultimately
+  show ?thesis
+    unfolding forcerel_def frecrel_def
+    using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
+    by auto
+qed
+
+lemma forcerelI3 :
+  assumes "\<langle>n2, r\<rangle> \<in> c" "p\<in>P" "d\<in>P" "r \<in> P"
+  shows "\<langle>\<langle>0, b, n2, p\<rangle>,\<langle>1, b, c, d\<rangle>\<rangle> \<in> forcerel(P,\<langle>1,b,c,d\<rangle>)"
+proof -
+  let ?x="\<langle>0, b, n2, p\<rangle>"
+  let ?y="\<langle>1, b, c, d\<rangle>"
+  note assms
+  moreover from this
+  have "frecR(?x,?y)"
+    using frecRI3 by simp
+  moreover from calculation
+  have "?x\<in>names_below(P,?y)"  "?y \<in> names_below(P,?y)"
+    using names_belowI components_in_eclose
+    unfolding names_below_def by auto
+  ultimately
+  show ?thesis
+    unfolding forcerel_def frecrel_def
+    using subsetD[OF r_subset_trancl[OF relation_Rrel]] RrelI
+    by auto
+qed
+
+lemmas forcerelI = forcerelI1[THEN vimage_singleton_iff[THEN iffD2]]
+  forcerelI2[THEN vimage_singleton_iff[THEN iffD2]]
+  forcerelI3[THEN vimage_singleton_iff[THEN iffD2]]
+
+lemma  aux_def_frc_at:
+  assumes "z \<in> forcerel(P,x) -`` {x}"
+  shows "wfrec(forcerel(P,x), z, H) =  wfrec(forcerel(P,z), z, H)"
+proof -
+  let ?A="names_below(P,z)"
+  from assms
+  have "\<langle>z,x\<rangle> \<in> forcerel(P,x)"
+    using vimage_singleton_iff by simp
+  moreover from this
+  have "z \<in> ?A"
+    using forcerel_arg_into_names_below by simp
+  moreover from calculation
+  have "forcerel(P,z) = forcerel(P,x) \<inter> (?A\<times>?A)"
+    "forcerel(P,x) -`` {z} \<subseteq> ?A"
+    using forcerel_eq forcerel_below
+    by auto
+  moreover from calculation
+  have "wfrec(forcerel(P,x), z, H) = wfrec[?A](forcerel(P,x), z, H)"
+    using wfrec_trans_restr[OF relation_forcerel(1) wf_forcerel relation_forcerel(2), of x z ?A]
+    by simp
+  ultimately
+  show ?thesis
+    using wfrec_restr_eq by simp
+qed
+
+subsection\<open>Recursive expression of \<^term>\<open>frc_at\<close>\<close>
+
+lemma def_frc_at :
+  assumes "p\<in>P"
+  shows
+    "frc_at(P,leq,\<langle>ft,n1,n2,p\<rangle>) =
+   bool_of_o( p \<in>P \<and>
+  (  ft = 0 \<and>  (\<forall>s. s\<in>domain(n1) \<union> domain(n2) \<longrightarrow>
+        (\<forall>q. q\<in>P \<and> q \<preceq> p \<longrightarrow> (frc_at(P,leq,\<langle>1,s,n1,q\<rangle>) =1 \<longleftrightarrow> frc_at(P,leq,\<langle>1,s,n2,q\<rangle>) =1)))
+   \<or> ft = 1 \<and> ( \<forall>v\<in>P. v \<preceq> p \<longrightarrow>
+    (\<exists>q. \<exists>s. \<exists>r. r\<in>P \<and> q\<in>P \<and> q \<preceq> v \<and> \<langle>s,r\<rangle> \<in> n2 \<and> q \<preceq> r \<and>  frc_at(P,leq,\<langle>0,n1,s,q\<rangle>) = 1))))"
+proof -
+  let ?r="\<lambda>y. forcerel(P,y)" and ?Hf="\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f))"
+  let ?t="\<lambda>y. ?r(y) -`` {y}"
+  let ?arg="\<langle>ft,n1,n2,p\<rangle>"
+  from wf_forcerel
+  have wfr: "\<forall>w . wf(?r(w))" ..
+  with wfrec [of "?r(?arg)" ?arg ?Hf]
+  have "frc_at(P,leq,?arg) = ?Hf( ?arg, \<lambda>x\<in>?r(?arg) -`` {?arg}. wfrec(?r(?arg), x, ?Hf))"
+    using frc_at_trancl by simp
+  also
+  have " ... = ?Hf( ?arg, \<lambda>x\<in>?r(?arg) -`` {?arg}. frc_at(P,leq,x))"
+    using aux_def_frc_at frc_at_trancl by simp
+  finally
+  show ?thesis
+    unfolding Hfrc_def mem_case_def eq_case_def
+    using forcerelI  assms
+    by auto
+qed
+
+
+subsection\<open>Absoluteness of \<^term>\<open>frc_at\<close>\<close>
+
+lemma forcerel_in_M :
+  assumes "x\<in>M"
+  shows "forcerel(P,x)\<in>M"
+  unfolding forcerel_def def_frecrel names_below_def
+proof -
+  let ?Q = "2 \<times> ecloseN(x) \<times> ecloseN(x) \<times> P"
+  have "?Q \<times> ?Q \<in> M"
+    using \<open>x\<in>M\<close> P_in_M nat_into_M ecloseN_closed cartprod_closed by simp
+  moreover
+  have "separation(##M,\<lambda>z. frecrelP(##M,z))"
+    using separation_in_ctm[of "frecrelP_fm(0)",OF _ _ _ sats_frecrelP_fm]
+      arity_frecrelP_fm frecrelP_fm_type
+    by auto
+  moreover from this
+  have "separation(##M,\<lambda>z. \<exists>x y. z = \<langle>x, y\<rangle> \<and> frecR(x, y))"
+    using separation_cong[OF frecrelP_abs]
+    by force
+  ultimately
+  show "{z \<in> ?Q \<times> ?Q . \<exists>x y. z = \<langle>x, y\<rangle> \<and> frecR(x, y)}^+ \<in> M"
+    using separation_closed frecrelP_abs trancl_closed
+    by simp
+qed
+
+lemma relation2_Hfrc_at_abs:
+  "relation2(##M,is_Hfrc_at(##M,P,leq),\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f)))"
+  unfolding relation2_def using Hfrc_at_abs
+  by simp
+
+lemma Hfrc_at_closed :
+  "\<forall>x\<in>M. \<forall>g\<in>M. function(g) \<longrightarrow> bool_of_o(Hfrc(P,leq,x,g))\<in>M"
+  unfolding bool_of_o_def using zero_in_M nat_into_M[of 1] by simp
+
+lemma wfrec_Hfrc_at :
+  assumes "X\<in>M"
+  shows "wfrec_replacement(##M,is_Hfrc_at(##M,P,leq),forcerel(P,X))"
+proof -
+  have 0:"is_Hfrc_at(##M,P,leq,a,b,c) \<longleftrightarrow>
+        sats(M,Hfrc_at_fm(8,9,2,1,0),[c,b,a,d,e,y,x,z,P,leq,forcerel(P,X)])"
+    if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
+    for a b c d e y x z
+    using that P_in_M leq_in_M \<open>X\<in>M\<close> forcerel_in_M
+      Hfrc_at_iff_sats[of concl:M P leq a b c 8 9 2 1 0
+        "[c,b,a,d,e,y,x,z,P,leq,forcerel(P,X)]"] by simp
+  have 1:"sats(M,is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0),[y,x,z,P,leq,forcerel(P,X)]) \<longleftrightarrow>
+                   is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y)"
+    if "x\<in>M" "y\<in>M" "z\<in>M" for x y z
+    using that \<open>X\<in>M\<close> forcerel_in_M P_in_M leq_in_M sats_is_wfrec_fm[OF 0]
+    by simp
+  let
+    ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(Hfrc_at_fm(8,9,2,1,0),5,1,0)))"
+  have satsf:"sats(M, ?f, [x,z,P,leq,forcerel(P,X)]) \<longleftrightarrow>
+              (\<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y))"
+    if "x\<in>M" "z\<in>M" for x z
+    using that 1 \<open>X\<in>M\<close> forcerel_in_M P_in_M leq_in_M by (simp del:pair_abs)
+  have artyf:"arity(?f) = 5"
+    using arity_wfrec_replacement_fm[where p="Hfrc_at_fm(8,9,2,1,0)" and i=10]
+      arity_Hfrc_at_fm ord_simp_union
+    by simp
+  moreover
+  have "?f\<in>formula" by simp
+  ultimately
+  have "strong_replacement(##M,\<lambda>x z. sats(M,?f,[x,z,P,leq,forcerel(P,X)]))"
+    using replacement_ax1(1) 1 artyf \<open>X\<in>M\<close> forcerel_in_M P_in_M leq_in_M
+    unfolding replacement_assm_def by simp
+  then
+  have "strong_replacement(##M,\<lambda>x z.
+          \<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hfrc_at(##M,P,leq),forcerel(P,X), x, y))"
+    using repl_sats[of M ?f "[P,leq,forcerel(P,X)]"] satsf by (simp del:pair_abs)
+  then
+  show ?thesis unfolding wfrec_replacement_def by simp
+qed
+
+lemma names_below_abs :
+  "\<lbrakk>Q\<in>M;x\<in>M;nb\<in>M\<rbrakk> \<Longrightarrow> is_names_below(##M,Q,x,nb) \<longleftrightarrow> nb = names_below(Q,x)"
+  unfolding is_names_below_def names_below_def
+  using succ_in_M_iff zero_in_M cartprod_closed ecloseN_abs ecloseN_closed
+  by auto
+
+lemma names_below_closed:
+  "\<lbrakk>Q\<in>M;x\<in>M\<rbrakk> \<Longrightarrow> names_below(Q,x) \<in> M"
+  unfolding names_below_def
+  using zero_in_M cartprod_closed ecloseN_closed succ_in_M_iff
+  by simp
+
+lemma "names_below_productE" :
+  assumes "Q \<in> M" "x \<in> M"
+    "\<And>A1 A2 A3 A4. A1 \<in> M \<Longrightarrow> A2 \<in> M \<Longrightarrow> A3 \<in> M \<Longrightarrow> A4 \<in> M \<Longrightarrow> R(A1 \<times> A2 \<times> A3 \<times> A4)"
+  shows "R(names_below(Q,x))"
+  unfolding names_below_def using assms nat_into_M ecloseN_closed[of x] by auto
+
+lemma forcerel_abs :
+  "\<lbrakk>x\<in>M;z\<in>M\<rbrakk> \<Longrightarrow> is_forcerel(##M,P,x,z) \<longleftrightarrow> z = forcerel(P,x)"
+  unfolding is_forcerel_def forcerel_def
+  using frecrel_abs names_below_abs trancl_abs P_in_M ecloseN_closed names_below_closed
+    names_below_productE[of concl:"\<lambda>p. is_frecrel(##M,p,_) \<longleftrightarrow>  _ = frecrel(p)"] frecrel_closed
+  by simp
+
+lemma frc_at_abs:
+  assumes "fnnc\<in>M" "z\<in>M"
+  shows "is_frc_at(##M,P,leq,fnnc,z) \<longleftrightarrow> z = frc_at(P,leq,fnnc)"
+proof -
+  from assms
+  have "(\<exists>r\<in>M. is_forcerel(##M,P,fnnc, r) \<and> is_wfrec(##M, is_Hfrc_at(##M, P, leq), r, fnnc, z))
+        \<longleftrightarrow> is_wfrec(##M, is_Hfrc_at(##M, P, leq), forcerel(P,fnnc), fnnc, z)"
+    using forcerel_abs forcerel_in_M by simp
+  then
+  show ?thesis
+    unfolding frc_at_trancl is_frc_at_def
+    using assms wfrec_Hfrc_at[of fnnc] wf_forcerel relation_forcerel forcerel_in_M
+      Hfrc_at_closed relation2_Hfrc_at_abs
+      trans_wfrec_abs[of "forcerel(P,fnnc)" fnnc z "is_Hfrc_at(##M,P,leq)" "\<lambda>x f. bool_of_o(Hfrc(P,leq,x,f))"]
+    by (simp flip:setclass_iff)
+qed
+
+lemma forces_eq'_abs :
+  "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_eq'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_eq'(P,leq,p,t1,t2)"
+  unfolding is_forces_eq'_def forces_eq'_def
+  using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)
+
+lemma forces_mem'_abs :
+  "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_mem'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_mem'(P,leq,p,t1,t2)"
+  unfolding is_forces_mem'_def forces_mem'_def
+  using frc_at_abs nat_into_M pair_in_M_iff by (auto simp add:components_abs)
+
+lemma forces_neq'_abs :
+  assumes "p\<in>M" "t1\<in>M" "t2\<in>M"
+  shows "is_forces_neq'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_neq'(P,leq,p,t1,t2)"
+proof -
+  have "q\<in>M" if "q\<in>P" for q
+    using that transitivity P_in_M by simp
+  with assms
+  show ?thesis
+    unfolding is_forces_neq'_def forces_neq'_def
+    using forces_eq'_abs pair_in_M_iff
+    by (auto simp add:components_abs,blast)
+qed
+
+
+lemma forces_nmem'_abs :
+  assumes "p\<in>M" "t1\<in>M" "t2\<in>M"
+  shows "is_forces_nmem'(##M,P,leq,p,t1,t2) \<longleftrightarrow> forces_nmem'(P,leq,p,t1,t2)"
+proof -
+  have "q\<in>M" if "q\<in>P" for q
+    using that transitivity P_in_M by simp
+  with assms
+  show ?thesis
+    unfolding is_forces_nmem'_def forces_nmem'_def
+    using forces_mem'_abs pair_in_M_iff
+    by (auto simp add:components_abs,blast)
+qed
+
+subsection\<open>Forcing for general formulas\<close>
+
+lemma leq_abs:
+  "\<lbrakk> l\<in>M ; q\<in>M ; p\<in>M \<rbrakk> \<Longrightarrow> is_leq(##M,l,q,p) \<longleftrightarrow> \<langle>q,p\<rangle>\<in>l"
+  unfolding is_leq_def using pair_in_M_iff by simp
+
+(* TODO: MOVE THIS to an appropriate place: subsubsection\<open>The primitive recursion\<close> *)
+
+subsection\<open>Forcing for atomic formulas in context\<close>
+
+definition
+  forces_eq :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ = _')\<close> [36,1,1] 60) where
+  "forces_eq \<equiv> forces_eq'(P,leq)"
+
+definition
+  forces_mem :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ \<in> _')\<close> [36,1,1] 60) where
+  "forces_mem \<equiv> forces_mem'(P,leq)"
+
+(* frc_at(P,leq,\<langle>0,t1,t2,p\<rangle>) = 1*)
+abbreviation is_forces_eq
+  where "is_forces_eq \<equiv> is_forces_eq'(##M,P,leq)"
+
+(* frc_at(P,leq,\<langle>1,t1,t2,p\<rangle>) = 1*)
+abbreviation
+  is_forces_mem :: "[i,i,i] \<Rightarrow> o" where
+  "is_forces_mem \<equiv> is_forces_mem'(##M,P,leq)"
+
+lemma def_forces_eq: "p\<in>P \<Longrightarrow> p forces\<^sub>a (t1 = t2) \<longleftrightarrow>
+      (\<forall>s\<in>domain(t1) \<union> domain(t2). \<forall>q. q\<in>P \<and> q \<preceq> p \<longrightarrow>
+      (q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)))"
+  unfolding forces_eq_def forces_mem_def forces_eq'_def forces_mem'_def
+  using def_frc_at[of p 0 t1 t2 ]
+  unfolding bool_of_o_def
+  by auto
+
+lemma def_forces_mem: "p\<in>P \<Longrightarrow> p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow>
+     (\<forall>v\<in>P. v \<preceq> p \<longrightarrow>
+      (\<exists>q. \<exists>s. \<exists>r. r\<in>P \<and> q\<in>P \<and> q \<preceq> v \<and> \<langle>s,r\<rangle> \<in> t2 \<and> q \<preceq> r \<and> q forces\<^sub>a (t1 = s)))"
+  unfolding forces_eq'_def forces_mem'_def forces_eq_def forces_mem_def
+  using def_frc_at[of p 1 t1 t2]
+  unfolding bool_of_o_def
+  by auto
+
+lemma forces_eq_abs :
+  "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_eq(p,t1,t2) \<longleftrightarrow> p forces\<^sub>a (t1 = t2)"
+  unfolding forces_eq_def
+  using forces_eq'_abs by simp
+
+lemma forces_mem_abs :
+  "\<lbrakk>p\<in>M ; t1\<in>M ; t2\<in>M\<rbrakk> \<Longrightarrow> is_forces_mem(p,t1,t2) \<longleftrightarrow> p forces\<^sub>a (t1 \<in> t2)"
+  unfolding forces_mem_def
+  using forces_mem'_abs
+  by simp
+
+definition
+  forces_neq :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ \<noteq> _')\<close> [36,1,1] 60) where
+  "p forces\<^sub>a (t1 \<noteq> t2) \<equiv> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 = t2))"
+
+definition
+  forces_nmem :: "[i,i,i] \<Rightarrow> o" (\<open>_ forces\<^sub>a '(_ \<notin> _')\<close> [36,1,1] 60) where
+  "p forces\<^sub>a (t1 \<notin> t2) \<equiv> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 \<in> t2))"
+
+lemma forces_neq :
+  "p forces\<^sub>a (t1 \<noteq> t2) \<longleftrightarrow> forces_neq'(P,leq,p,t1,t2)"
+  unfolding forces_neq_def forces_neq'_def forces_eq_def by simp
+
+lemma forces_nmem :
+  "p forces\<^sub>a (t1 \<notin> t2) \<longleftrightarrow> forces_nmem'(P,leq,p,t1,t2)"
+  unfolding forces_nmem_def forces_nmem'_def forces_mem_def by simp
+
+abbreviation Forces :: "[i, i, i] \<Rightarrow> o"  ("_ \<tturnstile> _ _" [36,36,36] 60) where
+  "p \<tturnstile> \<phi> env   \<equiv>   M, ([p,P,leq,\<one>] @ env) \<Turnstile> forces(\<phi>)"
+
+lemma sats_forces_Member :
+  assumes  "x\<in>nat" "y\<in>nat" "env\<in>list(M)"
+    "nth(x,env)=xx" "nth(y,env)=yy" "q\<in>M"
+  shows "q \<tturnstile> \<cdot>x \<in> y\<cdot> env \<longleftrightarrow> q \<in> P \<and> is_forces_mem(q, xx, yy)"
+  unfolding forces_def
+  using assms P_in_M leq_in_M one_in_M
+  by simp
+
+lemma sats_forces_Equal :
+  assumes "a\<in>nat" "b\<in>nat" "env\<in>list(M)" "nth(a,env)=x" "nth(b,env)=y" "q\<in>M"
+  shows "q \<tturnstile> \<cdot>a = b\<cdot> env \<longleftrightarrow> q \<in> P \<and> is_forces_eq(q, x, y)"
+  unfolding forces_def
+  using assms P_in_M leq_in_M one_in_M
+  by simp
+
+lemma sats_forces_Nand :
+  assumes "\<phi>\<in>formula" "\<psi>\<in>formula" "env\<in>list(M)" "p\<in>M"
+  shows "p \<tturnstile> \<cdot>\<not>(\<phi> \<and> \<psi>)\<cdot> env \<longleftrightarrow>
+    p\<in>P \<and> \<not>(\<exists>q\<in>M. q\<in>P \<and> is_leq(##M,leq,q,p) \<and>
+    (M,[q,P,leq,\<one>]@env \<Turnstile> forces(\<phi>)) \<and> (M,[q,P,leq,\<one>]@env \<Turnstile> forces(\<psi>)))"
+  unfolding forces_def
+  using sats_is_leq_fm_auto assms sats_ren_forces_nand P_in_M leq_in_M one_in_M zero_in_M
+  by simp
+
+lemma sats_forces_Neg :
+  assumes "\<phi>\<in>formula" "env\<in>list(M)" "p\<in>M"
+  shows "p \<tturnstile> \<cdot>\<not>\<phi>\<cdot> env \<longleftrightarrow>
+         (p\<in>P \<and> \<not>(\<exists>q\<in>M. q\<in>P \<and> is_leq(##M,leq,q,p) \<and> (M, [q, P, leq, \<one>] @ env \<Turnstile> forces(\<phi>))))"
+  unfolding Neg_def using assms sats_forces_Nand
+  by simp
+
+lemma sats_forces_Forall :
+  assumes "\<phi>\<in>formula" "env\<in>list(M)" "p\<in>M"
+  shows "p \<tturnstile> (\<cdot>\<forall>\<phi>\<cdot>) env \<longleftrightarrow> p \<in> P \<and> (\<forall>x\<in>M. M,[p,P,leq,\<one>,x] @ env \<Turnstile> forces(\<phi>))"
+  unfolding forces_def using assms sats_ren_forces_forall P_in_M leq_in_M one_in_M
+  by simp
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Forcing_Data.thy b/thys/Independence_CH/Forcing_Data.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Forcing_Data.thy
@@ -0,0 +1,143 @@
+section\<open>Transitive set models of ZF\<close>
+text\<open>This theory defines locales for countable transitive models of $\ZF$,
+and on top of that, one that includes a forcing notion. Weakened versions
+of both locales are included, that only assume finitely many replacement
+instances.\<close>
+
+theory Forcing_Data
+  imports
+    Forcing_Notions
+    Cohen_Posets_Relative
+    Interface
+begin
+
+locale M_ctm1 = M_ZF1_trans +
+  fixes enum
+  assumes M_countable:      "enum\<in>bij(nat,M)"
+
+locale M_ctm1_AC = M_ctm1 + M_ZFC1_trans
+
+subsection\<open>A forcing locale and generic filters\<close>
+
+txt\<open>Ideally, countability should be separated from the assumption of this locale.
+The fact is that our present proofs of the "definition of forces" (and many
+consequences) and of the lemma for “forcing a value” of function
+unnecessarily depend on the countability of the ground model. \<close>
+
+locale forcing_data1 = forcing_notion + M_ctm1 +
+  assumes P_in_M:           "P \<in> M"
+    and leq_in_M:         "leq \<in> M"
+
+context forcing_data1
+begin
+
+(* P \<subseteq> M *)
+lemma P_sub_M : "P\<subseteq>M"
+  using transitivity P_in_M by auto
+
+definition
+  M_generic :: "i\<Rightarrow>o" where
+  "M_generic(G) \<equiv> filter(G) \<and> (\<forall>D\<in>M. D\<subseteq>P \<and> dense(D)\<longrightarrow>D\<inter>G\<noteq>0)"
+
+lemma M_genericD [dest]: "M_generic(G) \<Longrightarrow> x\<in>G \<Longrightarrow> x\<in>P"
+  unfolding M_generic_def by (blast dest:filterD)
+
+lemma M_generic_leqD [dest]: "M_generic(G) \<Longrightarrow> p\<in>G \<Longrightarrow> q\<in>P \<Longrightarrow> p\<preceq>q \<Longrightarrow> q\<in>G"
+  unfolding M_generic_def by (blast dest:filter_leqD)
+
+lemma M_generic_compatD [dest]: "M_generic(G) \<Longrightarrow> p\<in>G \<Longrightarrow> r\<in>G \<Longrightarrow> \<exists>q\<in>G. q\<preceq>p \<and> q\<preceq>r"
+  unfolding M_generic_def by (blast dest:low_bound_filter)
+
+lemma M_generic_denseD [dest]: "M_generic(G) \<Longrightarrow> dense(D) \<Longrightarrow> D\<subseteq>P \<Longrightarrow> D\<in>M \<Longrightarrow> \<exists>q\<in>G. q\<in>D"
+  unfolding M_generic_def by blast
+
+lemma G_nonempty: "M_generic(G) \<Longrightarrow> G\<noteq>0"
+  using P_in_M P_dense subset_refl[of P]
+  unfolding M_generic_def
+  by auto
+
+lemma one_in_G :
+  assumes "M_generic(G)"
+  shows  "\<one> \<in> G"
+proof -
+  from assms
+  have "G\<subseteq>P"
+    unfolding M_generic_def filter_def by simp
+  from \<open>M_generic(G)\<close>
+  have "increasing(G)"
+    unfolding M_generic_def filter_def by simp
+  with \<open>G\<subseteq>P\<close> \<open>M_generic(G)\<close>
+  show ?thesis
+    using G_nonempty one_in_P one_max
+    unfolding increasing_def by blast
+qed
+
+lemma G_subset_M: "M_generic(G) \<Longrightarrow> G \<subseteq> M"
+  using transitivity[OF _ P_in_M] by auto
+
+declare iff_trans [trans]
+
+lemma generic_filter_existence:
+  "p\<in>P \<Longrightarrow> \<exists>G. p\<in>G \<and> M_generic(G)"
+proof -
+  assume "p\<in>P"
+  let ?D="\<lambda>n\<in>nat. (if (enum`n\<subseteq>P \<and> dense(enum`n))  then enum`n else P)"
+  have "\<forall>n\<in>nat. ?D`n \<in> Pow(P)"
+    by auto
+  then
+  have "?D:nat\<rightarrow>Pow(P)"
+    using lam_type by auto
+  have "\<forall>n\<in>nat. dense(?D`n)"
+  proof(intro ballI)
+    fix n
+    assume "n\<in>nat"
+    then
+    have "dense(?D`n) \<longleftrightarrow> dense(if enum`n \<subseteq> P \<and> dense(enum`n) then enum`n else P)"
+      by simp
+    also
+    have "... \<longleftrightarrow>  (\<not>(enum`n \<subseteq> P \<and> dense(enum`n)) \<longrightarrow> dense(P)) "
+      using split_if by simp
+    finally
+    show "dense(?D`n)"
+      using P_dense \<open>n\<in>nat\<close> by auto
+  qed
+  with \<open>?D\<in>_\<close>
+  interpret cg: countable_generic P leq \<one> ?D
+    by (unfold_locales, auto)
+  from \<open>p\<in>P\<close>
+  obtain G where 1: "p\<in>G \<and> filter(G) \<and> (\<forall>n\<in>nat.(?D`n)\<inter>G\<noteq>0)"
+    using cg.countable_rasiowa_sikorski[where M="\<lambda>_. M"]  P_sub_M
+      M_countable[THEN bij_is_fun] M_countable[THEN bij_is_surj, THEN surj_range]
+    unfolding cg.D_generic_def by blast
+  then
+  have "(\<forall>D\<in>M. D\<subseteq>P \<and> dense(D)\<longrightarrow>D\<inter>G\<noteq>0)"
+  proof (intro ballI impI)
+    fix D
+    assume "D\<in>M" and 2: "D \<subseteq> P \<and> dense(D) "
+    moreover
+    have "\<forall>y\<in>M. \<exists>x\<in>nat. enum`x= y"
+      using M_countable and  bij_is_surj unfolding surj_def by (simp)
+    moreover from calculation
+    obtain n where Eq10: "n\<in>nat \<and> enum`n = D"
+      by auto
+    moreover from calculation if_P
+    have "?D`n = D"
+      by simp
+    moreover
+    note 1
+    ultimately
+    show "D\<inter>G\<noteq>0"
+      by auto
+  qed
+  with 1
+  show ?thesis
+    unfolding M_generic_def by auto
+qed
+
+lemma one_in_M: "\<one> \<in> M"
+  using one_in_P P_in_M transitivity
+  by simp
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Forcing_Main.thy b/thys/Independence_CH/Forcing_Main.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Forcing_Main.thy
@@ -0,0 +1,245 @@
+section\<open>The main theorem\<close>
+
+theory Forcing_Main
+  imports
+    Ordinals_In_MG
+    Choice_Axiom
+    ZF_Trans_Interpretations
+
+begin
+
+subsection\<open>The generic extension is countable\<close>
+
+lemma (in forcing_data1) surj_nat_MG : "\<exists>f. f \<in> surj(\<omega>,M[G])"
+proof -
+  let ?f="\<lambda>n\<in>\<omega>. val(P,G,enum`n)"
+  have "x \<in> \<omega> \<Longrightarrow> val(P,G, enum ` x)\<in> M[G]" for x
+    using GenExt_iff[THEN iffD2, of _ G] bij_is_fun[OF M_countable] by force
+  then
+  have "?f: \<omega> \<rightarrow> M[G]"
+    using lam_type[of \<omega> "\<lambda>n. val(P,G,enum`n)" "\<lambda>_.M[G]"] by simp
+  moreover
+  have "\<exists>n\<in>\<omega>. ?f`n = x" if "x\<in>M[G]" for x
+    using that GenExt_iff[of _ G] bij_is_surj[OF M_countable]
+    unfolding surj_def by auto
+  ultimately
+  show ?thesis
+    unfolding surj_def by blast
+qed
+
+lemma (in G_generic1) MG_eqpoll_nat: "M[G] \<approx> \<omega>"
+proof -
+  obtain f where "f \<in> surj(\<omega>,M[G])"
+    using surj_nat_MG by blast
+  then
+  have "M[G] \<lesssim> \<omega>"
+    using well_ord_surj_imp_lepoll well_ord_Memrel[of \<omega>] by simp
+  moreover
+  have "\<omega> \<lesssim> M[G]"
+    using ext.nat_into_M subset_imp_lepoll by (auto del:lepollI)
+  ultimately
+  show ?thesis
+    using eqpollI by simp
+qed
+
+subsection\<open>Extensions of ctms of fragments of $\ZFC$\<close>
+
+lemma M_satT_imp_M_ZF2: "(M \<Turnstile> ZF) \<Longrightarrow> M_ZF2(M)"
+proof -
+  assume "M \<Turnstile> ZF"
+  then
+  have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
+    "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
+    unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
+    using ZFC_fm_sats[of M] by simp_all
+  {
+    fix \<phi> env
+    assume "\<phi> \<in> formula" "env\<in>list(M)"
+    moreover from \<open>M \<Turnstile> ZF\<close>
+    have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
+      "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
+      unfolding ZF_def ZF_schemes_def by auto
+    moreover from calculation
+    have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
+      "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
+      using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
+  }
+  with fin
+  show "M_ZF2(M)"
+    by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
+qed
+
+lemma M_satT_imp_M_ZFC2:
+  shows "(M \<Turnstile> ZFC) \<longrightarrow> M_ZFC2(M)"
+proof -
+  have "(M \<Turnstile> ZF) \<and> choice_ax(##M) \<longrightarrow> M_ZFC2(M)"
+    using M_satT_imp_M_ZF2[of M] unfolding M_ZF2_def M_ZFC1_def M_ZFC2_def
+      M_ZC_basic_def M_ZF1_def M_AC_def by auto
+  then
+  show ?thesis
+    unfolding ZFC_def by auto
+qed
+
+lemma M_satT_instances12_imp_M_ZF2:
+  assumes "(M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms})"
+  shows "M_ZF2(M)"
+proof -
+  from assms
+  have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
+    "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
+    unfolding ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
+    using ZFC_fm_sats[of M] by simp_all
+  moreover
+  {
+    fix \<phi> env
+    from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
+    have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
+      unfolding Zermelo_fms_def ZF_def instances1_fms_def
+        instances2_fms_def by auto
+    moreover
+    assume "\<phi> \<in> formula" "env\<in>list(M)"
+    ultimately
+    have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
+      using sats_ZF_separation_fm_iff by simp_all
+  }
+  moreover
+  {
+    fix \<phi> env
+    assume "\<phi> \<in> instances1_fms \<union> instances2_fms" "env\<in>list(M)"
+    moreover from this and \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
+    have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
+    ultimately
+    have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
+      using sats_ZF_replacement_fm_iff[of \<phi>] instances1_fms_type instances2_fms_type by auto
+  }
+  ultimately
+  show ?thesis
+    unfolding instances1_fms_def instances2_fms_def
+    by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
+qed
+
+context G_generic1
+begin
+
+lemma sats_ground_repl_fm_imp_sats_ZF_replacement_fm:
+  assumes
+    "\<phi>\<in>formula" "M, [] \<Turnstile> \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot>"
+  shows
+    "M[G], [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>"
+  using assms sats_ZF_replacement_fm_iff
+  by (auto simp:replacement_assm_def ground_replacement_assm_def
+      intro:strong_replacement_in_MG[simplified])
+
+lemma satT_ground_repl_fm_imp_satT_ZF_replacement_fm:
+  assumes
+    "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
+  shows
+    "M[G] \<Turnstile> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}"
+  using assms sats_ground_repl_fm_imp_sats_ZF_replacement_fm
+  by auto
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+theorem extensions_of_ctms:
+  assumes
+    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}"
+    "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
+  shows
+    "\<exists>N.
+      M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> M\<noteq>N \<and>
+      (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)) \<and>
+      ((M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and> N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>}"
+proof -
+  from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
+  interpret M_ZF2 M
+    using M_satT_instances12_imp_M_ZF2
+    by simp
+  from \<open>Transset(M)\<close>
+  interpret M_ZF1_trans M
+    using M_satT_imp_M_ZF2
+    by unfold_locales
+  from \<open>M \<approx> \<omega>\<close>
+  obtain enum where "enum \<in> bij(\<omega>,M)"
+    using eqpoll_sym unfolding eqpoll_def by blast
+  then
+  interpret M_ctm2 M enum by unfold_locales simp_all
+  interpret forcing_data1 "2\<^bsup><\<omega>\<^esup>" seqle 0 M enum
+    using nat_into_M seqspace_closed seqle_in_M
+    by unfold_locales simp
+  obtain G where "M_generic(G)" "M \<noteq> M\<^bsup>s\<^esup>[G]"
+    using cohen_extension_is_proper
+    by blast
+  txt\<open>Recall that \<^term>\<open>M\<^bsup>s\<^esup>[G]\<close> denotes the generic extension \<^term>\<open>M\<^bsup>2\<^bsup><\<omega>\<^esup>\<^esup>[G]\<close>
+  of \<^term>\<open>M\<close> using the poset of sequences \<^term>\<open>2\<^bsup><\<omega>\<^esup>\<close>.\<close>
+  then
+  interpret G_generic1 "2\<^bsup><\<omega>\<^esup>" seqle 0 _ enum G by unfold_locales
+  interpret MG: M_Z_basic "M\<^bsup>s\<^esup>[G]"
+    using generic pairing_in_MG
+      Union_MG  extensionality_in_MG power_in_MG
+      foundation_in_MG replacement_assm_MG
+      separation_in_MG infinity_in_MG replacement_ax1
+    by unfold_locales simp
+  have "M, []\<Turnstile> \<cdot>AC\<cdot> \<Longrightarrow> M\<^bsup>s\<^esup>[G], [] \<Turnstile> \<cdot>AC\<cdot>"
+  proof -
+    assume "M, [] \<Turnstile> \<cdot>AC\<cdot>"
+    then
+    have "choice_ax(##M)"
+      unfolding ZF_choice_fm_def using ZF_choice_auto by simp
+    then
+    have "choice_ax(##M\<^bsup>s\<^esup>[G])" using choice_in_MG by simp
+    then
+    show "M\<^bsup>s\<^esup>[G], [] \<Turnstile> \<cdot>AC\<cdot>"
+      using ZF_choice_auto sats_ZFC_iff_sats_ZF_AC
+      unfolding ZF_choice_fm_def by simp
+  qed
+  moreover
+  note \<open>M \<noteq> M\<^bsup>s\<^esup>[G]\<close> \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
+  moreover
+  have "Transset(M\<^bsup>s\<^esup>[G])" using Transset_MG .
+  moreover
+  have "M \<subseteq> M\<^bsup>s\<^esup>[G]" using M_subset_MG[OF one_in_G] generic by simp
+  ultimately
+  show ?thesis
+    using Ord_MG_iff MG_eqpoll_nat ext.M_satT_Zermelo_fms
+      satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
+    by (rule_tac x="M\<^bsup>s\<^esup>[G]" in exI, auto)
+qed
+
+lemma ZF_replacement_instances12_sub_ZF: "{\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms} \<subseteq> ZF"
+  using instances1_fms_type instances2_fms_type unfolding ZF_def ZF_schemes_def by auto
+
+theorem extensions_of_ctms_ZF:
+  assumes
+    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZF"
+  shows
+    "\<exists>N.
+      M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZF \<and> M\<noteq>N \<and>
+      (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)) \<and>
+      ((M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N \<Turnstile> ZFC)"
+proof -
+  from assms
+  have "\<exists>N.
+      M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> M\<noteq>N \<and>
+      (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)) \<and>
+      ((M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>) \<and> N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula}"
+    using extensions_of_ctms[of M formula] satT_ZF_imp_satT_Z[of M]
+      satT_mono[OF _ ground_repl_fm_sub_ZF, of M]
+      satT_mono[OF _ ZF_replacement_instances12_sub_ZF, of M]
+    by (auto simp: satT_Un_iff)
+  then
+  obtain N where "N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula}" "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)"
+    "M \<noteq> N" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
+    "(M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>"
+    by blast
+  moreover from \<open>N \<Turnstile> \<cdot>Z\<cdot> \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula}\<close>
+  have "N \<Turnstile> ZF"
+    using satT_Z_ZF_replacement_imp_satT_ZF by auto
+  moreover from this and \<open>(M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N, [] \<Turnstile> \<cdot>AC\<cdot>\<close>
+  have "(M, []\<Turnstile> \<cdot>AC\<cdot>) \<longrightarrow> N \<Turnstile> ZFC"
+    using sats_ZFC_iff_sats_ZF_AC by simp
+  ultimately
+  show ?thesis
+    by auto
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Forcing_Notions.thy b/thys/Independence_CH/Forcing_Notions.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Forcing_Notions.thy
@@ -0,0 +1,424 @@
+section\<open>Forcing notions\<close>
+text\<open>This theory defines a locale for forcing notions, that is,
+ preorders with a distinguished maximum element.\<close>
+
+theory Forcing_Notions
+  imports
+    "ZF-Constructible.Relative"
+    "Delta_System_Lemma.ZF_Library"
+begin
+
+subsection\<open>Basic concepts\<close>
+text\<open>We say that two elements $p,q$ are
+  \<^emph>\<open>compatible\<close> if they have a lower bound in $P$\<close>
+definition compat_in :: "i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
+  "compat_in(A,r,p,q) \<equiv> \<exists>d\<in>A . \<langle>d,p\<rangle>\<in>r \<and> \<langle>d,q\<rangle>\<in>r"
+
+lemma compat_inI :
+  "\<lbrakk> d\<in>A ; \<langle>d,p\<rangle>\<in>r ; \<langle>d,g\<rangle>\<in>r \<rbrakk> \<Longrightarrow> compat_in(A,r,p,g)"
+  by (auto simp add: compat_in_def)
+
+lemma refl_compat:
+  "\<lbrakk> refl(A,r) ; \<langle>p,q\<rangle> \<in> r | p=q | \<langle>q,p\<rangle> \<in> r ; p\<in>A ; q\<in>A\<rbrakk> \<Longrightarrow> compat_in(A,r,p,q)"
+  by (auto simp add: refl_def compat_inI)
+
+lemma  chain_compat:
+  "refl(A,r) \<Longrightarrow> linear(A,r) \<Longrightarrow>  (\<forall>p\<in>A.\<forall>q\<in>A. compat_in(A,r,p,q))"
+  by (simp add: refl_compat linear_def)
+
+lemma subset_fun_image: "f:N\<rightarrow>P \<Longrightarrow> f``N\<subseteq>P"
+  by (auto simp add: image_fun apply_funtype)
+
+lemma refl_monot_domain: "refl(B,r) \<Longrightarrow> A\<subseteq>B \<Longrightarrow> refl(A,r)"
+  unfolding refl_def by blast
+
+locale forcing_notion =
+  fixes P leq one
+  assumes one_in_P:       "one \<in> P"
+    and leq_preord:       "preorder_on(P,leq)"
+    and one_max:          "\<forall>p\<in>P. \<langle>p,one\<rangle>\<in>leq"
+begin
+
+notation one (\<open>\<one>\<close>)
+
+abbreviation Leq :: "[i, i] \<Rightarrow> o"  (infixl "\<preceq>" 50)
+  where "x \<preceq> y \<equiv> \<langle>x,y\<rangle>\<in>leq"
+
+lemma refl_leq:
+  "r\<in>P \<Longrightarrow> r\<preceq>r"
+  using leq_preord unfolding preorder_on_def refl_def by simp
+
+text\<open>A set $D$ is \<^emph>\<open>dense\<close> if every element $p\in P$ has a lower
+bound in $D$.\<close>
+definition
+  dense :: "i\<Rightarrow>o" where
+  "dense(D) \<equiv> \<forall>p\<in>P. \<exists>d\<in>D . d\<preceq>p"
+
+text\<open>There is also a weaker definition which asks for
+a lower bound in $D$ only for the elements below some fixed
+element $q$.\<close>
+definition
+  dense_below :: "i\<Rightarrow>i\<Rightarrow>o" where
+  "dense_below(D,q) \<equiv> \<forall>p\<in>P. p\<preceq>q \<longrightarrow> (\<exists>d\<in>D. d\<in>P \<and> d\<preceq>p)"
+
+lemma P_dense: "dense(P)"
+  by (insert leq_preord, auto simp add: preorder_on_def refl_def dense_def)
+
+definition
+  increasing :: "i\<Rightarrow>o" where
+  "increasing(F) \<equiv> \<forall>x\<in>F. \<forall> p \<in> P . x\<preceq>p \<longrightarrow> p\<in>F"
+
+definition
+  compat :: "i\<Rightarrow>i\<Rightarrow>o" where
+  "compat(p,q) \<equiv> compat_in(P,leq,p,q)"
+
+lemma leq_transD:  "a\<preceq>b \<Longrightarrow> b\<preceq>c \<Longrightarrow> a \<in> P\<Longrightarrow> b \<in> P\<Longrightarrow> c \<in> P\<Longrightarrow> a\<preceq>c"
+  using leq_preord trans_onD unfolding preorder_on_def by blast
+
+lemma leq_transD':  "A\<subseteq>P \<Longrightarrow> a\<preceq>b \<Longrightarrow> b\<preceq>c \<Longrightarrow> a \<in> A \<Longrightarrow> b \<in> P\<Longrightarrow> c \<in> P\<Longrightarrow> a\<preceq>c"
+  using leq_preord trans_onD subsetD unfolding preorder_on_def by blast
+
+lemma compatD[dest!]: "compat(p,q) \<Longrightarrow> \<exists>d\<in>P. d\<preceq>p \<and> d\<preceq>q"
+  unfolding compat_def compat_in_def .
+
+abbreviation Incompatible :: "[i, i] \<Rightarrow> o"  (infixl "\<bottom>" 50)
+  where "p \<bottom> q \<equiv> \<not> compat(p,q)"
+
+lemma compatI[intro!]: "d\<in>P \<Longrightarrow> d\<preceq>p \<Longrightarrow> d\<preceq>q \<Longrightarrow> compat(p,q)"
+  unfolding compat_def compat_in_def by blast
+
+lemma denseD [dest]: "dense(D) \<Longrightarrow> p\<in>P \<Longrightarrow>  \<exists>d\<in>D. d\<preceq> p"
+  unfolding dense_def by blast
+
+lemma denseI [intro!]: "\<lbrakk> \<And>p. p\<in>P \<Longrightarrow> \<exists>d\<in>D. d\<preceq> p \<rbrakk> \<Longrightarrow> dense(D)"
+  unfolding dense_def by blast
+
+lemma dense_belowD [dest]:
+  assumes "dense_below(D,p)" "q\<in>P" "q\<preceq>p"
+  shows "\<exists>d\<in>D. d\<in>P \<and> d\<preceq>q"
+  using assms unfolding dense_below_def by simp
+
+lemma dense_belowI [intro!]:
+  assumes "\<And>q. q\<in>P \<Longrightarrow> q\<preceq>p \<Longrightarrow> \<exists>d\<in>D. d\<in>P \<and> d\<preceq>q"
+  shows "dense_below(D,p)"
+  using assms unfolding dense_below_def by simp
+
+lemma dense_below_cong: "p\<in>P \<Longrightarrow> D = D' \<Longrightarrow> dense_below(D,p) \<longleftrightarrow> dense_below(D',p)"
+  by blast
+
+lemma dense_below_cong': "p\<in>P \<Longrightarrow> \<lbrakk>\<And>x. x\<in>P \<Longrightarrow> Q(x) \<longleftrightarrow> Q'(x)\<rbrakk> \<Longrightarrow>
+           dense_below({q\<in>P. Q(q)},p) \<longleftrightarrow> dense_below({q\<in>P. Q'(q)},p)"
+  by blast
+
+lemma dense_below_mono: "p\<in>P \<Longrightarrow> D \<subseteq> D' \<Longrightarrow> dense_below(D,p) \<Longrightarrow> dense_below(D',p)"
+  by blast
+
+lemma dense_below_under:
+  assumes "dense_below(D,p)" "p\<in>P" "q\<in>P" "q\<preceq>p"
+  shows "dense_below(D,q)"
+  using assms leq_transD by blast
+
+lemma ideal_dense_below:
+  assumes "\<And>q. q\<in>P \<Longrightarrow> q\<preceq>p \<Longrightarrow> q\<in>D"
+  shows "dense_below(D,p)"
+  using assms refl_leq by blast
+
+lemma dense_below_dense_below:
+  assumes "dense_below({q\<in>P. dense_below(D,q)},p)" "p\<in>P"
+  shows "dense_below(D,p)"
+  using assms leq_transD refl_leq  by blast
+
+text\<open>A filter is an increasing set $G$ with all its elements
+being compatible in $G$.\<close>
+definition
+  filter :: "i\<Rightarrow>o" where
+  "filter(G) \<equiv> G\<subseteq>P \<and> increasing(G) \<and> (\<forall>p\<in>G. \<forall>q\<in>G. compat_in(G,leq,p,q))"
+
+lemma filterD : "filter(G) \<Longrightarrow> x \<in> G \<Longrightarrow> x \<in> P"
+  by (auto simp add : subsetD filter_def)
+
+lemma filter_leqD : "filter(G) \<Longrightarrow> x \<in> G \<Longrightarrow> y \<in> P \<Longrightarrow> x\<preceq>y \<Longrightarrow> y \<in> G"
+  by (simp add: filter_def increasing_def)
+
+lemma filter_imp_compat: "filter(G) \<Longrightarrow> p\<in>G \<Longrightarrow> q\<in>G \<Longrightarrow> compat(p,q)"
+  unfolding filter_def compat_in_def compat_def by blast
+
+lemma low_bound_filter: \<comment> \<open>says the compatibility is attained inside G\<close>
+  assumes "filter(G)" and "p\<in>G" and "q\<in>G"
+  shows "\<exists>r\<in>G. r\<preceq>p \<and> r\<preceq>q"
+  using assms
+  unfolding compat_in_def filter_def by blast
+
+text\<open>We finally introduce the upward closure of a set
+and prove that the closure of $A$ is a filter if its elements are
+compatible in $A$.\<close>
+definition
+  upclosure :: "i\<Rightarrow>i" where
+  "upclosure(A) \<equiv> {p\<in>P.\<exists>a\<in>A. a\<preceq>p}"
+
+lemma  upclosureI [intro] : "p\<in>P \<Longrightarrow> a\<in>A \<Longrightarrow> a\<preceq>p \<Longrightarrow> p\<in>upclosure(A)"
+  by (simp add:upclosure_def, auto)
+
+lemma  upclosureE [elim] :
+  "p\<in>upclosure(A) \<Longrightarrow> (\<And>x a. x\<in>P \<Longrightarrow> a\<in>A \<Longrightarrow> a\<preceq>x \<Longrightarrow> R) \<Longrightarrow> R"
+  by (auto simp add:upclosure_def)
+
+lemma  upclosureD [dest] :
+  "p\<in>upclosure(A) \<Longrightarrow> \<exists>a\<in>A.(a\<preceq>p) \<and> p\<in>P"
+  by (simp add:upclosure_def)
+
+lemma upclosure_increasing :
+  assumes "A\<subseteq>P"
+  shows "increasing(upclosure(A))"
+  unfolding increasing_def upclosure_def
+  using leq_transD'[OF \<open>A\<subseteq>P\<close>] by auto
+
+lemma  upclosure_in_P: "A \<subseteq> P \<Longrightarrow> upclosure(A) \<subseteq> P"
+  using subsetI upclosure_def by simp
+
+lemma  A_sub_upclosure: "A \<subseteq> P \<Longrightarrow> A\<subseteq>upclosure(A)"
+  using subsetI leq_preord
+  unfolding upclosure_def preorder_on_def refl_def by auto
+
+lemma  elem_upclosure: "A\<subseteq>P \<Longrightarrow> x\<in>A  \<Longrightarrow> x\<in>upclosure(A)"
+  by (blast dest:A_sub_upclosure)
+
+lemma  closure_compat_filter:
+  assumes "A\<subseteq>P" "(\<forall>p\<in>A.\<forall>q\<in>A. compat_in(A,leq,p,q))"
+  shows "filter(upclosure(A))"
+  unfolding filter_def
+proof(auto)
+  show "increasing(upclosure(A))"
+    using assms upclosure_increasing by simp
+next
+  let ?UA="upclosure(A)"
+  show "compat_in(upclosure(A), leq, p, q)" if "p\<in>?UA" "q\<in>?UA" for p q
+  proof -
+    from that
+    obtain a b where 1:"a\<in>A" "b\<in>A" "a\<preceq>p" "b\<preceq>q" "p\<in>P" "q\<in>P"
+      using upclosureD[OF \<open>p\<in>?UA\<close>] upclosureD[OF \<open>q\<in>?UA\<close>] by auto
+    with assms(2)
+    obtain d where "d\<in>A" "d\<preceq>a" "d\<preceq>b"
+      unfolding compat_in_def by auto
+    with 1
+    have "d\<preceq>p" "d\<preceq>q" "d\<in>?UA"
+      using A_sub_upclosure[THEN subsetD] \<open>A\<subseteq>P\<close>
+        leq_transD'[of A d a] leq_transD'[of A d b] by auto
+    then
+    show ?thesis unfolding compat_in_def by auto
+  qed
+qed
+
+lemma  aux_RS1:  "f \<in> N \<rightarrow> P \<Longrightarrow> n\<in>N \<Longrightarrow> f`n \<in> upclosure(f ``N)"
+  using elem_upclosure[OF subset_fun_image] image_fun
+  by (simp, blast)
+
+lemma decr_succ_decr:
+  assumes "f \<in> nat \<rightarrow> P" "preorder_on(P,leq)"
+    "\<forall>n\<in>nat.  \<langle>f ` succ(n), f ` n\<rangle> \<in> leq"
+    "m\<in>nat"
+  shows "n\<in>nat \<Longrightarrow> n\<le>m \<Longrightarrow> \<langle>f ` m, f ` n\<rangle> \<in> leq"
+  using \<open>m\<in>_\<close>
+proof(induct m)
+  case 0
+  then show ?case using assms refl_leq by simp
+next
+  case (succ x)
+  then
+  have 1:"f`succ(x) \<preceq> f`x" "f`n\<in>P" "f`x\<in>P" "f`succ(x)\<in>P"
+    using assms by simp_all
+  consider (lt) "n<succ(x)" | (eq) "n=succ(x)"
+    using succ le_succ_iff by auto
+  then
+  show ?case
+  proof(cases)
+    case lt
+    with 1 show ?thesis using leI succ leq_transD by auto
+  next
+    case eq
+    with 1 show ?thesis using refl_leq by simp
+  qed
+qed
+
+lemma decr_seq_linear:
+  assumes "refl(P,leq)" "f \<in> nat \<rightarrow> P"
+    "\<forall>n\<in>nat.  \<langle>f ` succ(n), f ` n\<rangle> \<in> leq"
+    "trans[P](leq)"
+  shows "linear(f `` nat, leq)"
+proof -
+  have "preorder_on(P,leq)"
+    unfolding preorder_on_def using assms by simp
+  {
+    fix n m
+    assume "n\<in>nat" "m\<in>nat"
+    then
+    have "f`m \<preceq> f`n \<or> f`n \<preceq> f`m"
+    proof(cases "m\<le>n")
+      case True
+      with \<open>n\<in>_\<close> \<open>m\<in>_\<close>
+      show ?thesis
+        using decr_succ_decr[of f n m] assms leI \<open>preorder_on(P,leq)\<close> by simp
+    next
+      case False
+      with \<open>n\<in>_\<close> \<open>m\<in>_\<close>
+      show ?thesis
+        using decr_succ_decr[of f m n] assms leI not_le_iff_lt \<open>preorder_on(P,leq)\<close> by simp
+    qed
+  }
+  then
+  show ?thesis
+    unfolding linear_def using ball_image_simp assms by auto
+qed
+
+end \<comment> \<open>\<^locale>\<open>forcing_notion\<close>\<close>
+
+subsection\<open>Towards Rasiowa-Sikorski Lemma (RSL)\<close>
+locale countable_generic = forcing_notion +
+  fixes \<D>
+  assumes countable_subs_of_P:  "\<D> \<in> nat\<rightarrow>Pow(P)"
+    and     seq_of_denses:        "\<forall>n \<in> nat. dense(\<D>`n)"
+
+begin
+
+definition
+  D_generic :: "i\<Rightarrow>o" where
+  "D_generic(G) \<equiv> filter(G) \<and> (\<forall>n\<in>nat.(\<D>`n)\<inter>G\<noteq>0)"
+
+text\<open>The next lemma identifies a sufficient condition for obtaining
+RSL.\<close>
+lemma RS_sequence_imp_rasiowa_sikorski:
+  assumes
+    "p\<in>P" "f : nat\<rightarrow>P" "f ` 0 = p"
+    "\<And>n. n\<in>nat \<Longrightarrow> f ` succ(n)\<preceq> f ` n \<and> f ` succ(n) \<in> \<D> ` n"
+  shows
+    "\<exists>G. p\<in>G \<and> D_generic(G)"
+proof -
+  note assms
+  moreover from this
+  have "f``nat  \<subseteq> P"
+    by (simp add:subset_fun_image)
+  moreover from calculation
+  have "refl(f``nat, leq) \<and> trans[P](leq)"
+    using leq_preord unfolding preorder_on_def by (blast intro:refl_monot_domain)
+  moreover from calculation
+  have "\<forall>n\<in>nat.  f ` succ(n)\<preceq> f ` n" by (simp)
+  moreover from calculation
+  have "linear(f``nat, leq)"
+    using leq_preord and decr_seq_linear unfolding preorder_on_def by (blast)
+  moreover from calculation
+  have "(\<forall>p\<in>f``nat.\<forall>q\<in>f``nat. compat_in(f``nat,leq,p,q))"
+    using chain_compat by (auto)
+  ultimately
+  have "filter(upclosure(f``nat))" (is "filter(?G)")
+    using closure_compat_filter by simp
+  moreover
+  have "\<forall>n\<in>nat. \<D> ` n \<inter> ?G \<noteq> 0"
+  proof
+    fix n
+    assume "n\<in>nat"
+    with assms
+    have "f`succ(n) \<in> ?G \<and> f`succ(n) \<in> \<D> ` n"
+      using aux_RS1 by simp
+    then
+    show "\<D> ` n \<inter> ?G \<noteq> 0"  by blast
+  qed
+  moreover from assms
+  have "p \<in> ?G"
+    using aux_RS1 by auto
+  ultimately
+  show ?thesis unfolding D_generic_def by auto
+qed
+
+end \<comment> \<open>\<^locale>\<open>countable_generic\<close>\<close>
+
+text\<open>Now, the following recursive definition will fulfill the
+requirements of lemma \<^term>\<open>RS_sequence_imp_rasiowa_sikorski\<close> \<close>
+
+consts RS_seq :: "[i,i,i,i,i,i] \<Rightarrow> i"
+primrec
+  "RS_seq(0,P,leq,p,enum,\<D>) = p"
+  "RS_seq(succ(n),P,leq,p,enum,\<D>) =
+    enum`(\<mu> m. \<langle>enum`m, RS_seq(n,P,leq,p,enum,\<D>)\<rangle> \<in> leq \<and> enum`m \<in> \<D> ` n)"
+
+context countable_generic
+begin
+
+lemma countable_RS_sequence_aux:
+  fixes p enum
+  defines "f(n) \<equiv> RS_seq(n,P,leq,p,enum,\<D>)"
+    and   "Q(q,k,m) \<equiv> enum`m\<preceq> q \<and> enum`m \<in> \<D> ` k"
+  assumes "n\<in>nat" "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
+    "\<And>x k. x\<in>P \<Longrightarrow> k\<in>nat \<Longrightarrow>  \<exists>q\<in>P. q\<preceq> x \<and> q \<in> \<D> ` k"
+  shows
+    "f(succ(n)) \<in> P \<and> f(succ(n))\<preceq> f(n) \<and> f(succ(n)) \<in> \<D> ` n"
+  using \<open>n\<in>nat\<close>
+proof (induct)
+  case 0
+  from assms
+  obtain q where "q\<in>P" "q\<preceq> p" "q \<in> \<D> ` 0" by blast
+  moreover from this and \<open>P \<subseteq> range(enum)\<close>
+  obtain m where "m\<in>nat" "enum`m = q"
+    using Pi_rangeD[OF \<open>enum:nat\<rightarrow>M\<close>] by blast
+  moreover
+  have "\<D>`0 \<subseteq> P"
+    using apply_funtype[OF countable_subs_of_P] by simp
+  moreover note \<open>p\<in>P\<close>
+  ultimately
+  show ?case
+    using LeastI[of "Q(p,0)" m] unfolding Q_def f_def by auto
+next
+  case (succ n)
+  with assms
+  obtain q where "q\<in>P" "q\<preceq> f(succ(n))" "q \<in> \<D> ` succ(n)" by blast
+  moreover from this and \<open>P \<subseteq> range(enum)\<close>
+  obtain m where "m\<in>nat" "enum`m\<preceq> f(succ(n))" "enum`m \<in> \<D> ` succ(n)"
+    using Pi_rangeD[OF \<open>enum:nat\<rightarrow>M\<close>] by blast
+  moreover note succ
+  moreover from calculation
+  have "\<D>`succ(n) \<subseteq> P"
+    using apply_funtype[OF countable_subs_of_P] by auto
+  ultimately
+  show ?case
+    using LeastI[of "Q(f(succ(n)),succ(n))" m] unfolding Q_def f_def by auto
+qed
+
+lemma countable_RS_sequence:
+  fixes p enum
+  defines "f \<equiv> \<lambda>n\<in>nat. RS_seq(n,P,leq,p,enum,\<D>)"
+    and   "Q(q,k,m) \<equiv> enum`m\<preceq> q \<and> enum`m \<in> \<D> ` k"
+  assumes "n\<in>nat" "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
+  shows
+    "f`0 = p" "f`succ(n)\<preceq> f`n \<and> f`succ(n) \<in> \<D> ` n" "f`succ(n) \<in> P"
+proof -
+  from assms
+  show "f`0 = p" by simp
+  {
+    fix x k
+    assume "x\<in>P" "k\<in>nat"
+    then
+    have "\<exists>q\<in>P. q\<preceq> x \<and> q \<in> \<D> ` k"
+      using seq_of_denses apply_funtype[OF countable_subs_of_P]
+      unfolding dense_def by blast
+  }
+  with assms
+  show "f`succ(n)\<preceq> f`n \<and> f`succ(n) \<in> \<D> ` n" "f`succ(n)\<in>P"
+    unfolding f_def using countable_RS_sequence_aux by simp_all
+qed
+
+lemma RS_seq_type:
+  assumes "n \<in> nat" "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
+  shows "RS_seq(n,P,leq,p,enum,\<D>) \<in> P"
+  using assms countable_RS_sequence(1,3)
+  by (induct;simp)
+
+lemma RS_seq_funtype:
+  assumes "p\<in>P" "P \<subseteq> range(enum)" "enum:nat\<rightarrow>M"
+  shows "(\<lambda>n\<in>nat. RS_seq(n,P,leq,p,enum,\<D>)): nat \<rightarrow> P"
+  using assms lam_type RS_seq_type by auto
+
+lemmas countable_rasiowa_sikorski =
+  RS_sequence_imp_rasiowa_sikorski[OF _ RS_seq_funtype countable_RS_sequence(1,2)]
+
+end \<comment> \<open>\<^locale>\<open>countable_generic\<close>\<close>
+
+end
diff --git a/thys/Independence_CH/Forcing_Theorems.thy b/thys/Independence_CH/Forcing_Theorems.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Forcing_Theorems.thy
@@ -0,0 +1,1516 @@
+section\<open>The Forcing Theorems\<close>
+
+theory Forcing_Theorems
+  imports
+    Cohen_Posets_Relative
+    Forces_Definition
+    Names
+
+begin
+
+context forcing_data1
+begin
+
+subsection\<open>The forcing relation in context\<close>
+
+lemma separation_forces :
+  assumes
+    fty: "\<phi>\<in>formula" and
+    far: "arity(\<phi>)\<le>length(env)" and
+    envty: "env\<in>list(M)"
+  shows
+    "separation(##M,\<lambda>p. (p \<tturnstile> \<phi> env))"
+  using separation_ax arity_forces far fty P_in_M leq_in_M one_in_M envty arity_forces_le
+    transitivity[of _ P]
+  by simp
+
+lemma Collect_forces :
+  assumes
+    "\<phi>\<in>formula" and
+    "arity(\<phi>)\<le>length(env)" and
+    "env\<in>list(M)"
+  shows
+    "{p\<in>P . p \<tturnstile> \<phi> env} \<in> M"
+  using assms separation_forces separation_closed P_in_M
+  by simp
+
+lemma forces_mem_iff_dense_below:  "p\<in>P \<Longrightarrow> p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow> dense_below(
+    {q\<in>P. \<exists>s. \<exists>r. r\<in>P \<and> \<langle>s,r\<rangle> \<in> t2 \<and> q\<preceq>r \<and> q forces\<^sub>a (t1 = s)}
+    ,p)"
+  using def_forces_mem[of p t1 t2] by blast
+
+subsection\<open>Kunen 2013, Lemma IV.2.37(a)\<close>
+
+lemma strengthening_eq:
+  assumes "p\<in>P" "r\<in>P" "r\<preceq>p" "p forces\<^sub>a (t1 = t2)"
+  shows "r forces\<^sub>a (t1 = t2)"
+  using assms def_forces_eq[of _ t1 t2] leq_transD by blast
+    (* Long proof *)
+    (*
+proof -
+  {
+    fix s q
+    assume "q\<preceq> r" "q\<in>P"
+    with assms
+    have "q\<preceq>p"
+      using leq_preord unfolding preorder_on_def trans_on_def by blast
+    moreover
+    note \<open>q\<in>P\<close> assms
+    moreover
+    assume "s\<in>domain(t1) \<union> domain(t2)"
+    ultimately
+    have "q forces\<^sub>a ( s \<in>  t1) \<longleftrightarrow> q forces\<^sub>a ( s \<in>  t2)"
+      using def_forces_eq[of p t1 t2] by simp
+  }
+  with \<open>r\<in>P\<close>
+  show ?thesis using def_forces_eq[of r t1 t2] by blast
+qed
+*)
+
+subsection\<open>Kunen 2013, Lemma IV.2.37(a)\<close>
+lemma strengthening_mem:
+  assumes "p\<in>P" "r\<in>P" "r\<preceq>p" "p forces\<^sub>a (t1 \<in> t2)"
+  shows "r forces\<^sub>a (t1 \<in> t2)"
+  using assms forces_mem_iff_dense_below dense_below_under by auto
+
+subsection\<open>Kunen 2013, Lemma IV.2.37(b)\<close>
+lemma density_mem:
+  assumes "p\<in>P"
+  shows "p forces\<^sub>a (t1 \<in> t2)  \<longleftrightarrow> dense_below({q\<in>P. q forces\<^sub>a (t1 \<in> t2)},p)"
+proof
+  assume "p forces\<^sub>a (t1 \<in> t2)"
+  with assms
+  show "dense_below({q\<in>P. q forces\<^sub>a (t1 \<in> t2)},p)"
+    using forces_mem_iff_dense_below strengthening_mem[of p] ideal_dense_below by auto
+next
+  assume "dense_below({q \<in> P . q forces\<^sub>a ( t1 \<in>  t2)}, p)"
+  with assms
+  have "dense_below({q\<in>P.
+    dense_below({q'\<in>P. \<exists>s r. r \<in> P \<and> \<langle>s,r\<rangle>\<in>t2 \<and> q'\<preceq>r \<and> q' forces\<^sub>a (t1 = s)},q)
+    },p)"
+    using forces_mem_iff_dense_below by simp
+  with assms
+  show "p forces\<^sub>a (t1 \<in> t2)"
+    using dense_below_dense_below forces_mem_iff_dense_below[of p t1 t2] by blast
+qed
+
+lemma aux_density_eq:
+  assumes
+    "dense_below(
+    {q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow> q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)}
+    ,p)"
+    "q forces\<^sub>a (s \<in> t1)" "q\<in>P" "p\<in>P" "q\<preceq>p"
+  shows
+    "dense_below({r\<in>P. r forces\<^sub>a (s \<in> t2)},q)"
+proof
+  fix r
+  assume "r\<in>P" "r\<preceq>q"
+  moreover from this and \<open>p\<in>P\<close> \<open>q\<preceq>p\<close> \<open>q\<in>P\<close>
+  have "r\<preceq>p"
+    using leq_transD by simp
+  moreover
+  note \<open>q forces\<^sub>a (s \<in> t1)\<close> \<open>dense_below(_,p)\<close> \<open>q\<in>P\<close>
+  ultimately
+  obtain q1 where "q1\<preceq>r" "q1\<in>P" "q1 forces\<^sub>a (s \<in> t2)"
+    using strengthening_mem[of q _ s t1] refl_leq leq_transD[of _ r q] by blast
+  then
+  show "\<exists>d\<in>{r \<in> P . r forces\<^sub>a ( s \<in>  t2)}. d \<in> P \<and> d\<preceq> r"
+    by blast
+qed
+
+(* Kunen 2013, Lemma IV.2.37(b) *)
+lemma density_eq:
+  assumes "p\<in>P"
+  shows "p forces\<^sub>a (t1 = t2)  \<longleftrightarrow> dense_below({q\<in>P. q forces\<^sub>a (t1 = t2)},p)"
+proof
+  assume "p forces\<^sub>a (t1 = t2)"
+  with \<open>p\<in>P\<close>
+  show "dense_below({q\<in>P. q forces\<^sub>a (t1 = t2)},p)"
+    using strengthening_eq ideal_dense_below by auto
+next
+  assume "dense_below({q\<in>P. q forces\<^sub>a (t1 = t2)},p)"
+  {
+    fix s q
+    let ?D1="{q'\<in>P. \<forall>s\<in>domain(t1) \<union> domain(t2). \<forall>q. q \<in> P \<and> q\<preceq>q' \<longrightarrow>
+           q forces\<^sub>a (s \<in> t1)\<longleftrightarrow>q forces\<^sub>a (s \<in> t2)}"
+    let ?D2="{q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow> q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)}"
+    assume "s\<in>domain(t1) \<union> domain(t2)"
+    then
+    have "?D1\<subseteq>?D2" by blast
+    with \<open>dense_below(_,p)\<close>
+    have "dense_below({q'\<in>P. \<forall>s\<in>domain(t1) \<union> domain(t2). \<forall>q. q \<in> P \<and> q\<preceq>q' \<longrightarrow>
+           q forces\<^sub>a (s \<in> t1)\<longleftrightarrow>q forces\<^sub>a (s \<in> t2)},p)"
+      using dense_below_cong'[OF \<open>p\<in>P\<close> def_forces_eq[of _ t1 t2]] by simp
+    with \<open>p\<in>P\<close> \<open>?D1\<subseteq>?D2\<close>
+    have "dense_below({q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow>
+            q forces\<^sub>a (s \<in> t1) \<longleftrightarrow> q forces\<^sub>a (s \<in> t2)},p)"
+      using dense_below_mono by simp
+    moreover from this (* Automatic tools can't handle this symmetry
+                          in order to apply aux_density_eq below *)
+    have  "dense_below({q'\<in>P. \<forall>q. q\<in>P \<and> q\<preceq>q' \<longrightarrow>
+            q forces\<^sub>a (s \<in> t2) \<longleftrightarrow> q forces\<^sub>a (s \<in> t1)},p)"
+      by blast
+    moreover
+    assume "q \<in> P" "q\<preceq>p"
+    moreover
+    note \<open>p\<in>P\<close>
+    ultimately (*We can omit the next step but it is slower *)
+    have "q forces\<^sub>a (s \<in> t1) \<Longrightarrow> dense_below({r\<in>P. r forces\<^sub>a (s \<in> t2)},q)"
+      "q forces\<^sub>a (s \<in> t2) \<Longrightarrow> dense_below({r\<in>P. r forces\<^sub>a (s \<in> t1)},q)"
+      using aux_density_eq by simp_all
+    then
+    have "q forces\<^sub>a ( s \<in>  t1) \<longleftrightarrow> q forces\<^sub>a ( s \<in>  t2)"
+      using density_mem[OF \<open>q\<in>P\<close>] by blast
+  }
+  with \<open>p\<in>P\<close>
+  show "p forces\<^sub>a (t1 = t2)" using def_forces_eq by blast
+qed
+
+subsection\<open>Kunen 2013, Lemma IV.2.38\<close>
+lemma not_forces_neq:
+  assumes "p\<in>P"
+  shows "p forces\<^sub>a (t1 = t2) \<longleftrightarrow> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 \<noteq> t2))"
+  using assms density_eq unfolding forces_neq_def by blast
+
+lemma not_forces_nmem:
+  assumes "p\<in>P"
+  shows "p forces\<^sub>a (t1 \<in> t2) \<longleftrightarrow> \<not> (\<exists>q\<in>P. q\<preceq>p \<and> q forces\<^sub>a (t1 \<notin> t2))"
+  using assms density_mem unfolding forces_nmem_def by blast
+
+subsection\<open>The relation of forcing and atomic formulas\<close>
+lemma Forces_Equal:
+  assumes
+    "p\<in>P" "t1\<in>M" "t2\<in>M" "env\<in>list(M)" "nth(n,env) = t1" "nth(m,env) = t2" "n\<in>nat" "m\<in>nat"
+  shows
+    "(p \<tturnstile> Equal(n,m) env) \<longleftrightarrow> p forces\<^sub>a (t1 = t2)"
+  using assms sats_forces_Equal forces_eq_abs transitivity P_in_M
+  by simp
+
+lemma Forces_Member:
+  assumes
+    "p\<in>P" "t1\<in>M" "t2\<in>M" "env\<in>list(M)" "nth(n,env) = t1" "nth(m,env) = t2" "n\<in>nat" "m\<in>nat"
+  shows
+    "(p \<tturnstile> Member(n,m) env) \<longleftrightarrow> p forces\<^sub>a (t1 \<in> t2)"
+  using assms sats_forces_Member forces_mem_abs transitivity P_in_M
+  by simp
+
+lemma Forces_Neg:
+  assumes
+    "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula"
+  shows
+    "(p \<tturnstile> Neg(\<phi>) env) \<longleftrightarrow> \<not>(\<exists>q\<in>M. q\<in>P \<and> q\<preceq>p \<and> (q \<tturnstile> \<phi> env))"
+  using assms sats_forces_Neg transitivity P_in_M pair_in_M_iff leq_in_M leq_abs
+  by simp
+
+subsection\<open>The relation of forcing and connectives\<close>
+
+lemma Forces_Nand:
+  assumes
+    "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
+  shows
+    "(p \<tturnstile> Nand(\<phi>,\<psi>) env) \<longleftrightarrow> \<not>(\<exists>q\<in>M. q\<in>P \<and> q\<preceq>p \<and> (q \<tturnstile> \<phi> env) \<and> (q \<tturnstile> \<psi> env))"
+  using assms sats_forces_Nand transitivity
+    P_in_M pair_in_M_iff leq_in_M leq_abs by simp
+
+lemma Forces_And_aux:
+  assumes
+    "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
+  shows
+    "p \<tturnstile> And(\<phi>,\<psi>) env   \<longleftrightarrow>
+    (\<forall>q\<in>M. q\<in>P \<and> q\<preceq>p \<longrightarrow> (\<exists>r\<in>M. r\<in>P \<and> r\<preceq>q \<and> (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)))"
+  unfolding And_def using assms Forces_Neg Forces_Nand by (auto simp only:)
+
+lemma Forces_And_iff_dense_below:
+  assumes
+    "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
+  shows
+    "(p \<tturnstile> And(\<phi>,\<psi>) env) \<longleftrightarrow> dense_below({r\<in>P. (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env) },p)"
+  unfolding dense_below_def using Forces_And_aux assms
+  by (auto dest:transitivity[OF _ P_in_M]; rename_tac q; drule_tac x=q in bspec)+
+
+lemma Forces_Forall:
+  assumes
+    "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula"
+  shows
+    "(p \<tturnstile> Forall(\<phi>) env) \<longleftrightarrow> (\<forall>x\<in>M. (p \<tturnstile> \<phi> ([x] @ env)))"
+  using sats_forces_Forall assms transitivity[OF _ P_in_M]
+  by simp
+
+(* "x\<in>val(P,G,\<pi>) \<Longrightarrow> \<exists>\<theta>. \<exists>p\<in>G.  \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x" *)
+bundle some_rules =  elem_of_val_pair [dest]
+
+context
+  includes some_rules
+begin
+
+lemma elem_of_valI: "\<exists>\<theta>. \<exists>p\<in>P. p\<in>G \<and> \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x \<Longrightarrow> x\<in>val(P,G,\<pi>)"
+  by (subst def_val, auto)
+
+lemma GenExt_iff: "x\<in>M[G] \<longleftrightarrow> (\<exists>\<tau>\<in>M. x = val(P,G,\<tau>))"
+  unfolding GenExt_def by simp
+
+subsection\<open>Kunen 2013, Lemma IV.2.29\<close>
+lemma generic_inter_dense_below:
+  assumes "D\<in>M" "M_generic(G)" "dense_below(D,p)" "p\<in>G"
+  shows "D \<inter> G \<noteq> 0"
+proof -
+  let ?D="{q\<in>P. p\<bottom>q \<or> q\<in>D}"
+  have "dense(?D)"
+  proof
+    fix r
+    assume "r\<in>P"
+    show "\<exists>d\<in>{q \<in> P . p \<bottom> q \<or> q \<in> D}. d \<preceq> r"
+    proof (cases "p \<bottom> r")
+      case True
+      with \<open>r\<in>P\<close>
+        (* Automatic tools can't handle this case for some reason... *)
+      show ?thesis using refl_leq[of r] by (intro bexI) (blast+)
+    next
+      case False
+      then
+      obtain s where "s\<in>P" "s\<preceq>p" "s\<preceq>r" by blast
+      with assms \<open>r\<in>P\<close>
+      show ?thesis
+        using dense_belowD[OF assms(3), of s] leq_transD[of _ s r]
+        by blast
+    qed
+  qed
+  have "?D\<subseteq>P" by auto
+      (* D\<in>M *)
+  let ?d_fm="\<cdot>\<cdot>\<not>compat_in_fm(1, 2, 3, 0) \<cdot> \<or> \<cdot>0 \<in> 4\<cdot>\<cdot>"
+  have 1:"p\<in>M"
+    using \<open>M_generic(G)\<close> M_genericD transitivity[OF _ P_in_M]
+      \<open>p\<in>G\<close> by simp
+  moreover
+  have "?d_fm\<in>formula" by simp
+  moreover
+  have "arity(?d_fm) = 5"
+    by (auto simp add: arity)
+  moreover
+  have "(M, [q,P,leq,p,D] \<Turnstile> ?d_fm) \<longleftrightarrow> (\<not> is_compat_in(##M,P,leq,p,q) \<or> q\<in>D)"
+    if "q\<in>M" for q
+    using that sats_compat_in_fm P_in_M leq_in_M 1 \<open>D\<in>M\<close> zero_in_M
+    by simp
+  moreover
+  have "(\<not> is_compat_in(##M,P,leq,p,q) \<or> q\<in>D) \<longleftrightarrow> p\<bottom>q \<or> q\<in>D" if "q\<in>M" for q
+    unfolding compat_def
+    using that compat_in_abs P_in_M leq_in_M 1
+    by simp
+  ultimately
+  have "?D\<in>M"
+    using Collect_in_M[of ?d_fm "[P,leq,p,D]"] P_in_M leq_in_M \<open>D\<in>M\<close>
+    by simp
+  note asm = \<open>M_generic(G)\<close> \<open>dense(?D)\<close> \<open>?D\<subseteq>P\<close> \<open>?D\<in>M\<close>
+  obtain x where "x\<in>G" "x\<in>?D" using M_generic_denseD[OF asm]
+    by force (* by (erule bexE) does it, but the other automatic tools don't *)
+  moreover from this and \<open>M_generic(G)\<close>
+  have "x\<in>D"
+    using M_generic_compatD[OF _ \<open>p\<in>G\<close>, of x] refl_leq compatI[of _ p x]
+    by force
+  ultimately
+  show ?thesis by auto
+qed
+
+subsection\<open>Auxiliary results for Lemma IV.2.40(a)\<close>
+lemma IV240a_mem_Collect:
+  assumes
+    "\<pi>\<in>M" "\<tau>\<in>M"
+  shows
+    "{q\<in>P. \<exists>\<sigma>. \<exists>r. r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>)}\<in>M"
+proof -
+  let ?rel_pred= "\<lambda>M x a1 a2 a3 a4. \<exists>\<sigma>[M]. \<exists>r[M]. \<exists>\<sigma>r[M].
+                r\<in>a1 \<and> pair(M,\<sigma>,r,\<sigma>r) \<and> \<sigma>r\<in>a4 \<and> is_leq(M,a2,x,r) \<and> is_forces_eq'(M,a1,a2,x,a3,\<sigma>)"
+  let ?\<phi>="Exists(Exists(Exists(And(Member(1,4),And(pair_fm(2,1,0),
+          And(Member(0,7),And(is_leq_fm(5,3,1),forces_eq_fm(4,5,3,6,2))))))))"
+  have "\<sigma>\<in>M \<and> r\<in>M" if "\<langle>\<sigma>, r\<rangle> \<in> \<tau>"  for \<sigma> r
+    using that \<open>\<tau>\<in>M\<close> pair_in_M_iff transitivity[of "\<langle>\<sigma>,r\<rangle>" \<tau>] by simp
+  then
+  have "?rel_pred(##M,q,P,leq,\<pi>,\<tau>) \<longleftrightarrow> (\<exists>\<sigma>. \<exists>r. r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>))"
+    if "q\<in>M" for q
+    unfolding forces_eq_def
+    using assms that P_in_M leq_in_M leq_abs forces_eq'_abs pair_in_M_iff
+    by auto
+  moreover
+  have "(M, [q,P,leq,\<pi>,\<tau>] \<Turnstile> ?\<phi>) \<longleftrightarrow> ?rel_pred(##M,q,P,leq,\<pi>,\<tau>)" if "q\<in>M" for q
+    using assms that sats_forces_eq_fm sats_is_leq_fm P_in_M leq_in_M zero_in_M
+    by simp
+  moreover
+  have "?\<phi>\<in>formula" by simp
+  moreover
+  have "arity(?\<phi>)=5"
+    using arity_forces_eq_fm
+    by (simp add:ord_simp_union arity)
+  ultimately
+  show ?thesis
+    unfolding forces_eq_def using P_in_M leq_in_M assms Collect_in_M[of ?\<phi> "[P,leq,\<pi>,\<tau>]"]
+    by simp
+qed
+
+(* Lemma IV.2.40(a), membership *)
+lemma IV240a_mem:
+  assumes
+    "M_generic(G)" "p\<in>G" "\<pi>\<in>M" "\<tau>\<in>M" "p forces\<^sub>a (\<pi> \<in> \<tau>)"
+    "\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<Longrightarrow> q forces\<^sub>a (\<pi> = \<sigma>) \<Longrightarrow>
+      val(P,G,\<pi>) = val(P,G,\<sigma>)" (* inductive hypothesis *)
+  shows
+    "val(P,G,\<pi>)\<in>val(P,G,\<tau>)"
+proof (intro elem_of_valI)
+  let ?D="{q\<in>P. \<exists>\<sigma>. \<exists>r. r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>)}"
+  from \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
+  have "p\<in>P" by blast
+  moreover
+  note \<open>\<pi>\<in>M\<close> \<open>\<tau>\<in>M\<close>
+  ultimately
+  have "?D \<in> M" using IV240a_mem_Collect by simp
+  moreover from assms \<open>p\<in>P\<close>
+  have "dense_below(?D,p)"
+    using forces_mem_iff_dense_below by simp
+  moreover
+  note \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
+  ultimately
+  obtain q where "q\<in>G" "q\<in>?D" using generic_inter_dense_below by blast
+  then
+  obtain \<sigma> r where "r\<in>P" "\<langle>\<sigma>,r\<rangle> \<in> \<tau>" "q\<preceq>r" "q forces\<^sub>a (\<pi> = \<sigma>)" by blast
+  moreover from this and \<open>q\<in>G\<close> assms
+  have "r \<in> G" "val(P,G,\<pi>) = val(P,G,\<sigma>)" by blast+
+  ultimately
+  show "\<exists> \<sigma>. \<exists>p\<in>P. p \<in> G \<and> \<langle>\<sigma>, p\<rangle> \<in> \<tau> \<and> val(P,G, \<sigma>) = val(P,G, \<pi>)" by auto
+qed
+
+(* Example IV.2.36 (next two lemmas) *)
+lemma refl_forces_eq:"p\<in>P \<Longrightarrow> p forces\<^sub>a (x = x)"
+  using def_forces_eq by simp
+
+lemma forces_memI: "\<langle>\<sigma>,r\<rangle>\<in>\<tau> \<Longrightarrow> p\<in>P \<Longrightarrow> r\<in>P \<Longrightarrow> p\<preceq>r \<Longrightarrow> p forces\<^sub>a (\<sigma> \<in> \<tau>)"
+  using refl_forces_eq[of _ \<sigma>] leq_transD refl_leq
+  by (blast intro:forces_mem_iff_dense_below[THEN iffD2])
+
+(* Lemma IV.2.40(a), equality, first inclusion *)
+lemma IV240a_eq_1st_incl:
+  assumes
+    "M_generic(G)" "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
+    and
+    IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
+        (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<tau>)) \<and>
+        (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<theta>))"
+    (* Strong enough for this case: *)
+    (*  IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<Longrightarrow> q forces\<^sub>a (\<sigma> \<in> \<theta>) \<Longrightarrow>
+      val(P,G,\<sigma>) \<in> val(P,G,\<theta>)" *)
+  shows
+    "val(P,G,\<tau>) \<subseteq> val(P,G,\<theta>)"
+proof
+  fix x
+  assume "x\<in>val(P,G,\<tau>)"
+  then
+  obtain \<sigma> r where "\<langle>\<sigma>,r\<rangle>\<in>\<tau>" "r\<in>G" "val(P,G,\<sigma>)=x" by blast
+  moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+  obtain q where "q\<in>G" "q\<preceq>p" "q\<preceq>r" by force
+  moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+  have "q\<in>P" "p\<in>P" by blast+
+  moreover from calculation and \<open>M_generic(G)\<close>
+  have "q forces\<^sub>a (\<sigma> \<in> \<tau>)"
+    using forces_memI by blast
+  moreover
+  note \<open>p forces\<^sub>a (\<tau> = \<theta>)\<close>
+  ultimately
+  have "q forces\<^sub>a (\<sigma> \<in> \<theta>)"
+    using def_forces_eq by blast
+  with \<open>q\<in>P\<close> \<open>q\<in>G\<close> IH[of q \<sigma>] \<open>\<langle>\<sigma>,r\<rangle>\<in>\<tau>\<close> \<open>val(P,G,\<sigma>) = x\<close>
+  show "x\<in>val(P,G,\<theta>)" by (blast)
+qed
+
+(* Lemma IV.2.40(a), equality, second inclusion--- COPY-PASTE *)
+lemma IV240a_eq_2nd_incl:
+  assumes
+    "M_generic(G)" "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
+    and
+    IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
+        (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<tau>)) \<and>
+        (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<theta>))"
+  shows
+    "val(P,G,\<theta>) \<subseteq> val(P,G,\<tau>)"
+proof
+  fix x
+  assume "x\<in>val(P,G,\<theta>)"
+  then
+  obtain \<sigma> r where "\<langle>\<sigma>,r\<rangle>\<in>\<theta>" "r\<in>G" "val(P,G,\<sigma>)=x" by blast
+  moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+  obtain q where "q\<in>G" "q\<preceq>p" "q\<preceq>r" by force
+  moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+  have "q\<in>P" "p\<in>P" by blast+
+  moreover from calculation and \<open>M_generic(G)\<close>
+  have "q forces\<^sub>a (\<sigma> \<in> \<theta>)"
+    using forces_memI by blast
+  moreover
+  note \<open>p forces\<^sub>a (\<tau> = \<theta>)\<close>
+  ultimately
+  have "q forces\<^sub>a (\<sigma> \<in> \<tau>)"
+    using def_forces_eq by blast
+  with \<open>q\<in>P\<close> \<open>q\<in>G\<close> IH[of q \<sigma>] \<open>\<langle>\<sigma>,r\<rangle>\<in>\<theta>\<close> \<open>val(P,G,\<sigma>) = x\<close>
+  show "x\<in>val(P,G,\<tau>)" by (blast)
+qed
+
+(* Lemma IV.2.40(a), equality, second inclusion--- COPY-PASTE *)
+lemma IV240a_eq:
+  assumes
+    "M_generic(G)" "p\<in>G" "p forces\<^sub>a (\<tau> = \<theta>)"
+    and
+    IH:"\<And>q \<sigma>. q\<in>P \<Longrightarrow> q\<in>G \<Longrightarrow> \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
+        (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<tau>)) \<and>
+        (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G,\<sigma>) \<in> val(P,G,\<theta>))"
+  shows
+    "val(P,G,\<tau>) = val(P,G,\<theta>)"
+  using IV240a_eq_1st_incl[OF assms] IV240a_eq_2nd_incl[OF assms] IH by blast
+
+subsection\<open>Induction on names\<close>
+
+lemma core_induction:
+  assumes
+    "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<sigma>,q)\<rbrakk> \<Longrightarrow> Q(1,\<tau>,\<theta>,p)"
+    "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(1,\<sigma>,\<tau>,q) \<and> Q(1,\<sigma>,\<theta>,q)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<theta>,p)"
+    "ft \<in> 2" "p \<in> P"
+  shows
+    "Q(ft,\<tau>,\<theta>,p)"
+proof -
+  {
+    fix ft p \<tau> \<theta>
+    have "Transset(eclose({\<tau>,\<theta>}))" (is "Transset(?e)")
+      using Transset_eclose by simp
+    have "\<tau> \<in> ?e" "\<theta> \<in> ?e"
+      using arg_into_eclose by simp_all
+    moreover
+    assume "ft \<in> 2" "p \<in> P"
+    ultimately
+    have "\<langle>ft,\<tau>,\<theta>,p\<rangle>\<in> 2\<times>?e\<times>?e\<times>P" (is "?a\<in>2\<times>?e\<times>?e\<times>P") by simp
+    then
+    have "Q(ftype(?a), name1(?a), name2(?a), cond_of(?a))"
+      using core_induction_aux[of ?e P Q ?a,OF \<open>Transset(?e)\<close> assms(1,2) \<open>?a\<in>_\<close>]
+      by (clarify) (blast)
+    then have "Q(ft,\<tau>,\<theta>,p)" by (simp add:components_simp)
+  }
+  then show ?thesis using assms by simp
+qed
+
+lemma forces_induction_with_conds:
+  assumes
+    "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(q,\<tau>,\<sigma>)\<rbrakk> \<Longrightarrow> R(p,\<tau>,\<theta>)"
+    "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> R(q,\<sigma>,\<tau>) \<and> R(q,\<sigma>,\<theta>)\<rbrakk> \<Longrightarrow> Q(p,\<tau>,\<theta>)"
+    "p \<in> P"
+  shows
+    "Q(p,\<tau>,\<theta>) \<and> R(p,\<tau>,\<theta>)"
+proof -
+  let ?Q="\<lambda>ft \<tau> \<theta> p. (ft = 0 \<longrightarrow> Q(p,\<tau>,\<theta>)) \<and> (ft = 1 \<longrightarrow> R(p,\<tau>,\<theta>))"
+  from assms(1)
+  have "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> ?Q(0,\<tau>,\<sigma>,q)\<rbrakk> \<Longrightarrow> ?Q(1,\<tau>,\<theta>,p)"
+    by simp
+  moreover from assms(2)
+  have "\<And>\<tau> \<theta> p. p \<in> P \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk>q\<in>P ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> ?Q(1,\<sigma>,\<tau>,q) \<and> ?Q(1,\<sigma>,\<theta>,q)\<rbrakk> \<Longrightarrow> ?Q(0,\<tau>,\<theta>,p)"
+    by simp
+  moreover
+  note \<open>p\<in>P\<close>
+  ultimately
+  have "?Q(ft,\<tau>,\<theta>,p)" if "ft\<in>2" for ft
+    by (rule core_induction[OF _ _ that, of ?Q])
+  then
+  show ?thesis by auto
+qed
+
+lemma forces_induction:
+  assumes
+    "\<And>\<tau> \<theta>. \<lbrakk>\<And>\<sigma>. \<sigma>\<in>domain(\<theta>) \<Longrightarrow> Q(\<tau>,\<sigma>)\<rbrakk> \<Longrightarrow> R(\<tau>,\<theta>)"
+    "\<And>\<tau> \<theta>. \<lbrakk>\<And>\<sigma>. \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> R(\<sigma>,\<tau>) \<and> R(\<sigma>,\<theta>)\<rbrakk> \<Longrightarrow> Q(\<tau>,\<theta>)"
+  shows
+    "Q(\<tau>,\<theta>) \<and> R(\<tau>,\<theta>)"
+proof (intro forces_induction_with_conds[OF _ _ one_in_P ])
+  fix \<tau> \<theta> p
+  assume "q \<in> P \<Longrightarrow> \<sigma> \<in> domain(\<theta>) \<Longrightarrow> Q(\<tau>, \<sigma>)" for q \<sigma>
+  with assms(1)
+  show "R(\<tau>,\<theta>)"
+    using one_in_P by simp
+next
+  fix \<tau> \<theta> p
+  assume "q \<in> P \<Longrightarrow> \<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> R(\<sigma>,\<tau>) \<and> R(\<sigma>,\<theta>)" for q \<sigma>
+  with assms(2)
+  show "Q(\<tau>,\<theta>)"
+    using one_in_P by simp
+qed
+
+subsection\<open>Lemma IV.2.40(a), in full\<close>
+lemma IV240a:
+  assumes
+    "M_generic(G)"
+  shows
+    "(\<tau>\<in>M \<longrightarrow> \<theta>\<in>M \<longrightarrow> (\<forall>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>) \<longrightarrow> val(P,G,\<tau>) = val(P,G,\<theta>))) \<and>
+     (\<tau>\<in>M \<longrightarrow> \<theta>\<in>M \<longrightarrow> (\<forall>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>) \<longrightarrow> val(P,G,\<tau>) \<in> val(P,G,\<theta>)))"
+    (is "?Q(\<tau>,\<theta>) \<and> ?R(\<tau>,\<theta>)")
+proof (intro forces_induction[of ?Q ?R] impI)
+  fix \<tau> \<theta>
+  assume "\<tau>\<in>M" "\<theta>\<in>M"  "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> ?Q(\<tau>,\<sigma>)" for \<sigma>
+  moreover from this
+  have "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> q forces\<^sub>a (\<tau> = \<sigma>) \<Longrightarrow> val(P,G, \<tau>) = val(P,G, \<sigma>)"
+    if "q\<in>P" "q\<in>G" for q \<sigma>
+    using that domain_closed[of \<theta>] transitivity by auto
+  moreover
+  note assms
+  ultimately
+  show "\<forall>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>) \<longrightarrow> val(P,G,\<tau>) \<in> val(P,G,\<theta>)"
+    using IV240a_mem domain_closed transitivity by (simp)
+next
+  fix \<tau> \<theta>
+  assume "\<tau>\<in>M" "\<theta>\<in>M" "\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> ?R(\<sigma>,\<tau>) \<and> ?R(\<sigma>,\<theta>)" for \<sigma>
+  moreover from this
+  have IH':"\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> q\<in>G \<Longrightarrow>
+            (q forces\<^sub>a (\<sigma> \<in> \<tau>) \<longrightarrow> val(P,G, \<sigma>) \<in> val(P,G, \<tau>)) \<and>
+            (q forces\<^sub>a (\<sigma> \<in> \<theta>) \<longrightarrow> val(P,G, \<sigma>) \<in> val(P,G, \<theta>))" for q \<sigma>
+    by (auto intro:  transitivity[OF _ domain_closed[simplified]])
+  ultimately
+  show "\<forall>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>) \<longrightarrow> val(P,G,\<tau>) = val(P,G,\<theta>)"
+    using IV240a_eq[OF assms(1) _ _ IH'] by (simp)
+qed
+
+subsection\<open>Lemma IV.2.40(b)\<close>
+  (* Lemma IV.2.40(b), membership *)
+lemma IV240b_mem:
+  assumes
+    "M_generic(G)" "val(P,G,\<pi>)\<in>val(P,G,\<tau>)" "\<pi>\<in>M" "\<tau>\<in>M"
+    and
+    IH:"\<And>\<sigma>. \<sigma>\<in>domain(\<tau>) \<Longrightarrow> val(P,G,\<pi>) = val(P,G,\<sigma>) \<Longrightarrow>
+      \<exists>p\<in>G. p forces\<^sub>a (\<pi> = \<sigma>)" (* inductive hypothesis *)
+  shows
+    "\<exists>p\<in>G. p forces\<^sub>a (\<pi> \<in> \<tau>)"
+proof -
+  from \<open>val(P,G,\<pi>)\<in>val(P,G,\<tau>)\<close>
+  obtain \<sigma> r where "r\<in>G" "\<langle>\<sigma>,r\<rangle>\<in>\<tau>" "val(P,G,\<pi>) = val(P,G,\<sigma>)" by auto
+  moreover from this and IH
+  obtain p' where "p'\<in>G" "p' forces\<^sub>a (\<pi> = \<sigma>)" by blast
+  moreover
+  note \<open>M_generic(G)\<close>
+  ultimately
+  obtain p where "p\<preceq>r" "p\<in>G" "p forces\<^sub>a (\<pi> = \<sigma>)"
+    using M_generic_compatD strengthening_eq[of p'] by blast
+  moreover
+  note \<open>M_generic(G)\<close>
+  moreover from calculation
+  have "q forces\<^sub>a (\<pi> = \<sigma>)" if "q\<in>P" "q\<preceq>p" for q
+    using that strengthening_eq by blast
+  moreover
+  note \<open>\<langle>\<sigma>,r\<rangle>\<in>\<tau>\<close> \<open>r\<in>G\<close>
+  ultimately
+  have "r\<in>P \<and> \<langle>\<sigma>,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = \<sigma>)" if "q\<in>P" "q\<preceq>p" for q
+    using that leq_transD[of _ p r] by blast
+  then
+  have "dense_below({q\<in>P. \<exists>s r. r\<in>P \<and> \<langle>s,r\<rangle> \<in> \<tau> \<and> q\<preceq>r \<and> q forces\<^sub>a (\<pi> = s)},p)"
+    using refl_leq by blast
+  moreover
+  note \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
+  moreover from calculation
+  have "p forces\<^sub>a (\<pi> \<in> \<tau>)"
+    using forces_mem_iff_dense_below by blast
+  ultimately
+  show ?thesis by blast
+qed
+
+end \<comment> \<open>includes some\_rules\<close>
+
+lemma Collect_forces_eq_in_M:
+  assumes "\<tau> \<in> M" "\<theta> \<in> M"
+  shows "{p\<in>P. p forces\<^sub>a (\<tau> = \<theta>)} \<in> M"
+  using assms Collect_in_M[of "forces_eq_fm(1,2,0,3,4)" "[P,leq,\<tau>,\<theta>]"]
+    arity_forces_eq_fm P_in_M leq_in_M sats_forces_eq_fm forces_eq_abs forces_eq_fm_type
+  by (simp add: union_abs1 Un_commute)
+
+lemma IV240b_eq_Collects:
+  assumes "\<tau> \<in> M" "\<theta> \<in> M"
+  shows "{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)}\<in>M" and
+    "{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)}\<in>M"
+proof -
+  let ?rel_pred="\<lambda>M x a1 a2 a3 a4.
+        \<exists>\<sigma>[M]. \<exists>u[M]. \<exists>da3[M]. \<exists>da4[M]. is_domain(M,a3,da3) \<and> is_domain(M,a4,da4) \<and>
+          union(M,da3,da4,u) \<and> \<sigma>\<in>u \<and> is_forces_mem'(M,a1,a2,x,\<sigma>,a3) \<and>
+          is_forces_nmem'(M,a1,a2,x,\<sigma>,a4)"
+  let ?\<phi>="Exists(Exists(Exists(Exists(And(domain_fm(7,1),And(domain_fm(8,0),
+          And(union_fm(1,0,2),And(Member(3,2),And(forces_mem_fm(5,6,4,3,7),
+                              forces_nmem_fm(5,6,4,3,8))))))))))"
+  have 1:"\<sigma>\<in>M" if "\<langle>\<sigma>,y\<rangle>\<in>\<delta>" "\<delta>\<in>M" for \<sigma> \<delta> y
+    using that pair_in_M_iff transitivity[of "\<langle>\<sigma>,y\<rangle>" \<delta>] by simp
+  have abs1:"?rel_pred(##M,p,P,leq,\<tau>,\<theta>) \<longleftrightarrow>
+        (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). forces_mem'(P,leq,p,\<sigma>,\<tau>) \<and> forces_nmem'(P,leq,p,\<sigma>,\<theta>))"
+    if "p\<in>M" for p
+    unfolding forces_mem_def forces_nmem_def
+    using assms that forces_mem'_abs forces_nmem'_abs P_in_M leq_in_M
+      domain_closed Un_closed
+    by (auto simp add:1[of _ _ \<tau>] 1[of _ _ \<theta>])
+  have abs2:"?rel_pred(##M,p,P,leq,\<theta>,\<tau>) \<longleftrightarrow> (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>).
+        forces_nmem'(P,leq,p,\<sigma>,\<tau>) \<and> forces_mem'(P,leq,p,\<sigma>,\<theta>))" if "p\<in>M" for p
+    unfolding forces_mem_def forces_nmem_def
+    using assms that forces_mem'_abs forces_nmem'_abs P_in_M leq_in_M
+      domain_closed Un_closed
+    by (auto simp add:1[of _ _ \<tau>] 1[of _ _ \<theta>])
+  have fsats1:"(M,[p,P,leq,\<tau>,\<theta>] \<Turnstile> ?\<phi>) \<longleftrightarrow> ?rel_pred(##M,p,P,leq,\<tau>,\<theta>)" if "p\<in>M" for p
+    using that assms sats_forces_mem_fm sats_forces_nmem_fm P_in_M leq_in_M zero_in_M
+      domain_closed Un_closed by simp
+  have fsats2:"(M,[p,P,leq,\<theta>,\<tau>] \<Turnstile> ?\<phi>) \<longleftrightarrow> ?rel_pred(##M,p,P,leq,\<theta>,\<tau>)" if "p\<in>M" for p
+    using that assms sats_forces_mem_fm sats_forces_nmem_fm P_in_M leq_in_M zero_in_M
+      domain_closed Un_closed by simp
+  have fty:"?\<phi>\<in>formula" by simp
+  have farit:"arity(?\<phi>)=5"
+    by (simp add:ord_simp_union arity)
+  show
+    "{p \<in> P . \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)} \<in> M"
+    and "{p \<in> P . \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)} \<in> M"
+    unfolding forces_mem_def
+    using abs1 fty fsats1 farit P_in_M leq_in_M assms forces_nmem
+      Collect_in_M[of ?\<phi> "[P,leq,\<tau>,\<theta>]"]
+    using abs2 fty fsats2 farit P_in_M leq_in_M assms forces_nmem domain_closed Un_closed
+      Collect_in_M[of ?\<phi> "[P,leq,\<theta>,\<tau>]"]
+    by simp_all
+qed
+
+(* Lemma IV.2.40(b), equality *)
+lemma IV240b_eq:
+  assumes
+    "M_generic(G)" "val(P,G,\<tau>) = val(P,G,\<theta>)" "\<tau>\<in>M" "\<theta>\<in>M"
+    and
+    IH:"\<And>\<sigma>. \<sigma>\<in>domain(\<tau>)\<union>domain(\<theta>) \<Longrightarrow>
+      (val(P,G,\<sigma>)\<in>val(P,G,\<tau>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<tau>))) \<and>
+      (val(P,G,\<sigma>)\<in>val(P,G,\<theta>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<theta>)))"
+    (* inductive hypothesis *)
+  shows
+    "\<exists>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>)"
+proof -
+  let ?D1="{p\<in>P. p forces\<^sub>a (\<tau> = \<theta>)}"
+  let ?D2="{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)}"
+  let ?D3="{p\<in>P. \<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)}"
+  let ?D="?D1 \<union> ?D2 \<union> ?D3"
+  note assms
+  moreover from this
+  have "domain(\<tau>) \<union> domain(\<theta>)\<in>M" (is "?B\<in>M") using domain_closed Un_closed by auto
+  moreover from calculation
+  have "?D2\<in>M" and "?D3\<in>M" using IV240b_eq_Collects by simp_all
+  ultimately
+  have "?D\<in>M" using Collect_forces_eq_in_M Un_closed by auto
+  moreover
+  have "dense(?D)"
+  proof
+    fix p
+    assume "p\<in>P"
+    have "\<exists>d\<in>P. (d forces\<^sub>a (\<tau> = \<theta>) \<or>
+            (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). d forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> d forces\<^sub>a (\<sigma> \<notin> \<theta>)) \<or>
+            (\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). d forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> d forces\<^sub>a (\<sigma> \<in> \<theta>))) \<and>
+           d \<preceq> p"
+    proof (cases "p forces\<^sub>a (\<tau> = \<theta>)")
+      case True
+      with \<open>p\<in>P\<close>
+      show ?thesis using refl_leq by blast
+    next
+      case False
+      moreover note \<open>p\<in>P\<close>
+      moreover from calculation
+      obtain \<sigma> q where "\<sigma>\<in>domain(\<tau>)\<union>domain(\<theta>)" "q\<in>P" "q\<preceq>p"
+        "(q forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> \<not> q forces\<^sub>a (\<sigma> \<in> \<theta>)) \<or>
+         (\<not> q forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> q forces\<^sub>a (\<sigma> \<in> \<theta>))"
+        using def_forces_eq by blast
+      moreover from this
+      obtain r where "r\<preceq>q" "r\<in>P"
+        "(r forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> r forces\<^sub>a (\<sigma> \<notin> \<theta>)) \<or>
+         (r forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> r forces\<^sub>a (\<sigma> \<in> \<theta>))"
+        using not_forces_nmem strengthening_mem by blast
+      ultimately
+      show ?thesis using leq_transD by blast
+    qed
+    then
+    show "\<exists>d\<in>?D1 \<union> ?D2 \<union> ?D3. d \<preceq> p" by blast
+  qed
+  moreover
+  have "?D \<subseteq> P"
+    by auto
+  moreover
+  note \<open>M_generic(G)\<close>
+  ultimately
+  obtain p where "p\<in>G" "p\<in>?D"
+    unfolding M_generic_def by blast
+  then
+  consider
+    (1) "p forces\<^sub>a (\<tau> = \<theta>)" |
+    (2) "\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<in> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<notin> \<theta>)" |
+    (3) "\<exists>\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>). p forces\<^sub>a (\<sigma> \<notin> \<tau>) \<and> p forces\<^sub>a (\<sigma> \<in> \<theta>)"
+    by blast
+  then
+  show ?thesis
+  proof (cases)
+    case 1
+    with \<open>p\<in>G\<close>
+    show ?thesis by blast
+  next
+    case 2
+    then
+    obtain \<sigma> where "\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)" "p forces\<^sub>a (\<sigma> \<in> \<tau>)" "p forces\<^sub>a (\<sigma> \<notin> \<theta>)"
+      by blast
+    moreover from this and \<open>p\<in>G\<close> and assms
+    have "val(P,G,\<sigma>)\<in>val(P,G,\<tau>)"
+      using IV240a[of G \<sigma> \<tau>] transitivity[OF _ domain_closed[simplified]] by blast
+    moreover note IH \<open>val(P,G,\<tau>) = _\<close>
+    ultimately
+    obtain q where "q\<in>G" "q forces\<^sub>a (\<sigma> \<in> \<theta>)" by auto
+    moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+    obtain r where "r\<in>P" "r\<preceq>p" "r\<preceq>q"
+      by blast
+    moreover
+    note \<open>M_generic(G)\<close>
+    ultimately
+    have "r forces\<^sub>a (\<sigma> \<in> \<theta>)"
+      using strengthening_mem by blast
+    with \<open>r\<preceq>p\<close> \<open>p forces\<^sub>a (\<sigma> \<notin> \<theta>)\<close> \<open>r\<in>P\<close>
+    have "False"
+      unfolding forces_nmem_def by blast
+    then
+    show ?thesis by simp
+  next (* copy-paste from case 2 mutatis mutandis*)
+    case 3
+    then
+    obtain \<sigma> where "\<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)" "p forces\<^sub>a (\<sigma> \<in> \<theta>)" "p forces\<^sub>a (\<sigma> \<notin> \<tau>)"
+      by blast
+    moreover from this and \<open>p\<in>G\<close> and assms
+    have "val(P,G,\<sigma>)\<in>val(P,G,\<theta>)"
+      using IV240a[of G \<sigma> \<theta>] transitivity[OF _ domain_closed[simplified]] by blast
+    moreover note IH \<open>val(P,G,\<tau>) = _\<close>
+    ultimately
+    obtain q where "q\<in>G" "q forces\<^sub>a (\<sigma> \<in> \<tau>)" by auto
+    moreover from this and \<open>p\<in>G\<close> \<open>M_generic(G)\<close>
+    obtain r where "r\<in>P" "r\<preceq>p" "r\<preceq>q"
+      by blast
+    moreover
+    note \<open>M_generic(G)\<close>
+    ultimately
+    have "r forces\<^sub>a (\<sigma> \<in> \<tau>)"
+      using strengthening_mem by blast
+    with \<open>r\<preceq>p\<close> \<open>p forces\<^sub>a (\<sigma> \<notin> \<tau>)\<close> \<open>r\<in>P\<close>
+    have "False"
+      unfolding forces_nmem_def by blast
+    then
+    show ?thesis by simp
+  qed
+qed
+
+(* Lemma IV.2.40(b), full *)
+lemma IV240b:
+  assumes
+    "M_generic(G)"
+  shows
+    "(\<tau>\<in>M\<longrightarrow>\<theta>\<in>M\<longrightarrow>val(P,G,\<tau>) = val(P,G,\<theta>) \<longrightarrow> (\<exists>p\<in>G. p forces\<^sub>a (\<tau> = \<theta>))) \<and>
+     (\<tau>\<in>M\<longrightarrow>\<theta>\<in>M\<longrightarrow>val(P,G,\<tau>) \<in> val(P,G,\<theta>) \<longrightarrow> (\<exists>p\<in>G. p forces\<^sub>a (\<tau> \<in> \<theta>)))"
+    (is "?Q(\<tau>,\<theta>) \<and> ?R(\<tau>,\<theta>)")
+proof (intro forces_induction)
+  fix \<tau> \<theta> p
+  assume "\<sigma>\<in>domain(\<theta>) \<Longrightarrow> ?Q(\<tau>, \<sigma>)" for \<sigma>
+  with assms
+  show "?R(\<tau>, \<theta>)"
+    using IV240b_mem domain_closed transitivity by (simp)
+next
+  fix \<tau> \<theta> p
+  assume "\<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow> ?R(\<sigma>,\<tau>) \<and> ?R(\<sigma>,\<theta>)" for \<sigma>
+  moreover from this
+  have IH':"\<tau>\<in>M \<Longrightarrow> \<theta>\<in>M \<Longrightarrow> \<sigma> \<in> domain(\<tau>) \<union> domain(\<theta>) \<Longrightarrow>
+          (val(P,G, \<sigma>) \<in> val(P,G, \<tau>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<tau>))) \<and>
+          (val(P,G, \<sigma>) \<in> val(P,G, \<theta>) \<longrightarrow> (\<exists>q\<in>G. q forces\<^sub>a (\<sigma> \<in> \<theta>)))" for \<sigma>
+    using domain_trans[OF trans_M]
+    by (blast)
+  ultimately
+  show "?Q(\<tau>,\<theta>)"
+    using IV240b_eq[OF assms(1)] by (auto)
+qed
+
+lemma map_val_in_MG:
+  assumes
+    "env\<in>list(M)"
+  shows
+    "map(val(P,G),env)\<in>list(M[G])"
+  unfolding GenExt_def using assms map_type2 by simp
+
+lemma truth_lemma_mem:
+  assumes
+    "env\<in>list(M)" "M_generic(G)"
+    "n\<in>nat" "m\<in>nat" "n<length(env)" "m<length(env)"
+  shows
+    "(\<exists>p\<in>G. p \<tturnstile> Member(n,m) env)  \<longleftrightarrow>  M[G], map(val(P,G),env) \<Turnstile> Member(n,m)"
+  using assms IV240a[OF assms(2), of "nth(n,env)" "nth(m,env)"]
+    IV240b[OF assms(2), of "nth(n,env)" "nth(m,env)"]
+    P_in_M leq_in_M one_in_M
+    Forces_Member[of _  "nth(n,env)" "nth(m,env)" env n m] map_val_in_MG
+  by (auto)
+
+lemma truth_lemma_eq:
+  assumes
+    "env\<in>list(M)" "M_generic(G)"
+    "n\<in>nat" "m\<in>nat" "n<length(env)" "m<length(env)"
+  shows
+    "(\<exists>p\<in>G. p \<tturnstile> Equal(n,m) env)  \<longleftrightarrow>  M[G], map(val(P,G),env) \<Turnstile> Equal(n,m)"
+  using assms IV240a(1)[OF assms(2), of "nth(n,env)" "nth(m,env)"]
+    IV240b(1)[OF assms(2), of "nth(n,env)" "nth(m,env)"]
+    P_in_M leq_in_M one_in_M
+    Forces_Equal[of _  "nth(n,env)" "nth(m,env)" env n m] map_val_in_MG
+  by (auto)
+
+lemma arities_at_aux:
+  assumes
+    "n \<in> nat" "m \<in> nat" "env \<in> list(M)" "succ(n) \<union> succ(m) \<le> length(env)"
+  shows
+    "n < length(env)" "m < length(env)"
+  using assms succ_leE[OF Un_leD1, of n "succ(m)" "length(env)"]
+    succ_leE[OF Un_leD2, of "succ(n)" m "length(env)"] by auto
+
+subsection\<open>The Strenghtening Lemma\<close>
+
+lemma strengthening_lemma:
+  assumes
+    "p\<in>P" "\<phi>\<in>formula" "r\<in>P" "r\<preceq>p"
+    "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
+  shows
+    "p \<tturnstile> \<phi> env \<Longrightarrow> r \<tturnstile> \<phi> env"
+  using assms(2-)
+proof (induct arbitrary:env)
+  case (Member n m)
+  then
+  have "n<length(env)" "m<length(env)"
+    using arities_at_aux by simp_all
+  moreover
+  assume "env\<in>list(M)"
+  moreover
+  note assms Member
+  ultimately
+  show ?case
+    using Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m]
+      strengthening_mem[of p r "nth(n,env)" "nth(m,env)"] by simp
+next
+  case (Equal n m)
+  then
+  have "n<length(env)" "m<length(env)"
+    using arities_at_aux by simp_all
+  moreover
+  assume "env\<in>list(M)"
+  moreover
+  note assms Equal
+  ultimately
+  show ?case
+    using Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m]
+      strengthening_eq[of p r "nth(n,env)" "nth(m,env)"] by simp
+next
+  case (Nand \<phi> \<psi>)
+  with assms
+  show ?case
+    using Forces_Nand transitivity[OF _ P_in_M] pair_in_M_iff
+      transitivity[OF _ leq_in_M] leq_transD by auto
+next
+  case (Forall \<phi>)
+  with assms
+  have "p \<tturnstile> \<phi> ([x] @ env)" if "x\<in>M" for x
+    using that Forces_Forall by simp
+  with Forall
+  have "r \<tturnstile> \<phi> ([x] @ env)" if "x\<in>M" for x
+    using that pred_le2 by (simp)
+  with assms Forall
+  show ?case
+    using Forces_Forall by simp
+qed
+
+subsection\<open>The Density Lemma\<close>
+
+lemma arity_Nand_le:
+  assumes "\<phi> \<in> formula" "\<psi> \<in> formula" "arity(Nand(\<phi>, \<psi>)) \<le> length(env)" "env\<in>list(A)"
+  shows "arity(\<phi>) \<le> length(env)" "arity(\<psi>) \<le> length(env)"
+  using assms
+  by (rule_tac Un_leD1, rule_tac [5] Un_leD2, auto)
+
+lemma dense_below_imp_forces:
+  assumes
+    "p\<in>P" "\<phi>\<in>formula"
+    "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
+  shows
+    "dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p) \<Longrightarrow> (p \<tturnstile> \<phi> env)"
+  using assms(2-)
+proof (induct arbitrary:env)
+  case (Member n m)
+  then
+  have "n<length(env)" "m<length(env)"
+    using arities_at_aux by simp_all
+  moreover
+  assume "env\<in>list(M)"
+  moreover
+  note assms Member
+  ultimately
+  show ?case
+    using Forces_Member[of _ "nth(n,env)" "nth(m,env)" env n m]
+      density_mem[of p "nth(n,env)" "nth(m,env)"] by simp
+next
+  case (Equal n m)
+  then
+  have "n<length(env)" "m<length(env)"
+    using arities_at_aux by simp_all
+  moreover
+  assume "env\<in>list(M)"
+  moreover
+  note assms Equal
+  ultimately
+  show ?case
+    using Forces_Equal[of _ "nth(n,env)" "nth(m,env)" env n m]
+      density_eq[of p "nth(n,env)" "nth(m,env)"] by simp
+next
+  case (Nand \<phi> \<psi>)
+  {
+    fix q
+    assume "q\<in>M" "q\<in>P" "q\<preceq> p" "q \<tturnstile> \<phi> env"
+    moreover
+    note Nand
+    moreover from calculation
+    obtain d where "d\<in>P" "d \<tturnstile> Nand(\<phi>, \<psi>) env" "d\<preceq> q"
+      using dense_belowI by auto
+    moreover from calculation
+    have "\<not>(d\<tturnstile> \<psi> env)" if "d \<tturnstile> \<phi> env"
+      using that Forces_Nand refl_leq transitivity[OF _ P_in_M, of d] by auto
+    moreover
+    note arity_Nand_le[of \<phi> \<psi>]
+    moreover from calculation
+    have "d \<tturnstile> \<phi> env"
+      using strengthening_lemma[of q \<phi> d env] Un_leD1 by auto
+    ultimately
+    have "\<not> (q \<tturnstile> \<psi> env)"
+      using strengthening_lemma[of q \<psi> d env] by auto
+  }
+  with \<open>p\<in>P\<close>
+  show ?case
+    using Forces_Nand[symmetric, OF _ Nand(6,1,3)] by blast
+next
+  case (Forall \<phi>)
+  have "dense_below({q\<in>P. q \<tturnstile> \<phi> ([a]@env)},p)" if "a\<in>M" for a
+  proof
+    fix r
+    assume "r\<in>P" "r\<preceq>p"
+    with \<open>dense_below(_,p)\<close>
+    obtain q where "q\<in>P" "q\<preceq>r" "q \<tturnstile> Forall(\<phi>) env"
+      by blast
+    moreover
+    note Forall \<open>a\<in>M\<close>
+    moreover from calculation
+    have "q \<tturnstile> \<phi> ([a]@env)"
+      using Forces_Forall by simp
+    ultimately
+    show "\<exists>d \<in> {q\<in>P. q \<tturnstile> \<phi> ([a]@env)}. d \<in> P \<and> d\<preceq>r"
+      by auto
+  qed
+  moreover
+  note Forall(2)[of "Cons(_,env)"] Forall(1,3-5)
+  ultimately
+  have "p \<tturnstile> \<phi> ([a]@env)" if "a\<in>M" for a
+    using that pred_le2 by simp
+  with assms Forall
+  show ?case using Forces_Forall by simp
+qed
+
+lemma density_lemma:
+  assumes
+    "p\<in>P" "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
+  shows
+    "p \<tturnstile> \<phi> env   \<longleftrightarrow>   dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p)"
+proof
+  assume "dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p)"
+  with assms
+  show  "(p \<tturnstile> \<phi> env)"
+    using dense_below_imp_forces by simp
+next
+  assume "p \<tturnstile> \<phi> env"
+  with assms
+  show "dense_below({q\<in>P. q \<tturnstile> \<phi> env},p)"
+    using strengthening_lemma refl_leq by auto
+qed
+
+subsection\<open>The Truth Lemma\<close>
+
+lemma Forces_And:
+  assumes
+    "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
+    "arity(\<phi>) \<le> length(env)" "arity(\<psi>) \<le> length(env)"
+  shows
+    "p \<tturnstile> And(\<phi>,\<psi>) env   \<longleftrightarrow>  (p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)"
+proof
+  assume "p \<tturnstile> And(\<phi>, \<psi>) env"
+  with assms
+  have "dense_below({r \<in> P . (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)}, p)"
+    using Forces_And_iff_dense_below by simp
+  then
+  have "dense_below({r \<in> P . (r \<tturnstile> \<phi> env)}, p)" "dense_below({r \<in> P . (r \<tturnstile> \<psi> env)}, p)"
+    by blast+
+  with assms
+  show "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)"
+    using density_lemma[symmetric] by simp
+next
+  assume "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)"
+  have "dense_below({r \<in> P . (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)}, p)"
+  proof (intro dense_belowI bexI conjI, assumption)
+    fix q
+    assume "q\<in>P" "q\<preceq> p"
+    with assms \<open>(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)\<close>
+    show "q\<in>{r \<in> P . (r \<tturnstile> \<phi> env) \<and> (r \<tturnstile> \<psi> env)}" "q\<preceq> q"
+      using strengthening_lemma refl_leq by auto
+  qed
+  with assms
+  show "p \<tturnstile> And(\<phi>,\<psi>) env"
+    using Forces_And_iff_dense_below by simp
+qed
+
+lemma Forces_Nand_alt:
+  assumes
+    "p\<in>P" "env \<in> list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
+    "arity(\<phi>) \<le> length(env)" "arity(\<psi>) \<le> length(env)"
+  shows
+    "(p \<tturnstile> Nand(\<phi>,\<psi>) env) \<longleftrightarrow> (p \<tturnstile> Neg(And(\<phi>,\<psi>)) env)"
+  using assms Forces_Nand Forces_And Forces_Neg by auto
+
+lemma truth_lemma_Neg:
+  assumes
+    "\<phi>\<in>formula" "M_generic(G)" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)" and
+    IH: "(\<exists>p\<in>G. p \<tturnstile> \<phi> env) \<longleftrightarrow> M[G], map(val(P,G),env) \<Turnstile> \<phi>"
+  shows
+    "(\<exists>p\<in>G. p \<tturnstile> Neg(\<phi>) env)  \<longleftrightarrow>  M[G], map(val(P,G),env) \<Turnstile> Neg(\<phi>)"
+proof (intro iffI, elim bexE, rule ccontr)
+  (* Direct implication by contradiction *)
+  fix p
+  assume "p\<in>G" "p \<tturnstile> Neg(\<phi>) env" "\<not>(M[G],map(val(P,G),env) \<Turnstile> Neg(\<phi>))"
+  moreover
+  note assms
+  moreover from calculation
+  have "M[G], map(val(P,G),env) \<Turnstile> \<phi>"
+    using map_val_in_MG by simp
+  with IH
+  obtain r where "r \<tturnstile> \<phi> env" "r\<in>G" by blast
+  moreover from this and \<open>M_generic(G)\<close> \<open>p\<in>G\<close>
+  obtain q where "q\<preceq>p" "q\<preceq>r" "q\<in>G"
+    by blast
+  moreover from calculation
+  have "q \<tturnstile> \<phi> env"
+    using strengthening_lemma[where \<phi>=\<phi>] by blast
+  ultimately
+  show "False"
+    using Forces_Neg[where \<phi>=\<phi>] transitivity[OF _ P_in_M] by blast
+next
+  assume "M[G], map(val(P,G),env) \<Turnstile> Neg(\<phi>)"
+  with assms
+  have "\<not> (M[G], map(val(P,G),env) \<Turnstile> \<phi>)"
+    using map_val_in_MG by simp
+  let ?D="{p\<in>P. (p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env)}"
+  have "separation(##M,\<lambda>p. (p \<tturnstile> \<phi> env))"
+    using separation_ax[of "forces(\<phi>)"] arity_forces assms P_in_M leq_in_M one_in_M arity_forces_le
+    by simp
+  moreover
+  have "separation(##M,\<lambda>p. (p \<tturnstile> \<cdot>\<not>\<phi>\<cdot> env))"
+    using separation_ax[of "forces( \<cdot>\<not>\<phi>\<cdot> )"] arity_forces assms P_in_M leq_in_M one_in_M arity_forces_le
+    by simp
+  ultimately
+  have "separation(##M,\<lambda>p. (p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env))"
+    using separation_disj by simp
+  then
+  have "?D \<in> M"
+    using separation_closed P_in_M by simp
+  moreover
+  have "?D \<subseteq> P" by auto
+  moreover
+  have "dense(?D)"
+  proof
+    fix q
+    assume "q\<in>P"
+    show "\<exists>d\<in>{p \<in> P . (p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env)}. d\<preceq> q"
+    proof (cases "q \<tturnstile> Neg(\<phi>) env")
+      case True
+      with \<open>q\<in>P\<close>
+      show ?thesis using refl_leq by blast
+    next
+      case False
+      with \<open>q\<in>P\<close> and assms
+      show ?thesis using Forces_Neg by auto
+    qed
+  qed
+  moreover
+  note \<open>M_generic(G)\<close>
+  ultimately
+  obtain p where "p\<in>G" "(p \<tturnstile> \<phi> env) \<or> (p \<tturnstile> Neg(\<phi>) env)"
+    by blast
+  then
+  consider (1) "p \<tturnstile> \<phi> env" | (2) "p \<tturnstile> Neg(\<phi>) env" by blast
+  then
+  show "\<exists>p\<in>G. (p \<tturnstile> Neg(\<phi>) env)"
+  proof (cases)
+    case 1
+    with \<open>\<not> (M[G],map(val(P,G),env) \<Turnstile> \<phi>)\<close> \<open>p\<in>G\<close> IH
+    show ?thesis
+      by blast
+  next
+    case 2
+    with \<open>p\<in>G\<close>
+    show ?thesis by blast
+  qed
+qed
+
+lemma truth_lemma_And:
+  assumes
+    "env\<in>list(M)" "\<phi>\<in>formula" "\<psi>\<in>formula"
+    "arity(\<phi>)\<le>length(env)" "arity(\<psi>) \<le> length(env)" "M_generic(G)"
+    and
+    IH: "(\<exists>p\<in>G. p \<tturnstile> \<phi> env)  \<longleftrightarrow>   M[G], map(val(P,G),env) \<Turnstile> \<phi>"
+    "(\<exists>p\<in>G. p \<tturnstile> \<psi> env)  \<longleftrightarrow>   M[G], map(val(P,G),env) \<Turnstile> \<psi>"
+  shows
+    "(\<exists>p\<in>G. (p \<tturnstile> And(\<phi>,\<psi>) env)) \<longleftrightarrow> M[G] , map(val(P,G),env) \<Turnstile> And(\<phi>,\<psi>)"
+  using assms map_val_in_MG Forces_And[OF M_genericD assms(1-5)]
+proof (intro iffI, elim bexE)
+  fix p
+  assume "p\<in>G" "p \<tturnstile> And(\<phi>,\<psi>) env"
+  with assms
+  show "M[G], map(val(P,G),env) \<Turnstile> And(\<phi>,\<psi>)"
+    using Forces_And[OF M_genericD, of _ _ _ \<phi> \<psi>] map_val_in_MG by auto
+next
+  assume "M[G], map(val(P,G),env) \<Turnstile> And(\<phi>,\<psi>)"
+  moreover
+  note assms
+  moreover from calculation
+  obtain q r where "q \<tturnstile> \<phi> env" "r \<tturnstile> \<psi> env" "q\<in>G" "r\<in>G"
+    using map_val_in_MG Forces_And[OF M_genericD assms(1-5)] by auto
+  moreover from calculation
+  obtain p where "p\<preceq>q" "p\<preceq>r" "p\<in>G"
+    by blast
+  moreover from calculation
+  have "(p \<tturnstile> \<phi> env) \<and> (p \<tturnstile> \<psi> env)" (* can't solve as separate goals *)
+    using strengthening_lemma by (blast)
+  ultimately
+  show "\<exists>p\<in>G. (p \<tturnstile> And(\<phi>,\<psi>) env)"
+    using Forces_And[OF M_genericD assms(1-5)] by auto
+qed
+
+definition
+  ren_truth_lemma :: "i\<Rightarrow>i" where
+  "ren_truth_lemma(\<phi>) \<equiv>
+    Exists(Exists(Exists(Exists(Exists(
+    And(Equal(0,5),And(Equal(1,8),And(Equal(2,9),And(Equal(3,10),And(Equal(4,6),
+    iterates(\<lambda>p. incr_bv(p)`5 , 6, \<phi>)))))))))))"
+
+lemma ren_truth_lemma_type[TC] :
+  "\<phi>\<in>formula \<Longrightarrow> ren_truth_lemma(\<phi>) \<in>formula"
+  unfolding ren_truth_lemma_def
+  by simp
+
+lemma arity_ren_truth :
+  assumes "\<phi>\<in>formula"
+  shows "arity(ren_truth_lemma(\<phi>)) \<le> 6 \<union> succ(arity(\<phi>))"
+proof -
+  consider (lt) "5 <arity(\<phi>)" | (ge) "\<not> 5 < arity(\<phi>)"
+    by auto
+  then
+  show ?thesis
+  proof cases
+    case lt
+    consider (a) "5<arity(\<phi>)+\<^sub>\<omega>5"  | (b) "arity(\<phi>)+\<^sub>\<omega>5 \<le> 5"
+      using not_lt_iff_le \<open>\<phi>\<in>_\<close> by force
+    then
+    show ?thesis
+    proof cases
+      case a
+      with \<open>\<phi>\<in>_\<close> lt
+      have "5 < succ(arity(\<phi>))" "5<arity(\<phi>)+\<^sub>\<omega>2"  "5<arity(\<phi>)+\<^sub>\<omega>3"  "5<arity(\<phi>)+\<^sub>\<omega>4"
+        using succ_ltI by auto
+      with \<open>\<phi>\<in>_\<close>
+      have c:"arity(iterates(\<lambda>p. incr_bv(p)`5,5,\<phi>)) = 5+\<^sub>\<omega>arity(\<phi>)" (is "arity(?\<phi>') = _")
+        using arity_incr_bv_lemma lt a
+        by simp
+      with \<open>\<phi>\<in>_\<close>
+      have "arity(incr_bv(?\<phi>')`5) = 6+\<^sub>\<omega>arity(\<phi>)"
+        using arity_incr_bv_lemma[of ?\<phi>' 5] a by auto
+      with \<open>\<phi>\<in>_\<close>
+      show ?thesis
+        unfolding ren_truth_lemma_def
+        using pred_Un_distrib union_abs1 Un_assoc[symmetric] a c union_abs2
+        by (simp add:arity)
+    next
+      case b
+      with \<open>\<phi>\<in>_\<close> lt
+      have "5 < succ(arity(\<phi>))" "5<arity(\<phi>)+\<^sub>\<omega>2"  "5<arity(\<phi>)+\<^sub>\<omega>3"  "5<arity(\<phi>)+\<^sub>\<omega>4" "5<arity(\<phi>)+\<^sub>\<omega>5"
+        using succ_ltI by auto
+      with \<open>\<phi>\<in>_\<close>
+      have "arity(iterates(\<lambda>p. incr_bv(p)`5,6,\<phi>)) = 6+\<^sub>\<omega>arity(\<phi>)" (is "arity(?\<phi>') = _")
+        using arity_incr_bv_lemma lt
+        by simp
+      with \<open>\<phi>\<in>_\<close>
+      show ?thesis
+        unfolding ren_truth_lemma_def
+        using pred_Un_distrib union_abs1 Un_assoc[symmetric]  union_abs2
+        by (simp add:arity)
+    qed
+  next
+    case ge
+    with \<open>\<phi>\<in>_\<close>
+    have "arity(\<phi>) \<le> 5" "pred^5(arity(\<phi>)) \<le> 5"
+      using not_lt_iff_le le_trans[OF le_pred]
+      by auto
+    with \<open>\<phi>\<in>_\<close>
+    have "arity(iterates(\<lambda>p. incr_bv(p)`5,6,\<phi>)) = arity(\<phi>)" "arity(\<phi>)\<le>6" "pred^5(arity(\<phi>)) \<le> 6"
+      using arity_incr_bv_lemma ge le_trans[OF \<open>arity(\<phi>)\<le>5\<close>] le_trans[OF \<open>pred^5(arity(\<phi>))\<le>5\<close>]
+      by auto
+    with \<open>arity(\<phi>) \<le> 5\<close> \<open>\<phi>\<in>_\<close> \<open>pred^5(_) \<le> 5\<close>
+    show ?thesis
+      unfolding ren_truth_lemma_def
+      using  pred_Un_distrib union_abs1 Un_assoc[symmetric] union_abs2
+      by (simp add:arity)
+  qed
+qed
+
+lemma sats_ren_truth_lemma:
+  "[q,b,d,a1,a2,a3] @ env \<in> list(M) \<Longrightarrow> \<phi> \<in> formula \<Longrightarrow>
+   (M, [q,b,d,a1,a2,a3] @ env \<Turnstile> ren_truth_lemma(\<phi>) ) \<longleftrightarrow>
+   (M, [q,a1,a2,a3,b] @ env \<Turnstile> \<phi>)"
+  unfolding ren_truth_lemma_def
+  by (insert sats_incr_bv_iff [of _ _ M _ "[q,a1,a2,a3,b]"], simp)
+
+lemma truth_lemma' :
+  assumes
+    "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>) \<le> succ(length(env))"
+  shows
+    "separation(##M,\<lambda>d. \<exists>b\<in>M. \<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env)))"
+proof -
+  let ?rel_pred="\<lambda>M x a1 a2 a3. \<exists>b\<in>M. \<forall>q\<in>M. q\<in>a1 \<and> is_leq(##M,a2,q,x) \<longrightarrow>
+                  \<not>(M, [q,a1,a2,a3,b] @ env \<Turnstile> forces(\<phi>))"
+  let ?\<psi>="Exists(Forall(Implies(And(Member(0,3),is_leq_fm(4,0,2)),
+          Neg(ren_truth_lemma(forces(\<phi>))))))"
+  have "q\<in>M" if "q\<in>P" for q using that transitivity[OF _ P_in_M] by simp
+  then
+  have 1:"\<forall>q\<in>M. q\<in>P \<and> R(q) \<longrightarrow> Q(q) \<Longrightarrow> (\<forall>q\<in>P. R(q) \<longrightarrow> Q(q))" for R Q
+    by auto
+  then
+  have "\<lbrakk>b \<in> M; \<forall>q\<in>M. q \<in> P \<and> q \<preceq> d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env))\<rbrakk> \<Longrightarrow>
+         \<exists>c\<in>M. \<forall>q\<in>P. q \<preceq> d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([c]@env))" for b d
+    by (rule bexI,simp_all)
+  then
+  have "?rel_pred(M,d,P,leq,\<one>) \<longleftrightarrow> (\<exists>b\<in>M. \<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env)))" if "d\<in>M" for d
+    using that leq_abs leq_in_M P_in_M one_in_M assms
+    by auto
+  moreover
+  have "?\<psi>\<in>formula" using assms by simp
+  moreover
+  have "(M, [d,P,leq,\<one>]@env \<Turnstile> ?\<psi>) \<longleftrightarrow> ?rel_pred(M,d,P,leq,\<one>)" if "d\<in>M" for d
+    using assms that P_in_M leq_in_M one_in_M sats_is_leq_fm sats_ren_truth_lemma zero_in_M
+    by simp
+  moreover
+  have "arity(?\<psi>) \<le> 4+\<^sub>\<omega>length(env)"
+  proof -
+    have eq:"arity(is_leq_fm(4, 0, 2)) = 5"
+      using arity_is_leq_fm succ_Un_distrib ord_simp_union
+      by simp
+    with \<open>\<phi>\<in>_\<close>
+    have "arity(?\<psi>) = 3 \<union> (pred^2(arity(ren_truth_lemma(forces(\<phi>)))))"
+      using union_abs1 pred_Un_distrib by (simp add:arity)
+    moreover
+    have "... \<le> 3 \<union> (pred(pred(6 \<union> succ(arity(forces(\<phi>))))))" (is "_ \<le> ?r")
+      using  \<open>\<phi>\<in>_\<close> Un_le_compat[OF le_refl[of 3]]
+        le_imp_subset arity_ren_truth[of "forces(\<phi>)"]
+        pred_mono
+      by auto
+    finally
+    have "arity(?\<psi>) \<le> ?r" by simp
+    have i:"?r \<le> 4 \<union> pred(arity(forces(\<phi>)))"
+      using pred_Un_distrib pred_succ_eq \<open>\<phi>\<in>_\<close> Un_assoc[symmetric] union_abs1 by simp
+    have h:"4 \<union> pred(arity(forces(\<phi>))) \<le> 4 \<union> (4+\<^sub>\<omega>length(env))"
+      using  \<open>env\<in>_\<close> add_commute \<open>\<phi>\<in>_\<close>
+        Un_le_compat[of 4 4,OF _ pred_mono[OF _ arity_forces_le[OF _ _ \<open>arity(\<phi>)\<le>_\<close>]] ]
+        \<open>env\<in>_\<close> by auto
+    with \<open>\<phi>\<in>_\<close> \<open>env\<in>_\<close>
+    show ?thesis
+      using le_trans[OF  \<open>arity(?\<psi>) \<le> ?r\<close>  le_trans[OF i h]] ord_simp_union by simp
+  qed
+  ultimately
+  show ?thesis using assms P_in_M leq_in_M one_in_M
+      separation_ax[of "?\<psi>" "[P,leq,\<one>]@env"]
+      separation_cong[of "##M" "\<lambda>y. (M, [y,P,leq,\<one>]@env \<Turnstile>?\<psi>)"]
+    by simp
+qed
+
+
+lemma truth_lemma:
+  assumes
+    "\<phi>\<in>formula" "M_generic(G)"
+    "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
+  shows
+    "(\<exists>p\<in>G. p \<tturnstile> \<phi> env)   \<longleftrightarrow>   M[G], map(val(P,G),env) \<Turnstile> \<phi>"
+  using assms
+proof (induct arbitrary:env)
+  case (Member x y)
+  then
+  show ?case
+    using assms truth_lemma_mem[OF \<open>env\<in>list(M)\<close> assms(2) \<open>x\<in>nat\<close> \<open>y\<in>nat\<close>]
+      arities_at_aux by simp
+next
+  case (Equal x y)
+  then
+  show ?case
+    using assms truth_lemma_eq[OF \<open>env\<in>list(M)\<close> assms(2) \<open>x\<in>nat\<close> \<open>y\<in>nat\<close>]
+      arities_at_aux by simp
+next
+  case (Nand \<phi> \<psi>)
+  moreover
+  note \<open>M_generic(G)\<close>
+  ultimately
+  show ?case
+    using truth_lemma_And truth_lemma_Neg[of "\<cdot>\<phi> \<and> \<psi>\<cdot>"] Forces_Nand_alt
+      M_genericD map_val_in_MG arity_Nand_le[of \<phi> \<psi>] FOL_arities by auto
+next
+  case (Forall \<phi>)
+  with \<open>M_generic(G)\<close>
+  show ?case
+  proof (intro iffI)
+    assume "\<exists>p\<in>G. (p \<tturnstile> Forall(\<phi>) env)"
+    with \<open>M_generic(G)\<close>
+    obtain p where "p\<in>G" "p\<in>M" "p\<in>P" "p \<tturnstile> Forall(\<phi>) env"
+      using transitivity[OF _ P_in_M] by auto
+    with \<open>env\<in>list(M)\<close> \<open>\<phi>\<in>formula\<close>
+    have "p \<tturnstile> \<phi> ([x]@env)" if "x\<in>M" for x
+      using that Forces_Forall by simp
+    with \<open>p\<in>G\<close> \<open>\<phi>\<in>formula\<close> \<open>env\<in>_\<close> \<open>arity(Forall(\<phi>)) \<le> length(env)\<close>
+      Forall(2)[of "Cons(_,env)"] \<open>M_generic(G)\<close>
+    show "M[G], map(val(P,G),env) \<Turnstile>  Forall(\<phi>)"
+      using pred_le2 map_val_in_MG
+      by (auto iff:GenExt_iff)
+  next
+    assume "M[G], map(val(P,G),env) \<Turnstile> Forall(\<phi>)"
+    let ?D1="{d\<in>P. (d \<tturnstile> Forall(\<phi>) env)}"
+    let ?D2="{d\<in>P. \<exists>b\<in>M. \<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b]@env))}"
+    define D where "D \<equiv> ?D1 \<union> ?D2"
+    have ar\<phi>:"arity(\<phi>)\<le>succ(length(env))"
+      using assms \<open>arity(Forall(\<phi>)) \<le> length(env)\<close> \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close> pred_le2
+      by simp
+    then
+    have "arity(Forall(\<phi>)) \<le> length(env)"
+      using pred_le \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close> by simp
+    then
+    have "?D1\<in>M" using Collect_forces ar\<phi> \<open>\<phi>\<in>formula\<close> \<open>env\<in>list(M)\<close> by simp
+    moreover from \<open>env\<in>list(M)\<close> \<open>\<phi>\<in>formula\<close>
+    have "?D2\<in>M"
+      using  truth_lemma'[of \<phi>] separation_closed ar\<phi> P_in_M
+      by simp
+    ultimately
+    have "D\<in>M" unfolding D_def using Un_closed by simp
+    moreover
+    have "D \<subseteq> P" unfolding D_def by auto
+    moreover
+    have "dense(D)"
+    proof
+      fix p
+      assume "p\<in>P"
+      show "\<exists>d\<in>D. d\<preceq> p"
+      proof (cases "p \<tturnstile> Forall(\<phi>) env")
+        case True
+        with \<open>p\<in>P\<close>
+        show ?thesis unfolding D_def using refl_leq by blast
+      next
+        case False
+        with Forall \<open>p\<in>P\<close>
+        obtain b where "b\<in>M" "\<not>(p \<tturnstile> \<phi> ([b]@env))"
+          using Forces_Forall by blast
+        moreover from this \<open>p\<in>P\<close> Forall
+        have "\<not>dense_below({q\<in>P. q \<tturnstile> \<phi> ([b]@env)},p)"
+          using density_lemma pred_le2  by auto
+        moreover from this
+        obtain d where "d\<preceq>p" "\<forall>q\<in>P. q\<preceq>d \<longrightarrow> \<not>(q \<tturnstile> \<phi> ([b] @ env))"
+          "d\<in>P" by blast
+        ultimately
+        show ?thesis unfolding D_def by auto
+      qed
+    qed
+    moreover
+    note \<open>M_generic(G)\<close>
+    ultimately
+    obtain d where "d \<in> D"  "d \<in> G" by blast
+    then
+    consider (1) "d\<in>?D1" | (2) "d\<in>?D2" unfolding D_def by blast
+    then
+    show "\<exists>p\<in>G. (p \<tturnstile> Forall(\<phi>) env)"
+    proof (cases)
+      case 1
+      with \<open>d\<in>G\<close>
+      show ?thesis by blast
+    next
+      case 2
+      then
+      obtain b where "b\<in>M" "\<forall>q\<in>P. q\<preceq>d \<longrightarrow>\<not>(q \<tturnstile> \<phi> ([b] @ env))"
+        by blast
+      moreover from this(1) and  \<open>M[G], _ \<Turnstile>  Forall(\<phi>)\<close> and
+        Forall(2)[of "Cons(b,env)"] Forall(1,3-5) \<open>M_generic(G)\<close>
+      obtain p where "p\<in>G" "p\<in>P" "p \<tturnstile> \<phi> ([b] @ env)"
+        using pred_le2 using map_val_in_MG by (auto iff:GenExt_iff)
+      moreover
+      note \<open>d\<in>G\<close> \<open>M_generic(G)\<close>
+      ultimately
+      obtain q where "q\<in>G" "q\<in>P" "q\<preceq>d" "q\<preceq>p" by blast
+      moreover from this and  \<open>p \<tturnstile> \<phi> ([b] @ env)\<close>
+        Forall  \<open>b\<in>M\<close> \<open>p\<in>P\<close>
+      have "q \<tturnstile> \<phi> ([b] @ env)"
+        using pred_le2 strengthening_lemma by simp
+      moreover
+      note \<open>\<forall>q\<in>P. q\<preceq>d \<longrightarrow>\<not>(q \<tturnstile> \<phi> ([b] @ env))\<close>
+      ultimately
+      show ?thesis by simp
+    qed
+  qed
+qed
+
+subsection\<open>The ``Definition of forcing''\<close>
+lemma definition_of_forcing:
+  assumes
+    "p\<in>P" "\<phi>\<in>formula" "env\<in>list(M)" "arity(\<phi>)\<le>length(env)"
+  shows
+    "(p \<tturnstile> \<phi> env) \<longleftrightarrow>
+     (\<forall>G. M_generic(G) \<and> p\<in>G  \<longrightarrow>  M[G], map(val(P,G),env) \<Turnstile> \<phi>)"
+proof (intro iffI allI impI, elim conjE)
+  fix G
+  assume "(p \<tturnstile> \<phi> env)" "M_generic(G)" "p \<in> G"
+  with assms
+  show "M[G], map(val(P,G),env) \<Turnstile> \<phi>"
+    using truth_lemma[of \<phi>] by blast
+next
+  assume 1: "\<forall>G.(M_generic(G)\<and> p\<in>G)\<longrightarrow> M[G] , map(val(P,G),env) \<Turnstile> \<phi>"
+  {
+    fix r
+    assume 2: "r\<in>P" "r\<preceq>p"
+    then
+    obtain G where "r\<in>G" "M_generic(G)"
+      text\<open>Here we're using countability (via the existence of
+        generic filters) of \<^term>\<open>M\<close> as a shortcut.\<close>
+      using generic_filter_existence by auto
+    moreover from calculation 2 \<open>p\<in>P\<close>
+    have "p\<in>G"
+      unfolding M_generic_def using filter_leqD by simp
+    moreover note 1
+    ultimately
+    have "M[G], map(val(P,G),env) \<Turnstile> \<phi>"
+      by simp
+    with assms \<open>M_generic(G)\<close>
+    obtain s where "s\<in>G" "(s \<tturnstile> \<phi> env)"
+      using truth_lemma[of \<phi>] by blast
+    moreover from this and  \<open>M_generic(G)\<close> \<open>r\<in>G\<close>
+    obtain q where "q\<in>G" "q\<preceq>s" "q\<preceq>r"
+      by blast
+    moreover from calculation \<open>s\<in>G\<close> \<open>M_generic(G)\<close>
+    have "s\<in>P" "q\<in>P"
+      unfolding M_generic_def filter_def by auto
+    moreover
+    note assms
+    ultimately
+    have "\<exists>q\<in>P. q\<preceq>r \<and> (q \<tturnstile> \<phi> env)"
+      using strengthening_lemma by blast
+  }
+  then
+  have "dense_below({q\<in>P. (q \<tturnstile> \<phi> env)},p)"
+    unfolding dense_below_def by blast
+  with assms
+  show "(p \<tturnstile> \<phi> env)"
+    using density_lemma by blast
+qed
+
+lemmas definability = forces_type
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Foundation_Axiom.thy b/thys/Independence_CH/Foundation_Axiom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Foundation_Axiom.thy
@@ -0,0 +1,40 @@
+section\<open>The Axiom of Foundation in $M[G]$\<close>
+
+theory Foundation_Axiom
+  imports
+    Names
+begin
+
+context forcing_data1
+begin
+
+(* Slick proof essentially by Paulson (adapted from L) *)
+lemma foundation_in_MG : "foundation_ax(##(M[G]))"
+  unfolding foundation_ax_def
+  by (rule rallI, cut_tac A=x in foundation, auto intro: transitivity_MG)
+
+(* Same theorem as above, declarative proof,
+   without using transitivity *)
+lemma "foundation_ax(##(M[G]))"
+proof -
+  {
+    fix x
+    assume "x\<in>M[G]" "\<exists>y\<in>M[G] . y\<in>x"
+    then
+    have "\<exists>y\<in>M[G] . y\<in>x\<inter>M[G]"
+      by simp
+    then
+    obtain y where "y\<in>x\<inter>M[G]" "\<forall>z\<in>y. z \<notin> x\<inter>M[G]"
+      using foundation[of "x\<inter>M[G]"]  by blast
+    then
+    have "\<exists>y\<in>M[G] . y \<in> x \<and> (\<forall>z\<in>M[G] . z \<notin> x \<or> z \<notin> y)"
+      by auto
+  }
+  then
+  show ?thesis
+    unfolding foundation_ax_def by auto
+qed
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/FrecR.thy b/thys/Independence_CH/FrecR.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/FrecR.thy
@@ -0,0 +1,640 @@
+section\<open>Well-founded relation on names\<close>
+theory FrecR
+  imports
+    Transitive_Models.Discipline_Function
+    Edrel
+begin
+
+text\<open>\<^term>\<open>frecR\<close> is the well-founded relation on names that allows
+us to define forcing for atomic formulas.\<close>
+
+definition
+  ftype :: "i\<Rightarrow>i" where
+  "ftype \<equiv> fst"
+
+definition
+  name1 :: "i\<Rightarrow>i" where
+  "name1(x) \<equiv> fst(snd(x))"
+
+definition
+  name2 :: "i\<Rightarrow>i" where
+  "name2(x) \<equiv> fst(snd(snd(x)))"
+
+definition
+  cond_of :: "i\<Rightarrow>i" where
+  "cond_of(x) \<equiv> snd(snd(snd((x))))"
+
+lemma components_simp:
+  "ftype(\<langle>f,n1,n2,c\<rangle>) = f"
+  "name1(\<langle>f,n1,n2,c\<rangle>) = n1"
+  "name2(\<langle>f,n1,n2,c\<rangle>) = n2"
+  "cond_of(\<langle>f,n1,n2,c\<rangle>) = c"
+  unfolding ftype_def name1_def name2_def cond_of_def
+  by simp_all
+
+definition eclose_n :: "[i\<Rightarrow>i,i] \<Rightarrow> i" where
+  "eclose_n(name,x) = eclose({name(x)})"
+
+definition
+  ecloseN :: "i \<Rightarrow> i" where
+  "ecloseN(x) = eclose_n(name1,x) \<union> eclose_n(name2,x)"
+
+lemma components_in_eclose :
+  "n1 \<in> ecloseN(\<langle>f,n1,n2,c\<rangle>)"
+  "n2 \<in> ecloseN(\<langle>f,n1,n2,c\<rangle>)"
+  unfolding ecloseN_def eclose_n_def
+  using components_simp arg_into_eclose by auto
+
+lemmas names_simp = components_simp(2) components_simp(3)
+
+lemma ecloseNI1 :
+  assumes "x \<in> eclose(n1) \<or> x\<in>eclose(n2)"
+  shows "x \<in> ecloseN(\<langle>f,n1,n2,c\<rangle>)"
+  unfolding ecloseN_def eclose_n_def
+  using assms eclose_sing names_simp
+  by auto
+
+lemmas ecloseNI = ecloseNI1
+
+lemma ecloseN_mono :
+  assumes "u \<in> ecloseN(x)" "name1(x) \<in> ecloseN(y)" "name2(x) \<in> ecloseN(y)"
+  shows "u \<in> ecloseN(y)"
+proof -
+  from \<open>u\<in>_\<close>
+  consider (a) "u\<in>eclose({name1(x)})" | (b) "u \<in> eclose({name2(x)})"
+    unfolding ecloseN_def  eclose_n_def by auto
+  then
+  show ?thesis
+  proof cases
+    case a
+    with \<open>name1(x) \<in> _\<close>
+    show ?thesis
+      unfolding ecloseN_def  eclose_n_def
+      using eclose_singE[OF a] mem_eclose_trans[of u "name1(x)" ] by auto
+  next
+    case b
+    with \<open>name2(x) \<in> _\<close>
+    show ?thesis
+      unfolding ecloseN_def eclose_n_def
+      using eclose_singE[OF b] mem_eclose_trans[of u "name2(x)"] by auto
+  qed
+qed
+
+definition
+  is_ftype :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
+  "is_ftype \<equiv> is_fst"
+
+definition
+  ftype_fm :: "[i,i] \<Rightarrow> i" where
+  "ftype_fm \<equiv> fst_fm"
+
+lemma is_ftype_iff_sats [iff_sats]:
+  assumes
+    "nth(a,env) = x" "nth(b,env) = y" "a\<in>nat" "b\<in>nat" "env \<in> list(A)"
+  shows
+    "is_ftype(##A,x,y)  \<longleftrightarrow> sats(A,ftype_fm(a,b), env)"
+  unfolding ftype_fm_def is_ftype_def
+  using assms sats_fst_fm
+  by simp
+
+definition
+  is_name1 :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
+  "is_name1(M,x,t2) \<equiv> is_hcomp(M,is_fst(M),is_snd(M),x,t2)"
+
+definition
+  name1_fm :: "[i,i] \<Rightarrow> i" where
+  "name1_fm(x,t) \<equiv> hcomp_fm(fst_fm,snd_fm,x,t)"
+
+lemma sats_name1_fm [simp]:
+  "\<lbrakk> x \<in> nat; y \<in> nat;env \<in> list(A) \<rbrakk> \<Longrightarrow>
+    (A, env \<Turnstile> name1_fm(x,y)) \<longleftrightarrow> is_name1(##A, nth(x,env), nth(y,env))"
+  unfolding name1_fm_def is_name1_def
+  using sats_fst_fm sats_snd_fm sats_hcomp_fm[of A "is_fst(##A)" _ fst_fm "is_snd(##A)"]
+  by simp
+
+lemma is_name1_iff_sats [iff_sats]:
+  assumes
+    "nth(a,env) = x" "nth(b,env) = y" "a\<in>nat" "b\<in>nat" "env \<in> list(A)"
+  shows
+    "is_name1(##A,x,y)  \<longleftrightarrow> A , env \<Turnstile> name1_fm(a,b)"
+  using assms sats_name1_fm
+  by simp
+
+definition
+  is_snd_snd :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
+  "is_snd_snd(M,x,t) \<equiv> is_hcomp(M,is_snd(M),is_snd(M),x,t)"
+
+definition
+  snd_snd_fm :: "[i,i]\<Rightarrow>i" where
+  "snd_snd_fm(x,t) \<equiv> hcomp_fm(snd_fm,snd_fm,x,t)"
+
+lemma sats_snd2_fm [simp]:
+  "\<lbrakk> x \<in> nat; y \<in> nat;env \<in> list(A) \<rbrakk> \<Longrightarrow>
+    (A, env  \<Turnstile> snd_snd_fm(x,y)) \<longleftrightarrow> is_snd_snd(##A, nth(x,env), nth(y,env))"
+  unfolding snd_snd_fm_def is_snd_snd_def
+  using sats_snd_fm sats_hcomp_fm[of A "is_snd(##A)" _ snd_fm "is_snd(##A)"]
+  by simp
+
+definition
+  is_name2 :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
+  "is_name2(M,x,t3) \<equiv> is_hcomp(M,is_fst(M),is_snd_snd(M),x,t3)"
+
+definition
+  name2_fm :: "[i,i] \<Rightarrow> i" where
+  "name2_fm(x,t3) \<equiv> hcomp_fm(fst_fm,snd_snd_fm,x,t3)"
+
+lemma sats_name2_fm :
+  "\<lbrakk> x \<in> nat; y \<in> nat;env \<in> list(A) \<rbrakk>
+    \<Longrightarrow> (A , env \<Turnstile> name2_fm(x,y)) \<longleftrightarrow> is_name2(##A, nth(x,env), nth(y,env))"
+  unfolding name2_fm_def is_name2_def
+  using sats_fst_fm sats_snd2_fm sats_hcomp_fm[of A "is_fst(##A)" _ fst_fm "is_snd_snd(##A)"]
+  by simp
+
+lemma is_name2_iff_sats [iff_sats]:
+  assumes
+    "nth(a,env) = x" "nth(b,env) = y" "a\<in>nat" "b\<in>nat" "env \<in> list(A)"
+  shows
+    "is_name2(##A,x,y)  \<longleftrightarrow> A, env \<Turnstile> name2_fm(a,b)"
+  using assms sats_name2_fm
+  by simp
+
+definition
+  is_cond_of :: "(i\<Rightarrow>o)\<Rightarrow>i\<Rightarrow>i\<Rightarrow>o" where
+  "is_cond_of(M,x,t4) \<equiv> is_hcomp(M,is_snd(M),is_snd_snd(M),x,t4)"
+
+definition
+  cond_of_fm :: "[i,i] \<Rightarrow> i" where
+  "cond_of_fm(x,t4) \<equiv> hcomp_fm(snd_fm,snd_snd_fm,x,t4)"
+
+lemma sats_cond_of_fm :
+  "\<lbrakk> x \<in> nat; y \<in> nat;env \<in> list(A) \<rbrakk> \<Longrightarrow>
+    (A, env \<Turnstile> cond_of_fm(x,y)) \<longleftrightarrow> is_cond_of(##A, nth(x,env), nth(y,env))"
+  unfolding cond_of_fm_def is_cond_of_def
+  using sats_snd_fm sats_snd2_fm sats_hcomp_fm[of A "is_snd(##A)" _ snd_fm "is_snd_snd(##A)"]
+  by simp
+
+lemma is_cond_of_iff_sats [iff_sats]:
+  assumes
+    "nth(a,env) = x" "nth(b,env) = y" "a\<in>nat" "b\<in>nat" "env \<in> list(A)"
+  shows
+    "is_cond_of(##A,x,y) \<longleftrightarrow> A, env \<Turnstile> cond_of_fm(a,b)"
+  using assms sats_cond_of_fm
+  by simp
+
+lemma components_type[TC] :
+  assumes "a\<in>nat" "b\<in>nat"
+  shows
+    "ftype_fm(a,b)\<in>formula"
+    "name1_fm(a,b)\<in>formula"
+    "name2_fm(a,b)\<in>formula"
+    "cond_of_fm(a,b)\<in>formula"
+  using assms
+  unfolding ftype_fm_def fst_fm_def snd_fm_def snd_snd_fm_def name1_fm_def name2_fm_def
+    cond_of_fm_def hcomp_fm_def
+  by simp_all
+
+lemmas components_iff_sats = is_ftype_iff_sats is_name1_iff_sats is_name2_iff_sats
+  is_cond_of_iff_sats
+
+lemmas components_defs = ftype_fm_def snd_snd_fm_def hcomp_fm_def
+  name1_fm_def name2_fm_def cond_of_fm_def
+
+definition
+  is_eclose_n :: "[i\<Rightarrow>o,[i\<Rightarrow>o,i,i]\<Rightarrow>o,i,i] \<Rightarrow> o" where
+  "is_eclose_n(N,is_name,en,t) \<equiv>
+        \<exists>n1[N].\<exists>s1[N]. is_name(N,t,n1) \<and> is_singleton(N,n1,s1) \<and> is_eclose(N,s1,en)"
+
+definition
+  eclose_n1_fm :: "[i,i] \<Rightarrow> i" where
+  "eclose_n1_fm(m,t) \<equiv> Exists(Exists(And(And(name1_fm(t+\<^sub>\<omega>2,0),singleton_fm(0,1)),
+                                       is_eclose_fm(1,m+\<^sub>\<omega>2))))"
+
+definition
+  eclose_n2_fm :: "[i,i] \<Rightarrow> i" where
+  "eclose_n2_fm(m,t) \<equiv> Exists(Exists(And(And(name2_fm(t+\<^sub>\<omega>2,0),singleton_fm(0,1)),
+                                       is_eclose_fm(1,m+\<^sub>\<omega>2))))"
+
+definition
+  is_ecloseN :: "[i\<Rightarrow>o,i,i] \<Rightarrow> o" where
+  "is_ecloseN(N,t,en) \<equiv> \<exists>en1[N].\<exists>en2[N].
+                is_eclose_n(N,is_name1,en1,t) \<and> is_eclose_n(N,is_name2,en2,t)\<and>
+                union(N,en1,en2,en)"
+
+definition
+  ecloseN_fm :: "[i,i] \<Rightarrow> i" where
+  "ecloseN_fm(en,t) \<equiv> Exists(Exists(And(eclose_n1_fm(1,t+\<^sub>\<omega>2),
+                            And(eclose_n2_fm(0,t+\<^sub>\<omega>2),union_fm(1,0,en+\<^sub>\<omega>2)))))"
+
+lemma ecloseN_fm_type [TC] :
+  "\<lbrakk> en \<in> nat ; t \<in> nat \<rbrakk> \<Longrightarrow> ecloseN_fm(en,t) \<in> formula"
+  unfolding ecloseN_fm_def eclose_n1_fm_def eclose_n2_fm_def by simp
+
+lemma sats_ecloseN_fm [simp]:
+  "\<lbrakk> en \<in> nat; t \<in> nat ; env \<in> list(A) \<rbrakk>
+    \<Longrightarrow> (A, env \<Turnstile> ecloseN_fm(en,t)) \<longleftrightarrow> is_ecloseN(##A,nth(t,env),nth(en,env))"
+  unfolding ecloseN_fm_def is_ecloseN_def eclose_n1_fm_def eclose_n2_fm_def is_eclose_n_def
+  using nth_0 nth_ConsI sats_name1_fm sats_name2_fm singleton_iff_sats[symmetric]
+  by auto
+
+lemma is_ecloseN_iff_sats [iff_sats]:
+  "\<lbrakk> nth(en, env) = ena; nth(t, env) = ta; en \<in> nat; t \<in> nat ; env \<in> list(A) \<rbrakk>
+    \<Longrightarrow> is_ecloseN(##A,ta,ena) \<longleftrightarrow> A, env \<Turnstile> ecloseN_fm(en,t)"
+  by simp
+
+(* Relation of forces *)
+definition
+  frecR :: "i \<Rightarrow> i \<Rightarrow> o" where
+  "frecR(x,y) \<equiv>
+    (ftype(x) = 1 \<and> ftype(y) = 0
+      \<and> (name1(x) \<in> domain(name1(y)) \<union> domain(name2(y)) \<and> (name2(x) = name1(y) \<or> name2(x) = name2(y))))
+   \<or> (ftype(x) = 0 \<and> ftype(y) =  1 \<and> name1(x) = name1(y) \<and> name2(x) \<in> domain(name2(y)))"
+
+lemma frecR_ftypeD :
+  assumes "frecR(x,y)"
+  shows "(ftype(x) = 0 \<and> ftype(y) = 1) \<or> (ftype(x) = 1 \<and> ftype(y) = 0)"
+  using assms unfolding frecR_def by auto
+
+lemma frecRI1: "s \<in> domain(n1) \<or> s \<in> domain(n2) \<Longrightarrow> frecR(\<langle>1, s, n1, q\<rangle>, \<langle>0, n1, n2, q'\<rangle>)"
+  unfolding frecR_def by (simp add:components_simp)
+
+lemma frecRI1': "s \<in> domain(n1) \<union> domain(n2) \<Longrightarrow> frecR(\<langle>1, s, n1, q\<rangle>, \<langle>0, n1, n2, q'\<rangle>)"
+  unfolding frecR_def by (simp add:components_simp)
+
+lemma frecRI2: "s \<in> domain(n1) \<or> s \<in> domain(n2) \<Longrightarrow> frecR(\<langle>1, s, n2, q\<rangle>, \<langle>0, n1, n2, q'\<rangle>)"
+  unfolding frecR_def by (simp add:components_simp)
+
+lemma frecRI2': "s \<in> domain(n1) \<union> domain(n2) \<Longrightarrow> frecR(\<langle>1, s, n2, q\<rangle>, \<langle>0, n1, n2, q'\<rangle>)"
+  unfolding frecR_def by (simp add:components_simp)
+
+lemma frecRI3: "\<langle>s, r\<rangle> \<in> n2 \<Longrightarrow> frecR(\<langle>0, n1, s, q\<rangle>, \<langle>1, n1, n2, q'\<rangle>)"
+  unfolding frecR_def by (auto simp add:components_simp)
+
+lemma frecRI3': "s \<in> domain(n2) \<Longrightarrow> frecR(\<langle>0, n1, s, q\<rangle>, \<langle>1, n1, n2, q'\<rangle>)"
+  unfolding frecR_def by (auto simp add:components_simp)
+
+lemma frecR_D1 :
+  "frecR(x,y) \<Longrightarrow> ftype(y) = 0 \<Longrightarrow> ftype(x) = 1 \<and>
+      (name1(x) \<in> domain(name1(y)) \<union> domain(name2(y)) \<and> (name2(x) = name1(y) \<or> name2(x) = name2(y)))"
+  unfolding frecR_def
+  by auto
+
+lemma frecR_D2 :
+  "frecR(x,y) \<Longrightarrow> ftype(y) = 1 \<Longrightarrow> ftype(x) = 0 \<and>
+      ftype(x) = 0 \<and> ftype(y) =  1 \<and> name1(x) = name1(y) \<and> name2(x) \<in> domain(name2(y))"
+  unfolding frecR_def
+  by auto
+
+lemma frecR_DI :
+  assumes "frecR(\<langle>a,b,c,d\<rangle>,\<langle>ftype(y),name1(y),name2(y),cond_of(y)\<rangle>)"
+  shows "frecR(\<langle>a,b,c,d\<rangle>,y)"
+  using assms
+  unfolding frecR_def
+  by (force simp add:components_simp)
+
+reldb_add "ftype" "is_ftype"
+reldb_add "name1" "is_name1"
+reldb_add "name2" "is_name2"
+
+relativize "frecR" "is_frecR"
+
+schematic_goal sats_frecR_fm_auto:
+  assumes
+    "i\<in>nat" "j\<in>nat" "env\<in>list(A)"
+  shows
+    "is_frecR(##A,nth(i,env),nth(j,env)) \<longleftrightarrow> A, env \<Turnstile> ?fr_fm(i,j)"
+  unfolding is_frecR_def
+  by (insert assms ; (rule sep_rules' cartprod_iff_sats components_iff_sats
+        | simp del:sats_cartprod_fm)+)
+
+synthesize "frecR" from_schematic sats_frecR_fm_auto
+
+text\<open>Third item of Kunen's observations (p. 257) about the trcl relation.\<close>
+lemma eq_ftypep_not_frecrR:
+  assumes "ftype(x) = ftype(y)"
+  shows "\<not> frecR(x,y)"
+  using assms frecR_ftypeD by force
+
+definition
+  rank_names :: "i \<Rightarrow> i" where
+  "rank_names(x) \<equiv> max(rank(name1(x)),rank(name2(x)))"
+
+lemma rank_names_types [TC]:
+  shows "Ord(rank_names(x))"
+  unfolding rank_names_def max_def using Ord_rank Ord_Un by auto
+
+definition
+  mtype_form :: "i \<Rightarrow> i" where
+  "mtype_form(x) \<equiv> if rank(name1(x)) < rank(name2(x)) then 0 else 2"
+
+definition
+  type_form :: "i \<Rightarrow> i" where
+  "type_form(x) \<equiv> if ftype(x) = 0 then 1 else mtype_form(x)"
+
+lemma type_form_tc [TC]:
+  shows "type_form(x) \<in> 3"
+  unfolding type_form_def mtype_form_def by auto
+
+lemma frecR_le_rnk_names :
+  assumes  "frecR(x,y)"
+  shows "rank_names(x)\<le>rank_names(y)"
+proof -
+  obtain a b c d where
+    H: "a = name1(x)" "b = name2(x)"
+    "c = name1(y)" "d = name2(y)"
+    "(a \<in> domain(c)\<union>domain(d) \<and> (b=c \<or> b = d)) \<or> (a = c \<and> b \<in> domain(d))"
+    using assms
+    unfolding frecR_def
+    by force
+  then
+  consider
+    (m) "a \<in> domain(c) \<and> (b = c \<or> b = d) "
+    | (n) "a \<in> domain(d) \<and> (b = c \<or> b = d)"
+    | (o) "b \<in> domain(d) \<and> a = c"
+    by auto
+  then
+  show ?thesis
+  proof(cases)
+    case m
+    then
+    have "rank(a) < rank(c)"
+      using eclose_rank_lt  in_dom_in_eclose
+      by simp
+    with \<open>rank(a) < rank(c)\<close> H m
+    show ?thesis
+      unfolding rank_names_def
+      using Ord_rank max_cong max_cong2 leI
+      by auto
+  next
+    case n
+    then
+    have "rank(a) < rank(d)"
+      using eclose_rank_lt in_dom_in_eclose
+      by simp
+    with \<open>rank(a) < rank(d)\<close> H n
+    show ?thesis
+      unfolding rank_names_def
+      using Ord_rank max_cong2 max_cong max_commutes[of "rank(c)" "rank(d)"] leI
+      by auto
+  next
+    case o
+    then
+    have "rank(b) < rank(d)" (is "?b < ?d") "rank(a) = rank(c)" (is "?a = _")
+      using eclose_rank_lt in_dom_in_eclose
+      by simp_all
+    with H
+    show ?thesis
+      unfolding rank_names_def
+      using Ord_rank max_commutes max_cong2[OF leI[OF \<open>?b < ?d\<close>], of ?a]
+      by simp
+  qed
+qed
+
+definition
+  \<Gamma> :: "i \<Rightarrow> i" where
+  "\<Gamma>(x) = 3 ** rank_names(x) ++ type_form(x)"
+
+lemma \<Gamma>_type [TC]:
+  shows "Ord(\<Gamma>(x))"
+  unfolding \<Gamma>_def by simp
+
+lemma \<Gamma>_mono :
+  assumes "frecR(x,y)"
+  shows "\<Gamma>(x) < \<Gamma>(y)"
+proof -
+  have F: "type_form(x) < 3" "type_form(y) < 3"
+    using ltI
+    by simp_all
+  from assms
+  have A: "rank_names(x) \<le> rank_names(y)" (is "?x \<le> ?y")
+    using frecR_le_rnk_names
+    by simp
+  then
+  have "Ord(?y)"
+    unfolding rank_names_def
+    using Ord_rank max_def
+    by simp
+  note leE[OF \<open>?x\<le>?y\<close>]
+  then
+  show ?thesis
+  proof(cases)
+    case 1
+    then
+    show ?thesis
+      unfolding \<Gamma>_def
+      using oadd_lt_mono2 \<open>?x < ?y\<close> F
+      by auto
+  next
+    case 2
+    consider (a) "ftype(x) = 0 \<and> ftype(y) = 1" | (b) "ftype(x) = 1 \<and> ftype(y) = 0"
+      using frecR_ftypeD[OF \<open>frecR(x,y)\<close>]
+      by auto
+    then show ?thesis
+    proof(cases)
+      case b
+      moreover from this
+      have "type_form(y) = 1"
+        using type_form_def by simp
+      moreover from calculation
+      have "name2(x) = name1(y) \<or> name2(x) = name2(y) "  (is "?\<tau> = ?\<sigma>' \<or> ?\<tau> = ?\<tau>'")
+        "name1(x) \<in> domain(name1(y)) \<union> domain(name2(y))" (is "?\<sigma> \<in> domain(?\<sigma>') \<union> domain(?\<tau>')")
+        using assms unfolding type_form_def frecR_def by auto
+      moreover from calculation
+      have E: "rank(?\<tau>) = rank(?\<sigma>') \<or> rank(?\<tau>) = rank(?\<tau>')" by auto
+      from calculation
+      consider (c) "rank(?\<sigma>) < rank(?\<sigma>')" |  (d) "rank(?\<sigma>) < rank(?\<tau>')"
+        using eclose_rank_lt in_dom_in_eclose by force
+      then
+      have "rank(?\<sigma>) < rank(?\<tau>)"
+      proof (cases)
+        case c
+        with \<open>rank_names(x) = rank_names(y) \<close>
+        show ?thesis
+          unfolding rank_names_def mtype_form_def type_form_def
+          using max_D2[OF E c] E assms Ord_rank
+          by simp
+      next
+        case d
+        with \<open>rank_names(x) = rank_names(y) \<close>
+        show ?thesis
+          unfolding rank_names_def mtype_form_def type_form_def
+          using max_D2[OF _ d] max_commutes E assms Ord_rank disj_commute
+          by simp
+      qed
+      with b
+      have "type_form(x) = 0" unfolding type_form_def mtype_form_def by simp
+      with \<open>rank_names(x) = rank_names(y) \<close> \<open>type_form(y) = 1\<close> \<open>type_form(x) = 0\<close>
+      show ?thesis
+        unfolding \<Gamma>_def by auto
+    next
+      case a
+      then
+      have "name1(x) = name1(y)" (is "?\<sigma> = ?\<sigma>'")
+        "name2(x) \<in> domain(name2(y))" (is "?\<tau> \<in> domain(?\<tau>')")
+        "type_form(x) = 1"
+        using assms
+        unfolding type_form_def frecR_def
+        by auto
+      then
+      have "rank(?\<sigma>) = rank(?\<sigma>')" "rank(?\<tau>) < rank(?\<tau>')"
+        using  eclose_rank_lt in_dom_in_eclose
+        by simp_all
+      with \<open>rank_names(x) = rank_names(y) \<close>
+      have "rank(?\<tau>') \<le> rank(?\<sigma>')"
+        using Ord_rank max_D1
+        unfolding rank_names_def
+        by simp
+      with a
+      have "type_form(y) = 2"
+        unfolding type_form_def mtype_form_def
+        using not_lt_iff_le assms
+        by simp
+      with \<open>rank_names(x) = rank_names(y) \<close> \<open>type_form(y) = 2\<close> \<open>type_form(x) = 1\<close>
+      show ?thesis
+        unfolding \<Gamma>_def by auto
+    qed
+  qed
+qed
+
+definition
+  frecrel :: "i \<Rightarrow> i" where
+  "frecrel(A) \<equiv> Rrel(frecR,A)"
+
+lemma frecrelI :
+  assumes "x \<in> A" "y\<in>A" "frecR(x,y)"
+  shows "\<langle>x,y\<rangle>\<in>frecrel(A)"
+  using assms unfolding frecrel_def Rrel_def by auto
+
+lemma frecrelD :
+  assumes "\<langle>x,y\<rangle> \<in> frecrel(A1\<times>A2\<times>A3\<times>A4)"
+  shows
+    "ftype(x) \<in> A1" "ftype(x) \<in> A1"
+    "name1(x) \<in> A2" "name1(y) \<in> A2"
+    "name2(x) \<in> A3" "name2(x) \<in> A3"
+    "cond_of(x) \<in> A4" "cond_of(y) \<in> A4"
+    "frecR(x,y)"
+  using assms
+  unfolding frecrel_def Rrel_def ftype_def by (auto simp add:components_simp)
+
+lemma wf_frecrel :
+  shows "wf(frecrel(A))"
+proof -
+  have "frecrel(A) \<subseteq> measure(A,\<Gamma>)"
+    unfolding frecrel_def Rrel_def measure_def
+    using \<Gamma>_mono
+    by force
+  then
+  show ?thesis
+    using wf_subset wf_measure by auto
+qed
+
+lemma core_induction_aux:
+  fixes A1 A2 :: "i"
+  assumes
+    "Transset(A1)"
+    "\<And>\<tau> \<theta> p.  p \<in> A2 \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk> q\<in>A2 ; \<sigma>\<in>domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<sigma>,q)\<rbrakk> \<Longrightarrow> Q(1,\<tau>,\<theta>,p)"
+    "\<And>\<tau> \<theta> p.  p \<in> A2 \<Longrightarrow> \<lbrakk>\<And>q \<sigma>. \<lbrakk> q\<in>A2 ; \<sigma>\<in>domain(\<tau>) \<union> domain(\<theta>)\<rbrakk> \<Longrightarrow> Q(1,\<sigma>,\<tau>,q) \<and> Q(1,\<sigma>,\<theta>,q)\<rbrakk> \<Longrightarrow> Q(0,\<tau>,\<theta>,p)"
+  shows "a\<in>2\<times>A1\<times>A1\<times>A2 \<Longrightarrow> Q(ftype(a),name1(a),name2(a),cond_of(a))"
+proof (induct a rule:wf_induct[OF wf_frecrel[of "2\<times>A1\<times>A1\<times>A2"]])
+  case (1 x)
+  let ?\<tau> = "name1(x)"
+  let ?\<theta> = "name2(x)"
+  let ?D = "2\<times>A1\<times>A1\<times>A2"
+  assume "x \<in> ?D"
+  then
+  have "cond_of(x)\<in>A2"
+    by (auto simp add:components_simp)
+  from \<open>x\<in>?D\<close>
+  consider (eq) "ftype(x)=0" | (mem) "ftype(x)=1"
+    by (auto simp add:components_simp)
+  then
+  show ?case
+  proof cases
+    case eq
+    then
+    have "Q(1, \<sigma>, ?\<tau>, q) \<and> Q(1, \<sigma>, ?\<theta>, q)" if "\<sigma> \<in> domain(?\<tau>) \<union> domain(?\<theta>)" and "q\<in>A2" for q \<sigma>
+    proof -
+      from 1
+      have "?\<tau>\<in>A1" "?\<theta>\<in>A1" "?\<tau>\<in>eclose(A1)" "?\<theta>\<in>eclose(A1)"
+        using  arg_into_eclose
+        by (auto simp add:components_simp)
+      moreover from \<open>Transset(A1)\<close> that(1)
+      have "\<sigma>\<in>eclose(?\<tau>) \<union> eclose(?\<theta>)"
+        using in_dom_in_eclose
+        by auto
+      then
+      have "\<sigma>\<in>A1"
+        using mem_eclose_subset[OF \<open>?\<tau>\<in>A1\<close>] mem_eclose_subset[OF \<open>?\<theta>\<in>A1\<close>]
+          Transset_eclose_eq_arg[OF \<open>Transset(A1)\<close>]
+        by auto
+      with \<open>q\<in>A2\<close> \<open>?\<theta> \<in> A1\<close> \<open>cond_of(x)\<in>A2\<close> \<open>?\<tau>\<in>A1\<close>
+      have "frecR(\<langle>1, \<sigma>, ?\<tau>, q\<rangle>, x)" (is "frecR(?T,_)")
+           "frecR(\<langle>1, \<sigma>, ?\<theta>, q\<rangle>, x)" (is "frecR(?U,_)")
+        using frecRI1'[OF that(1)] frecR_DI  \<open>ftype(x) = 0\<close>
+          frecRI2'[OF that(1)]
+        by (auto simp add:components_simp)
+      with \<open>x\<in>?D\<close> \<open>\<sigma>\<in>A1\<close> \<open>q\<in>A2\<close>
+      have "\<langle>?T,x\<rangle>\<in> frecrel(?D)" "\<langle>?U,x\<rangle>\<in> frecrel(?D)"
+        using frecrelI[of ?T ?D x]  frecrelI[of ?U ?D x]
+        by (auto simp add:components_simp)
+      with \<open>q\<in>A2\<close> \<open>\<sigma>\<in>A1\<close> \<open>?\<tau>\<in>A1\<close> \<open>?\<theta>\<in>A1\<close>
+      have "Q(1, \<sigma>, ?\<tau>, q)"
+        using 1
+        by (force simp add:components_simp)
+      moreover from \<open>q\<in>A2\<close> \<open>\<sigma>\<in>A1\<close> \<open>?\<tau>\<in>A1\<close> \<open>?\<theta>\<in>A1\<close> \<open>\<langle>?U,x\<rangle>\<in> frecrel(?D)\<close>
+      have "Q(1, \<sigma>, ?\<theta>, q)"
+        using 1 by (force simp add:components_simp)
+      ultimately
+      show ?thesis
+        by simp
+    qed
+    with assms(3) \<open>ftype(x) = 0\<close> \<open>cond_of(x)\<in>A2\<close>
+    show ?thesis
+      by auto
+  next
+    case mem
+    have "Q(0, ?\<tau>,  \<sigma>, q)" if "\<sigma> \<in> domain(?\<theta>)" and "q\<in>A2" for q \<sigma>
+    proof -
+      from 1 assms
+      have "?\<tau>\<in>A1" "?\<theta>\<in>A1" "cond_of(x)\<in>A2" "?\<tau>\<in>eclose(A1)" "?\<theta>\<in>eclose(A1)"
+        using arg_into_eclose
+        by (auto simp add:components_simp)
+      with  \<open>Transset(A1)\<close> that(1)
+      have "\<sigma>\<in> eclose(?\<theta>)"
+        using in_dom_in_eclose
+        by auto
+      then
+      have "\<sigma>\<in>A1"
+        using mem_eclose_subset[OF \<open>?\<theta>\<in>A1\<close>] Transset_eclose_eq_arg[OF \<open>Transset(A1)\<close>]
+        by auto
+      with \<open>q\<in>A2\<close> \<open>?\<theta> \<in> A1\<close> \<open>cond_of(x)\<in>A2\<close> \<open>?\<tau>\<in>A1\<close> \<open>ftype(x) = 1\<close>
+      have "frecR(\<langle>0, ?\<tau>, \<sigma>, q\<rangle>, x)" (is "frecR(?T,_)")
+        using frecRI3'[OF that(1)] frecR_DI
+        by (auto simp add:components_simp)
+      with \<open>x\<in>?D\<close> \<open>\<sigma>\<in>A1\<close> \<open>q\<in>A2\<close> \<open>?\<tau>\<in>A1\<close>
+      have "\<langle>?T,x\<rangle>\<in> frecrel(?D)" "?T\<in>?D"
+        using frecrelI[of ?T ?D x]
+        by (auto simp add:components_simp)
+      with \<open>q\<in>A2\<close> \<open>\<sigma>\<in>A1\<close> \<open>?\<tau>\<in>A1\<close> \<open>?\<theta>\<in>A1\<close> 1
+      show ?thesis
+        by (force simp add:components_simp)
+    qed
+    with assms(2) \<open>ftype(x) = 1\<close> \<open>cond_of(x)\<in>A2\<close>
+    show ?thesis
+      by auto
+  qed
+qed
+
+lemma def_frecrel : "frecrel(A) = {z\<in>A\<times>A. \<exists>x y. z = \<langle>x, y\<rangle> \<and> frecR(x,y)}"
+  unfolding frecrel_def Rrel_def ..
+
+lemma frecrel_fst_snd:
+  "frecrel(A) = {z \<in> A\<times>A .
+            ftype(fst(z)) = 1 \<and>
+        ftype(snd(z)) = 0 \<and> name1(fst(z)) \<in> domain(name1(snd(z))) \<union> domain(name2(snd(z))) \<and>
+            (name2(fst(z)) = name1(snd(z)) \<or> name2(fst(z)) = name2(snd(z)))
+          \<or> (ftype(fst(z)) = 0 \<and>
+        ftype(snd(z)) = 1 \<and>  name1(fst(z)) = name1(snd(z)) \<and> name2(fst(z)) \<in> domain(name2(snd(z))))}"
+  unfolding def_frecrel frecR_def
+  by (intro equalityI subsetI CollectI; elim CollectE; auto)
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/FrecR_Arities.thy b/thys/Independence_CH/FrecR_Arities.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/FrecR_Arities.thy
@@ -0,0 +1,79 @@
+theory FrecR_Arities
+  imports
+    FrecR
+begin
+
+context
+  notes FOL_arities[simp]
+begin
+
+arity_theorem intermediate for "fst_fm"
+lemma arity_fst_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(fst_fm(x,t)) = succ(x) \<union> succ(t)"
+  using arity_fst_fm'
+  by auto
+
+arity_theorem intermediate for "snd_fm"
+lemma arity_snd_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(snd_fm(x,t)) = succ(x) \<union> succ(t)"
+  using arity_snd_fm'
+  by auto
+
+lemma arity_snd_snd_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(snd_snd_fm(x,t)) = succ(x) \<union> succ(t)"
+  unfolding snd_snd_fm_def hcomp_fm_def
+  using arity_snd_fm arity_empty_fm union_abs2 pred_Un_distrib
+  by auto
+
+lemma arity_ftype_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(ftype_fm(x,t)) = succ(x) \<union> succ(t)"
+  unfolding ftype_fm_def
+  using arity_fst_fm
+  by auto
+
+lemma arity_name1_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(name1_fm(x,t)) = succ(x) \<union> succ(t)"
+  unfolding name1_fm_def hcomp_fm_def
+  using arity_fst_fm arity_snd_fm union_abs2 pred_Un_distrib
+  by auto
+
+lemma arity_name2_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(name2_fm(x,t)) = succ(x) \<union> succ(t)"
+  unfolding name2_fm_def hcomp_fm_def
+  using arity_fst_fm arity_snd_snd_fm union_abs2 pred_Un_distrib
+  by auto
+
+lemma arity_cond_of_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(cond_of_fm(x,t)) = succ(x) \<union> succ(t)"
+  unfolding cond_of_fm_def hcomp_fm_def
+  using arity_snd_fm arity_snd_snd_fm union_abs2 pred_Un_distrib
+  by auto
+
+lemma arity_eclose_n1_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(eclose_n1_fm(x,t)) = succ(x) \<union> succ(t)"
+  unfolding eclose_n1_fm_def
+  using arity_is_eclose_fm arity_singleton_fm arity_name1_fm union_abs2 pred_Un_distrib
+  by auto
+
+lemma arity_eclose_n2_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(eclose_n2_fm(x,t)) = succ(x) \<union> succ(t)"
+  unfolding eclose_n2_fm_def
+  using arity_is_eclose_fm arity_singleton_fm arity_name2_fm union_abs2 pred_Un_distrib
+  by auto
+
+lemma arity_ecloseN_fm [arity] :
+  "\<lbrakk>x\<in>nat ; t\<in>nat\<rbrakk> \<Longrightarrow> arity(ecloseN_fm(x,t)) = succ(x) \<union> succ(t)"
+  unfolding ecloseN_fm_def
+  using arity_eclose_n1_fm arity_eclose_n2_fm arity_union_fm union_abs2 pred_Un_distrib
+  by auto
+
+lemma arity_frecR_fm [arity]:
+  "\<lbrakk>a\<in>nat;b\<in>nat\<rbrakk> \<Longrightarrow> arity(frecR_fm(a,b)) = succ(a) \<union> succ(b)"
+  unfolding frecR_fm_def
+  using arity_ftype_fm arity_name1_fm arity_name2_fm arity_domain_fm
+      arity_empty_fm arity_union_fm pred_Un_distrib arity_succ_fm
+  by auto
+
+end \<comment> \<open>@{thm [source] FOL_arities}\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Infinity_Axiom.thy b/thys/Independence_CH/Infinity_Axiom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Infinity_Axiom.thy
@@ -0,0 +1,37 @@
+section\<open>The Axiom of Infinity in $M[G]$\<close>
+theory Infinity_Axiom
+  imports Separation_Axiom Union_Axiom Pairing_Axiom
+begin
+
+context G_generic1 begin
+
+interpretation mg_triv: M_trivial"##M[G]"
+  using transitivity_MG zero_in_MG generic Union_MG pairing_in_MG
+  by unfold_locales auto
+
+lemma infinity_in_MG : "infinity_ax(##M[G])"
+proof -
+  from infinity_ax
+  obtain I where "I\<in>M" "0 \<in> I" "\<forall>y\<in>M. y \<in> I \<longrightarrow> succ(y) \<in> I"
+    unfolding infinity_ax_def  by auto
+  then
+  have "check(I) \<in> M"
+    using check_in_M by simp
+  then
+  have "I\<in> M[G]"
+    using valcheck generic one_in_G one_in_P GenExtI[of "check(I)" G] by simp
+  moreover from this \<open>I\<in>M[G]\<close> \<open>\<forall>y\<in>M. y \<in> I \<longrightarrow> succ(y) \<in> I\<close>
+  have "succ(y) \<in> I \<inter> M[G]" if "y \<in> I" for y
+    using that transitivity_MG transitivity[OF _ \<open>I\<in>M\<close>] by blast
+  moreover
+  note \<open>0\<in>I\<close>
+  ultimately
+  show ?thesis
+    using transitivity_MG[of _ I]
+    unfolding infinity_ax_def
+    by auto
+qed
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Interface.thy b/thys/Independence_CH/Interface.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Interface.thy
@@ -0,0 +1,1535 @@
+section\<open>Interface between set models and Constructibility\<close>
+
+text\<open>This theory provides an interface between Paulson's
+relativization results and set models of ZFC. In particular,
+it is used to prove that the locale \<^term>\<open>forcing_data\<close> is
+a sublocale of all relevant locales in \<^session>\<open>ZF-Constructible\<close>
+(\<^term>\<open>M_trivial\<close>, \<^term>\<open>M_basic\<close>, \<^term>\<open>M_eclose\<close>, etc).
+
+In order to interpret the locales in \<^session>\<open>ZF-Constructible\<close> we
+introduce new locales, each stronger than the previous one, assuming
+only the instances of Replacement needed to interpret the subsequent
+locales of that session. From the start we assume Separation for
+every internalized formula (with one parameter, but this is not a
+problem since we can use pairing).\<close>
+
+theory Interface
+  imports
+    Fm_Definitions
+    Transitive_Models.Cardinal_AC_Relative
+    Transitive_Models.M_Basic_No_Repl
+begin
+
+locale M_Z_basic =
+  fixes M
+  assumes
+    upair_ax:      "upair_ax(##M)" and
+    Union_ax:      "Union_ax(##M)" and
+    power_ax:      "power_ax(##M)" and
+    extensionality:"extensionality(##M)" and
+    foundation_ax: "foundation_ax(##M)" and
+    infinity_ax:   "infinity_ax(##M)" and
+    separation_ax: "\<phi> \<in> formula \<Longrightarrow> env \<in> list(M) \<Longrightarrow>
+                    arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<Longrightarrow>
+                    separation(##M,\<lambda>x. (M, [x] @ env \<Turnstile> \<phi>))"
+
+locale M_transset =
+  fixes M
+  assumes
+    trans_M:       "Transset(M)"
+
+locale M_Z_trans = M_Z_basic + M_transset
+
+locale M_ZF1 = M_Z_basic +
+  assumes
+    replacement_ax1:
+    "replacement_assm(M,env,wfrec_Hfrc_at_fm)"
+    "replacement_assm(M,env,list_repl1_intf_fm)"
+    "replacement_assm(M,env,list_repl2_intf_fm)"
+    "replacement_assm(M,env,formula_repl2_intf_fm)"
+    "replacement_assm(M,env,eclose_repl2_intf_fm)"
+    "replacement_assm(M,env,powapply_repl_fm)"
+    "replacement_assm(M,env,phrank_repl_fm)"
+    "replacement_assm(M,env,wfrec_rank_fm)"
+    "replacement_assm(M,env,trans_repl_HVFrom_fm)"
+    "replacement_assm(M,env,wfrec_Hcheck_fm)"
+    "replacement_assm(M,env,repl_PHcheck_fm)"
+    "replacement_assm(M,env,check_replacement_fm)"
+    "replacement_assm(M,env,G_dot_in_M_fm)"
+    "replacement_assm(M,env,repl_opname_check_fm)"
+    "replacement_assm(M,env,tl_repl_intf_fm)"
+    "replacement_assm(M,env,formula_repl1_intf_fm)"
+    "replacement_assm(M,env,eclose_repl1_intf_fm)"
+
+definition instances1_fms where "instances1_fms \<equiv>
+  { wfrec_Hfrc_at_fm,
+    list_repl1_intf_fm,
+    list_repl2_intf_fm,
+    formula_repl2_intf_fm,
+    eclose_repl2_intf_fm,
+    powapply_repl_fm,
+    phrank_repl_fm,
+    wfrec_rank_fm,
+    trans_repl_HVFrom_fm,
+    wfrec_Hcheck_fm,
+    repl_PHcheck_fm,
+    check_replacement_fm,
+    G_dot_in_M_fm,
+    repl_opname_check_fm,
+    tl_repl_intf_fm,
+    formula_repl1_intf_fm,
+    eclose_repl1_intf_fm }"
+
+txt\<open>This set has 17 internalized formulas.\<close>
+
+lemmas replacement_instances1_defs = tl_repl_intf_fm_def formula_repl1_intf_fm_def
+  eclose_repl1_intf_fm_def wfrec_Hfrc_at_fm_def
+  list_repl1_intf_fm_def list_repl2_intf_fm_def formula_repl2_intf_fm_def
+  eclose_repl2_intf_fm_def powapply_repl_fm_def phrank_repl_fm_def wfrec_rank_fm_def
+  trans_repl_HVFrom_fm_def wfrec_Hcheck_fm_def repl_PHcheck_fm_def check_replacement_fm_def
+  G_dot_in_M_fm_def repl_opname_check_fm_def
+
+lemma instances1_fms_type[TC]: "instances1_fms \<subseteq> formula"
+  unfolding replacement_instances1_defs instances1_fms_def by simp
+
+declare (in M_ZF1) replacement_instances1_defs[simp]
+
+locale M_ZF1_trans = M_ZF1 + M_Z_trans
+
+context M_Z_trans
+begin
+
+lemmas transitivity = Transset_intf[OF trans_M]
+
+subsection\<open>Interface with \<^term>\<open>M_trivial\<close>\<close>
+
+lemma zero_in_M:  "0 \<in> M"
+proof -
+  obtain z where "empty(##M,z)"  "z\<in>M"
+    using empty_intf[OF infinity_ax]
+    by auto
+  moreover from this
+  have "z=0"
+    using transitivity empty_def
+    by auto
+  ultimately
+  show ?thesis
+    by simp
+qed
+
+lemma separation_in_ctm :
+  assumes
+    "\<phi> \<in> formula" "env\<in>list(M)"
+    "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" and
+    satsQ: "\<And>x. x\<in>M \<Longrightarrow> (M, [x]@env \<Turnstile> \<phi>) \<longleftrightarrow> Q(x)"
+  shows
+    "separation(##M,Q)"
+  using assms separation_ax satsQ transitivity
+    separation_cong[of "##M" "\<lambda>y. (M, [y]@env \<Turnstile> \<phi>)" "Q"]
+  by simp
+
+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
+
+locale M_ZC_basic = M_Z_basic + M_AC "##M"
+
+locale M_ZFC1 = M_ZF1 + M_ZC_basic
+
+locale M_ZFC1_trans = M_ZF1_trans + M_ZFC1
+
+sublocale M_Z_trans \<subseteq> M_trans "##M"
+  using transitivity zero_in_M exI[of "\<lambda>x. x\<in>M"]
+  by unfold_locales simp_all
+
+sublocale M_Z_trans \<subseteq> M_trivial "##M"
+  using upair_ax Union_ax by unfold_locales
+
+subsection\<open>Interface with \<^term>\<open>M_basic\<close>\<close>
+
+definition Intersection where
+  "Intersection(N,B,x) \<equiv> (\<forall>y[N]. y\<in>B \<longrightarrow> x\<in>y)"
+
+synthesize "Intersection" from_definition "Intersection" assuming "nonempty"
+arity_theorem for "Intersection_fm"
+
+definition CartProd where
+  "CartProd(N,B,C,z) \<equiv> (\<exists>x[N]. x\<in>B \<and> (\<exists>y[N]. y\<in>C \<and> pair(N,x,y,z)))"
+
+synthesize "CartProd" from_definition "CartProd" assuming "nonempty"
+arity_theorem for "CartProd_fm"
+
+definition Image where
+  "Image(N,B,r,y) \<equiv> (\<exists>p[N]. p\<in>r \<and> (\<exists>x[N]. x\<in>B \<and> pair(N,x,y,p)))"
+
+synthesize "Image" from_definition "Image" assuming "nonempty"
+arity_theorem for "Image_fm"
+
+definition Converse where
+  "Converse(N,R,z) \<equiv> \<exists>p[N]. p\<in>R \<and> (\<exists>x[N].\<exists>y[N]. pair(N,x,y,p) \<and> pair(N,y,x,z))"
+
+synthesize "Converse" from_definition "Converse" assuming "nonempty"
+arity_theorem for "Converse_fm"
+
+definition Restrict where
+  "Restrict(N,A,z) \<equiv> \<exists>x[N]. x\<in>A \<and> (\<exists>y[N]. pair(N,x,y,z))"
+
+synthesize "Restrict" from_definition "Restrict" assuming "nonempty"
+arity_theorem for "Restrict_fm"
+
+definition Comp where
+  "Comp(N,R,S,xz) \<equiv> \<exists>x[N]. \<exists>y[N]. \<exists>z[N]. \<exists>xy[N]. \<exists>yz[N].
+              pair(N,x,z,xz) \<and> pair(N,x,y,xy) \<and> pair(N,y,z,yz) \<and> xy\<in>S \<and> yz\<in>R"
+
+synthesize "Comp" from_definition "Comp" assuming "nonempty"
+arity_theorem for "Comp_fm"
+
+definition Pred where
+  "Pred(N,R,X,y) \<equiv> \<exists>p[N]. p\<in>R \<and> pair(N,y,X,p)"
+
+synthesize "Pred" from_definition "Pred" assuming "nonempty"
+arity_theorem for "Pred_fm"
+
+definition is_Memrel where
+  "is_Memrel(N,z) \<equiv> \<exists>x[N]. \<exists>y[N]. pair(N,x,y,z) \<and> x \<in> y"
+
+synthesize "is_Memrel" from_definition "is_Memrel" assuming "nonempty"
+arity_theorem for "is_Memrel_fm"
+
+definition RecFun where
+  "RecFun(N,r,f,g,a,b,x) \<equiv> \<exists>xa[N]. \<exists>xb[N].
+                    pair(N,x,a,xa) \<and> xa \<in> r \<and> pair(N,x,b,xb) \<and> xb \<in> r \<and>
+                    (\<exists>fx[N]. \<exists>gx[N]. fun_apply(N,f,x,fx) \<and> fun_apply(N,g,x,gx) \<and>
+                                     fx \<noteq> gx)"
+
+synthesize "RecFun" from_definition "RecFun" assuming "nonempty"
+arity_theorem for "RecFun_fm"
+
+arity_theorem for "rtran_closure_mem_fm"
+
+synthesize "wellfounded_trancl" from_definition assuming "nonempty"
+arity_theorem for "wellfounded_trancl_fm"
+
+context M_Z_trans
+begin
+
+lemma inter_sep_intf :
+  assumes "A\<in>M"
+  shows "separation(##M,\<lambda>x . \<forall>y\<in>M . y\<in>A \<longrightarrow> x\<in>y)"
+  using assms separation_in_ctm[of "Intersection_fm(1,0)" "[A]" "Intersection(##M,A)"]
+    Intersection_iff_sats[of 1 "[_,A]" A 0 _ M] arity_Intersection_fm Intersection_fm_type
+    ord_simp_union zero_in_M
+  unfolding Intersection_def
+  by simp
+
+lemma diff_sep_intf :
+  assumes "B\<in>M"
+  shows "separation(##M,\<lambda>x . x\<notin>B)"
+  using assms separation_in_ctm[of "Neg(Member(0,1))" "[B]" "\<lambda>x . x\<notin>B"] ord_simp_union
+  by simp
+
+lemma cartprod_sep_intf :
+  assumes "A\<in>M" and "B\<in>M"
+  shows "separation(##M,\<lambda>z. \<exists>x\<in>M. x\<in>A \<and> (\<exists>y\<in>M. y\<in>B \<and> pair(##M,x,y,z)))"
+  using assms separation_in_ctm[of "CartProd_fm(1,2,0)" "[A,B]" "CartProd(##M,A,B)"]
+    CartProd_iff_sats[of 1 "[_,A,B]" A 2 B 0 _ M] arity_CartProd_fm  CartProd_fm_type
+    ord_simp_union zero_in_M
+  unfolding CartProd_def
+  by simp
+
+lemma image_sep_intf :
+  assumes "A\<in>M" and "B\<in>M"
+  shows "separation(##M, \<lambda>y. \<exists>p\<in>M. p\<in>B \<and> (\<exists>x\<in>M. x\<in>A \<and> pair(##M,x,y,p)))"
+  using assms separation_in_ctm[of "Image_fm(1,2,0)" "[A,B]" "Image(##M,A,B)"]
+    Image_iff_sats[of 1 "[_,A,B]" _ 2 _ 0 _ M] arity_Image_fm Image_fm_type
+    ord_simp_union zero_in_M
+  unfolding Image_def
+  by simp
+
+lemma converse_sep_intf :
+  assumes "R\<in>M"
+  shows "separation(##M,\<lambda>z. \<exists>p\<in>M. p\<in>R \<and> (\<exists>x\<in>M.\<exists>y\<in>M. pair(##M,x,y,p) \<and> pair(##M,y,x,z)))"
+  using assms separation_in_ctm[of "Converse_fm(1,0)" "[R]" "Converse(##M,R)"]
+    Converse_iff_sats[of 1 "[_,R]" _ 0 _ M] arity_Converse_fm Converse_fm_type
+    ord_simp_union zero_in_M
+  unfolding Converse_def
+  by simp
+
+lemma restrict_sep_intf :
+  assumes "A\<in>M"
+  shows "separation(##M,\<lambda>z. \<exists>x\<in>M. x\<in>A \<and> (\<exists>y\<in>M. pair(##M,x,y,z)))"
+  using assms separation_in_ctm[of "Restrict_fm(1,0)" "[A]" "Restrict(##M,A)"]
+    Restrict_iff_sats[of 1 "[_,A]" _ 0 _ M] arity_Restrict_fm Restrict_fm_type
+    ord_simp_union zero_in_M
+  unfolding Restrict_def
+  by simp
+
+lemma comp_sep_intf :
+  assumes "R\<in>M" and "S\<in>M"
+  shows "separation(##M,\<lambda>xz. \<exists>x\<in>M. \<exists>y\<in>M. \<exists>z\<in>M. \<exists>xy\<in>M. \<exists>yz\<in>M.
+           pair(##M,x,z,xz) \<and> pair(##M,x,y,xy) \<and> pair(##M,y,z,yz) \<and> xy\<in>S \<and> yz\<in>R)"
+  using assms separation_in_ctm[of "Comp_fm(1,2,0)" "[R,S]" "Comp(##M,R,S)"]
+    Comp_iff_sats[of 1 "[_,R,S]" _ 2 _ 0 _ M] arity_Comp_fm Comp_fm_type
+    ord_simp_union zero_in_M
+  unfolding Comp_def
+  by simp
+
+lemma pred_sep_intf:
+  assumes "R\<in>M" and "X\<in>M"
+  shows "separation(##M, \<lambda>y. \<exists>p\<in>M. p\<in>R \<and> pair(##M,y,X,p))"
+  using assms separation_in_ctm[of "Pred_fm(1,2,0)" "[R,X]" "Pred(##M,R,X)"]
+    Pred_iff_sats[of 1 "[_,R,X]" _ 2 _ 0 _ M] arity_Pred_fm Pred_fm_type
+    ord_simp_union zero_in_M
+  unfolding Pred_def
+  by simp
+
+lemma memrel_sep_intf:
+  "separation(##M, \<lambda>z. \<exists>x\<in>M. \<exists>y\<in>M. pair(##M,x,y,z) \<and> x \<in> y)"
+  using separation_in_ctm[of "is_Memrel_fm(0)" "[]" "is_Memrel(##M)"]
+    is_Memrel_iff_sats[of 0 "[_]" _ M] arity_is_Memrel_fm is_Memrel_fm_type
+    ord_simp_union zero_in_M
+  unfolding is_Memrel_def
+  by simp
+
+lemma is_recfun_sep_intf :
+  assumes "r\<in>M" "f\<in>M" "g\<in>M" "a\<in>M" "b\<in>M"
+  shows "separation(##M,\<lambda>x. \<exists>xa\<in>M. \<exists>xb\<in>M.
+                    pair(##M,x,a,xa) \<and> xa \<in> r \<and> pair(##M,x,b,xb) \<and> xb \<in> r \<and>
+                    (\<exists>fx\<in>M. \<exists>gx\<in>M. fun_apply(##M,f,x,fx) \<and> fun_apply(##M,g,x,gx) \<and>
+                                     fx \<noteq> gx))"
+  using assms separation_in_ctm[of "RecFun_fm(1,2,3,4,5,0)" "[r,f,g,a,b]" "RecFun(##M,r,f,g,a,b)"]
+    RecFun_iff_sats[of 1 "[_,r,f,g,a,b]" _ 2 _ 3 _ 4 _ 5 _ 0 _ M] arity_RecFun_fm RecFun_fm_type
+    ord_simp_union zero_in_M
+  unfolding RecFun_def
+  by simp
+
+lemmas M_basic_sep_instances =
+  inter_sep_intf diff_sep_intf cartprod_sep_intf
+  image_sep_intf converse_sep_intf restrict_sep_intf
+  pred_sep_intf memrel_sep_intf comp_sep_intf is_recfun_sep_intf
+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
+
+sublocale M_Z_trans \<subseteq> M_basic_no_repl "##M"
+  using power_ax M_basic_sep_instances
+  by unfold_locales simp_all
+
+lemma Replace_eq_Collect:
+  assumes "\<And>x y y'. x\<in>A \<Longrightarrow> P(x,y) \<Longrightarrow> P(x,y') \<Longrightarrow> y=y'" "{y . x \<in> A, P(x, y)} \<subseteq> B"
+  shows "{y . x \<in> A, P(x, y)} = {y\<in>B . \<exists>x\<in>A. P(x,y)}"
+  using assms by blast
+
+context M_Z_trans
+begin
+
+lemma Pow_inter_M_closed: assumes "A \<in> M" shows "Pow(A) \<inter> M \<in> M"
+proof -
+  have "{a \<in> Pow(A) . a \<in> M} = Pow(A) \<inter> M" by auto
+  then
+  show ?thesis
+    using power_ax powerset_abs assms unfolding power_ax_def
+    by auto
+qed
+
+lemma Pow'_inter_M_closed: assumes "A \<in> M" shows "{a \<in> Pow(A) . a \<in> M} \<in> M"
+  using power_ax powerset_abs assms unfolding power_ax_def by auto
+
+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
+
+context M_basic_no_repl
+begin
+
+lemma Replace_funspace_succ_rep_intf_sub:
+  assumes
+    "M(A)" "M(n)"
+  shows
+    "{z . p \<in> A, funspace_succ_rep_intf_rel(M,p,z,n)}
+      \<subseteq> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>domain(A) \<union> ({n} \<times> range(A)) \<union> (\<Union>({n} \<times> range(A)))))"
+  unfolding funspace_succ_rep_intf_rel_def using assms mem_Pow_rel_abs
+  by clarsimp (auto simp: cartprod_def)
+
+lemma funspace_succ_rep_intf_uniq:
+  assumes
+    "funspace_succ_rep_intf_rel(M,p,z,n)" "funspace_succ_rep_intf_rel(M,p,z',n)"
+  shows
+    "z = z'"
+  using assms unfolding funspace_succ_rep_intf_rel_def by auto
+
+lemma Replace_funspace_succ_rep_intf_eq:
+  assumes
+    "M(A)" "M(n)"
+  shows
+    "{z . p \<in> A, funspace_succ_rep_intf_rel(M,p,z,n)} =
+     {z \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>domain(A) \<union> ({n} \<times> range(A)) \<union> (\<Union>({n} \<times> range(A))))) .
+        \<exists>p\<in>A. funspace_succ_rep_intf_rel(M,p,z,n)}"
+  using assms Replace_eq_Collect[OF funspace_succ_rep_intf_uniq, of A,
+      OF _ _ Replace_funspace_succ_rep_intf_sub[of A n], of "\<lambda>x y z. x" "\<lambda>x y z. n"]
+  by (intro equalityI)
+    (auto dest:transM simp:funspace_succ_rep_intf_rel_def)
+
+end \<comment> \<open>\<^locale>\<open>M_basic_no_repl\<close>\<close>
+
+definition fsri where
+  "fsri(N,A,B) \<equiv> \<lambda>z. \<exists>p\<in>A. \<exists>f[N]. \<exists>b[N]. p = \<langle>f, b\<rangle> \<and> z = {cons(\<langle>B, b\<rangle>, f)}"
+
+relationalize "fsri" "is_fsri"
+synthesize "is_fsri" from_definition assuming "nonempty"
+arity_theorem for "is_fsri_fm"
+
+
+context M_Z_trans
+begin
+
+lemma separation_fsri:
+  "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> separation(##M, is_fsri(##M,A,B))"
+  using separation_in_ctm[where env="[A,B]" and \<phi>="is_fsri_fm(1,2,0)"]
+    zero_in_M is_fsri_iff_sats[symmetric] arity_is_fsri_fm is_fsri_fm_type
+  by (simp_all add: ord_simp_union)
+
+lemma separation_funspace_succ_rep_intf_rel:
+  "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> separation(##M, \<lambda>z. \<exists>p\<in>A. funspace_succ_rep_intf_rel(##M,p,z,B))"
+  using separation_fsri zero_in_M
+  by (rule_tac separation_cong[THEN iffD1, of _ "is_fsri(##M,A,B)"])
+    (auto simp flip:setclass_iff dest:transM
+      simp:is_fsri_def funspace_succ_rep_intf_rel_def, force)
+
+lemma Replace_funspace_succ_rep_intf_in_M:
+  assumes
+    "A \<in> M" "n \<in> M"
+  shows
+    "{z . p \<in> A, funspace_succ_rep_intf_rel(##M,p,z,n)} \<in> M"
+proof -
+  have "(##M)({z \<in> Pow\<^bsup>M\<^esup>(Pow\<^bsup>M\<^esup>(\<Union>domain(A) \<union> ({n} \<times> range(A)) \<union> (\<Union>({n} \<times> range(A))))) .
+        \<exists>p\<in>A. funspace_succ_rep_intf_rel(##M,p,z,n)})"
+    using assms separation_funspace_succ_rep_intf_rel
+    by (intro separation_closed) (auto simp flip:setclass_iff)
+  with assms
+  show ?thesis
+    using Replace_funspace_succ_rep_intf_eq by auto
+qed
+
+lemma funspace_succ_rep_intf:
+  assumes "n\<in>M"
+  shows
+    "strong_replacement(##M,
+          \<lambda>p z. \<exists>f\<in>M. \<exists>b\<in>M. \<exists>nb\<in>M. \<exists>cnbf\<in>M.
+                pair(##M,f,b,p) \<and> pair(##M,n,b,nb) \<and> is_cons(##M,nb,f,cnbf) \<and>
+                upair(##M,cnbf,cnbf,z))"
+  using assms
+  unfolding strong_replacement_def univalent_def
+  apply (simp add:pair_in_M_iff[simplified])
+  apply clarsimp
+  apply (rule_tac x="{z . p \<in> A, funspace_succ_rep_intf_rel(##M,p,z,n)}" in bexI)
+   apply (auto simp:funspace_succ_rep_intf_rel_def
+      Replace_funspace_succ_rep_intf_in_M[unfolded funspace_succ_rep_intf_rel_def, simplified])
+  apply (rule_tac x="\<langle>f, ba\<rangle>" in bexI)
+   apply (auto dest:transM simp:pair_in_M_iff[simplified] cons_closed[simplified])
+  done
+
+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
+
+sublocale M_Z_trans \<subseteq> M_basic "##M"
+  using power_ax M_basic_sep_instances funspace_succ_rep_intf
+  by unfold_locales auto
+
+subsection\<open>Interface with \<^term>\<open>M_trancl\<close>\<close>
+
+lemma (in M_ZF1_trans) rtrancl_separation_intf:
+  assumes "r\<in>M" "A\<in>M"
+  shows "separation (##M, rtran_closure_mem(##M,A,r))"
+  using assms separation_in_ctm[of "rtran_closure_mem_fm(1,2,0)" "[A,r]" "rtran_closure_mem(##M,A,r)"]
+    arity_rtran_closure_mem_fm ord_simp_union zero_in_M
+  by simp
+
+context M_ZF1_trans
+begin
+
+lemma wftrancl_separation_intf:
+  assumes "r\<in>M" and "Z\<in>M"
+  shows "separation (##M, wellfounded_trancl(##M,Z,r))"
+  using assms separation_in_ctm[of "wellfounded_trancl_fm(1,2,0)" "[Z,r]" "wellfounded_trancl(##M,Z,r)"]
+    arity_wellfounded_trancl_fm ord_simp_union zero_in_M
+  by simp
+
+text\<open>To prove \<^term>\<open>nat \<in> M\<close> we get an infinite set \<^term>\<open>I\<close> from \<^term>\<open>infinity_ax\<close>
+closed under \<^term>\<open>0\<close> and \<^term>\<open>succ\<close>; that shows \<^term>\<open>nat\<subseteq>I\<close>. Then we
+can separate \<^term>\<open>I\<close> with the predicate \<^term>\<open>\<lambda>x. x\<in>nat\<close>.\<close>
+lemma finite_sep_intf: "separation(##M, \<lambda>x. x\<in>nat)"
+proof -
+  have "(\<forall>v\<in>M. separation(##M,\<lambda>x. (M, [x,v] \<Turnstile> finite_ordinal_fm(0))))"
+    using separation_ax arity_finite_ordinal_fm
+    by simp
+  then
+  have "(\<forall>v\<in>M. separation(##M,finite_ordinal(##M)))"
+    unfolding separation_def
+    by simp
+  then
+  have "separation(##M,finite_ordinal(##M))"
+    using separation_in_ctm zero_in_M
+    by auto
+  then
+  show ?thesis
+    unfolding separation_def
+    by simp
+qed
+
+lemma nat_subset_I: "\<exists>I\<in>M. nat \<subseteq> I"
+proof -
+  have "nat \<subseteq> I"
+    if "I\<in>M" and "0\<in>I" and "\<And>x. x\<in>I \<Longrightarrow> succ(x)\<in>I" for I
+    using that
+    by (rule_tac subsetI,induct_tac x,simp_all)
+  moreover
+  obtain I where
+    "I\<in>M" "0\<in>I" "\<And>x. x\<in>I \<Longrightarrow> succ(x)\<in>I"
+    using infinity_ax transitivity
+    unfolding infinity_ax_def
+    by auto
+  ultimately
+  show ?thesis
+    by auto
+qed
+
+lemma nat_in_M: "nat \<in> M"
+proof -
+  have "{x\<in>B . x\<in>A}=A" if "A\<subseteq>B" for A B
+    using that by auto
+  moreover
+  obtain I where
+    "I\<in>M" "nat\<subseteq>I"
+    using nat_subset_I by auto
+  moreover from this
+  have "{x\<in>I . x\<in>nat} \<in> M"
+    using finite_sep_intf separation_closed[of "\<lambda>x . x\<in>nat"]
+    by simp
+  ultimately
+  show ?thesis
+    by simp
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
+
+sublocale M_ZF1_trans \<subseteq> M_trancl "##M"
+  using rtrancl_separation_intf wftrancl_separation_intf nat_in_M
+    wellfounded_trancl_def
+  by unfold_locales auto
+
+subsection\<open>Interface with \<^term>\<open>M_eclose\<close>\<close>
+
+lemma repl_sats:
+  assumes
+    sat:"\<And>x z. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> (M, Cons(x,Cons(z,env)) \<Turnstile> \<phi>) \<longleftrightarrow> P(x,z)"
+  shows
+    "strong_replacement(##M,\<lambda>x z. (M, Cons(x,Cons(z,env)) \<Turnstile> \<phi>)) \<longleftrightarrow>
+   strong_replacement(##M,P)"
+  by (rule strong_replacement_cong,simp add:sat)
+
+arity_theorem for "list_functor_fm"
+
+lemma (in M_ZF1_trans) list_repl1_intf:
+  assumes "A\<in>M"
+  shows "iterates_replacement(##M, is_list_functor(##M,A), 0)"
+proof -
+  let ?f="Exists(And(pair_fm(1,0,2),
+               is_wfrec_fm(iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0),3,1,0)))"
+  have "arity(?f) = 5"
+    using arity_iterates_MH_fm[where isF="list_functor_fm(13,1,0)" and i=14]
+      arity_wfrec_replacement_fm[where i=11] arity_list_functor_fm ord_simp_union
+    by simp
+  {
+    fix n
+    assume "n\<in>nat"
+    then
+    have "Memrel(succ(n))\<in>M"
+      using nat_into_M Memrel_closed
+      by simp
+    moreover
+    note assms zero_in_M
+    moreover from calculation
+    have "is_list_functor(##M, A, a, b)
+       \<longleftrightarrow> (M, [b,a,c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),A,0] \<Turnstile> list_functor_fm(13,1,0))"
+      if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "a0\<in>M" "a1\<in>M" "a2\<in>M" "a3\<in>M" "a4\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
+      for a b c d a0 a1 a2 a3 a4 y x z
+      using that
+      by simp
+    moreover from calculation
+    have "(M, [a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),A,0] \<Turnstile> 
+            iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0)) \<longleftrightarrow>
+          iterates_MH(##M,is_list_functor(##M,A),0,a2, a1, a0)"
+      if "a0\<in>M" "a1\<in>M" "a2\<in>M" "a3\<in>M" "a4\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
+      for a0 a1 a2 a3 a4 y x z
+      using that sats_iterates_MH_fm[of M "is_list_functor(##M,A)" _]
+      by simp
+    moreover from calculation
+    have "(M, [y,x,z,Memrel(succ(n)),A,0] \<Turnstile>
+              is_wfrec_fm(iterates_MH_fm(list_functor_fm(13,1,0),10,2,1,0),3,1,0)) \<longleftrightarrow>
+          is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) , Memrel(succ(n)), x, y)"
+      if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
+      using that sats_is_wfrec_fm
+      by simp
+    moreover from calculation
+    have "(M, [x,z,Memrel(succ(n)),A,0] \<Turnstile> ?f) \<longleftrightarrow>
+        
+        (\<exists>y\<in>M. pair(##M,x,y,z) \<and>
+        is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) , Memrel(succ(n)), x, y))"
+      if "x\<in>M" "z\<in>M" for x z
+      using that
+      by (simp del:pair_abs)
+    moreover
+    note \<open>arity(?f) = 5\<close>
+    moreover from calculation
+    have "strong_replacement(##M,\<lambda>x z. (M, [x,z,Memrel(succ(n)),A,0] \<Turnstile> ?f))"
+      using replacement_ax1(2)[unfolded replacement_assm_def]
+      by simp
+    moreover from calculation
+    have "strong_replacement(##M,\<lambda>x z.
+          \<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, iterates_MH(##M,is_list_functor(##M,A),0) ,
+                Memrel(succ(n)), x, y))"
+      using repl_sats[of M ?f "[Memrel(succ(n)),A,0]"]
+      by (simp del:pair_abs)
+  }
+  then
+  show ?thesis
+    unfolding iterates_replacement_def wfrec_replacement_def
+    by simp
+qed
+
+text\<open>This lemma obtains \<^term>\<open>iterates_replacement\<close> for predicates
+without parameters.\<close>
+lemma (in M_ZF1_trans) iterates_repl_intf :
+  assumes
+    "v\<in>M" and
+    isfm:"is_F_fm \<in> formula" and
+    arty:"arity(is_F_fm)=2" and
+    satsf: "\<And>a b env'. \<lbrakk> a\<in>M ; b\<in>M ; env'\<in>list(M) \<rbrakk>
+              \<Longrightarrow> is_F(a,b) \<longleftrightarrow> (M,  [b,a]@env' \<Turnstile>  is_F_fm)"
+    and is_F_fm_replacement:
+    "\<And>env. (\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>) \<in> formula \<Longrightarrow> env \<in> list(M) \<Longrightarrow>
+      arity((\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>)) \<le> 2 +\<^sub>\<omega> length(env) \<Longrightarrow>
+     strong_replacement(##M,\<lambda>x y. 
+         M, [x,y] @ env \<Turnstile> (\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>))"
+  shows
+    "iterates_replacement(##M,is_F,v)"
+proof -
+  let ?f="(\<cdot>\<exists>\<cdot>\<cdot>\<langle>1,0\<rangle> is 2\<cdot> \<and> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0) \<cdot>\<cdot>)"
+  have "arity(?f) = 4" "?f\<in>formula"
+    using arity_iterates_MH_fm[where isF=is_F_fm and i=2]
+      arity_wfrec_replacement_fm[where i=10] isfm arty ord_simp_union
+    by simp_all
+  {
+    fix n
+    assume "n\<in>nat"
+    then
+    have "Memrel(succ(n))\<in>M"
+      using nat_into_M Memrel_closed
+      by simp
+    moreover
+    {
+      fix a0 a1 a2 a3 a4 y x z
+      assume "[a0,a1,a2,a3,a4,y,x,z]\<in>list(M)"
+      moreover
+      note \<open>v\<in>M\<close> \<open>Memrel(succ(n))\<in>M\<close>
+      moreover from calculation
+      have "(M, [b,a,c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v] \<Turnstile> is_F_fm) \<longleftrightarrow>
+           is_F(a,b)"
+        if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" for a b c d
+        using that satsf[of a b "[c,d,a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v]"]
+        by simp
+      moreover from calculation
+      have "(M, [a0,a1,a2,a3,a4,y,x,z,Memrel(succ(n)),v] \<Turnstile> iterates_MH_fm(is_F_fm,9,2,1,0)) \<longleftrightarrow>
+           iterates_MH(##M,is_F,v,a2, a1, a0)"
+        using sats_iterates_MH_fm[of M "is_F" "is_F_fm"]
+        by simp
+    }
+    moreover from calculation
+    have "(M, [y,x,z,Memrel(succ(n)),v] \<Turnstile> is_wfrec_fm(iterates_MH_fm(is_F_fm,9,2,1,0),3,1,0)) \<longleftrightarrow>
+          is_wfrec(##M, iterates_MH(##M,is_F,v),Memrel(succ(n)), x, y)"
+      if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
+      using that sats_is_wfrec_fm \<open>v\<in>M\<close> by simp
+    moreover from calculation
+    have "(M, [x,z,Memrel(succ(n)),v] \<Turnstile> ?f) \<longleftrightarrow>
+        
+        (\<exists>y\<in>M. pair(##M,x,y,z) \<and>
+        is_wfrec(##M, iterates_MH(##M,is_F,v) , Memrel(succ(n)), x, y))"
+      if "x\<in>M" "z\<in>M" for x z
+      using that \<open>v\<in>M\<close>
+      by (simp del:pair_abs)
+    moreover
+    note \<open>arity(?f) = 4\<close> \<open>?f\<in>formula\<close>
+    moreover from calculation \<open>v\<in>_\<close>
+    have "strong_replacement(##M,\<lambda>x z. (M, [x,z,Memrel(succ(n)),v] \<Turnstile> ?f))"
+      using is_F_fm_replacement
+      by simp
+    ultimately
+    have "strong_replacement(##M,\<lambda>x z.
+          \<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, iterates_MH(##M,is_F,v) ,
+                Memrel(succ(n)), x, y))"
+      using repl_sats[of M ?f "[Memrel(succ(n)),v]"]
+      by (simp del:pair_abs)
+  }
+  then
+  show ?thesis
+    unfolding iterates_replacement_def wfrec_replacement_def
+    by simp
+qed
+
+arity_theorem for "formula_functor_fm"
+lemma (in M_ZF1_trans) formula_repl1_intf :
+  "iterates_replacement(##M, is_formula_functor(##M), 0)"
+  using arity_formula_functor_fm zero_in_M ord_simp_union
+    iterates_repl_intf[where is_F_fm="formula_functor_fm(1,0)"]
+    replacement_ax1(16)[unfolded replacement_assm_def]
+  by simp
+
+arity_theorem for "Inl_fm"
+arity_theorem for "Inr_fm"
+arity_theorem for "Nil_fm"
+arity_theorem for "Cons_fm"
+arity_theorem for "quasilist_fm"
+arity_theorem for "tl_fm"
+
+lemma (in M_ZF1_trans) tl_repl_intf:
+  assumes "l \<in> M"
+  shows "iterates_replacement(##M,\<lambda>l' t. is_tl(##M,l',t),l)"
+  using assms arity_tl_fm ord_simp_union
+    iterates_repl_intf[where is_F_fm="tl_fm(1,0)"]
+    replacement_ax1(15)[unfolded replacement_assm_def]
+  by simp
+
+arity_theorem for "big_union_fm"
+
+lemma (in M_ZF1_trans) eclose_repl1_intf:
+  assumes "A\<in>M"
+  shows "iterates_replacement(##M, big_union(##M), A)"
+  using assms arity_big_union_fm
+    iterates_repl_intf[where is_F_fm="big_union_fm(1,0)"]
+    replacement_ax1(17)[unfolded replacement_assm_def]
+    ord_simp_union
+  by simp
+
+lemma (in M_ZF1_trans) list_repl2_intf:
+  assumes "A\<in>M"
+  shows "strong_replacement(##M,\<lambda>n y. n\<in>nat \<and>
+            is_iterates(##M, is_list_functor(##M,A), 0, n, y))"
+proof -
+  let ?f = "And(Member(0,4),is_iterates_fm(list_functor_fm(13,1,0),3,0,1))"
+  note zero_in_M nat_in_M \<open>A\<in>M\<close>
+  moreover from this
+  have "is_list_functor(##M,A,a,b) \<longleftrightarrow>
+        (M, [b,a,c,d,e,f,g,h,i,j,k,n,y,A,0,nat] \<Turnstile> list_functor_fm(13,1,0))"
+    if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "f\<in>M""g\<in>M""h\<in>M""i\<in>M""j\<in>M" "k\<in>M" "n\<in>M" "y\<in>M"
+    for a b c d e f g h i j k n y
+    using that
+    by simp
+  moreover from calculation
+  have "(M, [n,y,A,0,nat] \<Turnstile> is_iterates_fm(list_functor_fm(13,1,0),3,0,1)) \<longleftrightarrow>
+           is_iterates(##M, is_list_functor(##M,A), 0, n , y)"
+    if "n\<in>M" "y\<in>M" for n y
+    using that sats_is_iterates_fm[of M "is_list_functor(##M,A)"]
+    by simp
+  moreover from calculation
+  have "(M, [n,y,A,0,nat] \<Turnstile> ?f) \<longleftrightarrow>
+        n\<in>nat \<and> is_iterates(##M, is_list_functor(##M,A), 0, n, y)"
+    if "n\<in>M" "y\<in>M" for n y
+    using that
+    by simp
+  moreover
+  have "arity(?f) = 5"
+    using arity_is_iterates_fm[where p="list_functor_fm(13,1,0)" and i=14]
+      arity_list_functor_fm arity_And ord_simp_union
+    by simp
+  ultimately
+  show ?thesis
+    using replacement_ax1(3)[unfolded replacement_assm_def] repl_sats[of M ?f "[A,0,nat]"]
+    by simp
+qed
+
+lemma (in M_ZF1_trans) formula_repl2_intf:
+  "strong_replacement(##M,\<lambda>n y. n\<in>nat \<and> is_iterates(##M, is_formula_functor(##M), 0, n, y))"
+proof -
+  let ?f = "And(Member(0,3),is_iterates_fm(formula_functor_fm(1,0),2,0,1))"
+  note zero_in_M nat_in_M
+  moreover from this
+  have "is_formula_functor(##M,a,b) \<longleftrightarrow>
+        (M, [b,a,c,d,e,f,g,h,i,j,k,n,y,0,nat] \<Turnstile> formula_functor_fm(1,0))"
+    if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "f\<in>M""g\<in>M""h\<in>M""i\<in>M""j\<in>M" "k\<in>M" "n\<in>M" "y\<in>M"
+    for a b c d e f g h i j k n y
+    using that
+    by simp
+  moreover from calculation
+  have "(M, [n,y,0,nat] \<Turnstile> is_iterates_fm(formula_functor_fm(1,0),2,0,1)) \<longleftrightarrow>
+           is_iterates(##M, is_formula_functor(##M), 0, n , y)"
+    if "n\<in>M" "y\<in>M" for n y
+    using that sats_is_iterates_fm[of M "is_formula_functor(##M)"]
+    by simp
+  moreover from calculation
+  have "(M, [n,y,0,nat] \<Turnstile> ?f) \<longleftrightarrow>
+        n\<in>nat \<and> is_iterates(##M, is_formula_functor(##M), 0, n, y)"
+    if "n\<in>M" "y\<in>M" for n y
+    using that
+    by simp
+  moreover
+  have "arity(?f) = 4"
+    using arity_is_iterates_fm[where p="formula_functor_fm(1,0)" and i=2]
+      arity_formula_functor_fm arity_And ord_simp_union
+    by simp
+  ultimately
+  show ?thesis
+    using replacement_ax1(4)[unfolded replacement_assm_def] repl_sats[of M ?f "[0,nat]"]
+    by simp
+qed
+
+
+lemma (in M_ZF1_trans) eclose_repl2_intf:
+  assumes "A\<in>M"
+  shows "strong_replacement(##M,\<lambda>n y. n\<in>nat \<and> is_iterates(##M, big_union(##M), A, n, y))"
+proof -
+  let ?f = "And(Member(0,3),is_iterates_fm(big_union_fm(1,0),2,0,1))"
+  note nat_in_M \<open>A\<in>M\<close>
+  moreover from this
+  have "big_union(##M,a,b) \<longleftrightarrow>
+        (M, [b,a,c,d,e,f,g,h,i,j,k,n,y,A,nat] \<Turnstile> big_union_fm(1,0))"
+    if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "f\<in>M""g\<in>M""h\<in>M""i\<in>M""j\<in>M" "k\<in>M" "n\<in>M" "y\<in>M"
+    for a b c d e f g h i j k n y
+    using that by simp
+  moreover from calculation
+  have "(M, [n,y,A,nat] \<Turnstile> is_iterates_fm(big_union_fm(1,0),2,0,1)) \<longleftrightarrow>
+           is_iterates(##M, big_union(##M), A, n , y)"
+    if "n\<in>M" "y\<in>M" for n y
+    using that sats_is_iterates_fm[of M "big_union(##M)"]
+    by simp
+  moreover from calculation
+  have "(M, [n,y,A,nat] \<Turnstile> ?f) \<longleftrightarrow>
+        n\<in>nat \<and> is_iterates(##M, big_union(##M), A, n, y)"
+    if "n\<in>M" "y\<in>M" for n y
+    using that
+    by simp
+  moreover
+  have "arity(?f) = 4"
+    using arity_is_iterates_fm[where p="big_union_fm(1,0)" and i=2]
+      arity_big_union_fm arity_And ord_simp_union
+    by simp
+  ultimately
+  show ?thesis
+    using repl_sats[of M ?f "[A,nat]"] replacement_ax1(5)[unfolded replacement_assm_def]
+    by simp
+qed
+
+sublocale M_ZF1_trans \<subseteq> M_datatypes "##M"
+  using list_repl1_intf list_repl2_intf formula_repl1_intf
+    formula_repl2_intf tl_repl_intf
+  by unfold_locales auto
+
+sublocale M_ZF1_trans \<subseteq> M_eclose "##M"
+  using eclose_repl1_intf eclose_repl2_intf
+  by unfold_locales auto
+
+text\<open>Interface with \<^locale>\<open>M_eclose\<close>.\<close>
+
+lemma (in M_ZF1_trans) Powapply_repl :
+  assumes "f\<in>M"
+  shows "strong_replacement(##M,\<lambda>x y. y=Powapply_rel(##M,f,x))"
+proof -
+  note assms
+  moreover
+  have "arity(is_Powapply_fm(2,0,1)) = 3"
+    unfolding is_Powapply_fm_def
+    by (simp add:arity ord_simp_union)
+  moreover from calculation
+  have iff:"z=Powapply_rel(##M,f,p) \<longleftrightarrow> (M, [p,z,f] \<Turnstile> is_Powapply_fm(2,0,1) )"
+    if "p\<in>M" "z\<in>M" for p z
+    using that zero_in_M sats_is_Powapply_fm[of 2 0 1 "[p,z,f]" M] is_Powapply_iff
+      replacement_ax1[unfolded replacement_assm_def]
+    by simp
+  ultimately
+  show ?thesis
+    using replacement_ax1(6)[unfolded replacement_assm_def]
+    by (rule_tac strong_replacement_cong[THEN iffD2,OF iff],simp_all)
+qed
+
+lemma (in M_ZF1_trans) phrank_repl :
+  assumes
+    "f\<in>M"
+  shows
+    "strong_replacement(##M, \<lambda>x y. y = succ(f`x))"
+proof -
+  note assms
+  moreover from this
+  have iff:"y = succ(f ` x) \<longleftrightarrow> M, [x, y, f] \<Turnstile> PHrank_fm(2, 0, 1)" if "x\<in>M" "y\<in>M" for x y
+    using PHrank_iff_sats[of 2 "[x,y,f]" f 0 _ 1 _ M] zero_in_M that
+      apply_closed
+    unfolding PHrank_def
+    by simp
+  moreover
+  have "arity(PHrank_fm(2,0,1)) = 3"
+    unfolding PHrank_fm_def
+    by (simp add:arity ord_simp_union)
+  ultimately
+  show ?thesis
+    using replacement_ax1(7)[unfolded replacement_assm_def]
+    unfolding PHrank_def
+    by(rule_tac strong_replacement_cong[THEN iffD2,OF iff],simp_all)
+qed
+
+declare is_Hrank_fm_def[fm_definitions add]
+declare PHrank_fm_def[fm_definitions add]
+
+lemma (in M_ZF1_trans) wfrec_rank :
+  assumes "X\<in>M"
+  shows "wfrec_replacement(##M,is_Hrank(##M),rrank(X))"
+proof -
+  let ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(is_Hrank_fm(2,1,0),3,1,0)))"
+  note assms zero_in_M
+  moreover from this
+  have
+    "is_Hrank(##M,a2, a1, a0) \<longleftrightarrow>
+             (M, [a0,a1,a2,a3,a4,y,x,z,rrank(X)] \<Turnstile> is_Hrank_fm(2,1,0))"
+    if "a4\<in>M" "a3\<in>M" "a2\<in>M" "a1\<in>M" "a0\<in>M" "y\<in>M" "x\<in>M" "z\<in>M" for a4 a3 a2 a1 a0 y x z
+    using that rrank_in_M is_Hrank_iff_sats
+    by simp
+  moreover from calculation
+  have "(M, [y,x,z,rrank(X)] \<Turnstile> is_wfrec_fm(is_Hrank_fm(2,1,0),3,1,0)) \<longleftrightarrow>
+   is_wfrec(##M, is_Hrank(##M) ,rrank(X), x, y)"
+    if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
+    using that rrank_in_M sats_is_wfrec_fm
+    by simp
+  moreover from calculation
+  have "(M, [x,z,rrank(X)] \<Turnstile> ?f) \<longleftrightarrow>
+               (\<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, is_Hrank(##M) , rrank(X), x, y))"
+    if "x\<in>M" "z\<in>M" for x z
+    using that rrank_in_M
+    by (simp del:pair_abs)
+  moreover
+  have "arity(?f) = 3"
+    using arity_wfrec_replacement_fm[where p="is_Hrank_fm(2,1,0)" and i=3,simplified]
+      arity_is_Hrank_fm[of 2 1 0,simplified] ord_simp_union
+    by simp
+  moreover from calculation
+  have "strong_replacement(##M,\<lambda>x z. (M, [x,z,rrank(X)] \<Turnstile> ?f))"
+    using replacement_ax1(8)[unfolded replacement_assm_def] rrank_in_M
+    by simp
+  ultimately
+  show ?thesis
+    using repl_sats[of M ?f "[rrank(X)]"]
+    unfolding wfrec_replacement_def
+    by (simp del:pair_abs)
+qed
+
+schematic_goal sats_is_Vset_fm_auto:
+  assumes
+    "i\<in>nat" "v\<in>nat" "env\<in>list(A)" "0\<in>A"
+    "i < length(env)" "v < length(env)"
+  shows
+    "is_Vset(##A,nth(i, env),nth(v, env)) \<longleftrightarrow> (A, env \<Turnstile> ?ivs_fm(i,v))"
+  unfolding is_Vset_def is_Vfrom_def
+  by (insert assms; (rule sep_rules is_HVfrom_iff_sats is_transrec_iff_sats | simp)+)
+
+synthesize "is_Vset" from_schematic "sats_is_Vset_fm_auto"
+arity_theorem for "is_Vset_fm"
+
+lemma (in M_ZF1_trans) trans_repl_HVFrom :
+  assumes "A\<in>M" "i\<in>M"
+  shows "transrec_replacement(##M,is_HVfrom(##M,A),i)"
+proof -
+  let ?f="Exists(And(pair_fm(1,0,2),is_wfrec_fm(is_HVfrom_fm(8,2,1,0),4,1,0)))"
+  note facts = assms zero_in_M
+  moreover
+  have "\<exists>sa\<in>M. \<exists>esa\<in>M. \<exists>mesa\<in>M.
+       upair(##M,a,a,sa) \<and> is_eclose(##M,sa,esa) \<and> membership(##M,esa,mesa)"
+    if "a\<in>M" for a
+    using that upair_ax eclose_closed Memrel_closed
+    unfolding upair_ax_def
+    by (simp del:upair_abs)
+  moreover
+  {
+    fix mesa
+    assume "mesa\<in>M"
+    moreover
+    note facts
+    moreover from calculation
+    have "is_HVfrom(##M,A,a2, a1, a0) \<longleftrightarrow>
+      (M, [a0,a1,a2,a3,a4,y,x,z,A,mesa] \<Turnstile> is_HVfrom_fm(8,2,1,0))"
+      if "a4\<in>M" "a3\<in>M" "a2\<in>M" "a1\<in>M" "a0\<in>M" "y\<in>M" "x\<in>M" "z\<in>M" for a4 a3 a2 a1 a0 y x z
+      using that sats_is_HVfrom_fm
+      by simp
+    moreover from calculation
+    have "(M, [y,x,z,A,mesa] \<Turnstile> is_wfrec_fm(is_HVfrom_fm(8,2,1,0),4,1,0)) \<longleftrightarrow>
+         is_wfrec(##M, is_HVfrom(##M,A),mesa, x, y)"
+      if "y\<in>M" "x\<in>M" "z\<in>M" for y x z
+      using that sats_is_wfrec_fm
+      by simp
+    moreover from calculation
+    have "(M, [x,z,A,mesa] \<Turnstile> ?f) \<longleftrightarrow>
+               (\<exists>y\<in>M. pair(##M,x,y,z) \<and> is_wfrec(##M, is_HVfrom(##M,A) , mesa, x, y))"
+      if "x\<in>M" "z\<in>M" for x z
+      using that
+      by (simp del:pair_abs)
+    moreover
+    have "arity(?f) = 4"
+      using arity_wfrec_replacement_fm[where p="is_HVfrom_fm(8,2,1,0)" and i=9]
+        arity_is_HVfrom_fm ord_simp_union
+      by simp
+    moreover from calculation
+    have "strong_replacement(##M,\<lambda>x z. (M, [x,z,A,mesa] \<Turnstile> ?f))"
+      using replacement_ax1(9)[unfolded replacement_assm_def]
+      by simp
+    ultimately
+    have "wfrec_replacement(##M,is_HVfrom(##M,A),mesa)"
+      using repl_sats[of M ?f "[A,mesa]"]
+      unfolding wfrec_replacement_def
+      by (simp del:pair_abs)
+  }
+  ultimately
+  show ?thesis
+    unfolding transrec_replacement_def
+    by simp
+qed
+
+sublocale M_ZF1_trans \<subseteq> M_Vfrom "##M"
+  using power_ax Powapply_repl phrank_repl trans_repl_HVFrom wfrec_rank
+  by unfold_locales auto
+
+
+subsection\<open>Interface for proving Collects and Replace in M.\<close>
+context M_ZF1_trans
+begin
+
+lemma Collect_in_M :
+  assumes
+    "\<phi> \<in> formula" "env\<in>list(M)"
+    "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" "A\<in>M" and
+    satsQ: "\<And>x. x\<in>M \<Longrightarrow> (M, [x]@env \<Turnstile> \<phi>) \<longleftrightarrow> Q(x)"
+  shows
+    "{y\<in>A . Q(y)}\<in>M"
+proof -
+  have "separation(##M,\<lambda>x. (M, [x] @ env \<Turnstile> \<phi>))"
+    using assms separation_ax by simp
+  then
+  show ?thesis
+    using \<open>A\<in>M\<close> satsQ transitivity separation_closed
+      separation_cong[of "##M" "\<lambda>y. (M, [y]@env \<Turnstile> \<phi>)" "Q"]
+    by simp
+qed
+
+\<comment> \<open>This version has a weaker assumption.\<close>
+lemma separation_in_M :
+  assumes
+    "\<phi> \<in> formula" "env\<in>list(M)"
+    "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" "A\<in>M" and
+    satsQ: "\<And>x. x\<in>A \<Longrightarrow> (M, [x]@env \<Turnstile> \<phi>) \<longleftrightarrow> Q(x)"
+  shows
+    "{y\<in>A . Q(y)} \<in> M"
+proof -
+  let ?\<phi>' = "And(\<phi>,Member(0,length(env)+\<^sub>\<omega>1))"
+  note assms
+  moreover
+  have "arity(?\<phi>') \<le> 1 +\<^sub>\<omega> length(env@[A])"
+    using assms Un_le le_trans[of "arity(\<phi>)" "1+\<^sub>\<omega>length(env)" "2+\<^sub>\<omega>length(env)"]
+    by (force simp:FOL_arities)
+  moreover from calculation
+  have "?\<phi>'\<in>formula" "nth(length(env), env @ [A]) = A"
+    using nth_append
+    by auto
+  moreover from calculation
+  have "\<And> x . x \<in> M \<Longrightarrow> (M, [x]@env@[A] \<Turnstile> ?\<phi>') \<longleftrightarrow> Q(x) \<and> x\<in>A"
+    using arity_sats_iff[of _ "[A]" _ "[_]@env"]
+    by auto
+  ultimately
+  show ?thesis
+    using Collect_in_M[of ?\<phi>' "env@[A]" _ "\<lambda>x . Q(x) \<and> x\<in>A", OF _ _ _ \<open>A\<in>M\<close>]
+    by auto
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_ZF1_trans\<close>\<close>
+
+context M_Z_trans
+begin
+
+lemma strong_replacement_in_ctm:
+  assumes
+    f_fm:  "\<phi> \<in> formula" and
+    f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
+    fsats: "\<And>x y. x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> y = f(x)" and
+    fclosed: "\<And>x. x\<in>M \<Longrightarrow> f(x) \<in> M" and
+    phi_replacement:"replacement_assm(M,env,\<phi>)" and
+    "env\<in>list(M)"
+  shows "strong_replacement(##M, \<lambda>x y . y = f(x))"
+  using assms
+    strong_replacement_cong[of "##M" "\<lambda>x y. M,[x,y]@env\<Turnstile>\<phi>" "\<lambda>x y. y = f(x)"]
+  unfolding replacement_assm_def
+  by auto
+
+lemma strong_replacement_rel_in_ctm :
+  assumes
+    f_fm:  "\<phi> \<in> formula" and
+    f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
+    fsats: "\<And>x y. x\<in>M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> f(x,y)"  and
+    phi_replacement:"replacement_assm(M,env,\<phi>)" and
+    "env\<in>list(M)"
+  shows "strong_replacement(##M, f)"
+  using assms
+    strong_replacement_cong[of "##M" "\<lambda>x y. M,[x,y]@env\<Turnstile>\<phi>" "f"]
+  unfolding replacement_assm_def
+  by auto
+
+lemma Replace_in_M :
+  assumes
+    f_fm:  "\<phi> \<in> formula" and
+    f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
+    fsats: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> y = f(x)" and
+    fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M"  and
+    "A\<in>M" "env\<in>list(M)" and
+    phi'_replacement:"replacement_assm(M,env@[A], \<cdot>\<phi> \<and> \<cdot>0 \<in> length(env) +\<^sub>\<omega> 2\<cdot>\<cdot> )"
+  shows "{f(x) . x\<in>A}\<in>M"
+proof -
+  let ?\<phi>' = "And(\<phi>,Member(0,length(env)+\<^sub>\<omega>2))"
+  note assms
+  moreover from this
+  have "arity(?\<phi>') \<le> 2 +\<^sub>\<omega> length(env@[A])"
+    using Un_le le_trans[of "arity(\<phi>)" "2+\<^sub>\<omega>(length(env))" "3+\<^sub>\<omega>length(env)"]
+    by (force simp:FOL_arities)
+  moreover from calculation
+  have "?\<phi>'\<in>formula" "nth(length(env), env @ [A]) = A"
+    using nth_append by auto
+  moreover from calculation
+  have "\<And> x y. x \<in> M \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env@[A]\<Turnstile>?\<phi>') \<longleftrightarrow> y=f(x) \<and>x\<in>A"
+    using arity_sats_iff[of _ "[A]" _ "[_,_]@env"]
+    by auto
+  moreover from calculation
+  have "strong_replacement(##M, \<lambda>x y. M,[x,y]@env@[A] \<Turnstile> ?\<phi>')"
+    using phi'_replacement assms(1-6) unfolding replacement_assm_def by simp
+  ultimately
+  have 4:"strong_replacement(##M, \<lambda>x y. y = f(x) \<and> x\<in>A)"
+    using
+      strong_replacement_cong[of "##M" "\<lambda>x y. M,[x,y]@env@[A]\<Turnstile>?\<phi>'" "\<lambda>x y. y = f(x) \<and> x\<in>A"]
+    by simp
+  then
+  have "{y . x\<in>A , y = f(x)} \<in> M"
+    using \<open>A\<in>M\<close> strong_replacement_closed[OF 4,of A] fclosed by simp
+  moreover
+  have "{f(x). x\<in>A} = { y . x\<in>A , y = f(x)}"
+    by auto
+  ultimately
+  show ?thesis by simp
+qed
+
+lemma Replace_relativized_in_M :
+  assumes
+    f_fm:  "\<phi> \<in> formula" and
+    f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
+    fsats: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,y)" and
+    fabs:  "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> is_f(x,y) \<longleftrightarrow> y = f(x)" and
+    fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M"  and
+    "A\<in>M" "env\<in>list(M)" and
+    phi'_replacement:"replacement_assm(M,env@[A], \<cdot>\<phi> \<and> \<cdot>0 \<in> length(env) +\<^sub>\<omega> 2\<cdot>\<cdot> )"
+  shows "{f(x) . x\<in>A}\<in>M"
+  using assms Replace_in_M[of \<phi>] by auto
+
+lemma ren_action :
+  assumes
+    "env\<in>list(M)" "x\<in>M" "y\<in>M" "z\<in>M"
+  shows "\<forall> i . i < 2+\<^sub>\<omega>length(env) \<longrightarrow>
+          nth(i,[x,z]@env) = nth(\<rho>_repl(length(env))`i,[z,x,y]@env)"
+proof -
+  let ?f="{\<langle>0, 1\<rangle>, \<langle>1, 0\<rangle>}"
+  have 1:"(\<And>j. j < length(env) \<Longrightarrow> nth(j, env) = nth(id(length(env)) ` j, env))"
+    using assms ltD by simp
+  have 2:"nth(j, [x,z]) = nth(?f ` j, [z,x,y])" if "j<2" for j
+  proof -
+    consider "j=0" | "j=1" using  ltD[OF \<open>j<2\<close>] by auto
+    then show ?thesis
+    proof(cases)
+      case 1
+      then show ?thesis using apply_equality f_type by simp
+    next
+      case 2
+      then show ?thesis using apply_equality f_type by simp
+    qed
+  qed
+  show ?thesis
+    using sum_action[OF _ _ _ _ f_type id_type _ _ _ _ _ _ _ 2 1,simplified] assms
+    unfolding \<rho>_repl_def by simp
+qed
+
+lemma Lambda_in_M :
+  assumes
+    f_fm:  "\<phi> \<in> formula" and
+    f_ar:  "arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)" and
+    fsats: "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,y)" and
+    fabs:  "\<And>x y. x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> is_f(x,y) \<longleftrightarrow> y = f(x)" and
+    fclosed: "\<And>x. x\<in>A \<Longrightarrow> f(x) \<in> M" and
+    "A\<in>M" "env\<in>list(M)" and
+    phi'_replacement2: "replacement_assm(M,env@[A],Lambda_in_M_fm(\<phi>,length(env)))"
+  shows "(\<lambda>x\<in>A . f(x)) \<in>M"
+  unfolding lam_def
+proof -
+  let ?ren="\<rho>_repl(length(env))"
+  let ?j="2+\<^sub>\<omega>length(env)"
+  let ?k="3+\<^sub>\<omega>length(env)"
+  let ?\<psi>="ren(\<phi>)`?j`?k`?ren"
+  let ?\<phi>'="Exists(And(pair_fm(1,0,2),?\<psi>))"
+  let ?p="\<lambda>x y. \<exists>z\<in>M. pair(##M,x,z,y) \<and> is_f(x,z)"
+  have "?\<phi>'\<in>formula" "?\<psi>\<in>formula"
+    using \<open>env\<in>_\<close> length_type f_fm ren_type ren_tc[of \<phi> "2+\<^sub>\<omega>length(env)" "3+\<^sub>\<omega>length(env)" ?ren]
+    by simp_all
+  moreover from this
+  have "arity(?\<psi>)\<le>3+\<^sub>\<omega>(length(env))" "arity(?\<psi>)\<in>nat"
+    using assms arity_ren[OF f_fm _ _ ren_type,of "length(env)"] by simp_all
+  then
+  have "arity(?\<phi>') \<le> 2+\<^sub>\<omega>(length(env))"
+    using Un_le pred_Un_distrib assms pred_le
+    by (simp add:arity)
+  moreover from this calculation
+  have "x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> ?\<phi>') \<longleftrightarrow> ?p(x,y)" for x y
+    using \<open>env\<in>_\<close> length_type[OF \<open>env\<in>_\<close>] assms transitivity[OF _ \<open>A\<in>M\<close>]
+      sats_iff_sats_ren[OF f_fm _ _ _ _ ren_type f_ar ren_action[rule_format,of _ x y],of _ M ]
+    by auto
+  moreover
+  have "x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> ?p(x,y) \<longleftrightarrow> y = <x,f(x)>" for x y
+    using assms transitivity[OF _ \<open>A\<in>_\<close>] fclosed
+    by simp
+  moreover
+  have "\<And> x . x\<in>A \<Longrightarrow> <x,f(x)> \<in> M"
+    using transitivity[OF _ \<open>A\<in>M\<close>] pair_in_M_iff fclosed by simp
+  ultimately
+  show "{\<langle>x,f(x)\<rangle> . x\<in>A } \<in> M"
+    using Replace_in_M[of ?\<phi>' env A] phi'_replacement2 \<open>A\<in>M\<close> \<open>env\<in>_\<close>
+    by simp
+qed
+
+lemma ren_action' :
+  assumes
+    "env\<in>list(M)" "x\<in>M" "y\<in>M" "z\<in>M" "u\<in>M"
+  shows "\<forall> i . i < 3+\<^sub>\<omega>length(env) \<longrightarrow>
+          nth(i,[x,z,u]@env) = nth(\<rho>_pair_repl(length(env))`i,[x,z,y,u]@env)"
+proof -
+  let ?f="{\<langle>0, 0\<rangle>, \<langle>1, 1\<rangle>, \<langle>2,3\<rangle>}"
+  have 1:"(\<And>j. j < length(env) \<Longrightarrow> nth(j, env) = nth(id(length(env)) ` j, env))"
+    using assms ltD by simp
+  have 2:"nth(j, [x,z,u]) = nth(?f ` j, [x,z,y,u])" if "j<3" for j
+  proof -
+    consider "j=0" | "j=1" | "j=2" using  ltD[OF \<open>j<3\<close>] by auto
+    then show ?thesis
+    proof(cases)
+      case 1
+      then show ?thesis using apply_equality f_type' by simp
+    next
+      case 2
+      then show ?thesis using apply_equality f_type' by simp
+    next
+      case 3
+      then show ?thesis using apply_equality f_type' by simp
+    qed
+  qed
+  show ?thesis
+    using sum_action[OF _ _ _ _ f_type' id_type _ _ _ _ _ _ _ 2 1,simplified] assms
+    unfolding \<rho>_pair_repl_def by simp
+qed
+
+lemma LambdaPair_in_M :
+  assumes
+    f_fm:  "\<phi> \<in> formula" and
+    f_ar:  "arity(\<phi>)\<le> 3 +\<^sub>\<omega> length(env)" and
+    fsats: "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> (M,[x,z,r]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,z,r)" and
+    fabs:  "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> is_f(x,z,r) \<longleftrightarrow> r = f(x,z)" and
+    fclosed: "\<And>x z. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> f(x,z) \<in> M" and
+    "A\<in>M" "env\<in>list(M)" and
+    phi'_replacement3: "replacement_assm(M,env@[A],LambdaPair_in_M_fm(\<phi>,length(env)))"
+  shows "(\<lambda>x\<in>A . f(fst(x),snd(x))) \<in>M"
+proof -
+  let ?ren="\<rho>_pair_repl(length(env))"
+  let ?j="3+\<^sub>\<omega>length(env)"
+  let ?k="4+\<^sub>\<omega>length(env)"
+  let ?\<psi>="ren(\<phi>)`?j`?k`?ren"
+  let ?\<phi>'="Exists(Exists(And(fst_fm(2,0),(And(snd_fm(2,1),?\<psi>)))))"
+  let ?p="\<lambda>x y. is_f(fst(x),snd(x),y)"
+  have "?\<phi>'\<in>formula" "?\<psi>\<in>formula"
+    using \<open>env\<in>_\<close> length_type f_fm ren_type' ren_tc[of \<phi> ?j ?k ?ren]
+    by simp_all
+  moreover from this
+  have "arity(?\<psi>)\<le>4+\<^sub>\<omega>(length(env))" "arity(?\<psi>)\<in>nat"
+    using assms arity_ren[OF f_fm _ _ ren_type',of "length(env)"] by simp_all
+  moreover from calculation
+  have 1:"arity(?\<phi>') \<le> 2+\<^sub>\<omega>(length(env))" "?\<phi>'\<in>formula"
+    using Un_le pred_Un_distrib assms pred_le
+    by (simp_all add:arity)
+  moreover from this calculation
+  have 2:"x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> (M,[x,y]@env \<Turnstile> ?\<phi>') \<longleftrightarrow> ?p(x,y)" for x y
+    using
+      sats_iff_sats_ren[OF f_fm _ _ _ _ ren_type' f_ar
+        ren_action'[rule_format,of _ "fst(x)" x "snd(x)" y],simplified]
+      \<open>env\<in>_\<close> length_type[OF \<open>env\<in>_\<close>] transitivity[OF _ \<open>A\<in>M\<close>]
+      fst_snd_closed pair_in_M_iff fsats[of "fst(x)" "snd(x)" y,symmetric]
+      fst_abs snd_abs
+    by auto
+  moreover from assms
+  have 3:"x\<in>A \<Longrightarrow> y\<in>M \<Longrightarrow> ?p(x,y) \<longleftrightarrow> y = f(fst(x),snd(x))" for x y
+    using fclosed fst_snd_closed pair_in_M_iff fabs transitivity
+    by auto
+  moreover
+  have 4:"\<And> x . x\<in>A \<Longrightarrow> <x,f(fst(x),snd(x))> \<in> M" "\<And> x . x\<in>A \<Longrightarrow> f(fst(x),snd(x)) \<in> M"
+    using transitivity[OF _ \<open>A\<in>M\<close>] pair_in_M_iff fclosed fst_snd_closed
+    by simp_all
+  ultimately
+  show ?thesis
+    using Lambda_in_M[unfolded Lambda_in_M_fm_def, of ?\<phi>', OF _ _ _ _ _ _ _
+        phi'_replacement3[unfolded LambdaPair_in_M_fm_def]]
+      \<open>env\<in>_\<close> \<open>A\<in>_\<close> by simp
+
+qed
+
+lemma (in M_ZF1_trans) lam_replacement2_in_ctm :
+  assumes
+    f_fm:  "\<phi> \<in> formula" and
+    f_ar:  "arity(\<phi>)\<le> 3 +\<^sub>\<omega> length(env)" and
+    fsats: "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> (M,[x,z,r]@env \<Turnstile> \<phi>) \<longleftrightarrow> is_f(x,z,r)" and
+    fabs:  "\<And>x z r. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> is_f(x,z,r) \<longleftrightarrow> r = f(x,z)" and
+    fclosed: "\<And>x z. x\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> f(x,z) \<in> M" and
+    "env\<in>list(M)" and
+    phi'_replacement3: "\<And>A. A\<in>M \<Longrightarrow> replacement_assm(M,env@[A],LambdaPair_in_M_fm(\<phi>,length(env)))"
+  shows "lam_replacement(##M , \<lambda>x . f(fst(x),snd(x)))"
+  using
+    LambdaPair_in_M fabs
+    f_ar ord_simp_union transitivity assms fst_snd_closed
+  by (rule_tac lam_replacement_iff_lam_closed[THEN iffD2],simp_all)
+
+simple_rename "ren_U" src "[z1,x_P, x_leq, x_o, x_t, z2_c]"
+  tgt "[z2_c,z1,z,x_P, x_leq, x_o, x_t]"
+
+simple_rename "ren_V" src "[fz,x_P, x_leq, x_o,x_f, x_t, gz]"
+  tgt "[gz,fz,z,x_P, x_leq, x_o,x_f, x_t]"
+
+simple_rename "ren_V3" src "[fz,x_P, x_leq, x_o,x_f, gz, hz]"
+  tgt "[hz,gz,fz,z,x_P, x_leq, x_o,x_f]"
+
+lemma separation_sat_after_function_1:
+  assumes "[a,b,c,d]\<in>list(M)" and  "\<chi>\<in>formula" and "arity(\<chi>) \<le> 6"
+    and
+    f_fm:  "f_fm \<in> formula" and
+    f_ar:  "arity(f_fm) \<le> 6" and
+    fsats: "\<And> fx x. fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[fx,x]@[a, b, c, d] \<Turnstile> f_fm) \<longleftrightarrow> fx=f(x)" and
+    fclosed: "\<And>x . x\<in>M \<Longrightarrow> f(x) \<in> M" and
+    g_fm:  "g_fm \<in> formula" and
+    g_ar:  "arity(g_fm) \<le> 7" and
+    gsats: "\<And> gx fx x. gx\<in>M \<Longrightarrow>  fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[gx,fx,x]@[a, b, c, d] \<Turnstile> g_fm) \<longleftrightarrow> gx=g(x)" and
+    gclosed: "\<And>x . x\<in>M \<Longrightarrow> g(x) \<in> M"
+  shows  "separation(##M, \<lambda>r. M, [f(r), a, b, c, d, g(r)] \<Turnstile> \<chi>)"
+proof -
+  note types = assms(1-4)
+  let ?\<psi>="ren(\<chi>)`6`7`ren_U_fn"
+  let  ?\<psi>'="Exists(And(f_fm,Exists(And(g_fm,?\<psi>))))"
+  let ?\<rho>="\<lambda>z.[f(z), a, b, c, d, g(z)]"
+  let ?env="[a, b, c, d]"
+  let ?\<eta>="\<lambda>z.[g(z),f(z),z]@?env"
+  note types
+  moreover from this
+  have "arity(\<chi>) \<le> 7" "?\<psi>\<in>formula"
+    using ord_simp_union ren_tc ren_U_thm(2)[folded ren_U_fn_def] le_trans[of "arity(\<chi>)" 6]
+    by simp_all
+  moreover from calculation
+  have "arity(?\<psi>) \<le> 7" "?\<psi>'\<in>formula"
+    using arity_ren ren_U_thm(2)[folded ren_U_fn_def] f_fm g_fm
+    by simp_all
+  moreover from calculation f_ar g_ar f_fm g_fm
+  have "arity(?\<psi>') \<le> 5"
+    using ord_simp_union pred_le arity_type
+    by (simp add:arity)
+  moreover from calculation fclosed gclosed
+  have 0:"(M, [f(z), a, b, c, d,  g(z)] \<Turnstile> \<chi>) \<longleftrightarrow> (M,?\<eta>(z)\<Turnstile> ?\<psi>)" if "(##M)(z)" for z
+    using sats_iff_sats_ren[of \<chi> 6 7 _ _ "?\<eta>(z)"]
+      ren_U_thm(1)[where A=M,folded ren_U_fn_def] ren_U_thm(2)[folded ren_U_fn_def] that
+    by simp
+  moreover from calculation
+  have 1:"(M,?\<eta>(z)\<Turnstile> ?\<psi>) \<longleftrightarrow> M,[z]@?env\<Turnstile>?\<psi>'" if "(##M)(z)" for z
+    using that fsats[OF fclosed[of z],of z]  gsats[of "g(z)" "f(z)" z] fclosed gclosed f_fm g_fm
+  proof(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp,(auto)[1])
+    assume "M, [z] @ [a, b, c, d] \<Turnstile> (\<cdot>\<exists>\<cdot>f_fm \<and> (\<cdot>\<exists>\<cdot>g_fm \<and> ren(\<chi>) ` 6 ` 7 ` ren_U_fn\<cdot>\<cdot>)\<cdot>\<cdot>)"
+    then
+    have "\<exists>xa\<in>M. (M, [xa, z, a, b, c, d] \<Turnstile> f_fm) \<and>
+          (\<exists>x\<in>M. (M, [x, xa, z, a, b, c, d] \<Turnstile> g_fm) \<and>
+            (M, [x, xa, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 6 ` 7 ` ren_U_fn))"
+      using that calculation by auto
+    then
+    obtain xa x where "x\<in>M" "xa\<in>M" "M, [xa, z, a, b, c, d] \<Turnstile> f_fm"
+      "(M, [x, xa, z, a, b, c, d] \<Turnstile> g_fm)"
+      "(M, [x, xa, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 6 ` 7 ` ren_U_fn)"
+      using that calculation by auto
+    moreover from this
+    have "xa=f(z)" "x=g(z)" using fsats[of xa]  gsats[of x xa] that by simp_all
+    ultimately
+    show "M, [g(z), f(z), z] @ [a, b, c, d] \<Turnstile> ren(\<chi>) ` 6 ` 7 ` ren_U_fn"
+      by auto
+  qed
+  moreover from calculation
+  have "separation(##M, \<lambda>z. (M,[z]@?env \<Turnstile> ?\<psi>'))"
+    using separation_ax
+    by simp_all
+  ultimately
+  show ?thesis
+    by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
+qed
+
+lemma separation_sat_after_function3:
+  assumes "[a, b, c, d]\<in>list(M)" and  "\<chi>\<in>formula" and "arity(\<chi>) \<le> 7"
+    and
+    f_fm:  "f_fm \<in> formula" and
+    f_ar:  "arity(f_fm) \<le> 6" and
+    fsats: "\<And> fx x. fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[fx,x]@[a, b, c, d] \<Turnstile> f_fm) \<longleftrightarrow> fx=f(x)" and
+    fclosed: "\<And>x . x\<in>M \<Longrightarrow> f(x) \<in> M" and
+    g_fm:  "g_fm \<in> formula" and
+    g_ar:  "arity(g_fm) \<le> 7" and
+    gsats: "\<And> gx fx x. gx\<in>M \<Longrightarrow> fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[gx,fx,x]@[a, b, c, d] \<Turnstile> g_fm) \<longleftrightarrow> gx=g(x)" and
+    gclosed: "\<And>x . x\<in>M \<Longrightarrow> g(x) \<in> M" and
+    h_fm:  "h_fm \<in> formula" and
+    h_ar:  "arity(h_fm) \<le> 8" and
+    hsats: "\<And> hx gx fx x. hx\<in>M \<Longrightarrow> gx\<in>M \<Longrightarrow> fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[hx,gx,fx,x]@[a, b, c, d] \<Turnstile> h_fm) \<longleftrightarrow> hx=h(x)" and
+    hclosed: "\<And>x . x\<in>M \<Longrightarrow> h(x) \<in> M"
+  shows  "separation(##M, \<lambda>r. M, [f(r), a, b, c, d, g(r), h(r)] \<Turnstile> \<chi>)"
+proof -
+  note types = assms(1-3)
+  let ?\<phi>="\<chi>"
+  let ?\<psi>="ren(?\<phi>)`7`8`ren_V3_fn"
+  let ?\<psi>'="Exists(And(f_fm,Exists(And(g_fm,Exists(And(h_fm,?\<psi>))))))"
+  let ?\<rho>="\<lambda>z.[f(z), a, b, c, d,g(z), h(z)]"
+  let ?env="[a, b, c, d]"
+  let ?\<eta>="\<lambda>z.[h(z),g(z),f(z),z]@?env"
+  note types
+  moreover from this
+  have "?\<phi>\<in>formula" by simp
+  moreover from calculation
+  have "arity(?\<phi>) \<le> 9" "?\<psi>\<in>formula"
+    using ord_simp_union ren_tc ren_V3_thm(2)[folded ren_V3_fn_def] le_trans[of "arity(\<chi>)" 7]
+    by simp_all
+  moreover from calculation
+  have "arity(?\<psi>) \<le> 8" "?\<psi>'\<in>formula"
+    using arity_ren ren_V3_thm(2)[folded ren_V3_fn_def] f_fm g_fm h_fm
+    by (simp_all)
+  moreover from this f_ar g_ar f_fm g_fm h_fm h_ar \<open>?\<psi>'\<in>_\<close>
+  have "arity(?\<psi>') \<le> 5"
+    using ord_simp_union arity_type nat_into_Ord
+    by (simp add:arity,(rule_tac pred_le,simp,rule_tac Un_le,simp)+,simp_all add: \<open>?\<psi>\<in>_\<close>)
+  moreover from calculation fclosed gclosed hclosed
+  have 0:"(M, ?\<rho>(z) \<Turnstile> ?\<phi>) \<longleftrightarrow> (M,?\<eta>(z)\<Turnstile> ?\<psi>)" if "(##M)(z)" for z
+    using sats_iff_sats_ren[of ?\<phi> 7 8 "?\<rho>(z)" M "?\<eta>(z)"]
+      ren_V3_thm(1)[where A=M,folded ren_V3_fn_def,simplified] ren_V3_thm(2)[folded ren_V3_fn_def] that
+    by simp
+  moreover from calculation
+  have 1:"(M,?\<eta>(z)\<Turnstile> ?\<psi>) \<longleftrightarrow> M,[z]@?env\<Turnstile>?\<psi>'" if "(##M)(z)" for z
+    using that fsats[OF fclosed[of z],of z] gsats[of "g(z)" "f(z)" z]
+      hsats[of "h(z)" "g(z)" "f(z)" z]
+      fclosed gclosed hclosed f_fm g_fm h_fm
+    apply(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp)
+     apply(rule_tac conjI,simp,rule_tac rev_bexI[where x="g(z)"],simp)
+     apply(rule_tac conjI,simp,rule_tac rev_bexI[where x="h(z)"],simp,rule_tac conjI,simp,simp)
+  proof -
+    assume "M, [z] @ [a, b, c, d] \<Turnstile> (\<cdot>\<exists>\<cdot>f_fm \<and> (\<cdot>\<exists>\<cdot>g_fm \<and> (\<cdot>\<exists>\<cdot>h_fm \<and> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn\<cdot>\<cdot>)\<cdot>\<cdot>)\<cdot>\<cdot>)"
+    with calculation that
+    have "\<exists>x\<in>M. (M, [x, z, a, b, c, d] \<Turnstile> f_fm) \<and>
+           (\<exists>xa\<in>M. (M, [xa, x, z, a, b, c, d] \<Turnstile> g_fm) \<and> (\<exists>xb\<in>M. (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm) \<and> (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn)))"
+      by auto
+    with calculation
+    obtain x where "x\<in>M" "(M, [x, z, a, b, c, d] \<Turnstile> f_fm)"
+      "(\<exists>xa\<in>M. (M, [xa, x, z, a, b, c, d] \<Turnstile> g_fm) \<and> (\<exists>xb\<in>M. (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm) \<and> (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn)))"
+      by force
+    moreover from this
+    have "x=f(z)" using fsats[of x] that by simp
+    moreover from calculation
+    obtain xa where "xa\<in>M" "(M, [xa, x, z, a, b, c, d] \<Turnstile> g_fm)"
+      "(\<exists>xb\<in>M. (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm) \<and> (M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn))"
+      by auto
+    moreover from calculation
+    have "xa=g(z)" using gsats[of xa x] that by simp
+    moreover from calculation
+    obtain xb where "xb\<in>M" "(M, [xb, xa, x, z, a, b, c, d] \<Turnstile> h_fm)"
+      "(M, [xb, xa, x, z, a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn)"
+      by auto
+    moreover from calculation
+    have "xb=h(z)" using hsats[of xb xa x] that by simp
+    ultimately
+    show "M, [h(z), g(z), f(z), z] @ [a, b, c, d] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V3_fn"
+      by auto
+  qed
+  moreover from calculation \<open>?\<psi>'\<in>_\<close>
+  have "separation(##M, \<lambda>z. (M,[z]@?env \<Turnstile> ?\<psi>'))"
+    using separation_ax
+    by simp
+  ultimately
+  show ?thesis
+    by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
+qed
+
+lemma separation_sat_after_function:
+  assumes "[a, b, c, d, \<tau>]\<in>list(M)" and  "\<chi>\<in>formula" and "arity(\<chi>) \<le> 7"
+    and
+    f_fm:  "f_fm \<in> formula" and
+    f_ar:  "arity(f_fm) \<le> 7" and
+    fsats: "\<And> fx x. fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[fx,x]@[a, b, c, d, \<tau>] \<Turnstile> f_fm) \<longleftrightarrow> fx=f(x)" and
+    fclosed: "\<And>x . x\<in>M \<Longrightarrow> f(x) \<in> M" and
+    g_fm:  "g_fm \<in> formula" and
+    g_ar:  "arity(g_fm) \<le> 8" and
+    gsats: "\<And> gx fx x. gx\<in>M \<Longrightarrow>  fx\<in>M \<Longrightarrow> x\<in>M \<Longrightarrow> (M,[gx,fx,x]@[a, b, c, d, \<tau>] \<Turnstile> g_fm) \<longleftrightarrow> gx=g(x)" and
+    gclosed: "\<And>x . x\<in>M \<Longrightarrow> g(x) \<in> M"
+  shows  "separation(##M, \<lambda>r. M, [f(r), a, b, c, d, \<tau>, g(r)] \<Turnstile> \<chi>)"
+proof -
+  note types = assms(1-3)
+  let ?\<phi>="\<chi>"
+  let ?\<psi>="ren(?\<phi>)`7`8`ren_V_fn"
+  let  ?\<psi>'="Exists(And(f_fm,Exists(And(g_fm,?\<psi>))))"
+  let ?\<rho>="\<lambda>z.[f(z), a, b, c, d, \<tau>, g(z)]"
+  let ?env="[a, b, c, d, \<tau>]"
+  let ?\<eta>="\<lambda>z.[g(z),f(z),z]@?env"
+  note types
+  moreover from this
+  have "?\<phi>\<in>formula" by simp
+  moreover from calculation
+  have "arity(?\<phi>) \<le> 8" "?\<psi>\<in>formula"
+    using ord_simp_union ren_tc ren_V_thm(2)[folded ren_V_fn_def] le_trans[of "arity(\<chi>)" 7]
+    by simp_all
+  moreover from calculation
+  have "arity(?\<psi>) \<le> 8" "?\<psi>'\<in>formula"
+    using arity_ren ren_V_thm(2)[folded ren_V_fn_def] f_fm g_fm
+    by (simp_all)
+  moreover from calculation f_ar g_ar f_fm g_fm
+  have "arity(?\<psi>') \<le> 6"
+    using ord_simp_union pred_le arity_type
+    by (simp add:arity)
+  moreover from calculation fclosed gclosed
+  have 0:"(M, ?\<rho>(z) \<Turnstile> ?\<phi>) \<longleftrightarrow> (M,?\<eta>(z)\<Turnstile> ?\<psi>)" if "(##M)(z)" for z
+    using sats_iff_sats_ren[of ?\<phi> 7 8 "?\<rho>(z)" _ "?\<eta>(z)"]
+      ren_V_thm(1)[where A=M,folded ren_V_fn_def] ren_V_thm(2)[folded ren_V_fn_def] that
+    by simp
+  moreover from calculation
+  have 1:"(M,?\<eta>(z)\<Turnstile> ?\<psi>) \<longleftrightarrow> M,[z]@?env\<Turnstile>?\<psi>'" if "(##M)(z)" for z
+    using that fsats[OF fclosed[of z],of z]  gsats[of "g(z)" "f(z)" z]
+      fclosed gclosed f_fm g_fm
+    apply(rule_tac iffI,simp,rule_tac rev_bexI[where x="f(z)"],simp)
+     apply(auto)[1]
+  proof -
+    assume "M, [z] @ [a, b, c, d, \<tau>] \<Turnstile> (\<cdot>\<exists>\<cdot>f_fm \<and> (\<cdot>\<exists>\<cdot>g_fm \<and> ren(\<chi>) ` 7 ` 8 ` ren_V_fn\<cdot>\<cdot>)\<cdot>\<cdot>)"
+    then have "\<exists>xa\<in>M. (M, [xa, z, a, b, c, d, \<tau>] \<Turnstile> f_fm) \<and>
+       (\<exists>x\<in>M. (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> g_fm) \<and> (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn))"
+      using that calculation by auto
+    then
+    obtain xa where "xa\<in>M" "M, [xa, z, a, b, c, d, \<tau>] \<Turnstile> f_fm"
+      "(\<exists>x\<in>M. (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> g_fm) \<and> (M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn))"
+      by auto
+    moreover from this
+    have "xa=f(z)" using fsats[of xa] that by simp
+    moreover from calculation
+    obtain x where "x\<in>M" "M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> g_fm" "M, [x, xa, z, a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn"
+      by auto
+    moreover from calculation
+    have "x=g(z)" using gsats[of x xa] that by simp
+    ultimately
+    show "M, [g(z), f(z), z] @ [a, b, c, d, \<tau>] \<Turnstile> ren(\<chi>) ` 7 ` 8 ` ren_V_fn"
+      by auto
+  qed
+  moreover from calculation
+  have "separation(##M, \<lambda>z. (M,[z]@?env \<Turnstile> ?\<psi>'))"
+    using separation_ax
+    by simp_all
+  ultimately
+  show ?thesis
+    by(rule_tac separation_cong[THEN iffD2,OF iff_trans[OF 0 1]],clarify,force)
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_Z_trans\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Internal_ZFC_Axioms.thy b/thys/Independence_CH/Internal_ZFC_Axioms.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Internal_ZFC_Axioms.thy
@@ -0,0 +1,520 @@
+section\<open>The ZFC axioms, internalized\<close>
+theory Internal_ZFC_Axioms
+  imports
+    Forcing_Data
+
+begin
+
+schematic_goal ZF_union_auto:
+    "Union_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfunion)"
+  unfolding Union_ax_def
+  by ((rule sep_rules | simp)+)
+
+synthesize "ZF_union" from_schematic ZF_union_auto
+notation ZF_union_fm (\<open>\<cdot>Union Ax\<cdot>\<close>)
+
+schematic_goal ZF_power_auto:
+    "power_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfpow)"
+  unfolding power_ax_def powerset_def subset_def
+  by ((rule sep_rules | simp)+)
+
+synthesize "ZF_power" from_schematic ZF_power_auto
+notation ZF_power_fm (\<open>\<cdot>Powerset Ax\<cdot>\<close>)
+
+schematic_goal ZF_pairing_auto:
+    "upair_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfpair)"
+  unfolding upair_ax_def
+  by ((rule sep_rules | simp)+)
+
+synthesize "ZF_pairing" from_schematic ZF_pairing_auto
+notation ZF_pairing_fm (\<open>\<cdot>Pairing\<cdot>\<close>)
+
+schematic_goal ZF_foundation_auto:
+    "foundation_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zffound)"
+  unfolding foundation_ax_def
+  by ((rule sep_rules | simp)+)
+
+synthesize "ZF_foundation" from_schematic ZF_foundation_auto
+notation ZF_foundation_fm (\<open>\<cdot>Foundation\<cdot>\<close>)
+
+schematic_goal ZF_extensionality_auto:
+    "extensionality(##A) \<longleftrightarrow> (A, [] \<Turnstile> ?zfext)"
+  unfolding extensionality_def
+  by ((rule sep_rules | simp)+)
+
+synthesize "ZF_extensionality" from_schematic ZF_extensionality_auto
+notation ZF_extensionality_fm (\<open>\<cdot>Extensionality\<cdot>\<close>)
+
+schematic_goal ZF_infinity_auto:
+    "infinity_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> (?\<phi>(i,j,h)))"
+  unfolding infinity_ax_def
+  by ((rule sep_rules | simp)+)
+
+synthesize "ZF_infinity" from_schematic ZF_infinity_auto
+notation ZF_infinity_fm (\<open>\<cdot>Infinity\<cdot>\<close>)
+
+schematic_goal ZF_choice_auto:
+    "choice_ax(##A) \<longleftrightarrow> (A, [] \<Turnstile> (?\<phi>(i,j,h)))"
+  unfolding choice_ax_def
+  by ((rule sep_rules | simp)+)
+
+synthesize "ZF_choice" from_schematic ZF_choice_auto
+notation ZF_choice_fm (\<open>\<cdot>AC\<cdot>\<close>)
+
+lemmas ZFC_fm_defs = ZF_extensionality_fm_def ZF_foundation_fm_def ZF_pairing_fm_def
+              ZF_union_fm_def ZF_infinity_fm_def ZF_power_fm_def ZF_choice_fm_def
+
+lemmas ZFC_fm_sats = ZF_extensionality_auto ZF_foundation_auto ZF_pairing_auto
+              ZF_union_auto ZF_infinity_auto ZF_power_auto ZF_choice_auto
+
+definition
+  ZF_fin :: "i" where
+  "ZF_fin \<equiv> {\<cdot>Extensionality\<cdot>, \<cdot>Foundation\<cdot>, \<cdot>Pairing\<cdot>,
+              \<cdot>Union Ax\<cdot>, \<cdot>Infinity\<cdot>, \<cdot>Powerset Ax\<cdot>}"
+
+subsection\<open>The Axiom of Separation, internalized\<close>
+lemma iterates_Forall_type [TC]:
+      "\<lbrakk> n \<in> nat; p \<in> formula \<rbrakk> \<Longrightarrow> Forall^n(p) \<in> formula"
+  by (induct set:nat, auto)
+
+lemma last_init_eq :
+  assumes "l \<in> list(A)" "length(l) = succ(n)"
+  shows "\<exists> a\<in>A. \<exists>l'\<in>list(A). l = l'@[a]"
+proof-
+  from \<open>l\<in>_\<close> \<open>length(_) = _\<close>
+  have "rev(l) \<in> list(A)" "length(rev(l)) = succ(n)"
+    by simp_all
+  then
+  obtain a l' where "a\<in>A" "l'\<in>list(A)" "rev(l) = Cons(a,l')"
+    by (cases;simp)
+  then
+  have "l = rev(l') @ [a]" "rev(l') \<in> list(A)"
+    using rev_rev_ident[OF \<open>l\<in>_\<close>] by auto
+  with \<open>a\<in>_\<close>
+  show ?thesis by blast
+qed
+
+lemma take_drop_eq :
+  assumes "l\<in>list(M)"
+  shows "\<And> n . n < succ(length(l)) \<Longrightarrow> l = take(n,l) @ drop(n,l)"
+  using \<open>l\<in>list(M)\<close>
+proof induct
+  case Nil
+  then show ?case by auto
+next
+  case (Cons a l)
+  then show ?case
+  proof -
+    {
+      fix i
+      assume "i<succ(succ(length(l)))"
+      with \<open>l\<in>list(M)\<close>
+      consider (lt) "i = 0" | (eq) "\<exists>k\<in>nat. i = succ(k) \<and> k < succ(length(l))"
+        using \<open>l\<in>list(M)\<close>  le_natI nat_imp_quasinat
+        by (cases rule:nat_cases[of i];auto)
+      then
+      have "take(i,Cons(a,l)) @ drop(i,Cons(a,l)) = Cons(a,l)"
+        using Cons
+        by (cases;auto)
+    }
+    then show ?thesis using Cons by auto
+  qed
+qed
+
+lemma list_split :
+assumes "n \<le> succ(length(rest))" "rest \<in> list(M)"
+shows  "\<exists>re\<in>list(M). \<exists>st\<in>list(M). rest = re @ st \<and> length(re) = pred(n)"
+proof -
+  from assms
+  have "pred(n) \<le> length(rest)"
+    using pred_mono[OF _ \<open>n\<le>_\<close>] pred_succ_eq by auto
+  with \<open>rest\<in>_\<close>
+  have "pred(n)\<in>nat" "rest = take(pred(n),rest) @ drop(pred(n),rest)" (is "_ = ?re @ ?st")
+    using take_drop_eq[OF \<open>rest\<in>_\<close>] le_natI by auto
+  then
+  have "length(?re) = pred(n)" "?re\<in>list(M)" "?st\<in>list(M)"
+    using length_take[rule_format,OF _ \<open>pred(n)\<in>_\<close>] \<open>pred(n) \<le> _\<close> \<open>rest\<in>_\<close>
+    unfolding min_def
+    by auto
+  then
+  show ?thesis
+    using rev_bexI[of _ _ "\<lambda> re. \<exists>st\<in>list(M). rest = re @ st \<and> length(re) = pred(n)"]
+      \<open>length(?re) = _\<close> \<open>rest = _\<close>
+    by auto
+qed
+
+lemma sats_nForall:
+  assumes
+    "\<phi> \<in> formula"
+  shows
+    "n\<in>nat \<Longrightarrow> ms \<in> list(M) \<Longrightarrow>
+       (M, ms \<Turnstile> (Forall^n(\<phi>))) \<longleftrightarrow>
+       (\<forall>rest \<in> list(M). length(rest) = n \<longrightarrow> M, rest @ ms \<Turnstile> \<phi>)"
+proof (induct n arbitrary:ms set:nat)
+  case 0
+  with assms
+  show ?case by simp
+next
+  case (succ n)
+  have "(\<forall>rest\<in>list(M). length(rest) = succ(n) \<longrightarrow> P(rest,n)) \<longleftrightarrow>
+        (\<forall>t\<in>M. \<forall>res\<in>list(M). length(res) = n \<longrightarrow> P(res @ [t],n))"
+    if "n\<in>nat" for n P
+    using that last_init_eq by force
+  from this[of _ "\<lambda>rest _. (M, rest @ ms \<Turnstile> \<phi>)"] \<open>n\<in>nat\<close>
+  have "(\<forall>rest\<in>list(M). length(rest) = succ(n) \<longrightarrow> M, rest @ ms \<Turnstile> \<phi>) \<longleftrightarrow>
+        (\<forall>t\<in>M. \<forall>res\<in>list(M). length(res) = n \<longrightarrow>  M, (res @ [t]) @ ms \<Turnstile> \<phi>)"
+    by simp
+    with assms succ(1,3) succ(2)[of "Cons(_,ms)"]
+  show ?case
+    using arity_sats_iff[of \<phi> _ M "Cons(_, ms @ _)"] app_assoc
+    by (simp)
+qed
+
+definition
+  sep_body_fm :: "i \<Rightarrow> i" where
+  "sep_body_fm(p) \<equiv> (\<cdot>\<forall>(\<cdot>\<exists>(\<cdot>\<forall>\<cdot>\<cdot>0 \<in> 1\<cdot> \<leftrightarrow> \<cdot>\<cdot>0 \<in> 2\<cdot> \<and> incr_bv1^2 (p) \<cdot>\<cdot>\<cdot>)\<cdot>)\<cdot>)"
+
+lemma sep_body_fm_type [TC]: "p \<in> formula \<Longrightarrow> sep_body_fm(p) \<in> formula"
+  by (simp add: sep_body_fm_def)
+
+lemma sats_sep_body_fm:
+  assumes
+    "\<phi> \<in> formula" "ms\<in>list(M)" "rest\<in>list(M)"
+  shows
+    "(M, rest @ ms \<Turnstile> sep_body_fm(\<phi>)) \<longleftrightarrow>
+     separation(##M,\<lambda>x. M, [x] @ rest @ ms \<Turnstile> \<phi>)"
+  using assms formula_add_params1[of _ 2 _ _ "[_,_]" ]
+  unfolding sep_body_fm_def separation_def by simp
+
+definition
+  ZF_separation_fm :: "i \<Rightarrow> i" (\<open>\<cdot>Separation'(_')\<cdot>\<close>) where
+  "ZF_separation_fm(p) \<equiv> Forall^(pred(arity(p)))(sep_body_fm(p))"
+
+lemma ZF_separation_fm_type [TC]: "p \<in> formula \<Longrightarrow> ZF_separation_fm(p) \<in> formula"
+  by (simp add: ZF_separation_fm_def)
+
+lemma sats_ZF_separation_fm_iff:
+  assumes
+    "\<phi>\<in>formula"
+  shows
+  "(M, [] \<Turnstile> \<cdot>Separation(\<phi>)\<cdot>)
+   \<longleftrightarrow>
+   (\<forall>env\<in>list(M). arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<longrightarrow>
+      separation(##M,\<lambda>x. M, [x] @ env \<Turnstile> \<phi>))"
+proof (intro iffI ballI impI)
+  let ?n="pred(arity(\<phi>))"
+  fix env
+  assume "M, [] \<Turnstile> ZF_separation_fm(\<phi>)"
+  assume "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" "env\<in>list(M)"
+  moreover from this
+  have "arity(\<phi>) \<le> succ(length(env))" by simp
+  then
+  obtain some rest where "some\<in>list(M)" "rest\<in>list(M)"
+    "env = some @ rest" "length(some) = pred(arity(\<phi>))"
+    using list_split[OF \<open>arity(\<phi>) \<le> succ(_)\<close> \<open>env\<in>_\<close>] by force
+  moreover from \<open>\<phi>\<in>_\<close>
+  have "arity(\<phi>) \<le> succ(pred(arity(\<phi>)))"
+   using succpred_leI by simp
+  moreover
+  note assms
+  moreover
+  assume "M, [] \<Turnstile> ZF_separation_fm(\<phi>)"
+  moreover from calculation
+  have "M, some \<Turnstile> sep_body_fm(\<phi>)"
+    using sats_nForall[of "sep_body_fm(\<phi>)" ?n]
+    unfolding ZF_separation_fm_def by simp
+  ultimately
+  show "separation(##M, \<lambda>x. M, [x] @ env \<Turnstile> \<phi>)"
+    unfolding ZF_separation_fm_def
+    using sats_sep_body_fm[of \<phi> "[]" M some]
+      arity_sats_iff[of \<phi> rest M "[_] @ some"]
+      separation_cong[of "##M" "\<lambda>x. M, Cons(x, some @ rest) \<Turnstile> \<phi>" _ ]
+    by simp
+next \<comment> \<open>almost equal to the previous implication\<close>
+  let ?n="pred(arity(\<phi>))"
+  assume asm:"\<forall>env\<in>list(M). arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env) \<longrightarrow>
+    separation(##M, \<lambda>x. M, [x] @ env \<Turnstile> \<phi>)"
+  {
+    fix some
+    assume "some\<in>list(M)" "length(some) = pred(arity(\<phi>))"
+    moreover
+    note \<open>\<phi>\<in>_\<close>
+    moreover from calculation
+    have "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(some)"
+      using le_trans[OF succpred_leI] succpred_leI by simp
+    moreover from calculation and asm
+    have "separation(##M, \<lambda>x. M, [x] @ some \<Turnstile> \<phi>)" by blast
+    ultimately
+    have "M, some \<Turnstile> sep_body_fm(\<phi>)"
+    using sats_sep_body_fm[of \<phi> "[]" M some]
+      arity_sats_iff[of \<phi> _ M "[_,_] @ some"]
+      strong_replacement_cong[of "##M" "\<lambda>x y. M, Cons(x, Cons(y, some @ _)) \<Turnstile> \<phi>" _ ]
+    by simp
+  }
+  with \<open>\<phi>\<in>_\<close>
+  show "M, [] \<Turnstile> ZF_separation_fm(\<phi>)"
+    using sats_nForall[of "sep_body_fm(\<phi>)" ?n]
+    unfolding ZF_separation_fm_def
+    by simp
+qed
+
+subsection\<open>The Axiom of Replacement, internalized\<close>
+schematic_goal sats_univalent_fm_auto:
+  assumes
+    (*    Q_iff_sats:"\<And>a b z env aa bb. nth(a,Cons(z,env)) = aa \<Longrightarrow> nth(b,Cons(z,env)) = bb \<Longrightarrow> z\<in>A
+          \<Longrightarrow> aa \<in> A \<Longrightarrow> bb \<in> A \<Longrightarrow> env\<in> list(A) \<Longrightarrow>
+                 Q(aa,bb) \<longleftrightarrow> (A, Cons(z,env) \<Turnstile> (Q_fm(a,b)))" \<comment> \<open>using only \<one> formula\<close> *)
+    Q_iff_sats:"\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
+                 Q(x,z) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q1_fm)"
+       "\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
+                 Q(x,y) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q2_fm)"
+    and
+    asms: "nth(i,env) = B" "i \<in> nat" "env \<in> list(A)"
+  shows
+    "univalent(##A,B,Q) \<longleftrightarrow> A,env \<Turnstile> ?ufm(i)"
+  unfolding univalent_def
+  by (insert asms; (rule sep_rules Q_iff_sats | simp)+)
+
+synthesize_notc "univalent" from_schematic sats_univalent_fm_auto
+
+lemma univalent_fm_type [TC]: "q1\<in> formula \<Longrightarrow> q2\<in>formula \<Longrightarrow> i\<in>nat \<Longrightarrow>
+  univalent_fm(q2,q1,i) \<in>formula"
+  by (simp add:univalent_fm_def)
+
+lemma sats_univalent_fm :
+  assumes
+    Q_iff_sats:"\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
+                 Q(x,z) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q1_fm)"
+       "\<And>x y z. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z\<in>A \<Longrightarrow>
+                 Q(x,y) \<longleftrightarrow> (A,Cons(z,Cons(y,Cons(x,env))) \<Turnstile> Q2_fm)"
+    and
+    asms: "nth(i,env) = B" "i \<in> nat" "env \<in> list(A)"
+  shows
+    "(A,env \<Turnstile> univalent_fm(Q1_fm,Q2_fm,i)) \<longleftrightarrow> univalent(##A,B,Q)"
+  unfolding univalent_fm_def using asms sats_univalent_fm_auto[OF Q_iff_sats] by simp
+
+definition
+  swap_vars :: "i\<Rightarrow>i" where
+  "swap_vars(\<phi>) \<equiv>
+      Exists(Exists(And(Equal(0,3),And(Equal(1,2),iterates(\<lambda>p. incr_bv(p)`2 , 2, \<phi>)))))"
+
+lemma swap_vars_type[TC] :
+  "\<phi>\<in>formula \<Longrightarrow> swap_vars(\<phi>) \<in>formula"
+  unfolding swap_vars_def by simp
+
+lemma sats_swap_vars :
+  "[x,y] @ env \<in> list(M) \<Longrightarrow> \<phi>\<in>formula \<Longrightarrow>
+    (M, [x,y] @ env \<Turnstile> swap_vars(\<phi>)) \<longleftrightarrow> M,[y,x] @ env \<Turnstile> \<phi>"
+  unfolding swap_vars_def
+  using sats_incr_bv_iff [of _ _ M _ "[y,x]"] by simp
+
+definition
+  univalent_Q1 :: "i \<Rightarrow> i" where
+  "univalent_Q1(\<phi>) \<equiv> incr_bv1(swap_vars(\<phi>))"
+
+definition
+  univalent_Q2 :: "i \<Rightarrow> i" where
+  "univalent_Q2(\<phi>) \<equiv> incr_bv(swap_vars(\<phi>))`0"
+
+lemma univalent_Qs_type [TC]:
+  assumes "\<phi>\<in>formula"
+  shows "univalent_Q1(\<phi>) \<in> formula" "univalent_Q2(\<phi>) \<in> formula"
+  unfolding univalent_Q1_def univalent_Q2_def using assms by simp_all
+
+lemma sats_univalent_fm_assm:
+  assumes
+    "x \<in> A" "y \<in> A" "z\<in>A" "env\<in> list(A)" "\<phi> \<in> formula"
+  shows
+    "(A, ([x,z] @ env) \<Turnstile> \<phi>) \<longleftrightarrow> (A, Cons(z,Cons(y,Cons(x,env))) \<Turnstile> (univalent_Q1(\<phi>)))"
+    "(A, ([x,y] @ env) \<Turnstile> \<phi>) \<longleftrightarrow> (A, Cons(z,Cons(y,Cons(x,env))) \<Turnstile> (univalent_Q2(\<phi>)))"
+  unfolding univalent_Q1_def univalent_Q2_def
+  using
+    sats_incr_bv_iff[of _ _ A _ "[]"] \<comment> \<open>simplifies iterates of \<^term>\<open>\<lambda>x. incr_bv(x)`0\<close>\<close>
+    sats_incr_bv1_iff[of _ "Cons(x,env)" A z y]
+    sats_swap_vars  assms
+   by simp_all
+
+definition
+  rep_body_fm :: "i \<Rightarrow> i" where
+  "rep_body_fm(p) \<equiv> Forall(Implies(
+        univalent_fm(univalent_Q1(incr_bv(p)`2),univalent_Q2(incr_bv(p)`2),0),
+        Exists(Forall(
+          Iff(Member(0,1),Exists(And(Member(0,3),incr_bv(incr_bv(p)`2)`2)))))))"
+
+lemma rep_body_fm_type [TC]: "p \<in> formula \<Longrightarrow> rep_body_fm(p) \<in> formula"
+  by (simp add: rep_body_fm_def)
+
+lemmas ZF_replacement_simps = formula_add_params1[of \<phi> 2 _ M "[_,_]" ]
+  sats_incr_bv_iff[of _ _ M _ "[]"] \<comment> \<open>simplifies iterates of \<^term>\<open>\<lambda>x. incr_bv(x)`0\<close>\<close>
+  sats_incr_bv_iff[of _ _ M _ "[_,_]"]\<comment> \<open>simplifies \<^term>\<open>\<lambda>x. incr_bv(x)`2\<close>\<close>
+  sats_incr_bv1_iff[of _ _ M] sats_swap_vars for \<phi> M
+
+lemma sats_rep_body_fm:
+  assumes
+    "\<phi> \<in> formula" "ms\<in>list(M)" "rest\<in>list(M)"
+  shows
+    "(M, rest @ ms \<Turnstile> rep_body_fm(\<phi>)) \<longleftrightarrow>
+     strong_replacement(##M,\<lambda>x y. M, [x,y] @ rest @ ms \<Turnstile> \<phi>)"
+  using assms ZF_replacement_simps
+  unfolding rep_body_fm_def strong_replacement_def univalent_def
+  unfolding univalent_fm_def univalent_Q1_def univalent_Q2_def
+  by simp
+
+definition
+  ZF_replacement_fm :: "i \<Rightarrow> i" (\<open>\<cdot>Replacement'(_')\<cdot>\<close>) where
+  "ZF_replacement_fm(p) \<equiv> Forall^(pred(pred(arity(p))))(rep_body_fm(p))"
+
+lemma ZF_replacement_fm_type [TC]: "p \<in> formula \<Longrightarrow> ZF_replacement_fm(p) \<in> formula"
+  by (simp add: ZF_replacement_fm_def)
+
+lemma sats_ZF_replacement_fm_iff:
+  assumes
+    "\<phi>\<in>formula"
+  shows
+  "(M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>)
+   \<longleftrightarrow>
+   (\<forall>env\<in>list(M). arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
+      strong_replacement(##M,\<lambda>x y. M,[x,y] @ env \<Turnstile> \<phi>))"
+proof (intro iffI ballI impI)
+  let ?n="pred(pred(arity(\<phi>)))"
+  fix env
+  assume "M, [] \<Turnstile> ZF_replacement_fm(\<phi>)" "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env)" "env\<in>list(M)"
+  moreover from this
+  have "arity(\<phi>) \<le> succ(succ(length(env)))" by (simp)
+  moreover from calculation
+  have "pred(arity(\<phi>)) \<le> succ(length(env))"
+    using pred_mono[OF _ \<open>arity(\<phi>)\<le>succ(_)\<close>] pred_succ_eq by simp
+  moreover from calculation
+  obtain some rest where "some\<in>list(M)" "rest\<in>list(M)"
+    "env = some @ rest" "length(some) = pred(pred(arity(\<phi>)))"
+    using list_split[OF \<open>pred(_) \<le> _\<close> \<open>env\<in>_\<close>] by auto
+  moreover
+  note \<open>\<phi>\<in>_\<close>
+  moreover from this
+  have "arity(\<phi>) \<le> succ(succ(pred(pred(arity(\<phi>)))))"
+    using le_trans[OF succpred_leI] succpred_leI by simp
+  moreover from calculation
+  have "M, some \<Turnstile> rep_body_fm(\<phi>)"
+    using sats_nForall[of "rep_body_fm(\<phi>)" ?n]
+    unfolding ZF_replacement_fm_def
+    by simp
+  ultimately
+  show "strong_replacement(##M, \<lambda>x y. M, [x, y] @ env \<Turnstile> \<phi>)"
+    using sats_rep_body_fm[of \<phi> "[]" M some]
+      arity_sats_iff[of \<phi> rest M "[_,_] @ some"]
+      strong_replacement_cong[of "##M" "\<lambda>x y. M, Cons(x, Cons(y, some @ rest)) \<Turnstile> \<phi>" _ ]
+    by simp
+next \<comment> \<open>almost equal to the previous implication\<close>
+  let ?n="pred(pred(arity(\<phi>)))"
+  assume asm:"\<forall>env\<in>list(M). arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env) \<longrightarrow>
+    strong_replacement(##M, \<lambda>x y. M, [x, y] @ env \<Turnstile> \<phi>)"
+  {
+    fix some
+    assume "some\<in>list(M)" "length(some) = pred(pred(arity(\<phi>)))"
+    moreover
+    note \<open>\<phi>\<in>_\<close>
+    moreover from calculation
+    have "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(some)"
+      using le_trans[OF succpred_leI] succpred_leI by simp
+    moreover from calculation and asm
+    have "strong_replacement(##M, \<lambda>x y. M, [x, y] @ some \<Turnstile> \<phi>)" by blast
+    ultimately
+    have "M, some \<Turnstile> rep_body_fm(\<phi>)"
+    using sats_rep_body_fm[of \<phi> "[]" M some]
+      arity_sats_iff[of \<phi> _ M "[_,_] @ some"]
+      strong_replacement_cong[of "##M" "\<lambda>x y. M, Cons(x, Cons(y, some @ _)) \<Turnstile> \<phi>" _ ]
+    by simp
+  }
+  with \<open>\<phi>\<in>_\<close>
+  show "M, [] \<Turnstile> ZF_replacement_fm(\<phi>)"
+    using sats_nForall[of "rep_body_fm(\<phi>)" ?n]
+    unfolding ZF_replacement_fm_def
+    by simp
+qed
+
+definition
+  ZF_schemes :: "i" where
+  "ZF_schemes \<equiv> {\<cdot>Separation(p)\<cdot> . p \<in> formula } \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> formula }"
+
+lemma Un_subset_formula [TC]: "A\<subseteq>formula \<and> B\<subseteq>formula \<Longrightarrow> A\<union>B \<subseteq> formula"
+  by auto
+
+lemma ZF_schemes_subset_formula [TC]: "ZF_schemes \<subseteq> formula"
+  unfolding ZF_schemes_def by auto
+
+lemma ZF_fin_subset_formula [TC]: "ZF_fin \<subseteq> formula"
+  unfolding ZF_fin_def by simp
+
+definition
+  ZF :: "i" where
+  "ZF \<equiv> ZF_schemes \<union> ZF_fin"
+
+lemma ZF_subset_formula [TC]: "ZF \<subseteq> formula"
+  unfolding ZF_def by auto
+
+definition
+  ZFC :: "i" where
+  "ZFC \<equiv> ZF \<union> {\<cdot>AC\<cdot>}"
+
+definition
+  ZF_minus_P :: "i" where
+  "ZF_minus_P \<equiv> ZF - { \<cdot>Powerset Ax\<cdot> }"
+
+definition
+  Zermelo_fms :: "i" (\<open>\<cdot>Z\<cdot>\<close>) where
+  "Zermelo_fms \<equiv> ZF_fin \<union> {\<cdot>Separation(p)\<cdot> . p \<in> formula }"
+
+definition
+  ZC :: "i" where
+  "ZC \<equiv> Zermelo_fms \<union> {\<cdot>AC\<cdot>}"
+
+lemma ZFC_subset_formula: "ZFC \<subseteq> formula"
+  by (simp add:ZFC_def Un_subset_formula)
+
+txt\<open>Satisfaction of a set of sentences\<close>
+definition
+  satT :: "[i,i] \<Rightarrow> o"  ("_ \<Turnstile> _" [36,36] 60) where
+  "A \<Turnstile> \<Phi>  \<equiv>  \<forall>\<phi>\<in>\<Phi>. (A,[] \<Turnstile> \<phi>)"
+
+lemma satTI [intro!]:
+  assumes "\<And>\<phi>. \<phi>\<in>\<Phi> \<Longrightarrow> A,[] \<Turnstile> \<phi>"
+  shows "A \<Turnstile> \<Phi>"
+  using assms unfolding satT_def by simp
+
+lemma satTD [dest] :"A \<Turnstile> \<Phi> \<Longrightarrow> \<phi>\<in>\<Phi> \<Longrightarrow> A,[] \<Turnstile> \<phi>"
+  unfolding satT_def by simp
+
+lemma satT_mono: "A \<Turnstile> \<Phi> \<Longrightarrow> \<Psi> \<subseteq> \<Phi> \<Longrightarrow> A \<Turnstile> \<Psi>"
+  by blast
+
+lemma satT_Un_iff: "M \<Turnstile> \<Phi> \<union> \<Psi> \<longleftrightarrow> M \<Turnstile> \<Phi> \<and> M \<Turnstile> \<Psi>" by auto
+
+lemma sats_ZFC_iff_sats_ZF_AC:
+  "(N \<Turnstile> ZFC) \<longleftrightarrow> (N \<Turnstile> ZF) \<and> (N, [] \<Turnstile> \<cdot>AC\<cdot>)"
+    unfolding ZFC_def ZF_def by auto
+
+lemma satT_ZF_imp_satT_Z: "M \<Turnstile> ZF \<Longrightarrow> M \<Turnstile> \<cdot>Z\<cdot>"
+  unfolding ZF_def ZF_schemes_def Zermelo_fms_def ZF_fin_def by auto
+
+lemma satT_ZFC_imp_satT_ZC: "M \<Turnstile> ZFC \<Longrightarrow> M \<Turnstile> ZC"
+  unfolding ZFC_def ZF_def ZF_schemes_def ZC_def Zermelo_fms_def by auto
+
+lemma satT_Z_ZF_replacement_imp_satT_ZF: "N \<Turnstile> \<cdot>Z\<cdot> \<Longrightarrow> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<Longrightarrow> N \<Turnstile> ZF"
+  unfolding ZF_def ZF_schemes_def Zermelo_fms_def ZF_fin_def by auto
+
+lemma satT_ZC_ZF_replacement_imp_satT_ZFC: "N \<Turnstile> ZC \<Longrightarrow> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<Longrightarrow> N \<Turnstile> ZFC"
+  unfolding ZFC_def ZF_def ZF_schemes_def ZC_def Zermelo_fms_def  by auto
+
+lemma ground_repl_fm_sub_ZF: "{\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> formula} \<subseteq> ZF"
+   unfolding ZF_def ZF_schemes_def by auto
+
+lemma ZF_replacement_fms_sub_ZFC: "{\<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> formula} \<subseteq> ZFC"
+   unfolding ZFC_def ZF_def ZF_schemes_def by auto
+
+lemma ground_repl_fm_sub_ZFC: "{\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> formula} \<subseteq> ZFC"
+   unfolding ZFC_def ZF_def ZF_schemes_def by auto
+
+lemma ZF_replacement_ground_repl_fm_type: "{\<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> formula} \<subseteq> formula"
+  by auto
+
+end
diff --git a/thys/Independence_CH/Kappa_Closed_Notions.thy b/thys/Independence_CH/Kappa_Closed_Notions.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Kappa_Closed_Notions.thy
@@ -0,0 +1,723 @@
+section\<open>Preservation results for $\kappa$-closed forcing notions\<close>
+
+theory Kappa_Closed_Notions
+  imports
+    Not_CH
+begin
+
+definition
+  lerel :: "i\<Rightarrow>i" where
+  "lerel(\<alpha>) \<equiv> Memrel(\<alpha>) \<union> id(\<alpha>)"
+
+lemma lerelI[intro!]: "x\<le>y \<Longrightarrow> y\<in>\<alpha> \<Longrightarrow> Ord(\<alpha>) \<Longrightarrow> \<langle>x,y\<rangle> \<in> lerel(\<alpha>)"
+  using Ord_trans[of x y \<alpha>] ltD unfolding lerel_def by auto
+
+lemma lerelD[dest]: "\<langle>x,y\<rangle> \<in> lerel(\<alpha>) \<Longrightarrow> Ord(\<alpha>) \<Longrightarrow> x\<le>y"
+  using ltI[THEN leI] Ord_in_Ord unfolding lerel_def by auto
+
+definition
+  mono_seqspace :: "[i,i,i] \<Rightarrow> i" (\<open>_ \<^sub><\<rightarrow> '(_,_')\<close> [61] 60) where
+  "\<alpha> \<^sub><\<rightarrow> (P,leq) \<equiv> mono_map(\<alpha>,Memrel(\<alpha>),P,leq)"
+
+relativize functional "mono_seqspace" "mono_seqspace_rel"
+relationalize "mono_seqspace_rel" "is_mono_seqspace"
+synthesize "is_mono_seqspace" from_definition assuming "nonempty"
+
+context M_ZF_library
+begin
+
+rel_closed for "mono_seqspace"
+  unfolding mono_seqspace_rel_def mono_map_rel_def
+  using separation_closed separation_ball separation_imp separation_in
+    lam_replacement_fst lam_replacement_snd lam_replacement_hcomp lam_replacement_constant
+    lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
+    lam_replacement_apply2[THEN[5] lam_replacement_hcomp2]
+  by simp_all
+
+end \<comment> \<open>\<^locale>\<open>M_ZF_library\<close>\<close>
+
+abbreviation
+  mono_seqspace_r (\<open>_ \<^sub><\<rightarrow>\<^bsup>_\<^esup> '(_,_')\<close> [61] 60) where
+  "\<alpha> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) \<equiv> mono_seqspace_rel(M,\<alpha>,P,leq)"
+
+abbreviation
+  mono_seqspace_r_set (\<open>_ \<^sub><\<rightarrow>\<^bsup>_\<^esup> '(_,_')\<close> [61] 60) where
+  "\<alpha> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) \<equiv> mono_seqspace_rel(##M,\<alpha>,P,leq)"
+
+lemma mono_seqspaceI[intro!]:
+  includes mono_map_rules
+  assumes "f: A\<rightarrow>P" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x<y \<Longrightarrow> \<langle>f`x, f`y\<rangle> \<in> leq" "Ord(A)"
+  shows  "f: A \<^sub><\<rightarrow> (P,leq)"
+  using ltI[OF _ Ord_in_Ord[of A], THEN [3] assms(2)] assms(1,3)
+  unfolding mono_seqspace_def by auto
+
+lemma (in M_ZF_library) mono_seqspace_rel_char:
+  assumes "M(A)" "M(P)" "M(leq)"
+  shows "A \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) = {f\<in>A \<^sub><\<rightarrow> (P,leq). M(f)}"
+  using assms mono_map_rel_char
+  unfolding mono_seqspace_def mono_seqspace_rel_def by simp
+
+lemma (in M_ZF_library) mono_seqspace_relI[intro!]:
+  assumes "f: A\<rightarrow>\<^bsup>M\<^esup> P" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x<y \<Longrightarrow> \<langle>f`x, f`y\<rangle> \<in> leq"
+    "Ord(A)" "M(A)" "M(P)" "M(leq)"
+  shows  "f: A \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq)"
+  using mono_seqspace_rel_char function_space_rel_char assms by auto
+
+lemma mono_seqspace_is_fun[dest]:
+  includes mono_map_rules
+  shows "j: A \<^sub><\<rightarrow> (P,leq) \<Longrightarrow> j: A\<rightarrow> P"
+  unfolding mono_seqspace_def by auto
+
+lemma mono_map_lt_le_is_mono[dest]:
+  includes mono_map_rules
+  assumes "j: A \<^sub><\<rightarrow> (P,leq)" "a\<in>A" "c\<in>A" "a\<le>c" "Ord(A)" "refl(P,leq)"
+  shows "\<langle>j`a,j`c\<rangle> \<in> leq"
+  using assms mono_map_increasing unfolding mono_seqspace_def refl_def
+  by (cases "a=c") (auto dest:ltD)
+
+lemma (in M_ZF_library) mem_mono_seqspace_abs[absolut]:
+  assumes "M(f)" "M(A)" "M(P)" "M(leq)"
+  shows  "f:A \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,leq) \<longleftrightarrow>  f: A \<^sub><\<rightarrow> (P,leq)"
+  using assms mono_map_rel_char unfolding mono_seqspace_def mono_seqspace_rel_def
+  by (simp)
+
+definition
+  mono_map_lt_le :: "[i,i] \<Rightarrow> i" (infixr \<open>\<^sub><\<rightarrow>\<^sub>\<le>\<close> 60) where
+  "\<alpha> \<^sub><\<rightarrow>\<^sub>\<le> \<beta> \<equiv> \<alpha> \<^sub><\<rightarrow> (\<beta>,lerel(\<beta>))"
+
+lemma mono_map_lt_leI[intro!]:
+  includes mono_map_rules
+  assumes "f: A\<rightarrow>B" "\<And>x y. x\<in>A \<Longrightarrow> y\<in>A \<Longrightarrow> x<y \<Longrightarrow> f`x \<le> f`y" "Ord(A)" "Ord(B)"
+  shows  "f: A \<^sub><\<rightarrow>\<^sub>\<le> B"
+  using assms
+  unfolding mono_map_lt_le_def by auto
+
+\<comment> \<open>Kunen IV.7.13, with “$\kappa$” in place of “$\lambda$”\<close>
+definition
+  kappa_closed :: "[i,i,i] \<Rightarrow> o" (\<open>_-closed'(_,_')\<close>) where
+  "\<kappa>-closed(P,leq) \<equiv> \<forall>\<delta>. \<delta><\<kappa> \<longrightarrow> (\<forall>f\<in>\<delta> \<^sub><\<rightarrow> (P,converse(leq)). \<exists>q\<in>P. \<forall>\<alpha>\<in>\<delta>. \<langle>q,f`\<alpha>\<rangle>\<in>leq)"
+
+relativize functional "kappa_closed" "kappa_closed_rel"
+relationalize "kappa_closed_rel" "is_kappa_closed"
+synthesize "is_kappa_closed" from_definition assuming "nonempty"
+
+abbreviation
+  kappa_closed_r (\<open>_-closed\<^bsup>_\<^esup>'(_,_')\<close> [61] 60) where
+  "\<kappa>-closed\<^bsup>M\<^esup>(P,leq) \<equiv> kappa_closed_rel(M,\<kappa>,P,leq)"
+
+abbreviation
+  kappa_closed_r_set (\<open>_-closed\<^bsup>_\<^esup>'(_,_')\<close> [61] 60) where
+  "\<kappa>-closed\<^bsup>M\<^esup>(P,leq) \<equiv> kappa_closed_rel(##M,\<kappa>,P,leq)"
+
+lemma (in forcing_data4) forcing_a_value:
+  assumes "p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]" "a \<in> A"
+    "q \<preceq> p" "q \<in> P" "p\<in>P" "f_dot \<in> M" "A\<in>M" "B\<in>M"
+  shows "\<exists>d\<in>P. \<exists>b\<in>B. d \<preceq> q \<and> d \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]"
+    \<comment> \<open>Old neater version, but harder to use
+    (without the assumptions on \<^term>\<open>q\<close>):\<close>
+    (* "dense_below({q \<in> P. \<exists>b\<in>B. q \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, b\<^sup>v]}, p)" *)
+proof -
+  from assms
+  have "q \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]"
+    using strengthening_lemma[of p "\<cdot>0:1\<rightarrow>2\<cdot>" q "[f_dot, A\<^sup>v, B\<^sup>v]"]
+      typed_function_type arity_typed_function_fm
+    by (auto simp: union_abs2 union_abs1 check_in_M P_in_M)
+  from \<open>a\<in>A\<close> \<open>A\<in>M\<close>
+  have "a\<in>M" by (auto dest:transM)
+  from \<open>q\<in>P\<close>
+  text\<open>Here we're using countability (via the existence of generic filters)
+    of \<^term>\<open>M\<close> as a shortcut, to avoid a further density argument.\<close>
+  obtain G where "M_generic(G)" "q\<in>G"
+    using generic_filter_existence by blast
+  then
+  interpret G_generic4_AC _ _ _ _ _ G by unfold_locales
+  include G_generic1_lemmas
+  note \<open>q\<in>G\<close>
+  moreover
+  note \<open>q \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, A\<^sup>v, B\<^sup>v]\<close> \<open>M_generic(G)\<close>
+  moreover
+  note \<open>q\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close> \<open>A\<in>M\<close>
+  moreover from this
+  have "map(val(P, G), [f_dot, A\<^sup>v, B\<^sup>v]) \<in> list(M[G])" by simp
+  moreover from calculation
+  have "val(P,G,f_dot) : A \<rightarrow>\<^bsup>M[G]\<^esup> B"
+    using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[f_dot, A\<^sup>v, B\<^sup>v]", THEN iffD1]
+      typed_function_type arity_typed_function_fm valcheck[OF one_in_G one_in_P]
+    by (auto simp: union_abs2 union_abs1 ext.mem_function_space_rel_abs)
+  moreover
+  note \<open>a \<in> M\<close>
+  moreover from calculation and \<open>a\<in>A\<close>
+  have "val(P,G,f_dot) ` a \<in> B" (is "?b \<in> B")
+    by (simp add: ext.mem_function_space_rel_abs)
+  moreover from calculation
+  have "?b \<in> M" by (auto dest:transM)
+  moreover from calculation
+  have "M[G], map(val(P,G), [f_dot, a\<^sup>v, ?b\<^sup>v]) \<Turnstile> \<cdot>0`1 is 2\<cdot>"
+    by simp
+  moreover
+  note \<open>M_generic(G)\<close>
+  ultimately
+  obtain r where "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, ?b\<^sup>v]" "r\<in>G" "r\<in>P"
+    using truth_lemma[of "\<cdot>0`1 is 2\<cdot>" G "[f_dot, a\<^sup>v, ?b\<^sup>v]", THEN iffD2]
+      fun_apply_type arity_fun_apply_fm valcheck[OF one_in_G one_in_P]
+    by (auto simp: union_abs2 union_abs1 ext.mem_function_space_rel_abs)
+  moreover from this and \<open>q\<in>G\<close>
+  obtain d where "d\<preceq>q" "d\<preceq>r" "d\<in>P" by force
+  moreover
+  note \<open>f_dot\<in>M\<close> \<open>a\<in>M\<close> \<open>?b\<in>B\<close> \<open>B\<in>M\<close>
+  moreover from calculation
+  have "d \<preceq> q \<and> d \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, a\<^sup>v, ?b\<^sup>v]"
+    using fun_apply_type arity_fun_apply_fm
+      strengthening_lemma[of r "\<cdot>0`1 is 2\<cdot>" d "[f_dot, a\<^sup>v, ?b\<^sup>v]"]
+    by (auto dest:transM simp add: union_abs2 union_abs1)
+  ultimately
+  show ?thesis by auto
+qed
+
+context G_generic4_AC begin
+
+context
+  includes G_generic1_lemmas
+begin
+
+lemma separation_check_snd_aux:
+  assumes "f_dot\<in>M" "\<tau>\<in>M" "\<chi>\<in>formula" "arity(\<chi>) \<le> 7"
+  shows "separation(##M, \<lambda>r. M, [fst(r), P, leq, \<one>, f_dot, \<tau>, snd(r)\<^sup>v] \<Turnstile> \<chi>)"
+proof -
+  note types = assms leq_in_M P_in_M one_in_M
+  let ?f_fm="fst_fm(1,0)"
+  let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
+  have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
+    using ord_simp_union
+    unfolding hcomp_fm_def check_fm'_def
+    by (simp_all add:arity)
+  then
+  show ?thesis
+    using separation_sat_after_function assms types
+    using fst_abs snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M
+    unfolding hcomp_fm_def check_fm'_def
+    by simp
+qed
+
+lemma separation_check_fst_snd_aux :
+  assumes "f_dot\<in>M" "r\<in>M" "\<chi>\<in>formula" "arity(\<chi>) \<le> 7"
+  shows "separation(##M, \<lambda>p. M, [r, P, leq, \<one>, f_dot, fst(p)\<^sup>v, snd(p)\<^sup>v] \<Turnstile> \<chi>)"
+proof -
+  let ?\<rho>="\<lambda>z. [r, P, leq, \<one>, f_dot, fst(z)\<^sup>v, snd(z)\<^sup>v]"
+  let ?\<rho>'="\<lambda>z. [fst(z)\<^sup>v, P, leq, \<one>, f_dot, r, snd(z)\<^sup>v]"
+  let ?\<phi>=" (\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>(\<cdot>\<exists>\<cdot>\<cdot>0 = 11\<cdot> \<and> \<cdot>\<cdot>1 = 7\<cdot> \<and> \<cdot>\<cdot>2 = 8\<cdot> \<and> \<cdot>\<cdot>3 = 9\<cdot> \<and> \<cdot>\<cdot>4 = 10\<cdot> \<and> \<cdot>\<cdot>5 = 6\<cdot> \<and>
+    (\<lambda>p. incr_bv(p)`6)^6 (\<chi>) \<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)\<cdot>)"
+  note types = assms leq_in_M P_in_M one_in_M
+  let ?f_fm="hcomp_fm(check_fm'(5),fst_fm,1,0)"
+  let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
+  have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
+    using ord_simp_union
+    unfolding hcomp_fm_def check_fm'_def
+    by (simp_all add:arity)
+  moreover from assms
+  have fm:"?\<phi>\<in>formula" by simp
+  moreover from \<open>\<chi> \<in> formula\<close> \<open>arity(\<chi>) \<le> 7\<close>
+  have "arity(\<chi>) = 0 \<or> arity(\<chi>) = 1 \<or> arity(\<chi>) = 2 \<or> arity(\<chi>) = 3
+    \<or> arity(\<chi>) = 4 \<or> arity(\<chi>) = 5 \<or> arity(\<chi>) = 6 \<or> arity(\<chi>) = 7"
+    unfolding lt_def by auto
+  with calculation and \<open>\<chi> \<in> formula\<close>
+  have ar:"arity(?\<phi>) \<le> 7"
+    using arity_incr_bv_lemma by safe (simp_all add: arity ord_simp_union)
+  moreover from calculation
+  have sep:"separation(##M,\<lambda>z. M,?\<rho>'(z)\<Turnstile>?\<phi>)"
+    using separation_sat_after_function assms types sats_check_fm check_abs check_in_M
+      fst_abs snd_abs
+    unfolding hcomp_fm_def check_fm'_def
+    by simp
+  moreover
+  have "?\<rho>(z) \<in> list(M)" if "(##M)(z)" for z
+    using types that by simp
+  moreover from calculation and \<open>r \<in> M\<close> \<open>\<chi> \<in> formula\<close>
+  have "(M,?\<rho>(z) \<Turnstile> \<chi>) \<longleftrightarrow> (M,?\<rho>'(z)\<Turnstile>?\<phi>)" if "(##M)(z)" for z
+    using that types sats_incr_bv_iff[of _ _ M _ "[_,_,_,_,_,_]"]
+    by simp
+  ultimately
+  show ?thesis using separation_cong[THEN iffD1,OF _ sep]
+    by simp
+qed
+
+lemma separation_leq_and_forces_apply_aux:
+  assumes "f_dot\<in>M" "B\<in>M"
+  shows "\<forall>n\<in>M. separation(##M, \<lambda>x. snd(x) \<preceq> fst(x) \<and>
+          (\<exists>b\<in>B. M, [snd(x), P, leq, \<one>, f_dot, (\<Union>(n))\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> )))"
+proof -
+  have pred_nat_closed: "pred(n)\<in>M" if "n\<in>M" for n
+    using nat_case_closed that
+    unfolding pred_def
+    by auto
+  have "separation(##M, \<lambda>z. M, [snd(fst(z)), P, leq, \<one>, f_dot, \<tau>, snd(z)\<^sup>v] \<Turnstile> \<chi>)"
+    if "\<chi>\<in>formula" "arity(\<chi>) \<le> 7" "\<tau>\<in>M" for \<chi> \<tau>
+  proof -
+    note types = assms leq_in_M P_in_M one_in_M
+    let ?f_fm="hcomp_fm(snd_fm,fst_fm,1,0)"
+    let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
+    have "?f_fm \<in> formula" "arity(?f_fm) \<le> 7" "?g_fm \<in> formula" "arity(?g_fm) \<le> 8"
+      using ord_simp_union
+      unfolding hcomp_fm_def check_fm'_def
+      by (simp_all add:arity)
+    then
+    show ?thesis
+      using separation_sat_after_function assms types sats_check_fm check_abs fst_abs snd_abs that
+      unfolding hcomp_fm_def check_fm'_def
+      by simp
+  qed
+  then
+  show ?thesis
+    using P_in_M assms
+      separation_in lam_replacement_constant lam_replacement_snd lam_replacement_fst
+      lam_replacement_Pair[THEN[5] lam_replacement_hcomp2] leq_in_M  check_in_M pred_nat_closed
+      arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
+    by(clarify, rule_tac separation_conj,simp_all,rule_tac separation_bex,simp_all)
+qed
+
+lemma separation_ball_leq_and_forces_apply_aux:
+  assumes "f_dot\<in>M" "p\<in>M" "B\<in>M"
+  shows "separation
+     (##M,
+      \<lambda>pa. \<forall>x\<in>P. x \<preceq> p \<longrightarrow>
+            (\<forall>y\<in>P. y \<preceq> p \<longrightarrow>
+              \<langle>x, y\<rangle> \<in> snd(pa) \<longleftrightarrow>
+                y \<preceq> x \<and> (\<exists>b\<in>B. M, [y, P, leq, \<one>, f_dot, (\<Union>(fst(pa)))\<^sup>v, b\<^sup>v] \<Turnstile> forces(\<cdot>0`1 is 2\<cdot> ))))"
+proof -
+  have "separation(##M, \<lambda>z. M, [snd(fst(z)), P, leq, \<one>, f_dot, (\<Union>(fst(fst(fst(fst(z))))))\<^sup>v, snd(z)\<^sup>v] \<Turnstile> \<chi>)"
+    if "\<chi>\<in>formula" "arity(\<chi>) \<le> 7" for \<chi>
+  proof -
+    note types = assms leq_in_M P_in_M one_in_M
+    let ?f_fm="hcomp_fm(snd_fm,fst_fm,1,0)"
+    let ?g="\<lambda>z . (\<Union>(fst(fst(fst(fst(z))))))\<^sup>v"
+    let ?g_fm="hcomp_fm(check_fm'(6),hcomp_fm(big_union_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,hcomp_fm(fst_fm,fst_fm)))),2,0)"
+    let ?h_fm="hcomp_fm(check_fm'(7),snd_fm,3,0)"
+    have f_fm_facts:"?f_fm \<in> formula" "arity(?f_fm) \<le> 6"
+      using ord_simp_union
+      unfolding hcomp_fm_def
+      by (simp_all add:arity)
+    moreover from types
+    have "?g_fm \<in> formula" "arity(?g_fm) \<le> 7" "?h_fm \<in> formula" "arity(?h_fm) \<le> 8"
+      using ord_simp_union
+      unfolding hcomp_fm_def check_fm'_def
+      by (simp_all add:arity)
+    ultimately
+    show ?thesis
+      using separation_sat_after_function3[OF _ _ _ f_fm_facts] check_abs
+        types assms sats_check_fm that fst_abs snd_abs
+      unfolding hcomp_fm_def check_fm'_def
+      by simp
+  qed
+  then
+  show ?thesis
+    using P_in_M leq_in_M assms
+      separation_ball separation_imp separation_conj separation_bex separation_in separation_iff'
+      lam_replacement_constant lam_replacement_identity lam_replacement_hcomp
+      lam_replacement_fst lam_replacement_snd
+      lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
+      lam_replacement_hcomp[OF
+        lam_replacement_hcomp[OF lam_replacement_fst lam_replacement_fst]
+        lam_replacement_snd]
+      arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
+      separation_in[OF _ lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]]
+    by simp
+qed
+
+lemma separation_closed_leq_and_forces_eq_check_aux :
+  assumes "A\<in>M" "r\<in>G" "\<tau> \<in> M"
+  shows "(##M)({q\<in>P. \<exists>h\<in>A. q \<preceq> r \<and> q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]})"
+proof -
+  have "separation(##M, \<lambda>z. M, [fst(z), P, leq, \<one>, \<tau>, snd(z)\<^sup>v] \<Turnstile> \<chi>)" if
+    "\<chi>\<in>formula" "arity(\<chi>) \<le> 6" for \<chi>
+  proof -
+    let ?f_fm="fst_fm(1,0)"
+    let ?g_fm="hcomp_fm(check_fm'(6),snd_fm,2,0)"
+    note types = assms leq_in_M P_in_M one_in_M
+    moreover
+    have "?f_fm \<in> formula" "arity(?f_fm) \<le> 6" "?g_fm \<in> formula" "arity(?g_fm) \<le> 7"
+      using ord_simp_union
+      unfolding hcomp_fm_def check_fm'_def
+      by (simp_all add:arity)
+    ultimately
+    show ?thesis
+      using separation_sat_after_function_1 assms sats_fst_fm that
+        fst_abs snd_abs types sats_snd_fm sats_check_fm check_abs check_in_M
+      unfolding hcomp_fm_def check_fm'_def
+      by simp
+  qed
+  then
+  show ?thesis
+    using separation_conj separation_in
+      lam_replacement_constant lam_replacement_fst
+      lam_replacement_Pair[THEN[5] lam_replacement_hcomp2]
+      assms leq_in_M G_subset_M[THEN subsetD] generic
+      arity_forces[of "\<cdot>0 = 1\<cdot>",simplified] ord_simp_union
+    by(rule_tac separation_closed[OF separation_bex],simp_all)
+qed
+
+lemma separation_closed_forces_apply_aux:
+  assumes "B\<in>M" "f_dot\<in>M" "r\<in>M"
+  shows "(##M)({\<langle>n,b\<rangle> \<in> \<omega> \<times> B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]})"
+  using nat_in_M assms check_in_M transitivity[OF _ \<open>B\<in>M\<close>] nat_into_M separation_check_fst_snd_aux
+    arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm[of 0 1 2] ord_simp_union
+  unfolding split_def
+  by simp_all
+
+\<comment> \<open>Kunen IV.6.9 (3)$\Rightarrow$(2), with general domain.\<close>
+lemma kunen_IV_6_9_function_space_rel_eq:
+  assumes "\<And>p \<tau>. p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [\<tau>, A\<^sup>v, B\<^sup>v] \<Longrightarrow> p\<in>P \<Longrightarrow> \<tau> \<in> M \<Longrightarrow>
+    \<exists>q\<in>P. \<exists>h\<in>A \<rightarrow>\<^bsup>M\<^esup> B. q \<preceq> p \<and>  q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]" "A\<in>M" "B\<in>M"
+  shows
+    "A \<rightarrow>\<^bsup>M\<^esup> B = A \<rightarrow>\<^bsup>M[G]\<^esup> B"
+proof (intro equalityI; clarsimp simp add:
+    assms function_space_rel_char ext.function_space_rel_char)
+  fix f
+  assume "f \<in> A \<rightarrow> B" "f \<in> M[G]"
+  moreover from this
+  obtain \<tau> where "val(P,G,\<tau>) = f" "\<tau> \<in> M"
+    using GenExtD by force
+  moreover from calculation and \<open>A\<in>M\<close> \<open>B\<in>M\<close>
+  obtain r where "r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [\<tau>, A\<^sup>v, B\<^sup>v]" "r\<in>G"
+    using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[\<tau>, A\<^sup>v, B\<^sup>v]"] generic
+      typed_function_type arity_typed_function_fm valcheck[OF one_in_G one_in_P]
+    by (auto simp: union_abs2 union_abs1)
+  moreover from \<open>A\<in>M\<close> \<open>B\<in>M\<close> \<open>r\<in>G\<close> \<open>\<tau> \<in> M\<close>
+  have "{q\<in>P. \<exists>h\<in>A \<rightarrow>\<^bsup>M\<^esup> B. q \<preceq> r \<and> q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]} \<in> M" (is "?D \<in> M")
+    using separation_closed_leq_and_forces_eq_check_aux by auto
+  moreover from calculation and assms(2-)
+  have "dense_below(?D, r)"
+    using strengthening_lemma[of r "\<cdot>0:1\<rightarrow>2\<cdot>" _ "[\<tau>, A\<^sup>v, B\<^sup>v]", THEN assms(1)[of _ \<tau>]]
+      leq_transD generic_dests(1)[of r]
+    by (auto simp: union_abs2 union_abs1 typed_function_type arity_typed_function_fm) blast
+  moreover from calculation
+  obtain q h where "h\<in>A \<rightarrow>\<^bsup>M\<^esup> B" "q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]" "q \<preceq> r" "q\<in>P" "q\<in>G"
+    using generic_inter_dense_below[of ?D G r, OF _ generic] by blast
+  note \<open>q \<tturnstile> \<cdot>0 = 1\<cdot> [\<tau>, h\<^sup>v]\<close> \<open>\<tau>\<in>M\<close> \<open>h\<in>A \<rightarrow>\<^bsup>M\<^esup> B\<close> \<open>A\<in>M\<close> \<open>B\<in>M\<close> \<open>q\<in>G\<close>
+  moreover from this
+  have "map(val(P, G), [\<tau>, h\<^sup>v]) \<in> list(M[G])" "h\<in>M"
+    by (auto dest:transM)
+  ultimately
+  have "h = f"
+    using truth_lemma[of "\<cdot>0=1\<cdot>" G "[\<tau>, h\<^sup>v]"] generic valcheck[OF one_in_G one_in_P]
+    by (auto simp: ord_simp_union)
+  with \<open>h\<in>M\<close>
+  show "f \<in> M" by simp
+qed
+
+subsection\<open>$(\omega+1)$-Closed notions preserve countable sequences\<close>
+
+\<comment> \<open>Kunen IV.7.15, only for countable sequences\<close>
+lemma succ_omega_closed_imp_no_new_nat_sequences:
+  assumes "succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)" "f : \<omega> \<rightarrow> B" "f\<in>M[G]" "B\<in>M"
+  shows "f\<in>M"
+proof -
+  (* Nice jEdit folding level to read this: 7 *)
+  txt\<open>The next long block proves that the assumptions of Lemma
+  @{thm [source] kunen_IV_6_9_function_space_rel_eq} are satisfied.\<close>
+  {
+    fix p f_dot
+    assume "p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]" "p\<in>P" "f_dot\<in>M"
+    let ?subp="{q\<in>P. q \<preceq> p}"
+    from \<open>p\<in>P\<close>
+    have "?subp \<in> M"
+      using first_section_closed[of P p "converse(leq)"] leq_in_M P_in_M
+      by (auto dest:transM)
+    define S where "S \<equiv> \<lambda>n\<in>nat.
+    {\<langle>q,r\<rangle> \<in> ?subp\<times>?subp. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (\<Union>(n))\<^sup>v, b\<^sup>v])}"
+      (is "S \<equiv> \<lambda>n\<in>nat. ?Y(n)")
+    define S' where "S' \<equiv> \<lambda>n\<in>nat.
+    {\<langle>q,r\<rangle> \<in> ?subp\<times>?subp. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (pred(n))\<^sup>v, b\<^sup>v])}"
+      \<comment> \<open>Towards proving \<^term>\<open>S\<in>M\<close>.\<close>
+    moreover
+    have "S = S'"
+      unfolding S_def S'_def using pred_nat_eq lam_cong by auto
+    moreover from \<open>B\<in>M\<close> \<open>?subp\<in>M\<close> \<open>f_dot\<in>M\<close>
+    have "{r \<in> ?subp. \<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (\<Union>(n))\<^sup>v, b\<^sup>v]} \<in> M" (is "?X(n) \<in> M")
+      if "n\<in>\<omega>" for n
+      using that separation_check_snd_aux nat_into_M ord_simp_union
+        arity_forces[of " \<cdot>0`1 is 2\<cdot>"] arity_fun_apply_fm
+      by(rule_tac separation_closed[OF separation_bex,simplified], simp_all)
+    moreover
+    have "?Y(n) = (?subp \<times> ?X(n)) \<inter> converse(leq)" for n
+      by (intro equalityI) auto
+    moreover
+    note \<open>?subp \<in> M\<close> \<open>B\<in>M\<close> \<open>p\<in>P\<close> \<open>f_dot\<in>M\<close>
+    moreover from calculation
+    have "n \<in> \<omega> \<Longrightarrow> ?Y(n) \<in> M" for n
+      using nat_into_M leq_in_M by simp
+    moreover from calculation
+    have "S \<in> M"
+      using separation_ball_leq_and_forces_apply_aux separation_leq_and_forces_apply_aux
+        transitivity[OF \<open>p\<in>P\<close> P_in_M]
+      unfolding S_def split_def
+      by(rule_tac lam_replacement_Collect[THEN lam_replacement_imp_lam_closed,simplified], simp_all)
+    ultimately
+    have "S' \<in> M"
+      by simp
+    from \<open>p\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close> \<open>B\<in>M\<close>
+    have exr:"\<exists>r\<in>P. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, pred(n)\<^sup>v, b\<^sup>v])"
+      if "q \<preceq> p" "q\<in>P" "n\<in>\<omega>" for q n
+      using that forcing_a_value by (auto dest:transM)
+    have "\<forall>q\<in>?subp. \<forall>n\<in>\<omega>. \<exists>r\<in>?subp. \<langle>q,r\<rangle> \<in> S'`n"
+    proof -
+      {
+        fix q n
+        assume "q \<in> ?subp" "n\<in>\<omega>"
+        moreover from this
+        have "q \<preceq> p" "q \<in> P" "pred(n) = \<Union>n"
+          using pred_nat_eq by simp_all
+        moreover from calculation and exr
+        obtain r where MM:"r \<preceq> q" "\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, pred(n)\<^sup>v, b\<^sup>v]" "r\<in>P"
+          by blast
+        moreover from calculation \<open>q \<preceq> p\<close> \<open>p \<in> P\<close>
+        have "r \<preceq> p"
+          using leq_transD[of r q p] by auto
+        ultimately
+        have "\<exists>r\<in>?subp. r \<preceq> q \<and> (\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, (pred(n))\<^sup>v, b\<^sup>v])"
+          by auto
+      }
+      then
+      show ?thesis
+        unfolding S'_def by simp
+    qed
+    with \<open>p\<in>P\<close> \<open>?subp \<in> M\<close> \<open>S' \<in> M\<close>
+    obtain g where "g \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> ?subp" "g`0 = p" "\<forall>n \<in> nat. \<langle>g`n,g`succ(n)\<rangle>\<in>S'`succ(n)"
+      using sequence_DC[simplified] refl_leq[of p] by blast
+    moreover from this and \<open>?subp \<in> M\<close>
+    have "g : \<omega> \<rightarrow> P" "g \<in> M"
+      using fun_weaken_type[of g \<omega> ?subp P] function_space_rel_char by auto
+    ultimately
+    have "g : \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (P,converse(leq))"
+      using decr_succ_decr[of g] leq_preord leq_in_M P_in_M
+      unfolding S'_def by (auto simp:absolut intro:leI)
+    moreover from \<open>succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)\<close> and this
+    have "\<exists>q\<in>M. q \<in> P \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> q \<preceq> g ` \<alpha>)"
+      using transM[simplified, of g] leq_in_M
+        mono_seqspace_rel_closed[of \<omega> _ "converse(leq)"]
+      unfolding kappa_closed_rel_def
+      by auto
+    ultimately
+    obtain r where "r\<in>P" "r\<in>M" "\<forall>n\<in>\<omega>. r \<preceq> g`n"
+      using nat_into_M by auto
+    with \<open>g`0 = p\<close>
+    have "r \<preceq> p"
+      by blast
+    let ?h="{\<langle>n,b\<rangle> \<in> \<omega> \<times> B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]}"
+    have "function(?h)"
+    proof (rule_tac functionI, rule_tac ccontr, auto simp del: app_Cons)
+      fix n b b'
+      assume "n \<in> \<omega>" "b \<noteq> b'" "b \<in> B" "b' \<in> B"
+      moreover
+      assume "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]" "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b'\<^sup>v]"
+      moreover
+      note \<open>r \<in> P\<close>
+      moreover from this
+      have "\<not> r \<bottom> r"
+        by (auto intro!:refl_leq)
+      moreover
+      note \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close>
+      ultimately
+      show False
+        using forces_neq_apply_imp_incompatible[of r f_dot "n\<^sup>v" b r b']
+          transM[of _ B] by (auto dest:transM)
+    qed
+    moreover
+    have "range(?h) \<subseteq> B"
+      by auto
+    moreover
+    have "domain(?h) = \<omega>"
+    proof -
+      {
+        fix n
+        assume "n \<in> \<omega>"
+        moreover from this
+        have 1:"(\<Union>(n)) = pred(n)"
+          using pred_nat_eq by simp
+        moreover from calculation and \<open>\<forall>n \<in> nat. \<langle>g`n,g`succ(n)\<rangle>\<in>S'`succ(n)\<close>
+        obtain b where "g`(succ(n)) \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]" "b\<in>B"
+          unfolding S'_def by auto
+        moreover from \<open>B\<in>M\<close> and calculation
+        have "b \<in> M" "n \<in> M"
+          by (auto dest:transM)
+        moreover
+        note \<open>g : \<omega> \<rightarrow> P\<close> \<open>\<forall>n\<in>\<omega>. r \<preceq> g`n\<close> \<open>r\<in>P\<close> \<open>f_dot\<in>M\<close>
+        moreover from calculation
+        have "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]"
+          using fun_apply_type arity_fun_apply_fm
+            strengthening_lemma[of "g`succ(n)" "\<cdot>0`1 is 2\<cdot>" r "[f_dot, n\<^sup>v, b\<^sup>v]"]
+          by (simp add: union_abs2 union_abs1)
+        ultimately
+        have "\<exists>b\<in>B. r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]"
+          by auto
+      }
+      then
+      show ?thesis
+        by force
+    qed
+    moreover
+    have "relation(?h)"
+      unfolding relation_def by simp
+    moreover from \<open>f_dot\<in>M\<close> \<open>r\<in>M\<close> \<open>B\<in>M\<close>
+    have "?h \<in> M"
+      using separation_closed_forces_apply_aux by simp
+    moreover
+    note \<open>B \<in> M\<close>
+    ultimately
+    have "?h: \<omega> \<rightarrow>\<^bsup>M\<^esup> B"
+      using function_imp_Pi[THEN fun_weaken_type[of ?h _ "range(?h)" B]]
+        function_space_rel_char by simp
+    moreover
+    note \<open>p \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close> \<open>r \<preceq> p\<close> \<open>r\<in>P\<close> \<open>p\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close>
+    moreover from this
+    have "r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]"
+      using strengthening_lemma[of p "\<cdot>0:1\<rightarrow>2\<cdot>" r "[f_dot, \<omega>\<^sup>v, B\<^sup>v]"]
+        typed_function_type arity_typed_function_fm
+      by (auto simp: union_abs2 union_abs1)
+    moreover
+    note \<open>?h\<in>M\<close>
+    moreover from calculation
+    have "r \<tturnstile> \<cdot>0 = 1\<cdot> [f_dot, ?h\<^sup>v]"
+    proof (intro definition_of_forcing[THEN iffD2] allI impI,
+        simp_all add:union_abs2 union_abs1 del:app_Cons)
+      fix G
+      let ?f="val(P,G,f_dot)"
+      assume "M_generic(G) \<and> r \<in> G"
+      moreover from this
+      interpret g:G_generic1 _ _ _ _ _ G
+        by unfold_locales simp
+      note \<open>r\<in>P\<close> \<open>f_dot\<in>M\<close> \<open>B\<in>M\<close>
+      moreover from this
+      have "map(val(P, G), [f_dot, \<omega>\<^sup>v, B\<^sup>v]) \<in> list(M[G])"
+        by simp
+      moreover from calculation and \<open>r \<tturnstile> \<cdot>0:1\<rightarrow>2\<cdot> [f_dot, \<omega>\<^sup>v, B\<^sup>v]\<close>
+      have "?f : \<omega> \<rightarrow> B"
+        using truth_lemma[of "\<cdot>0:1\<rightarrow>2\<cdot>" G "[f_dot, \<omega>\<^sup>v, B\<^sup>v]"] one_in_G one_in_P
+          typed_function_type arity_typed_function_fm valcheck
+        by (auto simp: union_abs2 union_abs1)
+      moreover
+      have "?h`n = ?f`n" if "n \<in> \<omega>" for n
+      proof -
+        note \<open>n \<in> \<omega>\<close> \<open>domain(?h) = \<omega>\<close>
+        moreover from this
+        have "n\<in>domain(?h)"
+          by simp
+        moreover from this
+        obtain b where "r \<tturnstile> \<cdot>0`1 is 2\<cdot> [f_dot, n\<^sup>v, b\<^sup>v]" "b\<in>B"
+          by force
+        moreover
+        note \<open>function(?h)\<close>
+        moreover from calculation
+        have "b = ?h`n"
+          using function_apply_equality by simp
+        moreover
+        note \<open>B \<in> M\<close>
+        moreover from calculation
+        have "?h`n \<in> M"
+          by (auto dest:transM)
+        moreover
+        note \<open>f_dot \<in> M\<close> \<open>r \<in> P\<close> \<open>M_generic(G) \<and> r \<in> G\<close> \<open>map(val(P, G), [f_dot, \<omega>\<^sup>v, B\<^sup>v]) \<in> list(M[G])\<close>
+        moreover from calculation
+        have "[?f, n, ?h`n] \<in> list(M[G])"
+          using M_subset_MG nat_into_M[of n] one_in_G by (auto dest:transM)
+        ultimately
+        show ?thesis
+          using definition_of_forcing[of r "\<cdot>0`1 is 2\<cdot>" "[f_dot, n\<^sup>v, b\<^sup>v]",
+              THEN iffD1, rule_format, of G]\<comment> \<open>without this line is slower\<close>
+            valcheck one_in_G one_in_P nat_into_M
+          by (auto dest:transM simp add:fun_apply_type
+              arity_fun_apply_fm union_abs2 union_abs1)
+      qed
+      with calculation and \<open>B\<in>M\<close> \<open>?h: \<omega> \<rightarrow>\<^bsup>M\<^esup> B\<close>
+      have "?h = ?f"
+        using function_space_rel_char
+        by (rule_tac fun_extension[of ?h \<omega> "\<lambda>_.B" ?f]) auto
+      ultimately
+      show "?f = val(P, G, ?h\<^sup>v)"
+        using valcheck one_in_G one_in_P generic by simp
+    qed
+    ultimately
+    have "\<exists>r\<in>P. \<exists>h\<in>\<omega> \<rightarrow>\<^bsup>M\<^esup> B. r \<preceq> p \<and> r \<tturnstile> \<cdot>0 = 1\<cdot> [f_dot, h\<^sup>v]"
+      by blast
+  }
+  moreover
+  note \<open>B \<in> M\<close> assms
+  moreover from calculation
+  have "f : \<omega> \<rightarrow>\<^bsup>M\<^esup> B"
+    using kunen_IV_6_9_function_space_rel_eq function_space_rel_char
+      ext.mem_function_space_rel_abs by auto
+  ultimately
+  show ?thesis
+    by (auto dest:transM)
+qed
+
+declare mono_seqspace_rel_closed[rule del]
+  \<comment> \<open>Mysteriously breaks the end of the next proof\<close>
+
+lemma succ_omega_closed_imp_no_new_reals:
+  assumes "succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)"
+  shows "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2 = \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
+proof -
+  from assms
+  have "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2 \<subseteq> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
+    using succ_omega_closed_imp_no_new_nat_sequences function_space_rel_char
+      ext.function_space_rel_char Aleph_rel_succ Aleph_rel_zero
+    by auto
+  then
+  show ?thesis
+    using function_space_rel_transfer by (intro equalityI) auto
+qed
+
+lemma succ_omega_closed_imp_Aleph_1_preserved:
+  assumes "succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)"
+  shows "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> = \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
+proof -
+  have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
+  proof (rule ccontr)
+    assume "\<not> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
+    then
+    have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> < \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
+      \<comment> \<open>Ridiculously complicated proof\<close>
+      using Card_rel_is_Ord ext.Card_rel_is_Ord
+        not_le_iff_lt[THEN iffD1] by auto
+    then
+    have "|\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>|\<^bsup>M[G]\<^esup> \<le> \<omega>"
+      using ext.Card_rel_lt_csucc_rel_iff ext.Aleph_rel_zero
+        ext.Aleph_rel_succ ext.Card_rel_nat
+      by (auto intro!:ext.lt_csucc_rel_iff[THEN iffD1]
+          intro:Card_rel_Aleph_rel[THEN Card_rel_is_Ord, of 1])
+    then
+    obtain f where "f \<in> inj(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>,\<omega>)" "f \<in> M[G]"
+      using ext.countable_rel_iff_cardinal_rel_le_nat[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>", THEN iffD2]
+      unfolding countable_rel_def lepoll_rel_def
+      by auto
+    then
+    obtain g where "g \<in> surj\<^bsup>M[G]\<^esup>(\<omega>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)"
+      using ext.inj_rel_imp_surj_rel[of f _ \<omega>, OF _ zero_lt_Aleph_rel1[THEN ltD]]
+      by auto
+    moreover from this
+    have "g : \<omega> \<rightarrow> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "g \<in> M[G]"
+      using ext.surj_rel_char surj_is_fun by simp_all
+    moreover
+    note \<open>succ(\<omega>)-closed\<^bsup>M\<^esup>(P,leq)\<close>
+    ultimately
+    have "g \<in> surj\<^bsup>M\<^esup>(\<omega>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)" "g \<in> M"
+      using succ_omega_closed_imp_no_new_nat_sequences
+        mem_surj_abs ext.mem_surj_abs by simp_all
+    then
+    show False
+      using surj_rel_implies_cardinal_rel_le[of g \<omega> "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"]
+        Card_rel_nat[THEN Card_rel_cardinal_rel_eq] Card_rel_is_Ord
+        not_le_iff_lt[THEN iffD2, OF _ _ nat_lt_Aleph_rel1]
+      by simp
+  qed
+  then
+  show ?thesis
+    using Aleph_rel_le_Aleph_rel
+    by (rule_tac le_anti_sym) simp
+qed
+
+end \<comment> \<open>bundle G\_generic1\_lemmas\<close>
+
+end \<comment> \<open>\<^locale>\<open>G_generic4_AC\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Names.thy b/thys/Independence_CH/Names.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Names.thy
@@ -0,0 +1,634 @@
+section\<open>Names and generic extensions\<close>
+
+theory Names
+  imports
+    Forcing_Data
+    FrecR_Arities
+begin
+
+definition
+  Hv :: "[i,i,i,i]\<Rightarrow>i" where
+  "Hv(P,G,x,f) \<equiv> { z . y\<in> domain(x), (\<exists>p\<in>P. \<langle>y,p\<rangle> \<in> x \<and> p \<in> G) \<and> z=f`y}"
+
+text\<open>The funcion \<^term>\<open>val\<close> interprets a name in \<^term>\<open>M\<close>
+according to a (generic) filter \<^term>\<open>G\<close>. Note the definition
+in terms of the well-founded recursor.\<close>
+
+definition
+  val :: "[i,i,i]\<Rightarrow>i" where
+  "val(P,G,\<tau>) \<equiv> wfrec(edrel(eclose({\<tau>})), \<tau> ,Hv(P,G))"
+
+definition
+  GenExt :: "[i,i,i]\<Rightarrow>i"     ("_\<^bsup>_\<^esup>[_]" [71,1])
+  where "M\<^bsup>P\<^esup>[G] \<equiv> {val(P,G,\<tau>). \<tau> \<in> M}"
+
+abbreviation (in forcing_notion)
+  GenExt_at_P :: "i\<Rightarrow>i\<Rightarrow>i"     ("_[_]" [71,1])
+  where "M[G] \<equiv> M\<^bsup>P\<^esup>[G]"
+
+subsection\<open>Values and check-names\<close>
+context forcing_data1
+begin
+
+definition
+  Hcheck :: "[i,i] \<Rightarrow> i" where
+  "Hcheck(z,f)  \<equiv> { \<langle>f`y,\<one>\<rangle> . y \<in> z}"
+
+definition
+  check :: "i \<Rightarrow> i" where
+  "check(x) \<equiv> transrec(x , Hcheck)"
+
+lemma checkD:
+  "check(x) =  wfrec(Memrel(eclose({x})), x, Hcheck)"
+  unfolding check_def transrec_def ..
+
+lemma Hcheck_trancl:"Hcheck(y, restrict(f,Memrel(eclose({x}))-``{y}))
+                   = Hcheck(y, restrict(f,(Memrel(eclose({x}))^+)-``{y}))"
+  unfolding Hcheck_def
+  using restrict_trans_eq by simp
+
+lemma check_trancl: "check(x) = wfrec(rcheck(x), x, Hcheck)"
+  using checkD wf_eq_trancl Hcheck_trancl unfolding rcheck_def by simp
+
+lemma rcheck_in_M : "x \<in> M \<Longrightarrow> rcheck(x) \<in> M"
+  unfolding rcheck_def by (simp flip: setclass_iff)
+
+lemma  aux_def_check: "x \<in> y \<Longrightarrow>
+  wfrec(Memrel(eclose({y})), x, Hcheck) =
+  wfrec(Memrel(eclose({x})), x, Hcheck)"
+  by (rule wfrec_eclose_eq,auto simp add: arg_into_eclose eclose_sing)
+
+lemma def_check : "check(y) = { \<langle>check(w),\<one>\<rangle> . w \<in> y}"
+proof -
+  let
+    ?r="\<lambda>y. Memrel(eclose({y}))"
+  have wfr:   "\<forall>w . wf(?r(w))"
+    using wf_Memrel ..
+  then
+  have "check(y)= Hcheck( y, \<lambda>x\<in>?r(y) -`` {y}. wfrec(?r(y), x, Hcheck))"
+    using wfrec[of "?r(y)" y "Hcheck"] checkD by simp
+  also
+  have " ... = Hcheck( y, \<lambda>x\<in>y. wfrec(?r(y), x, Hcheck))"
+    using under_Memrel_eclose arg_into_eclose by simp
+  also
+  have " ... = Hcheck( y, \<lambda>x\<in>y. check(x))"
+    using aux_def_check checkD by simp
+  finally
+  show ?thesis
+    using Hcheck_def by simp
+qed
+
+lemma def_checkS :
+  fixes n
+  assumes "n \<in> nat"
+  shows "check(succ(n)) = check(n) \<union> {\<langle>check(n),\<one>\<rangle>}"
+proof -
+  have "check(succ(n)) = {\<langle>check(i),\<one>\<rangle> . i \<in> succ(n)} "
+    using def_check by blast
+  also
+  have "... = {\<langle>check(i),\<one>\<rangle> . i \<in> n} \<union> {\<langle>check(n),\<one>\<rangle>}"
+    by blast
+  also
+  have "... = check(n) \<union> {\<langle>check(n),\<one>\<rangle>}"
+    using def_check[of n,symmetric] by simp
+  finally
+  show ?thesis .
+qed
+
+lemma field_Memrel2 :
+  assumes "x \<in> M"
+  shows "field(Memrel(eclose({x}))) \<subseteq> M"
+proof -
+  have "field(Memrel(eclose({x}))) \<subseteq> eclose({x})" "eclose({x}) \<subseteq> M"
+    using Ordinal.Memrel_type field_rel_subset assms eclose_least[OF trans_M] by auto
+  then
+  show ?thesis
+    using subset_trans by simp
+qed
+
+lemma aux_def_val:
+  assumes "z \<in> domain(x)"
+  shows "wfrec(edrel(eclose({x})),z,Hv(P,G)) = wfrec(edrel(eclose({z})),z,Hv(P,G))"
+proof -
+  let ?r="\<lambda>x . edrel(eclose({x}))"
+  have "z\<in>eclose({z})"
+    using arg_in_eclose_sing .
+  moreover
+  have "relation(?r(x))"
+    using relation_edrel .
+  moreover
+  have "wf(?r(x))"
+    using wf_edrel .
+  moreover from assms
+  have "tr_down(?r(x),z) \<subseteq> eclose({z})"
+    using tr_edrel_subset by simp
+  ultimately
+  have "wfrec(?r(x),z,Hv(P,G)) = wfrec[eclose({z})](?r(x),z,Hv(P,G))"
+    using wfrec_restr by simp
+  also from \<open>z\<in>domain(x)\<close>
+  have "... = wfrec(?r(z),z,Hv(P,G))"
+    using restrict_edrel_eq wfrec_restr_eq by simp
+  finally
+  show ?thesis .
+qed
+
+text\<open>The next lemma provides the usual recursive expresion for the definition of term\<open>val\<close>.\<close>
+
+lemma def_val:  "val(P,G,x) = {z . t\<in>domain(x) , (\<exists>p\<in>P .  \<langle>t,p\<rangle>\<in>x \<and> p \<in> G) \<and> z=val(P,G,t)}"
+proof -
+  let
+    ?r="\<lambda>\<tau> . edrel(eclose({\<tau>}))"
+  let
+    ?f="\<lambda>z\<in>?r(x)-``{x}. wfrec(?r(x),z,Hv(P,G))"
+  have "\<forall>\<tau>. wf(?r(\<tau>))"
+    using wf_edrel by simp
+  with wfrec [of _ x]
+  have "val(P,G,x) = Hv(P,G,x,?f)"
+    using val_def by simp
+  also
+  have " ... = Hv(P,G,x,\<lambda>z\<in>domain(x). wfrec(?r(x),z,Hv(P,G)))"
+    using dom_under_edrel_eclose by simp
+  also
+  have " ... = Hv(P,G,x,\<lambda>z\<in>domain(x). val(P,G,z))"
+    using aux_def_val val_def by simp
+  finally
+  show ?thesis
+    using Hv_def by simp
+qed
+
+lemma val_mono : "x\<subseteq>y \<Longrightarrow> val(P,G,x) \<subseteq> val(P,G,y)"
+  by (subst (1 2) def_val, force)
+
+text\<open>Check-names are the canonical names for elements of the
+ground model. Here we show that this is the case.\<close>
+
+lemma valcheck : "\<one> \<in> G \<Longrightarrow>  \<one> \<in> P \<Longrightarrow> val(P,G,check(y))  = y"
+proof (induct rule:eps_induct)
+  case (1 y)
+  then show ?case
+  proof -
+    have "check(y) = { \<langle>check(w), \<one>\<rangle> . w \<in> y}"  (is "_ = ?C")
+      using def_check .
+    then
+    have "val(P,G,check(y)) = val(P,G, {\<langle>check(w), \<one>\<rangle> . w \<in> y})"
+      by simp
+    also
+    have " ...  = {z . t\<in>domain(?C) , (\<exists>p\<in>P .  \<langle>t, p\<rangle>\<in>?C \<and> p \<in> G) \<and> z=val(P,G,t) }"
+      using def_val by blast
+    also
+    have " ... =  {z . t\<in>domain(?C) , (\<exists>w\<in>y. t=check(w)) \<and> z=val(P,G,t) }"
+      using 1 by simp
+    also
+    have " ... = {val(P,G,check(w)) . w\<in>y }"
+      by force
+    finally
+    show "val(P,G,check(y)) = y"
+      using 1 by simp
+  qed
+qed
+
+lemma val_of_name :
+  "val(P,G,{x\<in>A\<times>P. Q(x)}) = {z . t\<in>A , (\<exists>p\<in>P .  Q(\<langle>t,p\<rangle>) \<and> p \<in> G) \<and> z=val(P,G,t)}"
+proof -
+  let
+    ?n="{x\<in>A\<times>P. Q(x)}" and
+    ?r="\<lambda>\<tau> . edrel(eclose({\<tau>}))"
+  let
+    ?f="\<lambda>z\<in>?r(?n)-``{?n}. val(P,G,z)"
+  have
+    wfR : "wf(?r(\<tau>))" for \<tau>
+    by (simp add: wf_edrel)
+  have "domain(?n) \<subseteq> A" by auto
+  { fix t
+    assume H:"t \<in> domain({x \<in> A \<times> P . Q(x)})"
+    then have "?f ` t = (if t \<in> ?r(?n)-``{?n} then val(P,G,t) else 0)"
+      by simp
+    moreover have "... = val(P,G,t)"
+      using dom_under_edrel_eclose H if_P by auto
+  }
+  then
+  have Eq1: "t \<in> domain({x \<in> A \<times> P . Q(x)}) \<Longrightarrow> val(P,G,t) = ?f` t"  for t
+    by simp
+  have "val(P,G,?n) = {z . t\<in>domain(?n), (\<exists>p \<in> P . \<langle>t,p\<rangle> \<in> ?n \<and> p \<in> G) \<and> z=val(P,G,t)}"
+    by (subst def_val,simp)
+  also
+  have "... = {z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=?f`t}"
+    unfolding Hv_def
+    by (auto simp add:Eq1)
+  also
+  have "... = {z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=(if t\<in>?r(?n)-``{?n} then val(P,G,t) else 0)}"
+    by (simp)
+  also
+  have "... = { z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(P,G,t)}"
+  proof -
+    have "domain(?n) \<subseteq> ?r(?n)-``{?n}"
+      using dom_under_edrel_eclose by simp
+    then
+    have "\<forall>t\<in>domain(?n). (if t\<in>?r(?n)-``{?n} then val(P,G,t) else 0) = val(P,G,t)"
+      by auto
+    then
+    show "{ z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=(if t\<in>?r(?n)-``{?n} then val(P,G,t) else 0)} =
+          { z . t\<in>domain(?n), (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(P,G,t)}"
+      by auto
+  qed
+  also
+  have " ... = { z . t\<in>A, (\<exists>p\<in>P . \<langle>t,p\<rangle>\<in>?n \<and> p\<in>G) \<and> z=val(P,G,t)}"
+    by force
+  finally
+  show " val(P,G,?n)  = { z . t\<in>A, (\<exists>p\<in>P . Q(\<langle>t,p\<rangle>) \<and> p\<in>G) \<and> z=val(P,G,t)}"
+    by auto
+qed
+
+lemma val_of_name_alt :
+  "val(P,G,{x\<in>A\<times>P. Q(x)}) = {z . t\<in>A , (\<exists>p\<in>P\<inter>G .  Q(\<langle>t,p\<rangle>)) \<and> z=val(P,G,t) }"
+  using val_of_name by force
+
+lemma val_only_names: "val(P,F,\<tau>) = val(P,F,{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>P. x=\<langle>t,p\<rangle>})"
+  (is "_ = val(P,F,?name)")
+proof -
+  have "val(P,F,?name) = {z . t\<in>domain(?name), (\<exists>p\<in>P. \<langle>t, p\<rangle> \<in> ?name \<and> p \<in> F) \<and> z=val(P,F, t)}"
+    using def_val by blast
+  also
+  have " ... = {val(P,F, t). t\<in>{y\<in>domain(\<tau>). \<exists>p\<in>P. \<langle>y, p\<rangle> \<in> \<tau> \<and> p \<in> F}}"
+    by blast
+  also
+  have " ... = {z . t\<in>domain(\<tau>), (\<exists>p\<in>P. \<langle>t, p\<rangle> \<in> \<tau> \<and> p \<in> F) \<and> z=val(P,F, t)}"
+    by blast
+  also
+  have " ... = val(P,F, \<tau>)"
+    using def_val[symmetric] by blast
+  finally
+  show ?thesis ..
+qed
+
+lemma val_only_pairs: "val(P,F,\<tau>) = val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})"
+proof
+  have "val(P,F,\<tau>) = val(P,F,{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>P. x=\<langle>t,p\<rangle>})" (is "_ = val(P,F,?name)")
+    using val_only_names .
+  also
+  have "... \<subseteq> val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})"
+    using val_mono[of ?name "{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}"] by auto
+  finally
+  show "val(P,F,\<tau>) \<subseteq> val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>})" by simp
+next
+  show "val(P,F,{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}) \<subseteq> val(P,F,\<tau>)"
+    using val_mono[of "{x\<in>\<tau>. \<exists>t p. x=\<langle>t,p\<rangle>}"] by auto
+qed
+
+lemma val_subset_domain_times_range: "val(P,F,\<tau>) \<subseteq> val(P,F,domain(\<tau>)\<times>range(\<tau>))"
+  using val_only_pairs[THEN equalityD1]
+    val_mono[of "{x \<in> \<tau> . \<exists>t p. x = \<langle>t, p\<rangle>}" "domain(\<tau>)\<times>range(\<tau>)"] by blast
+
+lemma val_subset_domain_times_P: "val(P,F,\<tau>) \<subseteq> val(P,F,domain(\<tau>)\<times>P)"
+  using val_only_names[of F \<tau>] val_mono[of "{x\<in>\<tau>. \<exists>t\<in>domain(\<tau>). \<exists>p\<in>P. x=\<langle>t,p\<rangle>}" "domain(\<tau>)\<times>P" F]
+  by auto
+
+lemma val_of_elem: "\<langle>\<theta>,p\<rangle> \<in> \<pi> \<Longrightarrow> p\<in>G \<Longrightarrow> p\<in>P \<Longrightarrow> val(P,G,\<theta>) \<in> val(P,G,\<pi>)"
+proof -
+  assume "\<langle>\<theta>,p\<rangle> \<in> \<pi>"
+  then
+  have "\<theta>\<in>domain(\<pi>)"
+    by auto
+  assume "p\<in>G" "p\<in>P"
+  with \<open>\<theta>\<in>domain(\<pi>)\<close> \<open>\<langle>\<theta>,p\<rangle> \<in> \<pi>\<close>
+  have "val(P,G,\<theta>) \<in> {z . t\<in>domain(\<pi>) , (\<exists>p\<in>P .  \<langle>t, p\<rangle>\<in>\<pi> \<and> p \<in> G) \<and> z=val(P,G,t) }"
+    by auto
+  then
+  show ?thesis
+    by (subst def_val)
+qed
+
+lemma elem_of_val: "x\<in>val(P,G,\<pi>) \<Longrightarrow> \<exists>\<theta>\<in>domain(\<pi>). val(P,G,\<theta>) = x"
+  by (subst (asm) def_val,auto)
+
+lemma elem_of_val_pair: "x\<in>val(P,G,\<pi>) \<Longrightarrow> \<exists>\<theta>. \<exists>p\<in>G.  \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x"
+  by (subst (asm) def_val,auto)
+
+lemma elem_of_val_pair':
+  assumes "\<pi>\<in>M" "x\<in>val(P,G,\<pi>)"
+  shows "\<exists>\<theta>\<in>M. \<exists>p\<in>G.  \<langle>\<theta>,p\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) = x"
+proof -
+  from assms
+  obtain \<theta> p where "p\<in>G" "\<langle>\<theta>,p\<rangle>\<in>\<pi>" "val(P,G,\<theta>) = x"
+    using elem_of_val_pair by blast
+  moreover from this \<open>\<pi>\<in>M\<close>
+  have "\<theta>\<in>M"
+    using pair_in_M_iff[THEN iffD1, THEN conjunct1, simplified]
+      transitivity by blast
+  ultimately
+  show ?thesis
+    by blast
+qed
+
+
+lemma GenExtD: "x \<in> M[G] \<Longrightarrow> \<exists>\<tau>\<in>M. x = val(P,G,\<tau>)"
+  by (simp add:GenExt_def)
+
+lemma GenExtI: "x \<in> M \<Longrightarrow> val(P,G,x) \<in> M[G]"
+  by (auto simp add: GenExt_def)
+
+lemma Transset_MG : "Transset(M[G])"
+proof -
+  { fix vc y
+    assume "vc \<in> M[G]" and "y \<in> vc"
+    then
+    obtain c where "c\<in>M" "val(P,G,c)\<in>M[G]" "y \<in> val(P,G,c)"
+      using GenExtD by auto
+    from \<open>y \<in> val(P,G,c)\<close>
+    obtain \<theta> where "\<theta>\<in>domain(c)" "val(P,G,\<theta>) = y"
+      using elem_of_val by blast
+    with trans_M \<open>c\<in>M\<close>
+    have "y \<in> M[G]"
+      using domain_trans GenExtI by blast
+  }
+  then
+  show ?thesis
+    using Transset_def by auto
+qed
+
+lemmas transitivity_MG = Transset_intf[OF Transset_MG]
+
+text\<open>This lemma can be proved before having \<^term>\<open>check_in_M\<close>. At some point Miguel naïvely
+thought that the \<^term>\<open>check_in_M\<close> could be proved using this argument.\<close>
+lemma check_nat_M :
+  assumes "n \<in> nat"
+  shows "check(n) \<in> M"
+  using assms
+proof (induct n)
+  case 0
+  then
+  show ?case
+    using zero_in_M by (subst def_check,simp)
+next
+  case (succ x)
+  have "\<one> \<in> M"
+    using one_in_P P_sub_M subsetD by simp
+  with \<open>check(x)\<in>M\<close>
+  have "\<langle>check(x),\<one>\<rangle> \<in> M"
+    using pair_in_M_iff by simp
+  then
+  have "{\<langle>check(x),\<one>\<rangle>} \<in> M"
+    using singleton_closed by simp
+  with \<open>check(x)\<in>M\<close>
+  have "check(x) \<union> {\<langle>check(x),\<one>\<rangle>} \<in> M"
+    using Un_closed by simp
+  then
+  show ?case
+    using \<open>x\<in>nat\<close> def_checkS by simp
+qed
+
+lemma def_PHcheck:
+  assumes
+    "z\<in>M" "f\<in>M"
+  shows
+    "Hcheck(z,f) = Replace(z,PHcheck(##M,\<one>,f))"
+proof -
+  from assms
+  have "\<langle>f`x,\<one>\<rangle> \<in> M" "f`x\<in>M" if "x\<in>z" for x
+    using pair_in_M_iff one_in_M transitivity that apply_closed by simp_all
+  then
+  have "{y . x \<in> z, y = \<langle>f ` x, \<one>\<rangle>} =  {y . x \<in> z, y = \<langle>f ` x, \<one>\<rangle> \<and> y\<in>M \<and> f`x\<in>M}"
+    by simp
+  then
+  show ?thesis
+    using \<open>z\<in>M\<close> \<open>f\<in>M\<close> transitivity
+    unfolding Hcheck_def PHcheck_def RepFun_def
+    by auto
+qed
+
+
+(* instance of replacement for hcheck *)
+lemma wfrec_Hcheck :
+  assumes "X\<in>M"
+  shows "wfrec_replacement(##M,is_Hcheck(##M,\<one>),rcheck(X))"
+proof -
+  let ?f="Exists(And(pair_fm(1,0,2),
+               is_wfrec_fm(is_Hcheck_fm(8,2,1,0),4,1,0)))"
+  have "is_Hcheck(##M,\<one>,a,b,c) \<longleftrightarrow>
+        sats(M,is_Hcheck_fm(8,2,1,0),[c,b,a,d,e,y,x,z,\<one>,rcheck(x)])"
+    if "a\<in>M" "b\<in>M" "c\<in>M" "d\<in>M" "e\<in>M" "y\<in>M" "x\<in>M" "z\<in>M"
+    for a b c d e y x z
+    using that one_in_M \<open>X\<in>M\<close> rcheck_in_M is_Hcheck_iff_sats zero_in_M
+    by simp
+  then
+  have "sats(M,is_wfrec_fm(is_Hcheck_fm(8,2,1,0),4,1,0), [y,x,z,\<one>,rcheck(X)])
+        \<longleftrightarrow> is_wfrec(##M, is_Hcheck(##M,\<one>),rcheck(X), x, y)"
+    if "x\<in>M" "y\<in>M" "z\<in>M" for x y z
+    using  that sats_is_wfrec_fm \<open>X\<in>M\<close> rcheck_in_M one_in_M zero_in_M
+    by simp
+  moreover from this
+  have satsf:"sats(M, ?f, [x,z,\<one>,rcheck(X)]) \<longleftrightarrow>
+              (\<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hcheck(##M,\<one>),rcheck(X), x, y))"
+    if "x\<in>M" "z\<in>M" for x z
+    using that \<open>X\<in>M\<close> rcheck_in_M one_in_M
+    by (simp del:pair_abs)
+  moreover
+  have artyf:"arity(?f) = 4"
+    using arity_wfrec_replacement_fm[where p="is_Hcheck_fm(8, 2, 1, 0)" and i=9]
+      arity_is_Hcheck_fm ord_simp_union
+    by simp
+  ultimately
+  have "strong_replacement(##M,\<lambda>x z. sats(M,?f,[x,z,\<one>,rcheck(X)]))"
+    using replacement_ax1(10) artyf \<open>X\<in>M\<close> rcheck_in_M one_in_M
+    unfolding replacement_assm_def by simp
+  then
+  have "strong_replacement(##M,\<lambda>x z.
+          \<exists>y\<in>M. pair(##M,x,y,z) & is_wfrec(##M, is_Hcheck(##M,\<one>),rcheck(X), x, y))"
+    using repl_sats[of M ?f "[\<one>,rcheck(X)]"] satsf by (simp del:pair_abs)
+  then
+  show ?thesis
+    unfolding wfrec_replacement_def by simp
+qed
+
+lemma repl_PHcheck :
+  assumes "f\<in>M"
+  shows "strong_replacement(##M,PHcheck(##M,\<one>,f))"
+proof -
+  from \<open>f\<in>M\<close>
+  have "strong_replacement(##M,\<lambda>x y. sats(M,PHcheck_fm(2,3,0,1),[x,y,\<one>,f]))"
+    using replacement_ax1(11) one_in_M unfolding replacement_assm_def
+    by (simp add:arity ord_simp_union)
+  with \<open>f\<in>M\<close>
+  show ?thesis
+    using one_in_M zero_in_M
+    unfolding strong_replacement_def univalent_def
+    by simp
+qed
+
+lemma univ_PHcheck : "\<lbrakk> z\<in>M ; f\<in>M \<rbrakk> \<Longrightarrow> univalent(##M,z,PHcheck(##M,\<one>,f))"
+  unfolding univalent_def PHcheck_def
+  by simp
+
+lemma PHcheck_closed : "\<lbrakk>z\<in>M ; f\<in>M ; x\<in>z; PHcheck(##M,\<one>,f,x,y) \<rbrakk> \<Longrightarrow> (##M)(y)"
+  unfolding PHcheck_def by simp
+
+lemma relation2_Hcheck : "relation2(##M,is_Hcheck(##M,\<one>),Hcheck)"
+proof -
+  have "is_Replace(##M,z,PHcheck(##M,\<one>,f),hc) \<longleftrightarrow> hc = Replace(z,PHcheck(##M,\<one>,f))"
+    if "z\<in>M" "f\<in>M" "hc\<in>M" for z f hc
+    using that Replace_abs[OF _ _ univ_PHcheck] PHcheck_closed[of z f]
+    by simp
+  with def_PHcheck
+  show ?thesis
+    unfolding relation2_def is_Hcheck_def Hcheck_def
+    by simp
+qed
+
+lemma Hcheck_closed : "\<forall>y\<in>M. \<forall>g\<in>M. function(g) \<longrightarrow> Hcheck(y,g)\<in>M"
+proof -
+  have "Replace(y,PHcheck(##M,\<one>,f))\<in>M" if "f\<in>M" "y\<in>M" for f y
+    using that repl_PHcheck  PHcheck_closed[of y f] univ_PHcheck
+      strong_replacement_closed
+    by (simp flip: setclass_iff)
+  then
+  show ?thesis
+    using def_PHcheck by auto
+qed
+
+lemma wf_rcheck : "x\<in>M \<Longrightarrow> wf(rcheck(x))"
+  unfolding rcheck_def using wf_trancl[OF wf_Memrel] .
+
+lemma trans_rcheck : "x\<in>M \<Longrightarrow> trans(rcheck(x))"
+  unfolding rcheck_def using trans_trancl .
+
+lemma relation_rcheck : "x\<in>M \<Longrightarrow> relation(rcheck(x))"
+  unfolding rcheck_def using relation_trancl .
+
+lemma check_in_M : "x\<in>M \<Longrightarrow> check(x) \<in> M"
+  unfolding transrec_def
+  using wfrec_Hcheck[of x] check_trancl wf_rcheck trans_rcheck relation_rcheck rcheck_in_M
+    Hcheck_closed relation2_Hcheck trans_wfrec_closed[of "rcheck(x)" x "is_Hcheck(##M,\<one>)" Hcheck]
+  by (simp flip: setclass_iff)
+
+(* Internalization and absoluteness of rcheck\<close> *)
+
+lemma rcheck_abs[Rel] : "\<lbrakk> x\<in>M ; r\<in>M \<rbrakk> \<Longrightarrow> is_rcheck(##M,x,r) \<longleftrightarrow> r = rcheck(x)"
+  unfolding rcheck_def is_rcheck_def
+  using singleton_closed trancl_closed Memrel_closed eclose_closed zero_in_M
+  by simp
+
+lemma check_abs[Rel] :
+  assumes "x\<in>M" "z\<in>M"
+  shows "is_check(##M,\<one>,x,z) \<longleftrightarrow> z = check(x)"
+proof -
+  have "is_check(##M,\<one>,x,z) \<longleftrightarrow> is_wfrec(##M,is_Hcheck(##M,\<one>),rcheck(x),x,z)"
+    unfolding is_check_def
+    using assms rcheck_abs rcheck_in_M zero_in_M
+    unfolding check_trancl is_check_def
+    by simp
+  then
+  show ?thesis
+    unfolding check_trancl
+    using assms wfrec_Hcheck[of x] wf_rcheck trans_rcheck relation_rcheck rcheck_in_M
+      Hcheck_closed relation2_Hcheck trans_wfrec_abs[of "rcheck(x)" x z "is_Hcheck(##M,\<one>)" Hcheck]
+    by (simp flip: setclass_iff)
+qed
+
+lemma check_replacement: "{check(x). x\<in>P} \<in> M"
+proof -
+  have "arity(check_fm(0,2,1)) = 3"
+    by (simp add:ord_simp_union arity)
+  then
+  show ?thesis
+    using sats_check_fm check_abs P_in_M check_in_M one_in_M transitivity zero_in_M
+      Replace_relativized_in_M[of "check_fm(0,2,1)" "[\<one>]" _ "is_check(##M,\<one>)" check]
+      check_fm_type replacement_ax1(12)
+    by simp
+qed
+
+lemma M_subset_MG :  "\<one> \<in> G \<Longrightarrow> M \<subseteq> M[G]"
+  using check_in_M one_in_P GenExtI
+  by (intro subsetI, subst valcheck [of G,symmetric], auto)
+
+text\<open>The name for the generic filter\<close>
+definition
+  G_dot :: "i" where
+  "G_dot \<equiv> {\<langle>check(p),p\<rangle> . p\<in>P}"
+
+lemma G_dot_in_M : "G_dot \<in> M"
+proof -
+  let ?is_pcheck = "\<lambda>x y. \<exists>ch\<in>M. is_check(##M,\<one>,x,ch) \<and> pair(##M,ch,x,y)"
+  let ?pcheck_fm = "Exists(And(check_fm(1,3,0),pair_fm(0,1,2)))"
+  have "sats(M,?pcheck_fm,[x,y,\<one>]) \<longleftrightarrow> ?is_pcheck(x,y)" if "x\<in>M" "y\<in>M" for x y
+    using sats_check_fm that one_in_M zero_in_M by simp
+  moreover
+  have "?is_pcheck(x,y) \<longleftrightarrow> y = \<langle>check(x),x\<rangle>" if "x\<in>M" "y\<in>M" for x y
+    using that check_abs check_in_M by simp
+  moreover
+  have "?pcheck_fm\<in>formula"
+    by simp
+  moreover
+  have "arity(?pcheck_fm)=3"
+    by (simp add:ord_simp_union arity)
+  moreover
+  from P_in_M check_in_M pair_in_M_iff P_sub_M
+  have "\<langle>check(p),p\<rangle> \<in> M" if "p\<in>P" for p
+    using that by auto
+  ultimately
+  show ?thesis
+    unfolding G_dot_def
+    using one_in_M P_in_M transitivity Replace_relativized_in_M[of ?pcheck_fm "[\<one>]"]
+      replacement_ax1(13)
+    by simp
+qed
+
+lemma val_G_dot :
+  assumes "G \<subseteq> P" "\<one> \<in> G"
+  shows "val(P,G,G_dot) = G"
+proof (intro equalityI subsetI)
+  fix x
+  assume "x\<in>val(P,G,G_dot)"
+  then obtain \<theta> p where "p\<in>G" "\<langle>\<theta>,p\<rangle> \<in> G_dot" "val(P,G,\<theta>) = x" "\<theta> = check(p)"
+    unfolding G_dot_def using elem_of_val_pair G_dot_in_M
+    by force
+  with \<open>\<one>\<in>G\<close> \<open>G\<subseteq>P\<close>
+  show "x \<in> G"
+    using valcheck P_sub_M by auto
+next
+  fix p
+  assume "p\<in>G"
+  have "\<langle>check(q),q\<rangle> \<in> G_dot" if "q\<in>P" for q
+    unfolding G_dot_def using that by simp
+  with \<open>p\<in>G\<close> \<open>G\<subseteq>P\<close>
+  have "val(P,G,check(p)) \<in> val(P,G,G_dot)"
+    using val_of_elem G_dot_in_M by blast
+  with \<open>p\<in>G\<close> \<open>G\<subseteq>P\<close> \<open>\<one>\<in>G\<close>
+  show "p \<in> val(P,G,G_dot)"
+    using P_sub_M valcheck by auto
+qed
+
+lemma G_in_Gen_Ext :
+  assumes "G \<subseteq> P" "\<one> \<in> G"
+  shows   "G \<in> M[G]"
+  using assms val_G_dot GenExtI[of _ G] G_dot_in_M
+  by force
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+locale G_generic1 = forcing_data1 +
+  fixes G :: "i"
+  assumes generic : "M_generic(G)"
+begin
+
+lemma zero_in_MG :
+  "0 \<in> M[G]"
+proof -
+  have "0 = val(P,G,0)"
+    using zero_in_M elem_of_val by auto
+  also
+  have "... \<in> M[G]"
+    using GenExtI zero_in_M by simp
+  finally
+  show ?thesis .
+qed
+
+lemma G_nonempty: "G\<noteq>0"
+  using generic subset_refl[of P] P_in_M P_dense
+  unfolding M_generic_def
+  by auto
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+locale G_generic1_AC = G_generic1 + M_ctm1_AC
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Not_CH.thy b/thys/Independence_CH/Not_CH.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Not_CH.thy
@@ -0,0 +1,684 @@
+section\<open>Model of the negation of the Continuum Hypothesis\<close>
+
+theory Not_CH
+  imports
+    Cardinal_Preservation
+begin
+
+txt\<open>We are taking advantage that the poset of finite functions is absolute,
+and thus we work with the unrelativized \<^term>\<open>Fn\<close>. But it would have been more
+appropriate to do the following using the relative \<^term>\<open>Fn_rel\<close>. As it turns
+out, the present theory was developed prior to having \<^term>\<open>Fn\<close> relativized!
+
+We also note that \<^term>\<open>Fn(\<omega>,\<kappa>\<times>\<omega>,2)\<close> is separative, i.e. each \<^term>\<open>X \<in> Fn(\<omega>,\<kappa>\<times>\<omega>,2)\<close>
+has two incompatible extensions; therefore we may recover part of our previous theorem
+@{thm [source] extensions_of_ctms_ZF}. But that result also included the possibility
+of not having $\AC$ in the ground model, which would not be sensible in a context
+where the cardinality of the continuum is under discussion. It is also the case that
+@{thm [source] extensions_of_ctms_ZF} was historically our first formalized result
+(with a different proof) that showed the forcing machinery had all of its elements
+in place.\<close>
+
+abbreviation
+  Add_subs :: "i \<Rightarrow> i" where
+  "Add_subs(\<kappa>) \<equiv> Fn(\<omega>,\<kappa>\<times>\<omega>,2)"
+
+abbreviation
+  Add_le :: "i \<Rightarrow> i" where
+  "Add_le(\<kappa>) \<equiv> Fnle(\<omega>,\<kappa> \<times> \<omega>,2)"
+
+lemma (in M_aleph) Aleph_rel2_closed[intro,simp]: "M(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>)"
+  using nat_into_Ord by simp
+
+locale M_master = M_cohen + M_library_DC +
+  assumes
+  UN_lepoll_assumptions:
+  "M(A) \<Longrightarrow> M(b) \<Longrightarrow> M(f) \<Longrightarrow> M(A') \<Longrightarrow> separation(M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x\<in>if_range_F_else_F((`)(A), b, f, i)\<rangle>)"
+
+subsection\<open>Non-absolute concepts between extensions\<close>
+
+locale M_master_sub = M_master + N:M_master N for N +
+  assumes
+    M_imp_N: "M(x) \<Longrightarrow> N(x)" and
+    Ord_iff: "Ord(x) \<Longrightarrow> M(x) \<longleftrightarrow> N(x)"
+
+sublocale M_master_sub \<subseteq> M_N_Perm
+  using M_imp_N by unfold_locales
+
+context M_master_sub
+begin
+
+lemma cardinal_rel_le_cardinal_rel: "M(X) \<Longrightarrow> |X|\<^bsup>N\<^esup> \<le> |X|\<^bsup>M\<^esup>"
+  using M_imp_N N.lepoll_rel_cardinal_rel_le[OF lepoll_rel_transfer Card_rel_is_Ord]
+      cardinal_rel_eqpoll_rel[THEN eqpoll_rel_sym, THEN eqpoll_rel_imp_lepoll_rel]
+  by simp
+
+lemma Aleph_rel_sub_closed: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> N(\<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup>)"
+  using Ord_iff[THEN iffD1, OF Card_rel_Aleph_rel[THEN Card_rel_is_Ord]]
+  by simp
+
+lemma Card_rel_imp_Card_rel: "Card\<^bsup>N\<^esup>(\<kappa>) \<Longrightarrow> M(\<kappa>) \<Longrightarrow> Card\<^bsup>M\<^esup>(\<kappa>)"
+  using N.Card_rel_is_Ord[of \<kappa>] M_imp_N Ord_cardinal_rel_le[of \<kappa>]
+    cardinal_rel_le_cardinal_rel[of \<kappa>] le_anti_sym
+  unfolding Card_rel_def by auto
+
+lemma csucc_rel_le_csucc_rel:
+  assumes "Ord(\<kappa>)" "M(\<kappa>)"
+  shows "(\<kappa>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<kappa>\<^sup>+)\<^bsup>N\<^esup>"
+proof -
+  note assms
+  moreover from this
+  have "N(L) \<and> Card\<^bsup>N\<^esup>(L) \<and> \<kappa> < L \<Longrightarrow> M(L) \<and> Card\<^bsup>M\<^esup>(L) \<and> \<kappa> < L"
+    (is "?P(L) \<Longrightarrow> ?Q(L)") for L
+    using M_imp_N Ord_iff[THEN iffD2, of L] N.Card_rel_is_Ord lt_Ord
+      Card_rel_imp_Card_rel by auto
+  moreover from assms
+  have "N((\<kappa>\<^sup>+)\<^bsup>N\<^esup>)" "Card\<^bsup>N\<^esup>((\<kappa>\<^sup>+)\<^bsup>N\<^esup>)" "\<kappa> < (\<kappa>\<^sup>+)\<^bsup>N\<^esup>"
+    using N.lt_csucc_rel[of \<kappa>] N.Card_rel_csucc_rel[of \<kappa>] M_imp_N by simp_all
+  ultimately
+  show ?thesis
+    using M_imp_N Least_antitone[of _ ?P ?Q] unfolding csucc_rel_def by blast
+qed
+
+lemma Aleph_rel_le_Aleph_rel: "Ord(\<alpha>) \<Longrightarrow> M(\<alpha>) \<Longrightarrow> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>\<alpha>\<^esub>\<^bsup>N\<^esup>"
+proof (induct rule:trans_induct3)
+  case 0
+  then
+  show ?case
+    using Aleph_rel_zero N.Aleph_rel_zero by simp
+next
+  case (succ x)
+  then
+  have "\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>" "Ord(x)" "M(x)" by simp_all
+  moreover from this
+  have "(\<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>\<^sup>+)\<^bsup>M\<^esup>"
+    using M_imp_N Ord_iff[THEN iffD2, OF N.Card_rel_is_Ord]
+    by (intro csucc_rel_le_mono) simp_all
+  moreover from calculation
+  have "(\<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>\<^sup>+)\<^bsup>M\<^esup> \<le> (\<aleph>\<^bsub>x\<^esub>\<^bsup>N\<^esup>\<^sup>+)\<^bsup>N\<^esup>"
+    using M_imp_N N.Card_rel_is_Ord Ord_iff[THEN iffD2, OF N.Card_rel_is_Ord]
+    by (intro csucc_rel_le_csucc_rel) auto
+  ultimately
+  show ?case
+    using M_imp_N Aleph_rel_succ N.Aleph_rel_succ csucc_rel_le_csucc_rel
+      le_trans by auto
+next
+  case (limit x)
+  then
+  show ?case
+    using M_imp_N Aleph_rel_limit N.Aleph_rel_limit
+     by simp (blast dest: transM intro!:le_implies_UN_le_UN)
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_master_sub\<close>\<close>
+
+lemmas (in M_ZF3_trans) sep_instances =
+ separation_insnd_ballPair
+ separation_ifrangeF_body separation_ifrangeF_body2 separation_ifrangeF_body3
+ separation_ifrangeF_body4 separation_ifrangeF_body5 separation_ifrangeF_body6
+ separation_ifrangeF_body7 separation_cardinal_rel_lesspoll_rel
+ separation_is_dcwit_body
+
+lemmas (in M_ZF3_trans) repl_instances = lam_replacement_inj_rel
+  lam_replacement_cardinal replacement_trans_apply_image
+
+sublocale M_ZFC3_trans \<subseteq> M_master "##M"
+  using replacement_dcwit_repl_body\<comment> \<open>this is another replacement instance\<close>
+  by unfold_locales (simp_all add:repl_instances sep_instances del:setclass_iff
+      add: transrec_replacement_def wfrec_replacement_def dcwit_repl_body_def)
+
+subsection\<open>Cohen forcing is ccc\<close>
+
+context M_ctm3_AC
+begin
+
+lemma ccc_Add_subs_Aleph_2: "ccc\<^bsup>M\<^esup>(Add_subs(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>),Add_le(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>))"
+proof -
+  interpret M_add_reals "##M" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>"
+    by unfold_locales blast
+  show ?thesis
+    using ccc_rel_Fn_nat by fast
+qed
+
+end \<comment> \<open>\<^locale>\<open>M_ctm3_AC\<close>\<close>
+
+sublocale G_generic4_AC \<subseteq> M_master_sub "##M" "##(M[G])"
+  using M_subset_MG[OF one_in_G] generic Ord_MG_iff
+  by unfold_locales auto
+
+lemma (in M_trans) mem_F_bound4:
+  fixes F A
+  defines "F \<equiv> (`)"
+  shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> domain(A))"
+  using apply_0 unfolding F_def
+  by (cases "M(c)", auto simp:F_def)
+
+lemma (in M_trans) mem_F_bound5:
+  fixes F A
+  defines "F \<equiv> \<lambda>_ x. A`x "
+  shows "x\<in>F(A,c) \<Longrightarrow> c \<in> (range(f) \<union> domain(A))"
+  using apply_0 unfolding F_def
+  by (cases "M(c)", auto simp:F_def drSR_Y_def dC_F_def)
+
+sublocale M_ctm3_AC \<subseteq> M_replacement_lepoll "##M" "(`)"
+  using UN_lepoll_assumptions lam_replacement_apply lam_replacement_inj_rel
+    mem_F_bound4 apply_0
+  unfolding lepoll_assumptions_defs
+proof (unfold_locales,
+    rule_tac [3] lam_Least_assumption_general[where U=domain, OF _ mem_F_bound4], simp_all)
+  fix A i x
+  assume "A \<in> M" "x \<in> M" "x \<in> A ` i"
+  then
+  show "i \<in> M"
+    using apply_0[of i A] transM[of _ "domain(A)", simplified]
+    by force
+qed
+
+context G_generic4_AC begin
+
+context
+  includes G_generic1_lemmas
+begin
+
+lemma G_in_MG: "G \<in> M[G]"
+  using G_in_Gen_Ext[ OF _ one_in_G, OF _ generic]
+  by blast
+
+lemma ccc_preserves_Aleph_succ:
+  assumes "ccc\<^bsup>M\<^esup>(P,leq)" "Ord(z)" "z \<in> M"
+  shows "Card\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
+proof (rule ccontr)
+  assume "\<not> Card\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
+  moreover
+  note \<open>z \<in> M\<close> \<open>Ord(z)\<close>
+  moreover from this
+  have "Ord(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
+    using Card_rel_is_Ord by fastforce
+  ultimately
+  obtain \<alpha> f where "\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" "f \<in> surj\<^bsup>M[G]\<^esup>(\<alpha>, \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
+    using ext.lt_surj_rel_empty_imp_Card_rel M_subset_MG[OF one_in_G, OF generic]
+    by force
+  moreover from this and \<open>z\<in>M\<close> \<open>Ord(z)\<close>
+  have "\<alpha> \<in> M" "f \<in> M[G]"
+    using ext.trans_surj_rel_closed
+    by (auto dest:transM ext.transM dest!:ltD)
+  moreover
+  note \<open>ccc\<^bsup>M\<^esup>(P,leq)\<close> \<open>z\<in>M\<close>
+  ultimately
+  obtain F where "F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)" "\<forall>\<beta>\<in>\<alpha>. f`\<beta> \<in> F`\<beta>" "\<forall>\<beta>\<in>\<alpha>. |F`\<beta>|\<^bsup>M\<^esup> \<le> \<omega>"
+    "F \<in> M"
+    using ccc_fun_approximation_lemma[of \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" f]
+      ext.mem_surj_abs[of f \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"] \<open>Ord(z)\<close>
+      surj_is_fun[of f \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"] by auto
+  then
+  have "\<beta> \<in> \<alpha> \<Longrightarrow> |F`\<beta>|\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup>" for \<beta>
+    using Aleph_rel_zero by simp
+  have "w \<in> F ` x \<Longrightarrow> x \<in> M" for w x
+    proof -
+      fix w x
+      assume "w \<in> F`x"
+      then
+      have "x \<in> domain(F)"
+        using apply_0 by auto
+      with \<open>F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close>
+      have "x \<in> \<alpha>"
+        using domain_of_fun by simp
+      with \<open>\<alpha> \<in> M\<close>
+      show "x \<in> M" by (auto dest:transM)
+    qed
+    with \<open>\<alpha> \<in> M\<close> \<open>F:\<alpha>\<rightarrow>Pow\<^bsup>M\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close> \<open>F\<in>M\<close>
+  interpret M_cardinal_UN_lepoll "##M" "\<lambda>\<beta>. F`\<beta>" \<alpha>
+    using UN_lepoll_assumptions lepoll_assumptions
+      lam_replacement_apply lam_replacement_inj_rel
+  proof (unfold_locales, auto dest:transM simp del:if_range_F_else_F_def)
+    fix f b
+    assume "b\<in>M" "f\<in>M"
+    with \<open>F\<in>M\<close>
+    show "lam_replacement(##M, \<lambda>x. \<mu> i. x \<in> if_range_F_else_F((`)(F), b, f, i))"
+      using UN_lepoll_assumptions mem_F_bound5
+      by (rule_tac lam_Least_assumption_general[where U="domain", OF _ mem_F_bound5])
+        simp_all
+  qed
+  from \<open>\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>\<close> \<open>\<alpha> \<in> M\<close> assms
+  have "\<alpha> \<lesssim>\<^bsup>M\<^esup> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
+    using
+      Aleph_rel_zero
+      cardinal_rel_lt_csucc_rel_iff[of "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>" \<alpha>]
+      le_Card_rel_iff[of "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>" \<alpha>]
+      Aleph_rel_succ[of z] Card_rel_lt_iff[of \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"]
+      lt_Ord[of \<alpha> "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"]
+      Card_rel_csucc_rel[of "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"]
+      Aleph_rel_closed[of z]
+      Card_rel_Aleph_rel[THEN Card_rel_is_Ord, OF _ _ Aleph_rel_closed]
+    by simp
+  with \<open>\<alpha> < \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>\<close> \<open>\<forall>\<beta>\<in>\<alpha>. |F`\<beta>|\<^bsup>M\<^esup> \<le> \<omega>\<close> \<open>\<alpha> \<in> M\<close> assms
+  have "|\<Union>\<beta>\<in>\<alpha>. F`\<beta>|\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
+    using InfCard_rel_Aleph_rel[of z] Aleph_rel_zero
+      subset_imp_lepoll_rel[THEN lepoll_rel_imp_cardinal_rel_le,
+        of "\<Union>\<beta>\<in>\<alpha>. F`\<beta>" "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"] Aleph_rel_succ
+      Aleph_rel_increasing[THEN leI, THEN [2] le_trans, of _ 0 z]
+      Ord_0_lt_iff[THEN iffD1, of z]
+    by (cases "0<z"; rule_tac leqpoll_rel_imp_cardinal_rel_UN_le) (auto, force)
+  moreover
+  note \<open>z\<in>M\<close> \<open>Ord(z)\<close>
+  moreover from \<open>\<forall>\<beta>\<in>\<alpha>. f`\<beta> \<in> F`\<beta>\<close> \<open>f \<in> surj\<^bsup>M[G]\<^esup>(\<alpha>, \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)\<close>
+    \<open>\<alpha> \<in> M\<close> \<open>f \<in> M[G]\<close> and this
+  have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<subseteq> (\<Union>\<beta>\<in>\<alpha>. F`\<beta>)"
+    using ext.mem_surj_abs by (force simp add:surj_def)
+  moreover from \<open>F \<in> M\<close> \<open>\<alpha> \<in> M\<close>
+  have "(\<Union>x\<in>\<alpha>. F ` x) \<in> M"
+    using j.B_replacement\<comment> \<open>NOTE: it didn't require @{thm j.UN_closed} before!\<close>
+    by (intro Union_closed[simplified] RepFun_closed[simplified])
+      (auto dest:transM)
+  ultimately
+  have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
+    using subset_imp_le_cardinal_rel[of "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" "\<Union>\<beta>\<in>\<alpha>. F`\<beta>"]
+      le_trans by auto
+  with assms
+  show "False"
+    using Aleph_rel_increasing not_le_iff_lt[of "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"]
+      Card_rel_Aleph_rel[THEN Card_rel_is_Ord]
+    by auto
+qed
+
+end \<comment> \<open>bundle G\_generic1\_lemmas\<close>
+
+end \<comment> \<open>\<^locale>\<open>G_generic4_AC\<close>\<close>
+
+context M_ctm1
+begin
+
+abbreviation
+  Add :: "i" where
+  "Add \<equiv> Fn(\<omega>, \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>, 2)"
+
+end \<comment> \<open>\<^locale>\<open>M_ctm1\<close>\<close>
+
+locale add_generic4 = G_generic4_AC "Fn(\<omega>, \<aleph>\<^bsub>2\<^esub>\<^bsup>##M\<^esup> \<times> \<omega>, 2)" "Fnle(\<omega>, \<aleph>\<^bsub>2\<^esub>\<^bsup>##M\<^esup> \<times> \<omega>, 2)" 0
+
+sublocale add_generic4 \<subseteq> cohen_data \<omega> "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 2 by unfold_locales auto
+
+context add_generic4
+begin
+
+notation Leq (infixl "\<preceq>" 50)
+notation Incompatible (infixl "\<bottom>" 50)
+notation GenExt_at_P ("_[_]" [71,1])
+
+lemma Add_subs_preserves_Aleph_succ: "Ord(z) \<Longrightarrow> z\<in>M \<Longrightarrow> Card\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>)"
+  using ccc_preserves_Aleph_succ ccc_Add_subs_Aleph_2
+  by auto
+
+lemma Aleph_rel_nats_MG_eq_Aleph_rel_nats_M:
+  includes G_generic1_lemmas
+  assumes "z \<in> \<omega>"
+  shows "\<aleph>\<^bsub>z\<^esub>\<^bsup>M[G]\<^esup> = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>"
+  using assms
+proof (induct)
+  case 0
+  have "\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup> = \<omega>"
+    using ext.Aleph_rel_zero .
+  also
+  have "\<omega> = \<aleph>\<^bsub>0\<^esub>\<^bsup>M\<^esup>"
+    using Aleph_rel_zero by simp
+  finally
+  show ?case .
+next
+  case (succ z)
+  then
+  have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<le> \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M[G]\<^esup>"
+    using Aleph_rel_le_Aleph_rel nat_into_M by simp
+  moreover from \<open>z \<in> \<omega>\<close>
+  have "\<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup> \<in> M[G]"
+    using nat_into_M by simp_all
+  moreover from this and \<open>\<aleph>\<^bsub>z\<^esub>\<^bsup>M[G]\<^esup> = \<aleph>\<^bsub>z\<^esub>\<^bsup>M\<^esup>\<close> \<open>z \<in> \<omega>\<close>
+  have "\<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M[G]\<^esup> \<le> \<aleph>\<^bsub>succ(z)\<^esub>\<^bsup>M\<^esup>"
+    using ext.Aleph_rel_succ nat_into_M
+      Add_subs_preserves_Aleph_succ[THEN ext.csucc_rel_le, of z]
+      Aleph_rel_increasing[of z "succ(z)"]
+    by simp
+  ultimately
+  show ?case using le_anti_sym by blast
+qed
+
+abbreviation
+  f_G :: "i" (\<open>f\<^bsub>G\<^esub>\<close>) where
+  "f\<^bsub>G\<^esub> \<equiv> \<Union>G"
+
+abbreviation
+  dom_dense :: "i\<Rightarrow>i" where
+  "dom_dense(x) \<equiv> { p\<in>Add . x \<in> domain(p) }"
+
+(* TODO: write general versions of this for \<^term>\<open>Fn(\<omega>,I,J)\<close> *)
+lemma dense_dom_dense: "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega> \<Longrightarrow> dense(dom_dense(x))"
+proof
+  fix p
+  assume "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" "p \<in> Add"
+  show "\<exists>d\<in>dom_dense(x). d \<preceq> p"
+  proof (cases "x \<in> domain(p)")
+    case True
+    with \<open>x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>\<close> \<open>p \<in> Add\<close>
+    show ?thesis using refl_leq by auto
+  next
+    case False
+    note \<open>p \<in> Add\<close>
+    moreover from this and False and \<open>x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>\<close>
+    have "cons(\<langle>x,0\<rangle>, p) \<in> Add"
+      using FiniteFun.consI[of x "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 0 2 p]
+        Fn_nat_eq_FiniteFun by auto
+    moreover from \<open>p \<in> Add\<close>
+    have "x\<in>domain(cons(\<langle>x,0\<rangle>, p))" by simp
+    ultimately
+    show ?thesis
+      by (fastforce del:FnD)
+  qed
+qed
+
+declare (in M_ctm3_AC) Fn_nat_closed[simplified setclass_iff, simp, intro]
+declare (in M_ctm3_AC) Fnle_nat_closed[simp del, rule del,
+    simplified setclass_iff, simp, intro]
+declare (in M_ctm3_AC) cexp_rel_closed[simplified setclass_iff, simp, intro]
+declare (in G_generic4_AC) ext.cexp_rel_closed[simplified setclass_iff, simp, intro]
+
+lemma dom_dense_closed[intro,simp]: "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega> \<Longrightarrow> dom_dense(x) \<in> M"
+  using separation_in_domain[of x] nat_into_M
+  by (rule_tac separation_closed[simplified], blast dest:transM) simp
+
+lemma domain_f_G: assumes "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "y \<in> \<omega>"
+  shows "\<langle>x, y\<rangle> \<in> domain(f\<^bsub>G\<^esub>)"
+proof -
+  from assms
+  have "dense(dom_dense(\<langle>x, y\<rangle>))" using dense_dom_dense by simp
+  with assms
+  obtain p where "p\<in>dom_dense(\<langle>x, y\<rangle>)" "p\<in>G"
+    using generic[THEN M_generic_denseD, of "dom_dense(\<langle>x, y\<rangle>)"]
+    by auto
+  then
+  show "\<langle>x, y\<rangle> \<in> domain(f\<^bsub>G\<^esub>)" by blast
+qed
+
+lemma f_G_funtype:
+  includes G_generic1_lemmas
+  shows "f\<^bsub>G\<^esub> : \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega> \<rightarrow> 2"
+  using generic domain_f_G
+  unfolding Pi_def
+proof (auto)
+  show "x \<in> B \<Longrightarrow> B \<in> G \<Longrightarrow> x \<in> (\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>) \<times> 2" for B x
+    using Fn_nat_subset_Pow by blast
+  show "function(f\<^bsub>G\<^esub>)"
+    using Un_filter_is_function generic
+    unfolding M_generic_def by fast
+qed
+
+abbreviation
+  inj_dense :: "i\<Rightarrow>i\<Rightarrow>i" where
+  "inj_dense(w,x) \<equiv>
+    { p\<in>Add . (\<exists>n\<in>\<omega>. \<langle>\<langle>w,n\<rangle>,1\<rangle> \<in> p \<and> \<langle>\<langle>x,n\<rangle>,0\<rangle> \<in> p) }"
+
+(* TODO write general versions of this for \<^term>\<open>Fn(\<omega>,I,J)\<close> *)
+lemma dense_inj_dense:
+  assumes "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "w \<noteq> x"
+  shows "dense(inj_dense(w,x))"
+proof
+  fix p
+  assume "p \<in> Add"
+  then
+  obtain n where "\<langle>w,n\<rangle> \<notin> domain(p)" "\<langle>x,n\<rangle> \<notin> domain(p)" "n \<in> \<omega>"
+  proof -
+    {
+      assume "\<langle>w,n\<rangle> \<in> domain(p) \<or> \<langle>x,n\<rangle> \<in> domain(p)" if "n \<in> \<omega>" for n
+      then
+      have "\<omega> \<subseteq> range(domain(p))" by blast
+      then
+      have "\<not> Finite(p)"
+        using Finite_range Finite_domain subset_Finite nat_not_Finite
+        by auto
+      with \<open>p \<in> Add\<close>
+      have False
+        using Fn_nat_eq_FiniteFun FiniteFun.dom_subset[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 2]
+          Fin_into_Finite by auto
+    }
+    with that\<comment> \<open>the shape of the goal puts assumptions in this variable\<close>
+    show ?thesis by auto
+  qed
+  moreover
+  note \<open>p \<in> Add\<close> assms
+  moreover from calculation
+  have "cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p) \<in> Add"
+    using FiniteFun.consI[of "\<langle>x,n\<rangle>" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 0 2 p]
+      Fn_nat_eq_FiniteFun by auto
+  ultimately
+  have "cons(\<langle>\<langle>w,n\<rangle>,1\<rangle>, cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p) ) \<in> Add"
+    using FiniteFun.consI[of "\<langle>w,n\<rangle>" "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 1 2 "cons(\<langle>\<langle>x,n\<rangle>,0\<rangle>, p)"]
+      Fn_nat_eq_FiniteFun by auto
+  with \<open>n \<in> \<omega>\<close>
+  show "\<exists>d\<in>inj_dense(w,x). d \<preceq> p"
+    using \<open>p \<in> Add\<close> by (intro bexI) auto
+qed
+
+lemma inj_dense_closed[intro,simp]:
+  "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<Longrightarrow> inj_dense(w,x) \<in> M"
+  using transM[OF _ Aleph_rel2_closed] separation_conj separation_bex
+    lam_replacement_hcomp2[OF _ _  _ _ lam_replacement_Pair]
+    separation_in lam_replacement_fst lam_replacement_snd lam_replacement_constant
+    lam_replacement_hcomp[OF lam_replacement_snd lam_replacement_restrict']
+    separation_bex separation_conj
+  by simp
+
+lemma Aleph_rel2_new_reals:
+  assumes "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "w \<noteq> x"
+  shows "(\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>w, n\<rangle>) \<noteq> (\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>x, n\<rangle>)"
+proof -
+  from assms
+  have "dense(inj_dense(w,x))" using dense_inj_dense by simp
+  with assms
+  obtain p where "p\<in>inj_dense(w,x)" "p\<in>G"
+    using generic[THEN M_generic_denseD, of "inj_dense(w,x)"]
+    by blast
+  then
+  obtain n where "n \<in> \<omega>" "\<langle>\<langle>w, n\<rangle>, 1\<rangle> \<in> p" "\<langle>\<langle>x, n\<rangle>, 0\<rangle> \<in> p"
+    by blast
+  moreover from this and \<open>p\<in>G\<close>
+  have "\<langle>\<langle>w, n\<rangle>, 1\<rangle> \<in> f\<^bsub>G\<^esub>" "\<langle>\<langle>x, n\<rangle>, 0\<rangle> \<in> f\<^bsub>G\<^esub>" by auto
+  moreover from calculation
+  have "f\<^bsub>G\<^esub> ` \<langle>w, n\<rangle> = 1" "f\<^bsub>G\<^esub> ` \<langle>x, n\<rangle> = 0"
+    using f_G_funtype apply_equality
+    by auto
+  ultimately
+  have "(\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>w, n\<rangle>) ` n \<noteq> (\<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub> ` \<langle>x, n\<rangle>) ` n"
+    by simp
+  then
+  show ?thesis by fastforce
+qed
+
+definition
+  h_G :: "i" (\<open>h\<^bsub>G\<^esub>\<close>) where
+  "h\<^bsub>G\<^esub> \<equiv> \<lambda>\<alpha>\<in>\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>. \<lambda>n\<in>\<omega>. f\<^bsub>G\<^esub>`\<langle>\<alpha>,n\<rangle>"
+
+lemma h_G_in_MG[simp]:
+  includes G_generic1_lemmas
+  shows "h\<^bsub>G\<^esub> \<in> M[G]"
+  using ext.lam_apply_replacement ext.apply_replacement2
+    ext.lam_apply_replacement[unfolded lam_replacement_def]
+    ext.Union_closed[simplified, OF G_in_MG]
+    \<comment> \<open>The "simplified" here is because of
+        the \<^term>\<open>setclass\<close> ocurrences\<close>
+    ext.nat_into_M
+  unfolding h_G_def
+  by (rule_tac ext.lam_closed[simplified] |
+      auto dest:transM del:ext.cexp_rel_closed[simplified])+
+
+lemma h_G_inj_Aleph_rel2_reals: "h\<^bsub>G\<^esub> \<in> inj\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
+  using Aleph_rel_sub_closed
+proof (intro ext.mem_inj_abs[THEN iffD2])
+  show "h\<^bsub>G\<^esub> \<in> inj(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
+    unfolding inj_def
+  proof (intro ballI CollectI impI)
+    show "h\<^bsub>G\<^esub> \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
+      using f_G_funtype G_in_MG ext.nat_into_M
+      unfolding h_G_def
+      apply (intro lam_type ext.mem_function_space_rel_abs[THEN iffD2], simp_all)
+      apply (rule_tac ext.lam_closed[simplified], simp_all)
+       apply (rule ext.apply_replacement2)
+        apply (auto dest:ext.transM[OF _ Aleph_rel_sub_closed])
+      done
+    fix w x
+    assume "w \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "x \<in> \<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "h\<^bsub>G\<^esub> ` w = h\<^bsub>G\<^esub> ` x"
+    then
+    show "w = x"
+      unfolding h_G_def using Aleph_rel2_new_reals by auto
+  qed
+qed simp_all
+
+lemma Aleph2_extension_le_continuum_rel:
+  includes G_generic1_lemmas
+  shows "\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
+proof -
+  have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "Ord(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>)"
+    using Card_rel_is_Ord by auto
+  moreover from this
+  have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<lesssim>\<^bsup>M[G]\<^esup> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
+    using ext.def_lepoll_rel[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"]
+      h_G_inj_Aleph_rel2_reals by auto
+  moreover from calculation
+  have "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<lesssim>\<^bsup>M[G]\<^esup> |\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2|\<^bsup>M[G]\<^esup>"
+    using ext.lepoll_rel_imp_lepoll_rel_cardinal_rel by simp
+  ultimately
+  have "|\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>|\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
+    using ext.lepoll_rel_imp_cardinal_rel_le[of "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2",
+        OF _ _ ext.function_space_rel_closed]
+      ext.Aleph_rel_zero Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
+    unfolding cexp_rel_def by simp
+  then
+  show "\<aleph>\<^bsub>2\<^esub>\<^bsup>M[G]\<^esup> \<le> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
+    using Aleph_rel_nats_MG_eq_Aleph_rel_nats_M
+      ext.Card_rel_Aleph_rel[of 2, THEN ext.Card_rel_cardinal_rel_eq]
+    by simp
+qed
+
+lemma Aleph_rel_lt_continuum_rel: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> < 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
+  using Aleph2_extension_le_continuum_rel
+    ext.Aleph_rel_increasing[of 1 2] le_trans by auto
+
+corollary not_CH: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> \<noteq> 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
+  using Aleph_rel_lt_continuum_rel by auto
+
+end \<comment> \<open>\<^locale>\<open>add_generic4\<close>\<close>
+
+subsection\<open>Models of fragments of $\ZFC + \neg \CH$\<close>
+
+definition
+  ContHyp :: "o" where
+  "ContHyp \<equiv> \<aleph>\<^bsub>1\<^esub> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^esup>"
+
+relativize functional "ContHyp" "ContHyp_rel"
+notation ContHyp_rel (\<open>CH\<^bsup>_\<^esup>\<close>)
+relationalize "ContHyp_rel" "is_ContHyp"
+
+context M_master
+begin
+
+is_iff_rel for "ContHyp"
+  using is_cexp_iff is_Aleph_iff[of 0] is_Aleph_iff[of 1]
+  unfolding is_ContHyp_def ContHyp_rel_def
+  by (auto simp del:setclass_iff) (rule rexI[of _ _ M, OF _ nonempty], auto)
+
+end \<comment> \<open>\<^locale>\<open>M_master\<close>\<close>
+
+synthesize "is_ContHyp" from_definition assuming "nonempty"
+arity_theorem for "is_ContHyp_fm"
+
+notation is_ContHyp_fm (\<open>\<cdot>CH\<cdot>\<close>)
+
+theorem ctm_of_not_CH:
+  assumes
+    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
+    "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
+  shows
+    "\<exists>N.
+      M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
+      (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
+proof -
+  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
+  interpret M_ZFC4 M
+    using M_satT_overhead_imp_M_ZF4 by simp
+  from \<open>Transset(M)\<close>
+  interpret M_ZFC4_trans M
+    using M_satT_imp_M_ZF4
+    by unfold_locales
+  from \<open>M \<approx> \<omega>\<close>
+  obtain enum where "enum \<in> bij(\<omega>,M)"
+    using eqpoll_sym unfolding eqpoll_def by blast
+  then
+  interpret M_ctm4_AC M enum by unfold_locales
+  interpret cohen_data \<omega> "\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup> \<times> \<omega>" 2 by unfold_locales auto
+  have "Add \<in> M" "Add_le(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>) \<in> M"
+    using nat_into_M Aleph_rel_closed M_nat cartprod_closed Fn_nat_closed Fnle_nat_closed
+    by simp_all
+  then
+  interpret forcing_data1 "Add" "Add_le(\<aleph>\<^bsub>2\<^esub>\<^bsup>M\<^esup>)" 0 M enum
+    by unfold_locales simp_all
+  obtain G where "M_generic(G)"
+    using generic_filter_existence[OF one_in_P]
+    by auto
+  moreover from this
+  interpret add_generic4 M enum G by unfold_locales
+  have "\<not> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>)"
+    using not_CH .
+  then
+  have "M[G], [] \<Turnstile> \<cdot>\<not>\<cdot>CH\<cdot>\<cdot>"
+    using ext.is_ContHyp_iff
+    by (simp add:ContHyp_rel_def)
+  then
+  have "M[G] \<Turnstile> ZC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}"
+    using ext.M_satT_ZC by auto
+  moreover
+  have "Transset(M[G])" using Transset_MG .
+  moreover
+  have "M \<subseteq> M[G]" using M_subset_MG[OF one_in_G] generic by simp
+  moreover
+  note \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
+  ultimately
+  show ?thesis
+    using Ord_MG_iff MG_eqpoll_nat satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
+    by (rule_tac x="M[G]" in exI, blast)
+qed
+
+lemma ZF_replacement_overhead_sub_ZFC: "{\<cdot>Replacement(p)\<cdot> . p \<in> overhead} \<subseteq> ZFC"
+  using overhead_type unfolding ZFC_def ZF_def ZF_schemes_def by auto
+
+corollary ctm_ZFC_imp_ctm_not_CH:
+  assumes
+    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZFC"
+  shows
+    "\<exists>N.
+      M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<and>
+      (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
+proof-
+  from assms
+  have "\<exists>N.
+      M \<subseteq> N \<and>
+        N \<approx> \<omega> \<and>
+        Transset(N) \<and>
+        N \<Turnstile> ZC \<and> N \<Turnstile> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>} \<and> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
+    using ctm_of_not_CH[of M formula] satT_ZFC_imp_satT_ZC[of M]
+      satT_mono[OF _ ground_repl_fm_sub_ZFC, of M]
+      satT_mono[OF _ ZF_replacement_overhead_sub_ZFC, of M]
+      satT_mono[OF _ ZF_replacement_fms_sub_ZFC, of M]
+    by (simp add: satT_Un_iff)
+  then
+  obtain N where "N \<Turnstile> ZC" "N \<Turnstile> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}" "N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula}"
+    "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
+    by auto
+  moreover from this
+  have "N \<Turnstile> ZFC"
+    using satT_ZC_ZF_replacement_imp_satT_ZFC
+    by auto
+  moreover from this and \<open>N \<Turnstile> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}\<close>
+  have "N \<Turnstile> ZFC \<union> {\<cdot>\<not>\<cdot>CH\<cdot>\<cdot>}"
+    by auto
+  ultimately
+  show ?thesis by auto
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Ordinals_In_MG.thy b/thys/Independence_CH/Ordinals_In_MG.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Ordinals_In_MG.thy
@@ -0,0 +1,57 @@
+section\<open>Ordinals in generic extensions\<close>
+theory Ordinals_In_MG
+  imports
+    Forcing_Theorems
+begin
+
+context G_generic1
+begin
+
+lemma rank_val: "rank(val(P,G,x)) \<le> rank(x)" (is "?Q(x)")
+proof (induct rule:ed_induction[of ?Q])
+  case (1 x)
+  have "val(P,G,x) = {val(P,G,u). u\<in>{t\<in>domain(x). \<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G }}"
+    using def_val[of G x] by auto
+  then
+  have "rank(val(P,G,x)) = (\<Union>u\<in>{t\<in>domain(x). \<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G }. succ(rank(val(P,G,u))))"
+    using rank[of "val(P,G,x)"] by simp
+  moreover
+  have "succ(rank(val(P,G, y))) \<le> rank(x)" if "ed(y, x)" for y
+    using 1[OF that] rank_ed[OF that] by (auto intro:lt_trans1)
+  moreover from this
+  have "(\<Union>u\<in>{t\<in>domain(x). \<exists>p\<in>P . \<langle>t,p\<rangle>\<in>x \<and> p \<in> G }. succ(rank(val(P,G,u)))) \<le> rank(x)"
+    by (rule_tac UN_least_le) (auto)
+  ultimately
+  show ?case
+    by simp
+qed
+
+lemma Ord_MG_iff:
+  assumes "Ord(\<alpha>)"
+  shows "\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> M[G]"
+proof
+  show "\<alpha> \<in> M[G]" if "\<alpha> \<in> M"
+    using generic[THEN one_in_G, THEN M_subset_MG] that ..
+next
+  assume "\<alpha> \<in> M[G]"
+  then
+  obtain x where "x\<in>M" "val(P,G,x) = \<alpha>"
+    using GenExtD by auto
+  then
+  have "rank(\<alpha>) \<le> rank(x)"
+    using rank_val by blast
+  with assms
+  have "\<alpha> \<le> rank(x)"
+    using rank_of_Ord by simp
+  then
+  have "\<alpha> \<in> succ(rank(x))"
+    using ltD by simp
+  with \<open>x\<in>M\<close>
+  show "\<alpha> \<in> M"
+    using cons_closed transitivity[of \<alpha> "succ(rank(x))"] rank_closed
+    unfolding succ_def by simp
+qed
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Pairing_Axiom.thy b/thys/Independence_CH/Pairing_Axiom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Pairing_Axiom.thy
@@ -0,0 +1,54 @@
+section\<open>The Axiom of Pairing in $M[G]$\<close>
+
+theory Pairing_Axiom
+  imports
+    Names
+begin
+
+context forcing_data1
+begin
+
+lemma val_Upair :
+  "\<one> \<in> G \<Longrightarrow> val(P,G,{\<langle>\<tau>,\<one>\<rangle>,\<langle>\<rho>,\<one>\<rangle>}) = {val(P,G,\<tau>),val(P,G,\<rho>)}"
+  by (insert one_in_P, rule trans, subst def_val,auto)
+
+lemma pairing_in_MG :
+  assumes "M_generic(G)"
+  shows "upair_ax(##M[G])"
+proof -
+  from assms
+  have types: "\<one>\<in>G" "\<one>\<in>P" "\<one>\<in>M"
+    using one_in_G one_in_M one_in_P
+    by simp_all
+  {
+    fix x y
+    note assms types
+    moreover
+    assume "x \<in> M[G]" "y \<in> M[G]"
+    moreover from this
+    obtain \<tau> \<rho> where "val(P,G,\<tau>) = x" "val(P,G,\<rho>) = y" "\<rho> \<in> M"  "\<tau> \<in> M"
+      using GenExtD by blast
+    moreover from types this
+    have "\<langle>\<tau>,\<one>\<rangle> \<in> M" "\<langle>\<rho>,\<one>\<rangle>\<in>M"
+      using pair_in_M_iff by auto
+    moreover from this
+    have "{\<langle>\<tau>,\<one>\<rangle>,\<langle>\<rho>,\<one>\<rangle>} \<in> M" (is "?\<sigma> \<in> _")
+      using upair_in_M_iff by simp
+    moreover from this
+    have "val(P,G,?\<sigma>) \<in> M[G]"
+      using GenExtI by simp
+    moreover from calculation
+    have "{val(P,G,\<tau>),val(P,G,\<rho>)} \<in> M[G]"
+      using val_Upair assms one_in_G by simp
+    ultimately
+    have "{x,y} \<in> M[G]"
+      by simp
+  }
+  then
+  show ?thesis
+    unfolding upair_ax_def upair_def by auto
+qed
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Powerset_Axiom.thy b/thys/Independence_CH/Powerset_Axiom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Powerset_Axiom.thy
@@ -0,0 +1,298 @@
+section\<open>The Powerset Axiom in $M[G]$\<close>
+theory Powerset_Axiom
+  imports Separation_Axiom Pairing_Axiom Union_Axiom
+begin
+
+simple_rename "perm_pow" src "[ss,p,l,o,fs,\<chi>]" tgt "[fs,ss,sp,p,l,o,\<chi>]"
+
+lemma Collect_inter_Transset:
+  assumes
+    "Transset(M)" "b \<in> M"
+  shows
+    "{x\<in>b . P(x)} = {x\<in>b . P(x)} \<inter> M"
+  using assms unfolding Transset_def
+  by (auto)
+
+context G_generic1
+begin
+
+lemma name_components_in_M:
+  assumes "\<langle>\<sigma>,p\<rangle>\<in>\<theta>" "\<theta> \<in> M"
+  shows   "\<sigma>\<in>M" "p\<in>M"
+proof -
+  from assms
+  obtain a where "\<sigma> \<in> a" "p \<in> a" "a\<in>\<langle>\<sigma>,p\<rangle>"
+    unfolding Pair_def by auto
+  moreover from assms
+  have "\<langle>\<sigma>,p\<rangle>\<in>M"
+    using transitivity by simp
+  moreover from calculation
+  have "a\<in>M"
+    using transitivity by simp
+  ultimately
+  show "\<sigma>\<in>M" "p\<in>M"
+    using transitivity by simp_all
+qed
+
+lemma sats_fst_snd_in_M:
+  assumes
+    "A\<in>M" "B\<in>M" "\<phi> \<in> formula" "p\<in>M" "l\<in>M" "o\<in>M" "\<chi>\<in>M" "arity(\<phi>) \<le> 6"
+  shows "{\<langle>s,q\<rangle>\<in>A\<times>B . M, [q,p,l,o,s,\<chi>] \<Turnstile> \<phi>} \<in> M" (is "?\<theta> \<in> M")
+proof -
+  let ?\<phi>' = "ren(\<phi>)`6`7`perm_pow_fn"
+  from \<open>A\<in>M\<close> \<open>B\<in>M\<close>
+  have "A\<times>B \<in> M"
+    using cartprod_closed by simp
+  from \<open>arity(\<phi>) \<le> 6\<close> \<open>\<phi>\<in> formula\<close>
+  have "?\<phi>' \<in> formula" "arity(?\<phi>')\<le>7"
+    unfolding perm_pow_fn_def
+    using perm_pow_thm  arity_ren ren_tc Nil_type
+    by auto
+  with \<open>?\<phi>' \<in> formula\<close>
+  have arty: "arity(Exists(Exists(And(pair_fm(0,1,2),?\<phi>'))))\<le>5" (is "arity(?\<psi>)\<le>5")
+    using ord_simp_union pred_le
+    by (auto simp:arity)
+  {
+    fix sp
+    note \<open>A\<times>B \<in> M\<close> \<open>A\<in>M\<close> \<open>B\<in>M\<close>
+    moreover
+    assume "sp \<in> A\<times>B"
+    moreover from calculation
+    have "fst(sp) \<in> A" "snd(sp) \<in> B"
+      using fst_type snd_type by simp_all
+    ultimately
+    have "sp \<in> M" "fst(sp) \<in> M" "snd(sp) \<in> M"
+      using transitivity
+      by simp_all
+    note inM = \<open>A\<in>M\<close> \<open>B\<in>M\<close> \<open>p\<in>M\<close> \<open>l\<in>M\<close> \<open>o\<in>M\<close> \<open>\<chi>\<in>M\<close>
+      \<open>sp\<in>M\<close> \<open>fst(sp)\<in>M\<close> \<open>snd(sp)\<in>M\<close>
+    with arty \<open>sp \<in> M\<close> \<open>?\<phi>' \<in> formula\<close>
+    have "(M, [sp,p,l,o,\<chi>]@[p] \<Turnstile> ?\<psi>) \<longleftrightarrow> M,[sp,p,l,o,\<chi>] \<Turnstile> ?\<psi>" (is "(M,?env0@ _\<Turnstile>_) \<longleftrightarrow> _")
+      using arity_sats_iff[of ?\<psi> "[p]" M ?env0] by auto
+    also from inM \<open>sp \<in> A\<times>B\<close>
+    have "... \<longleftrightarrow> sats(M,?\<phi>',[fst(sp),snd(sp),sp,p,l,o,\<chi>])"
+      by auto
+    also from inM \<open>\<phi> \<in> formula\<close> \<open>arity(\<phi>) \<le> 6\<close>
+    have "... \<longleftrightarrow> M, [snd(sp),p,l,o,fst(sp),\<chi>] \<Turnstile> \<phi>"
+      (is "sats(_,_,?env1) \<longleftrightarrow> sats(_,_,?env2)")
+      using sats_iff_sats_ren[of \<phi> 6 7 ?env2 M ?env1 perm_pow_fn] perm_pow_thm
+      unfolding perm_pow_fn_def by simp
+    finally
+    have "(M,[sp,p,l,o,\<chi>,p] \<Turnstile> ?\<psi>) \<longleftrightarrow> M, [snd(sp),p,l,o,fst(sp),\<chi>] \<Turnstile> \<phi>"
+      by simp
+  }
+  then
+  have "?\<theta> = {sp\<in>A\<times>B . sats(M,?\<psi>,[sp,p,l,o,\<chi>,p])}"
+    by auto
+  also from assms \<open>A\<times>B\<in>M\<close>
+  have " ... \<in> M"
+  proof -
+    from arty
+    have "arity(?\<psi>) \<le> 6"
+      using leI by simp
+    moreover from \<open>?\<phi>' \<in> formula\<close>
+    have "?\<psi> \<in> formula"
+      by simp
+    moreover
+    note assms \<open>A\<times>B\<in>M\<close>
+    ultimately
+    show "{x \<in> A\<times>B . M, [x, p, l, o, \<chi>, p] \<Turnstile> ?\<psi>} \<in> M"
+      using separation_ax separation_iff
+      by simp
+  qed
+  finally show ?thesis .
+qed
+
+lemma Pow_inter_MG:
+  assumes "a\<in>M[G]"
+  shows "Pow(a) \<inter> M[G] \<in> M[G]"
+proof -
+  from assms
+  obtain \<tau> where "\<tau> \<in> M" "val(P,G, \<tau>) = a"
+    using GenExtD by auto
+  let ?Q="Pow(domain(\<tau>)\<times>P) \<inter> M"
+  from \<open>\<tau>\<in>M\<close>
+  have "domain(\<tau>)\<times>P \<in> M" "domain(\<tau>) \<in> M"
+    using domain_closed cartprod_closed P_in_M
+    by simp_all
+  then
+  have "?Q \<in> M"
+  proof -
+    from power_ax \<open>domain(\<tau>)\<times>P \<in> M\<close>
+    obtain Q where "powerset(##M,domain(\<tau>)\<times>P,Q)" "Q \<in> M"
+      unfolding power_ax_def by auto
+    moreover from calculation
+    have "z\<in>Q \<Longrightarrow> z\<in>M" for z
+      using transitivity by blast
+    ultimately
+    have "Q = {a\<in>Pow(domain(\<tau>)\<times>P) . a\<in>M}"
+      using \<open>domain(\<tau>)\<times>P \<in> M\<close> powerset_abs[of "domain(\<tau>)\<times>P" Q]
+      by (simp flip: setclass_iff)
+    also
+    have " ... = ?Q"
+      by auto
+    finally
+    show ?thesis
+      using \<open>Q\<in>M\<close> by simp
+  qed
+  let ?\<pi>="?Q\<times>{\<one>}"
+  let ?b="val(P,G,?\<pi>)"
+  from \<open>?Q\<in>M\<close>
+  have "?\<pi>\<in>M"
+    using one_in_P P_in_M transitivity
+    by (simp flip: setclass_iff)
+  then
+  have "?b \<in> M[G]"
+    using GenExtI by simp
+  have "Pow(a) \<inter> M[G] \<subseteq> ?b"
+  proof
+    fix c
+    assume "c \<in> Pow(a) \<inter> M[G]"
+    then
+    obtain \<chi> where "c\<in>M[G]" "\<chi> \<in> M" "val(P,G,\<chi>) = c"
+      using GenExt_iff by auto
+    let ?\<theta>="{\<langle>\<sigma>,p\<rangle> \<in>domain(\<tau>)\<times>P . p \<tturnstile> \<cdot>0 \<in> 1\<cdot> [\<sigma>,\<chi>] }"
+    have "arity(forces(Member(0,1))) = 6"
+      using arity_forces_at by auto
+    with \<open>domain(\<tau>) \<in> M\<close> \<open>\<chi> \<in> M\<close>
+    have "?\<theta> \<in> M"
+      using P_in_M one_in_M leq_in_M sats_fst_snd_in_M
+      by simp
+    then
+    have "?\<theta> \<in> ?Q" by auto
+    then
+    have "val(P,G,?\<theta>) \<in> ?b"
+      using one_in_G one_in_P generic val_of_elem [of ?\<theta> \<one> ?\<pi> G]
+      by auto
+    have "val(P,G,?\<theta>) = c"
+    proof(intro equalityI subsetI)
+      fix x
+      assume "x \<in> val(P,G,?\<theta>)"
+      then
+      obtain \<sigma> p where 1: "\<langle>\<sigma>,p\<rangle>\<in>?\<theta>" "p\<in>G" "val(P,G,\<sigma>) =  x"
+        using elem_of_val_pair
+        by blast
+      moreover from \<open>\<langle>\<sigma>,p\<rangle>\<in>?\<theta>\<close> \<open>?\<theta> \<in> M\<close>
+      have "\<sigma>\<in>M"
+        using name_components_in_M[of _ _ ?\<theta>] by auto
+      moreover from 1
+      have "p \<tturnstile> \<cdot>0 \<in> 1\<cdot> [\<sigma>,\<chi>]" "p\<in>P"
+        by simp_all
+      moreover
+      note \<open>val(P,G,\<chi>) = c\<close> \<open>\<chi> \<in> M\<close>
+      ultimately
+      have "M[G], [x, c] \<Turnstile> \<cdot>0 \<in> 1\<cdot>"
+        using generic definition_of_forcing[where \<phi>="\<cdot>0 \<in> 1\<cdot>"] ord_simp_union
+        by auto
+      moreover from \<open>\<sigma>\<in>M\<close> \<open>\<chi>\<in>M\<close>
+      have "x\<in>M[G]"
+        using \<open>val(P,G,\<sigma>) = x\<close> GenExtI by blast
+      ultimately
+      show "x\<in>c"
+        using \<open>c\<in>M[G]\<close> by simp
+    next
+      fix x
+      assume "x \<in> c"
+      with \<open>c \<in> Pow(a) \<inter> M[G]\<close>
+      have "x \<in> a" "c\<in>M[G]" "x\<in>M[G]"
+        using transitivity_MG by auto
+      with \<open>val(P,G, \<tau>) = a\<close>
+      obtain \<sigma> where "\<sigma>\<in>domain(\<tau>)" "val(P,G,\<sigma>) = x"
+        using elem_of_val by blast
+      moreover
+      note \<open>x\<in>c\<close> \<open>val(P,G,\<chi>) = c\<close> \<open>c\<in>M[G]\<close> \<open>x\<in>M[G]\<close>
+      moreover from calculation
+      have "val(P,G,\<sigma>) \<in> val(P,G,\<chi>)"
+        by simp
+      moreover from calculation
+      have "M[G], [x, c] \<Turnstile> \<cdot>0 \<in> 1\<cdot>"
+        by simp
+      moreover
+      have "\<sigma>\<in>M"
+      proof -
+        from \<open>\<sigma>\<in>domain(\<tau>)\<close>
+        obtain p where "\<langle>\<sigma>,p\<rangle> \<in> \<tau>"
+          by auto
+        with \<open>\<tau>\<in>M\<close>
+        show ?thesis
+          using name_components_in_M by blast
+      qed
+      moreover
+      note \<open>\<chi> \<in> M\<close>
+      ultimately
+      obtain p where "p\<in>G" "p \<tturnstile> \<cdot>0 \<in> 1\<cdot> [\<sigma>,\<chi>]"
+        using generic truth_lemma[of "\<cdot>0 \<in> 1\<cdot>" "G" "[\<sigma>,\<chi>]" ] ord_simp_union
+        by auto
+      moreover from \<open>p\<in>G\<close>
+      have "p\<in>P"
+        using generic by blast
+      ultimately
+      have "\<langle>\<sigma>,p\<rangle>\<in>?\<theta>"
+        using \<open>\<sigma>\<in>domain(\<tau>)\<close> by simp
+      with \<open>val(P,G,\<sigma>) =  x\<close> \<open>p\<in>G\<close>
+      show "x\<in>val(P,G,?\<theta>)"
+        using val_of_elem [of _ _ "?\<theta>"] by auto
+    qed
+    with \<open>val(P,G,?\<theta>) \<in> ?b\<close>
+    show "c\<in>?b"
+      by simp
+  qed
+  then
+  have "Pow(a) \<inter> M[G] = {x\<in>?b . x\<subseteq>a \<and> x\<in>M[G]}"
+    by auto
+  also from \<open>a\<in>M[G]\<close>
+  have " ... = {x\<in>?b . ( M[G], [x,a] \<Turnstile> \<cdot>0 \<subseteq> 1\<cdot> ) \<and> x\<in>M[G]}"
+    using Transset_MG by force
+  also
+  have " ... = {x\<in>?b . ( M[G], [x,a] \<Turnstile> \<cdot>0 \<subseteq> 1\<cdot> )} \<inter> M[G]"
+    by auto
+  also from \<open>?b\<in>M[G]\<close>
+  have " ... = {x\<in>?b . ( M[G], [x,a] \<Turnstile> \<cdot>0 \<subseteq> 1\<cdot> )}"
+    using Collect_inter_Transset Transset_MG
+    by simp
+  also from \<open>?b\<in>M[G]\<close> \<open>a\<in>M[G]\<close>
+  have " ... \<in> M[G]"
+    using Collect_sats_in_MG GenExtI ord_simp_union by (simp add:arity)
+  finally
+  show ?thesis .
+qed
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+sublocale G_generic1 \<subseteq> ext: M_trivial "##M[G]"
+  using generic Union_MG pairing_in_MG zero_in_MG transitivity_MG
+  unfolding M_trivial_def M_trans_def M_trivial_axioms_def
+  by (simp; blast)
+
+context G_generic1 begin
+
+theorem power_in_MG : "power_ax(##(M[G]))"
+  unfolding power_ax_def
+proof (intro rallI, simp only:setclass_iff rex_setclass_is_bex)
+  (* After simplification, we have to show that for every
+     a\<in>M[G] there exists some x\<in>M[G] with powerset(##M[G],a,x)
+  *)
+  fix a
+  assume "a \<in> M[G]"
+  then
+  have "(##M[G])(a)"
+    by simp
+  have "{x\<in>Pow(a) . x \<in> M[G]} = Pow(a) \<inter> M[G]"
+    by auto
+  also from \<open>a\<in>M[G]\<close>
+  have " ... \<in> M[G]"
+    using Pow_inter_MG by simp
+  finally
+  have "{x\<in>Pow(a) . x \<in> M[G]} \<in> M[G]" .
+  moreover from \<open>a\<in>M[G]\<close> \<open>{x\<in>Pow(a) . x \<in> M[G]} \<in> _\<close>
+  have "powerset(##M[G], a, {x\<in>Pow(a) . x \<in> M[G]})"
+    using ext.powerset_abs[OF \<open>(##M[G])(a)\<close>]
+    by simp
+  ultimately
+  show "\<exists>x\<in>M[G] . powerset(##M[G], a, x)"
+    by auto
+qed
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Proper_Extension.thy b/thys/Independence_CH/Proper_Extension.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Proper_Extension.thy
@@ -0,0 +1,79 @@
+section\<open>Separative notions and proper extensions\<close>
+theory Proper_Extension
+  imports
+    Names
+
+begin
+
+text\<open>The key ingredient to obtain a proper extension is to have
+a \<^emph>\<open>separative preorder\<close>:\<close>
+
+locale separative_notion = forcing_notion +
+  assumes separative: "p\<in>P \<Longrightarrow> \<exists>q\<in>P. \<exists>r\<in>P. q \<preceq> p \<and> r \<preceq> p \<and> q \<bottom> r"
+begin
+
+text\<open>For separative preorders, the complement of every filter is
+dense. Hence an $M$-generic filter cannot belong to the ground model.\<close>
+
+lemma filter_complement_dense:
+  assumes "filter(G)"
+  shows "dense(P - G)"
+proof
+  fix p
+  assume "p\<in>P"
+  show "\<exists>d\<in>P - G. d \<preceq> p"
+  proof (cases "p\<in>G")
+    case True
+    note \<open>p\<in>P\<close> assms
+    moreover
+    obtain q r where "q \<preceq> p" "r \<preceq> p" "q \<bottom> r" "q\<in>P" "r\<in>P"
+      using separative[OF \<open>p\<in>P\<close>]
+      by force
+    with \<open>filter(G)\<close>
+    obtain s where "s \<preceq> p" "s \<notin> G" "s \<in> P"
+      using filter_imp_compat[of G q r]
+      by auto
+    then
+    show ?thesis
+      by blast
+  next
+    case False
+    with \<open>p\<in>P\<close>
+    show ?thesis
+      using refl_leq unfolding Diff_def by auto
+  qed
+qed
+
+end \<comment> \<open>\<^locale>\<open>separative_notion\<close>\<close>
+
+locale ctm_separative = forcing_data1 + separative_notion
+begin
+
+lemma generic_not_in_M:
+  assumes "M_generic(G)"
+  shows "G \<notin> M"
+proof
+  assume "G\<in>M"
+  then
+  have "P - G \<in> M"
+    using P_in_M Diff_closed by simp
+  moreover
+  have "\<not>(\<exists>q\<in>G. q \<in> P - G)" "(P - G) \<subseteq> P"
+    unfolding Diff_def by auto
+  moreover
+  note assms
+  ultimately
+  show "False"
+    using filter_complement_dense[of G] M_generic_denseD[of G "P-G"]
+      M_generic_def by simp \<comment> \<open>need to put generic ==> filter in claset\<close>
+qed
+
+theorem proper_extension:
+  assumes "M_generic(G)"
+  shows "M \<noteq> M[G]"
+  using assms G_in_Gen_Ext[of G] one_in_G[of G] generic_not_in_M
+  by force
+
+end \<comment> \<open>\<^locale>\<open>ctm_separative\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/ROOT b/thys/Independence_CH/ROOT
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/ROOT
@@ -0,0 +1,21 @@
+chapter AFP
+
+session "Independence_CH" (AFP) =  "Transitive_Models" +
+  description "
+    The Independence of the Continuum Hypothesis in Isabelle/ZF
+
+    We redeveloped our formalization of forcing in the set theory framework of
+    Isabelle/ZF. Under the assumption of the existence of a countable
+    transitive model of ZFC, we construct proper generic extensions
+    that satisfy the Continuum Hypothesis and its negation.
+  "
+  options [timeout=300]
+  sessions
+    "Transitive_Models"
+  theories
+    "Definitions_Main"
+    "Demonstrations"
+  document_files
+    "root.tex"
+    "root.bib"
+    "root.bst"
diff --git a/thys/Independence_CH/Replacement_Axiom.thy b/thys/Independence_CH/Replacement_Axiom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Replacement_Axiom.thy
@@ -0,0 +1,393 @@
+section\<open>The Axiom of Replacement in $M[G]$\<close>
+theory Replacement_Axiom
+  imports
+    Separation_Axiom
+begin
+
+context forcing_data1
+begin
+
+bundle sharp_simps1 = snd_abs[simp] fst_abs[simp] fst_closed[simp del, simplified, simp]
+    snd_closed[simp del, simplified, simp] M_inhabited[simplified, simp]
+    pair_in_M_iff[simp del, simplified, simp]
+
+lemma sats_forces_iff_sats_rename_split_fm:
+  includes sharp_simps1
+  assumes
+    "[\<alpha>,m,p,P,leq,\<one>,t,\<tau>] @ nenv \<in>list(M)" "V \<in> M"
+    "\<phi>\<in>formula"
+  shows
+    "(M, [p, P, leq, \<one>, t, \<tau>] @ nenv \<Turnstile> forces(\<phi>)) \<longleftrightarrow>
+      M, [V, \<tau>, \<alpha>, \<langle>t,p\<rangle>, m, P, leq, \<one>] @ nenv \<Turnstile> rename_split_fm(\<phi>)"
+  using assms unfolding rename_split_fm_def
+  by (simp add:sats_incr_bv_iff[where bvs="[_,_,_,_,_,_]", simplified])
+
+lemma sats_body_ground_repl_fm:
+  includes sharp_simps1
+  assumes
+    "\<exists>t p. x=\<langle>t,p\<rangle>" "[x,\<alpha>,m,P,leq,\<one>] @ nenv \<in>list(M)"
+    "\<phi>\<in>formula"
+  shows
+    "(\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(\<lambda>a. (##M)(a),\<alpha>,V) \<and> \<tau> \<in> V \<and> (snd(x) \<tturnstile> \<phi> ([fst(x),\<tau>]@nenv)))
+    \<longleftrightarrow> M, [\<alpha>, x, m, P, leq, \<one>] @ nenv \<Turnstile> body_ground_repl_fm(\<phi>)"
+proof -
+  {
+    fix \<tau> V t p
+    assume "\<tau> \<in> M" "V \<in> M" "x = \<langle>t, p\<rangle>" "t \<in> M" "p \<in> M"
+    with assms
+    have "\<tau> \<in> V \<and> (M, [p,P,leq,\<one>,t,\<tau>] @ nenv \<Turnstile> forces(\<phi>)) \<longleftrightarrow>
+      \<tau> \<in> V \<and> (M, [V,\<tau>,\<alpha>,\<langle>t, p\<rangle>,m,P, leq, \<one>] @ nenv \<Turnstile> rename_split_fm(\<phi>))"
+      using sats_forces_iff_sats_rename_split_fm[of \<alpha> m p t \<tau>, where nenv=nenv and \<phi>=\<phi>]
+      by auto
+  }
+  note eq = this
+  show ?thesis
+    unfolding body_ground_repl_fm_def
+    apply (insert assms)
+    apply (rule iff_sats | simp add:nonempty[simplified])+
+    using eq
+    by (auto del: iffI)
+qed
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+context G_generic1
+begin
+
+lemma Replace_sats_in_MG:
+  assumes
+    "c\<in>M[G]" "env \<in> list(M[G])"
+    "\<phi> \<in> formula" "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env)"
+    "univalent(##M[G], c, \<lambda>x v. (M[G] , [x,v]@env \<Turnstile> \<phi>) )"
+    and
+    ground_replacement:
+    "\<And>nenv. ground_replacement_assm(M,[P,leq,\<one>] @ nenv, \<phi>)"
+  shows
+    "{v. x\<in>c, v\<in>M[G] \<and> (M[G] , [x,v]@env \<Turnstile> \<phi>)} \<in> M[G]"
+proof -
+  let ?R = "\<lambda> x v . v\<in>M[G] \<and> (M[G] , [x,v]@env \<Turnstile> \<phi>)"
+  from \<open>c\<in>M[G]\<close>
+  obtain \<pi>' where "val(P,G, \<pi>') = c" "\<pi>' \<in> M"
+    using GenExt_def by auto
+  then
+  have "domain(\<pi>')\<times>P\<in>M" (is "?\<pi>\<in>M")
+    using cartprod_closed P_in_M domain_closed by simp
+  from \<open>val(P,G, \<pi>') = c\<close>
+  have "c \<subseteq> val(P,G,?\<pi>)"
+    using def_val[of G ?\<pi>] one_in_P one_in_G[OF generic] elem_of_val
+      domain_of_prod[OF one_in_P, of "domain(\<pi>')"] by force
+  from \<open>env \<in> _\<close>
+  obtain nenv where "nenv\<in>list(M)" "env = map(val(P,G),nenv)"
+    using map_val by auto
+  then
+  have "length(nenv) = length(env)" by simp
+  define f where "f(\<rho>p) \<equiv> \<mu> \<alpha>. \<alpha>\<in>M \<and> (\<exists>\<tau>\<in>M. \<tau> \<in> Vset(\<alpha>) \<and>
+        (snd(\<rho>p) \<tturnstile> \<phi> ([fst(\<rho>p),\<tau>] @ nenv)))" (is "_ \<equiv> \<mu> \<alpha>. ?P(\<rho>p,\<alpha>)") for \<rho>p
+  have "f(\<rho>p) = (\<mu> \<alpha>. \<alpha>\<in>M \<and> (\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(##M,\<alpha>,V) \<and> \<tau>\<in>V \<and>
+        (snd(\<rho>p) \<tturnstile> \<phi> ([fst(\<rho>p),\<tau>] @ nenv))))" (is "_ = (\<mu> \<alpha>. \<alpha>\<in>M \<and> ?Q(\<rho>p,\<alpha>))") for \<rho>p
+    unfolding f_def using Vset_abs Vset_closed Ord_Least_cong[of "?P(\<rho>p)" "\<lambda> \<alpha>. \<alpha>\<in>M \<and> ?Q(\<rho>p,\<alpha>)"]
+    by (simp, simp del:setclass_iff)
+  moreover
+  have "f(\<rho>p) \<in> M" for \<rho>p
+    unfolding f_def using Least_closed'[of "?P(\<rho>p)"] by simp
+  ultimately
+  have 1:"least(##M,\<lambda>\<alpha>. ?Q(\<rho>p,\<alpha>),f(\<rho>p))" for \<rho>p
+    using least_abs'[of "\<lambda>\<alpha>. \<alpha>\<in>M \<and> ?Q(\<rho>p,\<alpha>)" "f(\<rho>p)"] least_conj
+    by (simp flip: setclass_iff)
+  have "Ord(f(\<rho>p))" for \<rho>p unfolding f_def by simp
+  define QQ where "QQ\<equiv>?Q"
+  from 1
+  have "least(##M,\<lambda>\<alpha>. QQ(\<rho>p,\<alpha>),f(\<rho>p))" for \<rho>p
+    unfolding QQ_def .
+  from \<open>arity(\<phi>) \<le> _\<close> \<open>length(nenv) = _\<close>
+  have "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(nenv)"
+    by simp
+  moreover
+  note assms \<open>nenv\<in>list(M)\<close> \<open>?\<pi>\<in>M\<close>
+  moreover
+  have "\<rho>p\<in>?\<pi> \<Longrightarrow> \<exists>t p. \<rho>p=\<langle>t,p\<rangle>" for \<rho>p
+    by auto
+  ultimately
+  have body:"(M , [\<alpha>,\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> body_ground_repl_fm(\<phi>)) \<longleftrightarrow> ?Q(\<rho>p,\<alpha>)"
+    if "\<rho>p\<in>?\<pi>" "\<rho>p\<in>M" "m\<in>M" "\<alpha>\<in>M" for \<alpha> \<rho>p m
+    using that P_in_M leq_in_M one_in_M sats_body_ground_repl_fm[of \<rho>p \<alpha> m nenv \<phi>] by simp
+  {
+    fix \<rho>p m
+    assume asm: "\<rho>p\<in>M" "\<rho>p\<in>?\<pi>" "m\<in>M"
+    note inM = this P_in_M leq_in_M one_in_M \<open>nenv\<in>list(M)\<close>
+    with body
+    have body':"\<And>\<alpha>. \<alpha> \<in> M \<Longrightarrow> (\<exists>\<tau>\<in>M. \<exists>V\<in>M. is_Vset(\<lambda>a. (##M)(a), \<alpha>, V) \<and> \<tau> \<in> V \<and>
+          (snd(\<rho>p) \<tturnstile> \<phi> ([fst(\<rho>p),\<tau>] @ nenv))) \<longleftrightarrow>
+          M, Cons(\<alpha>, [\<rho>p, m, P, leq, \<one>] @ nenv) \<Turnstile> body_ground_repl_fm(\<phi>)" by simp
+    from inM
+    have "(M , [\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(##M, QQ(\<rho>p), m)"
+      using sats_least_fm[OF body', of 1] unfolding QQ_def ground_repl_fm_def
+      by (simp, simp flip: setclass_iff)
+  }
+  then
+  have "(M, [\<rho>p,m,P,leq,\<one>] @ nenv \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(##M, QQ(\<rho>p), m)"
+    if "\<rho>p\<in>M" "\<rho>p\<in>?\<pi>" "m\<in>M" for \<rho>p m using that by simp
+  then
+  have "univalent(##M, ?\<pi>, \<lambda>\<rho>p m. M , [\<rho>p,m] @ ([P,leq,\<one>] @ nenv) \<Turnstile> ground_repl_fm(\<phi>))"
+    unfolding univalent_def by (auto intro:unique_least)
+  moreover from \<open>length(_) = _\<close> \<open>env \<in> _\<close>
+  have "length([P,leq,\<one>] @ nenv) = 3 +\<^sub>\<omega> length(env)" by simp
+  moreover from \<open>arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(nenv)\<close>
+    \<open>length(_) = length(_)\<close>[symmetric] \<open>nenv\<in>_\<close> \<open>\<phi>\<in>_\<close>
+  have "arity(ground_repl_fm(\<phi>)) \<le> 5 +\<^sub>\<omega> length(env)"
+    using arity_ground_repl_fm[of \<phi>] le_trans Un_le by auto
+  moreover from \<open>\<phi>\<in>formula\<close>
+  have "ground_repl_fm(\<phi>)\<in>formula" by simp
+  moreover
+  note inM = P_in_M leq_in_M one_in_M \<open>nenv\<in>list(M)\<close> \<open>?\<pi>\<in>M\<close>
+  moreover
+  note \<open>length(nenv) = length(env)\<close>
+  ultimately
+  obtain Y where "Y\<in>M"
+    "\<forall>m\<in>M. m \<in> Y \<longleftrightarrow> (\<exists>\<rho>p\<in>M. \<rho>p \<in> ?\<pi> \<and> (M, [\<rho>p,m] @ ([P,leq,\<one>] @ nenv) \<Turnstile> ground_repl_fm(\<phi>)))"
+    using ground_replacement[of nenv]
+    unfolding strong_replacement_def ground_replacement_assm_def replacement_assm_def by auto
+  with \<open>least(_,QQ(_),f(_))\<close> \<open>f(_) \<in> M\<close> \<open>?\<pi>\<in>M\<close>
+    \<open>_ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> (M,_ \<Turnstile> ground_repl_fm(\<phi>)) \<longleftrightarrow> least(_,_,_)\<close>
+  have "f(\<rho>p)\<in>Y" if "\<rho>p\<in>?\<pi>" for \<rho>p
+    using that transitivity[OF _ \<open>?\<pi>\<in>M\<close>]
+    by (clarsimp, rule_tac x="\<langle>x,y\<rangle>" in bexI, auto)
+  moreover
+  have "{y\<in>Y. Ord(y)} \<in> M"
+    using \<open>Y\<in>M\<close> separation_ax sats_ordinal_fm trans_M
+      separation_cong[of "##M" "\<lambda>y. sats(M,ordinal_fm(0),[y])" "Ord"]
+      separation_closed by (simp add:arity)
+  then
+  have "\<Union> {y\<in>Y. Ord(y)} \<in> M" (is "?sup \<in> M")
+    using Union_closed by simp
+  then
+  have "{x\<in>Vset(?sup). x \<in> M} \<in> M"
+    using Vset_closed by simp
+  moreover
+  have "{\<one>} \<in> M"
+    using one_in_M singleton_closed by simp
+  ultimately
+  have "{x\<in>Vset(?sup). x \<in> M} \<times> {\<one>} \<in> M" (is "?big_name \<in> M")
+    using cartprod_closed by simp
+  then
+  have "val(P,G,?big_name) \<in> M[G]"
+    by (blast intro:GenExtI)
+  {
+    fix v x
+    assume "x\<in>c"
+    moreover
+    note \<open>val(P,G,\<pi>')=c\<close> \<open>\<pi>'\<in>M\<close>
+    moreover
+    from calculation
+    obtain \<rho> p where "\<langle>\<rho>,p\<rangle>\<in>\<pi>'"  "val(P,G,\<rho>) = x" "p\<in>G" "\<rho>\<in>M"
+      using elem_of_val_pair'[of \<pi>' x G] by blast
+    moreover
+    assume "v\<in>M[G]"
+    then
+    obtain \<sigma> where "val(P,G,\<sigma>) = v" "\<sigma>\<in>M"
+      using GenExtD by auto
+    moreover
+    assume "sats(M[G], \<phi>, [x,v] @ env)"
+    moreover
+    note \<open>\<phi>\<in>_\<close> \<open>nenv\<in>_\<close> \<open>env = _\<close> \<open>arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(env)\<close>
+    ultimately
+    obtain q where "q\<in>G" "q \<tturnstile> \<phi> ([\<rho>,\<sigma>]@nenv)"
+      using truth_lemma[OF \<open>\<phi>\<in>_\<close> generic, symmetric, of "[\<rho>,\<sigma>] @ nenv"]
+      by auto
+    with \<open>\<langle>\<rho>,p\<rangle>\<in>\<pi>'\<close> \<open>\<langle>\<rho>,q\<rangle>\<in>?\<pi> \<Longrightarrow> f(\<langle>\<rho>,q\<rangle>)\<in>Y\<close>
+    have "f(\<langle>\<rho>,q\<rangle>)\<in>Y"
+      using generic unfolding M_generic_def filter_def by blast
+    let ?\<alpha>="succ(rank(\<sigma>))"
+    note \<open>\<sigma>\<in>M\<close>
+    moreover from this
+    have "?\<alpha> \<in> M"
+      using rank_closed cons_closed by (simp flip: setclass_iff)
+    moreover
+    have "\<sigma> \<in> Vset(?\<alpha>)"
+      using Vset_Ord_rank_iff by auto
+    moreover
+    note \<open>q \<tturnstile> \<phi> ([\<rho>,\<sigma>] @ nenv)\<close>
+    ultimately
+    have "?P(\<langle>\<rho>,q\<rangle>,?\<alpha>)" by (auto simp del: Vset_rank_iff)
+    moreover
+    have "(\<mu> \<alpha>. ?P(\<langle>\<rho>,q\<rangle>,\<alpha>)) = f(\<langle>\<rho>,q\<rangle>)"
+      unfolding f_def by simp
+    ultimately
+    obtain \<tau> where "\<tau>\<in>M" "\<tau> \<in> Vset(f(\<langle>\<rho>,q\<rangle>))" "q \<tturnstile> \<phi> ([\<rho>,\<tau>] @ nenv)"
+      using LeastI[of "\<lambda> \<alpha>. ?P(\<langle>\<rho>,q\<rangle>,\<alpha>)" ?\<alpha>] by auto
+    with \<open>q\<in>G\<close> \<open>\<rho>\<in>M\<close> \<open>nenv\<in>_\<close> \<open>arity(\<phi>)\<le> 2 +\<^sub>\<omega> length(nenv)\<close>
+    have "M[G], map(val(P,G),[\<rho>,\<tau>] @ nenv) \<Turnstile> \<phi>"
+      using truth_lemma[OF \<open>\<phi>\<in>_\<close> generic, of "[\<rho>,\<tau>] @ nenv"] by auto
+    moreover from \<open>x\<in>c\<close> \<open>c\<in>M[G]\<close>
+    have "x\<in>M[G]" using transitivity_MG by simp
+    moreover
+    note \<open>M[G],[x,v] @ env\<Turnstile> \<phi>\<close> \<open>env = map(val(P,G),nenv)\<close> \<open>\<tau>\<in>M\<close> \<open>val(P,G,\<rho>)=x\<close>
+      \<open>univalent(##M[G],_,_)\<close> \<open>x\<in>c\<close> \<open>v\<in>M[G]\<close>
+    ultimately
+    have "v=val(P,G,\<tau>)"
+      using GenExtI[of \<tau> G] unfolding univalent_def by (auto)
+    from \<open>\<tau> \<in> Vset(f(\<langle>\<rho>,q\<rangle>))\<close> \<open>Ord(f(_))\<close>  \<open>f(\<langle>\<rho>,q\<rangle>)\<in>Y\<close>
+    have "\<tau> \<in> Vset(?sup)"
+      using Vset_Ord_rank_iff lt_Union_iff[of _ "rank(\<tau>)"] by auto
+    with \<open>\<tau>\<in>M\<close>
+    have "val(P,G,\<tau>) \<in> val(P,G,?big_name)"
+      using domain_of_prod[of \<one> "{\<one>}" "{x\<in>Vset(?sup). x \<in> M}" ] def_val[of G ?big_name]
+        one_in_G[OF generic] one_in_P  by (auto simp del: Vset_rank_iff)
+    with \<open>v=val(P,G,\<tau>)\<close>
+    have "v \<in> val(P,G,{x\<in>Vset(?sup). x \<in> M} \<times> {\<one>})"
+      by simp
+  }
+  then
+  have "{v. x\<in>c, ?R(x,v)} \<subseteq> val(P,G,?big_name)" (is "?repl\<subseteq>?big")
+    by blast
+  with \<open>?big_name\<in>M\<close>
+  have "?repl = {v\<in>?big. \<exists>x\<in>c. sats(M[G], \<phi>, [x,v] @ env )}" (is "_ = ?rhs")
+  proof(intro equalityI subsetI)
+    fix v
+    assume "v\<in>?repl"
+    with \<open>?repl\<subseteq>?big\<close>
+    obtain x where "x\<in>c" "M[G], [x, v] @ env \<Turnstile> \<phi>" "v\<in>?big"
+      using subsetD by auto
+    with \<open>univalent(##M[G],_,_)\<close> \<open>c\<in>M[G]\<close>
+    show "v \<in> ?rhs"
+      unfolding univalent_def
+      using transitivity_MG ReplaceI[of "\<lambda> x v. \<exists>x\<in>c. M[G], [x, v] @ env \<Turnstile> \<phi>"] by blast
+  next
+    fix v
+    assume "v\<in>?rhs"
+    then
+    obtain x where
+      "v\<in>val(P,G, ?big_name)" "M[G], [x, v] @ env \<Turnstile> \<phi>" "x\<in>c"
+      by blast
+    moreover from this \<open>c\<in>M[G]\<close>
+    have "v\<in>M[G]" "x\<in>M[G]"
+      using transitivity_MG GenExtI[OF \<open>?big_name\<in>_\<close>,of G] by auto
+    moreover from calculation \<open>univalent(##M[G],_,_)\<close>
+    have "?R(x,y) \<Longrightarrow> y = v" for y
+      unfolding univalent_def by auto
+    ultimately
+    show "v\<in>?repl"
+      using ReplaceI[of ?R x v c]
+      by blast
+  qed
+  moreover
+  let ?\<psi> = "Exists(And(Member(0,2+\<^sub>\<omega>length(env)),\<phi>))"
+  have "v\<in>M[G] \<Longrightarrow> (\<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>) \<longleftrightarrow> M[G], [v] @ env @ [c] \<Turnstile> ?\<psi>"
+    "arity(?\<psi>) \<le> 2 +\<^sub>\<omega> length(env)" "?\<psi>\<in>formula"
+    for v
+  proof -
+    fix v
+    assume "v\<in>M[G]"
+    with \<open>c\<in>M[G]\<close>
+    have "nth(length(env)+\<^sub>\<omega>1,[v]@env@[c]) = c"
+      using  \<open>env\<in>_\<close>nth_concat[of v c "M[G]" env]
+      by auto
+    note inMG= \<open>nth(length(env)+\<^sub>\<omega>1,[v]@env@[c]) = c\<close> \<open>c\<in>M[G]\<close> \<open>v\<in>M[G]\<close> \<open>env\<in>_\<close>
+    show "(\<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>) \<longleftrightarrow> M[G], [v] @ env @ [c] \<Turnstile> ?\<psi>"
+    proof
+      assume "\<exists>x\<in>c. M[G], [x, v] @ env \<Turnstile> \<phi>"
+      then obtain x where
+        "x\<in>c" "M[G], [x, v] @ env \<Turnstile> \<phi>" "x\<in>M[G]"
+        using transitivity_MG[OF _ \<open>c\<in>M[G]\<close>]
+        by auto
+      with \<open>\<phi>\<in>_\<close> \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close> inMG
+      show "M[G], [v] @ env @ [c] \<Turnstile> Exists(And(Member(0, 2 +\<^sub>\<omega> length(env)), \<phi>))"
+        using arity_sats_iff[of \<phi> "[c]" _ "[x,v]@env"]
+        by auto
+    next
+      assume "M[G], [v] @ env @ [c] \<Turnstile> Exists(And(Member(0, 2 +\<^sub>\<omega> length(env)), \<phi>))"
+      with inMG
+      obtain x where
+        "x\<in>M[G]" "x\<in>c" "M[G], [x,v]@env@[c] \<Turnstile> \<phi>"
+        by auto
+      with \<open>\<phi>\<in>_\<close> \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close> inMG
+      show "\<exists>x\<in>c. M[G], [x, v] @ env\<Turnstile> \<phi>"
+        using arity_sats_iff[of \<phi> "[c]" _ "[x,v]@env"]
+        by auto
+    qed
+  next
+    from \<open>env\<in>_\<close> \<open>\<phi>\<in>_\<close>
+    show "arity(?\<psi>)\<le>2+\<^sub>\<omega>length(env)"
+      using pred_mono[OF _ \<open>arity(\<phi>)\<le>2+\<^sub>\<omega>length(env)\<close>] lt_trans[OF _ le_refl]
+      by (auto simp add:ord_simp_union arity)
+  next
+    from \<open>\<phi>\<in>_\<close>
+    show "?\<psi>\<in>formula" by simp
+  qed
+  moreover from this
+  have "{v\<in>?big. \<exists>x\<in>c. M[G], [x,v] @ env \<Turnstile> \<phi>} = {v\<in>?big. M[G], [v] @ env @ [c] \<Turnstile>  ?\<psi>}"
+    using transitivity_MG[OF _ GenExtI, OF _ \<open>?big_name\<in>M\<close>]
+    by simp
+  moreover from calculation and \<open>env\<in>_\<close> \<open>c\<in>_\<close> \<open>?big\<in>M[G]\<close>
+  have "{v\<in>?big. M[G] , [v] @ env @ [c] \<Turnstile> ?\<psi>} \<in> M[G]"
+    using Collect_sats_in_MG by auto
+  ultimately
+  show ?thesis by simp
+qed
+
+theorem strong_replacement_in_MG:
+  assumes
+    "\<phi>\<in>formula" and "arity(\<phi>) \<le> 2 +\<^sub>\<omega> length(env)" "env \<in> list(M[G])"
+    and
+    ground_replacement:
+    "\<And>nenv. ground_replacement_assm(M,[P,leq,\<one>] @ nenv, \<phi>)"
+  shows
+    "strong_replacement(##M[G],\<lambda>x v. sats(M[G],\<phi>,[x,v] @ env))"
+proof -
+  let ?R="\<lambda>x y . M[G], [x, y] @ env \<Turnstile> \<phi>"
+  {
+    fix A
+    let ?Y="{v . x \<in> A, v\<in>M[G] \<and> ?R(x,v)}"
+    assume 1: "(##M[G])(A)"
+      "\<forall>x[##M[G]]. x \<in> A \<longrightarrow> (\<forall>y[##M[G]]. \<forall>z[##M[G]]. ?R(x,y) \<and> ?R(x,z) \<longrightarrow> y = z)"
+    then
+    have "univalent(##M[G], A, ?R)" "A\<in>M[G]"
+      unfolding univalent_def by simp_all
+    with assms \<open>A\<in>_\<close>
+    have "(##M[G])(?Y)"
+      using Replace_sats_in_MG ground_replacement
+      unfolding ground_replacement_assm_def by (auto)
+    have "b \<in> ?Y \<longleftrightarrow> (\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b))" if "(##M[G])(b)" for b
+    proof(rule)
+      from \<open>A\<in>_\<close>
+      show "\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b)" if "b \<in> ?Y"
+        using that transitivity_MG by auto
+    next
+      show "b \<in> ?Y" if "\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b)"
+      proof -
+        from \<open>(##M[G])(b)\<close>
+        have "b\<in>M[G]" by simp
+        with that
+        obtain x where "(##M[G])(x)" "x\<in>A" "b\<in>M[G] \<and> ?R(x,b)"
+          by blast
+        moreover from this 1 \<open>(##M[G])(b)\<close>
+        have "x\<in>M[G]" "z\<in>M[G] \<and> ?R(x,z) \<Longrightarrow> b = z" for z
+          by auto
+        ultimately
+        show ?thesis
+          using ReplaceI[of "\<lambda> x y. y\<in>M[G] \<and> ?R(x,y)"] by blast
+      qed
+    qed
+    then
+    have "\<forall>b[##M[G]]. b \<in> ?Y \<longleftrightarrow> (\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b))"
+      by simp
+    with \<open>(##M[G])(?Y)\<close>
+    have " (\<exists>Y[##M[G]]. \<forall>b[##M[G]]. b \<in> Y \<longleftrightarrow> (\<exists>x[##M[G]]. x \<in> A \<and> ?R(x,b)))"
+      by auto
+  }
+  then show ?thesis unfolding strong_replacement_def univalent_def
+    by auto
+qed
+
+lemma replacement_assm_MG:
+  assumes
+    ground_replacement:
+    "\<And>nenv. ground_replacement_assm(M,[P,leq,\<one>] @ nenv, \<phi>)"
+  shows
+    "replacement_assm(M[G],env,\<phi>)"
+  using assms strong_replacement_in_MG
+  unfolding replacement_assm_def by simp
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Replacement_Instances.thy b/thys/Independence_CH/Replacement_Instances.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Replacement_Instances.thy
@@ -0,0 +1,1432 @@
+section\<open>More Instances of Replacement\<close>
+
+theory Replacement_Instances
+  imports
+    Separation_Instances
+    Transitive_Models.Pointed_DC_Relative
+begin
+
+synthesize "setdiff" from_definition "setdiff" assuming "nonempty"
+arity_theorem for "setdiff_fm"
+
+relationalize  "first_rel" "is_first" external
+synthesize "first_fm" from_definition "is_first" assuming "nonempty"
+
+relationalize  "minimum_rel" "is_minimum" external
+definition is_minimum' where
+  "is_minimum'(M,R,X,u) \<equiv> (M(u) \<and> u \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> u \<longrightarrow> a \<in> R) \<and> pair(M, u, v, a))) \<and>
+    (\<exists>x[M].
+        (M(x) \<and> x \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> x \<longrightarrow> a \<in> R) \<and> pair(M, x, v, a))) \<and>
+        (\<forall>y[M]. M(y) \<and> y \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> y \<longrightarrow> a \<in> R) \<and> pair(M, y, v, a)) \<longrightarrow> y = x)) \<or>
+    \<not> (\<exists>x[M]. (M(x) \<and> x \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> x \<longrightarrow> a \<in> R) \<and> pair(M, x, v, a))) \<and>
+               (\<forall>y[M]. M(y) \<and> y \<in> X \<and> (\<forall>v[M]. \<exists>a[M]. (v \<in> X \<longrightarrow> v \<noteq> y \<longrightarrow> a \<in> R) \<and> pair(M, y, v, a)) \<longrightarrow> y = x)) \<and>
+    empty(M, u)"
+
+synthesize "minimum" from_definition "is_minimum'" assuming "nonempty"
+arity_theorem for "minimum_fm"
+
+lemma composition_fm_type[TC]: "a0 \<in> \<omega> \<Longrightarrow> a1 \<in> \<omega> \<Longrightarrow> a2 \<in> \<omega> \<Longrightarrow>
+   composition_fm(a0,a1,a2) \<in> formula"
+  unfolding composition_fm_def by simp
+
+arity_theorem for "composition_fm"
+
+definition is_omega_funspace :: "[i\<Rightarrow>o,i,i,i]\<Rightarrow>o" where
+  "is_omega_funspace(N,B,n,z) \<equiv>  \<exists>o[N]. omega(N,o) \<and> n\<in>o \<and> is_funspace(N, n, B, z)"
+
+synthesize "omega_funspace" from_definition "is_omega_funspace" assuming "nonempty"
+arity_theorem for "omega_funspace_fm"
+
+definition HAleph_wfrec_repl_body where
+  "HAleph_wfrec_repl_body(N,mesa,x,z) \<equiv> \<exists>y[N].
+                   pair(N, x, y, z) \<and>
+                   (\<exists>f[N].
+                       (\<forall>z[N].
+                           z \<in> f \<longleftrightarrow>
+                           (\<exists>xa[N].
+                               \<exists>y[N].
+                                  \<exists>xaa[N].
+                                     \<exists>sx[N].
+                                        \<exists>r_sx[N].
+                                           \<exists>f_r_sx[N].
+                                              pair(N, xa, y, z) \<and>
+                                              pair(N, xa, x, xaa) \<and>
+                                              upair(N, xa, xa, sx) \<and>
+                                              pre_image(N, mesa, sx, r_sx) \<and> restriction(N, f, r_sx, f_r_sx) \<and> xaa \<in> mesa \<and> is_HAleph(N, xa, f_r_sx, y))) \<and>
+                       is_HAleph(N, x, f, y))"
+
+(* MOVE THIS to an appropriate place *)
+arity_theorem for "ordinal_fm"
+arity_theorem for "is_Limit_fm"
+arity_theorem for "empty_fm"
+arity_theorem for "fun_apply_fm"
+
+synthesize "HAleph_wfrec_repl_body" from_definition assuming "nonempty"
+arity_theorem for "HAleph_wfrec_repl_body_fm"
+
+definition dcwit_repl_body where
+  "dcwit_repl_body(N,mesa,A,a,s,R) \<equiv> \<lambda>x z. \<exists>y[N]. pair(N, x, y, z) \<and>
+                                is_wfrec
+                                 (N, \<lambda>n f. is_nat_case
+                                             (N, a,
+                                              \<lambda>m bmfm.
+                                                 \<exists>fm[N].
+                                                    \<exists>cp[N].
+                                                       is_apply(N, f, m, fm) \<and>
+                                                       is_Collect(N, A, \<lambda>x. \<exists>fmx[N]. (N(x) \<and> fmx \<in> R) \<and> pair(N, fm, x, fmx), cp) \<and>
+                                                       is_apply(N, s, cp, bmfm),
+                                              n),
+                                  mesa, x, y)"
+
+manual_schematic for "dcwit_repl_body" assuming "nonempty"
+  unfolding dcwit_repl_body_def
+  by (rule iff_sats is_nat_case_iff_sats is_eclose_iff_sats sep_rules | simp)+
+
+synthesize "dcwit_repl_body" from_schematic
+
+definition dcwit_aux_fm where
+  "dcwit_aux_fm(A,s,R) \<equiv> (\<cdot>\<exists>\<cdot>\<cdot>4`2 is 0\<cdot> \<and>
+               (\<cdot>\<exists>\<cdot>Collect_fm
+                   (succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(A)))))))))),
+                    (\<cdot>\<exists>\<cdot>\<cdot>0 \<in>
+                       succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(R)))))))))))) \<cdot> \<and>
+                       pair_fm(3, 1, 0) \<cdot>\<cdot>),
+                    0) \<and>
+                  \<cdot> succ(succ(succ(succ(succ(succ(succ(succ(succ(succ(s))))))))))`0 is 2\<cdot>\<cdot>\<cdot>)\<cdot>\<cdot>)"
+
+arity_theorem for "dcwit_aux_fm"
+
+lemma dcwit_aux_fm_type[TC]: "A \<in> \<omega> \<Longrightarrow> s \<in> \<omega> \<Longrightarrow> R \<in> \<omega> \<Longrightarrow> dcwit_aux_fm(A,s,R) \<in> formula"
+  by (simp_all add: dcwit_aux_fm_def)
+
+definition is_nat_case_dcwit_aux_fm where
+  "is_nat_case_dcwit_aux_fm(A,a,s,R) \<equiv> is_nat_case_fm
+           (succ(succ(succ(succ(succ(succ(a)))))),dcwit_aux_fm(A,s,R),
+            2, 0)"
+
+lemma is_nat_case_dcwit_aux_fm_type[TC]: "A \<in> \<omega> \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> s \<in> \<omega> \<Longrightarrow> R \<in> \<omega> \<Longrightarrow> is_nat_case_dcwit_aux_fm(A,a,s,R) \<in> formula"
+  by (simp_all add: is_nat_case_dcwit_aux_fm_def)
+
+manual_arity for "is_nat_case_dcwit_aux_fm"
+  unfolding is_nat_case_dcwit_aux_fm_def
+  by (rule arity_dcwit_aux_fm[THEN [6] arity_is_nat_case_fm]) simp_all
+
+manual_arity for "dcwit_repl_body_fm"
+  using arity_is_nat_case_dcwit_aux_fm[THEN [6] arity_is_wfrec_fm]
+  unfolding dcwit_repl_body_fm_def  is_nat_case_dcwit_aux_fm_def dcwit_aux_fm_def
+  by (auto simp add: arity(1-33))
+
+lemma arity_dcwit_repl_body: "arity(dcwit_repl_body_fm(6,5,4,3,2,0,1)) = 7"
+  by (simp_all add: FOL_arities arity_dcwit_repl_body_fm ord_simp_union)
+
+definition fst2_snd2
+  where "fst2_snd2(x) \<equiv> \<langle>fst(fst(x)), snd(snd(x))\<rangle>"
+
+relativize functional "fst2_snd2" "fst2_snd2_rel"
+relationalize "fst2_snd2_rel" "is_fst2_snd2"
+
+lemma (in M_trivial) fst2_snd2_abs:
+  assumes "M(x)" "M(res)"
+  shows "is_fst2_snd2(M, x, res) \<longleftrightarrow> res = fst2_snd2(x)"
+  unfolding is_fst2_snd2_def fst2_snd2_def
+  using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
+  by simp
+
+synthesize "is_fst2_snd2" from_definition assuming "nonempty"
+arity_theorem for "is_fst2_snd2_fm"
+
+definition sndfst_fst2_snd2
+  where "sndfst_fst2_snd2(x) \<equiv> \<langle>snd(fst(x)), fst(fst(x)), snd(snd(x))\<rangle>"
+
+relativize functional "sndfst_fst2_snd2" "sndfst_fst2_snd2_rel"
+relationalize "sndfst_fst2_snd2_rel" "is_sndfst_fst2_snd2"
+synthesize "is_sndfst_fst2_snd2" from_definition assuming "nonempty"
+arity_theorem for "is_sndfst_fst2_snd2_fm"
+
+definition RepFun_body :: "i \<Rightarrow> i \<Rightarrow> i"where
+  "RepFun_body(u,v) \<equiv> {{\<langle>v, x\<rangle>} . x \<in> u}"
+
+relativize functional "RepFun_body" "RepFun_body_rel"
+relationalize "RepFun_body_rel" "is_RepFun_body"
+synthesize "is_RepFun_body" from_definition assuming "nonempty"
+arity_theorem for "is_RepFun_body_fm"
+
+lemma arity_body_repfun:
+  "arity((\<cdot>\<exists>\<cdot>cons_fm(0, 3, 2) \<and> pair_fm(5, 1, 0) \<cdot>\<cdot>)) = 5"
+  using arity_cons_fm arity_pair_fm pred_Un_distrib union_abs1 FOL_arities
+  by auto
+
+lemma arity_RepFun: "arity(is_RepFun_body_fm(0, 1, 2)) = 3"
+  unfolding is_RepFun_body_fm_def
+  using arity_Replace_fm[OF _ _ _ _ arity_body_repfun] arity_fst_fm arity_snd_fm arity_empty_fm
+    pred_Un_distrib union_abs2 union_abs1 FOL_arities
+  by simp
+
+definition order_eq_map where
+  "order_eq_map(M,A,r,a,z) \<equiv> \<exists>x[M]. \<exists>g[M]. \<exists>mx[M]. \<exists>par[M].
+             ordinal(M,x) & pair(M,a,x,z) & membership(M,x,mx) &
+             pred_set(M,A,a,r,par) & order_isomorphism(M,par,r,x,mx,g)"
+
+synthesize "order_eq_map" from_definition assuming "nonempty"
+arity_theorem for "is_ord_iso_fm"
+arity_theorem for "order_eq_map_fm"
+
+(* Banach *)
+synthesize "is_banach_functor" from_definition assuming "nonempty"
+arity_theorem for "is_banach_functor_fm"
+
+definition banach_body_iterates where
+  "banach_body_iterates(M,X,Y,f,g,W,n,x,z) \<equiv>
+\<exists>y[M].
+                   pair(M, x, y, z) \<and>
+                   (\<exists>fa[M].
+                       (\<forall>z[M].
+                           z \<in> fa \<longleftrightarrow>
+                           (\<exists>xa[M].
+                               \<exists>y[M].
+                                  \<exists>xaa[M].
+                                     \<exists>sx[M].
+                                        \<exists>r_sx[M].
+                                           \<exists>f_r_sx[M]. \<exists>sn[M]. \<exists>msn[M]. successor(M,n,sn) \<and>
+                                              membership(M,sn,msn) \<and>
+                                              pair(M, xa, y, z) \<and>
+                                              pair(M, xa, x, xaa) \<and>
+                                              upair(M, xa, xa, sx) \<and>
+                                              pre_image(M, msn, sx, r_sx) \<and>
+                                              restriction(M, fa, r_sx, f_r_sx) \<and>
+                                              xaa \<in> msn \<and>
+                                              (empty(M, xa) \<longrightarrow> y = W) \<and>
+                                              (\<forall>m[M].
+                                                  successor(M, m, xa) \<longrightarrow>
+                                                  (\<exists>gm[M].
+                                                      is_apply(M, f_r_sx, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
+                                              (is_quasinat(M, xa) \<or> empty(M, y)))) \<and>
+                       (empty(M, x) \<longrightarrow> y = W) \<and>
+                       (\<forall>m[M].
+                           successor(M, m, x) \<longrightarrow>
+                           (\<exists>gm[M]. is_apply(M, fa, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
+                       (is_quasinat(M, x) \<or> empty(M, y)))"
+
+synthesize "is_quasinat" from_definition assuming "nonempty"
+arity_theorem for "is_quasinat_fm"
+
+synthesize "banach_body_iterates" from_definition assuming "nonempty"
+arity_theorem for "banach_body_iterates_fm"
+
+definition banach_is_iterates_body where
+  "banach_is_iterates_body(M,X,Y,f,g,W,n,y) \<equiv> \<exists>om[M]. omega(M,om) \<and> n \<in> om \<and>
+             (\<exists>sn[M].
+                 \<exists>msn[M].
+                    successor(M, n, sn) \<and>
+                    membership(M, sn, msn) \<and>
+                    (\<exists>fa[M].
+                        (\<forall>z[M].
+                            z \<in> fa \<longleftrightarrow>
+                            (\<exists>x[M].
+                                \<exists>y[M].
+                                   \<exists>xa[M].
+                                      \<exists>sx[M].
+                                         \<exists>r_sx[M].
+                                            \<exists>f_r_sx[M].
+                                               pair(M, x, y, z) \<and>
+                                               pair(M, x, n, xa) \<and>
+                                               upair(M, x, x, sx) \<and>
+                                               pre_image(M, msn, sx, r_sx) \<and>
+                                               restriction(M, fa, r_sx, f_r_sx) \<and>
+                                               xa \<in> msn \<and>
+                                               (empty(M, x) \<longrightarrow> y = W) \<and>
+                                               (\<forall>m[M].
+                                                   successor(M, m, x) \<longrightarrow>
+                                                   (\<exists>gm[M].
+                                                       fun_apply(M, f_r_sx, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
+                                               (is_quasinat(M, x) \<or> empty(M, y)))) \<and>
+                        (empty(M, n) \<longrightarrow> y = W) \<and>
+                        (\<forall>m[M].
+                            successor(M, m, n) \<longrightarrow>
+                            (\<exists>gm[M]. fun_apply(M, fa, m, gm) \<and> is_banach_functor(M, X, Y, f, g, gm, y))) \<and>
+                        (is_quasinat(M, n) \<or> empty(M, y))))"
+
+synthesize "banach_is_iterates_body" from_definition assuming "nonempty"
+arity_theorem for "banach_is_iterates_body_fm"
+
+(* (##M)(f) \<Longrightarrow> strong_replacement(##M, \<lambda>x y. y = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a))\<rangle>) *)
+
+definition trans_apply_image where
+  "trans_apply_image(f) \<equiv> \<lambda>a g. f ` (g `` a)"
+
+relativize functional "trans_apply_image" "trans_apply_image_rel"
+relationalize "trans_apply_image" "is_trans_apply_image"
+
+(* MOVE THIS to an appropriate place *)
+schematic_goal arity_is_recfun_fm[arity]:
+  "p \<in> formula \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> r \<in> \<omega> \<Longrightarrow> arity(is_recfun_fm(p, a, z ,r)) = ?ar"
+  unfolding is_recfun_fm_def
+  by (simp add:arity) (* clean simpset from arities, use correct attrib *)
+    (* Don't know why it doesn't use the theorem at \<^file>\<open>Arities\<close> *)
+schematic_goal arity_is_wfrec_fm[arity]:
+  "p \<in> formula \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> r \<in> \<omega> \<Longrightarrow> arity(is_wfrec_fm(p, a, z ,r)) = ?ar"
+  unfolding is_wfrec_fm_def
+  by (simp add:arity)
+schematic_goal arity_is_transrec_fm[arity]:
+  "p \<in> formula \<Longrightarrow> a \<in> \<omega> \<Longrightarrow> z \<in> \<omega> \<Longrightarrow> arity(is_transrec_fm(p, a, z)) = ?ar"
+  unfolding is_transrec_fm_def
+  by (simp add:arity)
+
+synthesize "is_trans_apply_image" from_definition assuming "nonempty"
+arity_theorem for "is_trans_apply_image_fm"
+
+
+definition transrec_apply_image_body where
+  "transrec_apply_image_body(M,f,mesa,x,z) \<equiv>  \<exists>y[M]. pair(M, x, y, z) \<and>
+                                (\<exists>fa[M].
+                                    (\<forall>z[M].
+                                        z \<in> fa \<longleftrightarrow>
+                                        (\<exists>xa[M].
+                                            \<exists>y[M].
+                                               \<exists>xaa[M].
+                                                  \<exists>sx[M].
+                                                     \<exists>r_sx[M].
+                                                        \<exists>f_r_sx[M].
+                                                           pair(M, xa, y, z) \<and>
+                                                           pair(M, xa, x, xaa) \<and>
+                                                           upair(M, xa, xa, sx) \<and>
+                                                           pre_image(M, mesa, sx, r_sx) \<and>
+                                                           restriction(M, fa, r_sx, f_r_sx) \<and>
+                                                           xaa \<in> mesa \<and> is_trans_apply_image(M, f, xa, f_r_sx, y))) \<and>
+                                    is_trans_apply_image(M, f, x, fa, y))"
+
+synthesize "transrec_apply_image_body" from_definition assuming "nonempty"
+arity_theorem for "transrec_apply_image_body_fm"
+
+definition is_trans_apply_image_body where
+  "is_trans_apply_image_body(M,f,\<beta>,a,w) \<equiv> \<exists>z[M]. pair(M,a,z,w) \<and> a\<in>\<beta> \<and> (\<exists>sa[M].
+                \<exists>esa[M].
+                   \<exists>mesa[M].
+                      upair(M, a, a, sa) \<and>
+                      is_eclose(M, sa, esa) \<and>
+                      membership(M, esa, mesa) \<and>
+                      (\<exists>fa[M].
+                          (\<forall>z[M].
+                              z \<in> fa \<longleftrightarrow>
+                              (\<exists>x[M].
+                                  \<exists>y[M].
+                                     \<exists>xa[M].
+                                        \<exists>sx[M].
+                                           \<exists>r_sx[M].
+                                              \<exists>f_r_sx[M].
+                                                 pair(M, x, y, z) \<and>
+                                                 pair(M, x, a, xa) \<and>
+                                                 upair(M, x, x, sx) \<and>
+                                                 pre_image(M, mesa, sx, r_sx) \<and>
+                                                 restriction(M, fa, r_sx, f_r_sx) \<and>
+                                                 xa \<in> mesa \<and> is_trans_apply_image(M, f, x, f_r_sx, y))) \<and>
+                          is_trans_apply_image(M, f, a, fa, z)))"
+
+manual_schematic "is_trans_apply_image_body_schematic" for "is_trans_apply_image_body"assuming "nonempty"
+  unfolding is_trans_apply_image_body_def
+  by (rule sep_rules is_eclose_iff_sats is_trans_apply_image_iff_sats | simp)+
+
+synthesize "is_trans_apply_image_body" from_schematic "is_trans_apply_image_body_schematic"
+arity_theorem for "is_trans_apply_image_body_fm"
+
+synthesize "is_converse" from_definition assuming "nonempty"
+arity_theorem for "is_converse_fm"
+
+definition replacement_is_omega_funspace_fm where "replacement_is_omega_funspace_fm \<equiv>  omega_funspace_fm(2,0,1)"
+definition replacement_HAleph_wfrec_repl_body_fm where "replacement_HAleph_wfrec_repl_body_fm \<equiv>  HAleph_wfrec_repl_body_fm(2,0,1)"
+definition replacement_is_fst2_snd2_fm where "replacement_is_fst2_snd2_fm \<equiv>  is_fst2_snd2_fm(0,1)"
+definition replacement_is_sndfst_fst2_snd2_fm where "replacement_is_sndfst_fst2_snd2_fm \<equiv>  is_sndfst_fst2_snd2_fm(0,1)"
+definition replacement_is_order_eq_map_fm where "replacement_is_order_eq_map_fm \<equiv>  order_eq_map_fm(2,3,0,1)"
+definition replacement_transrec_apply_image_body_fm where "replacement_transrec_apply_image_body_fm \<equiv>  transrec_apply_image_body_fm(3,2,0,1)"
+definition banach_replacement_iterates_fm where "banach_replacement_iterates_fm \<equiv> banach_is_iterates_body_fm(6,5,4,3,2,0,1)"
+definition replacement_is_trans_apply_image_fm where "replacement_is_trans_apply_image_fm \<equiv> is_trans_apply_image_body_fm(3,2,0,1)"
+definition banach_iterates_fm where "banach_iterates_fm \<equiv> banach_body_iterates_fm(7,6,5,4,3,2,0,1)"
+definition replacement_dcwit_repl_body_fm where "replacement_dcwit_repl_body_fm \<equiv> dcwit_repl_body_fm(6,5,4,3,2,0,1)"
+
+locale M_ZF2 = M_ZF1 +
+  assumes
+    replacement_ax2:
+    "replacement_assm(M,env,replacement_is_omega_funspace_fm)"
+    "replacement_assm(M,env,replacement_HAleph_wfrec_repl_body_fm)"
+    "replacement_assm(M,env,replacement_is_fst2_snd2_fm)"
+    "replacement_assm(M,env,replacement_is_sndfst_fst2_snd2_fm)"
+    "replacement_assm(M,env,replacement_is_order_eq_map_fm)"
+    "replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
+    "replacement_assm(M,env,banach_replacement_iterates_fm)"
+    "replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
+    "replacement_assm(M,env,banach_iterates_fm)"
+    "replacement_assm(M,env,replacement_dcwit_repl_body_fm)"
+    and
+    Lambda_in_M_replacement2:
+    "replacement_assm(M,env,Lambda_in_M_fm(fst_fm(0,1),0))"
+    "replacement_assm(M,env,Lambda_in_M_fm(domain_fm(0,1),0))"
+    "replacement_assm(M,env,Lambda_in_M_fm(snd_fm(0,1),0))"
+    "replacement_assm(M,env,Lambda_in_M_fm(big_union_fm(0,1),0))"
+    "replacement_assm(M,env,Lambda_in_M_fm(is_cardinal_fm(0,1),0))"
+    "replacement_assm(M,env,Lambda_in_M_fm(is_converse_fm(0,1),0))"
+    and
+    LambdaPair_in_M_replacement2:
+    "replacement_assm(M,env,LambdaPair_in_M_fm(image_fm(0,1,2),0))"
+    "replacement_assm(M,env,LambdaPair_in_M_fm(setdiff_fm(0,1,2),0))"
+    "replacement_assm(M,env,LambdaPair_in_M_fm(minimum_fm(0,1,2),0))"
+    "replacement_assm(M,env,LambdaPair_in_M_fm(upair_fm(0,1,2),0))"
+    "replacement_assm(M,env,LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0))"
+    "replacement_assm(M,env,LambdaPair_in_M_fm(composition_fm(0,1,2),0))"
+
+definition instances2_fms where "instances2_fms \<equiv>
+  { replacement_is_omega_funspace_fm,
+    replacement_HAleph_wfrec_repl_body_fm,
+    replacement_is_fst2_snd2_fm,
+    replacement_is_sndfst_fst2_snd2_fm,
+    replacement_is_order_eq_map_fm,
+    replacement_transrec_apply_image_body_fm,
+    banach_replacement_iterates_fm,
+    replacement_is_trans_apply_image_fm,
+    banach_iterates_fm,
+    replacement_dcwit_repl_body_fm,
+    Lambda_in_M_fm(fst_fm(0,1),0),
+    Lambda_in_M_fm(domain_fm(0,1),0),
+    Lambda_in_M_fm(snd_fm(0,1),0),
+    Lambda_in_M_fm(big_union_fm(0,1),0),
+    Lambda_in_M_fm(is_cardinal_fm(0,1),0),
+    Lambda_in_M_fm(is_converse_fm(0,1),0),
+    LambdaPair_in_M_fm(image_fm(0,1,2),0),
+    LambdaPair_in_M_fm(setdiff_fm(0,1,2),0),
+    LambdaPair_in_M_fm(minimum_fm(0,1,2),0),
+    LambdaPair_in_M_fm(upair_fm(0,1,2),0),
+    LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0),
+    LambdaPair_in_M_fm(composition_fm(0,1,2),0) }"
+
+txt\<open>This set has 22 internalized formulas.\<close>
+
+lemmas replacement_instances2_defs =
+  replacement_is_omega_funspace_fm_def
+  replacement_HAleph_wfrec_repl_body_fm_def
+  replacement_is_fst2_snd2_fm_def
+  replacement_is_sndfst_fst2_snd2_fm_def
+  replacement_is_order_eq_map_fm_def
+  replacement_transrec_apply_image_body_fm_def
+  banach_replacement_iterates_fm_def
+  replacement_is_trans_apply_image_fm_def
+  banach_iterates_fm_def
+  replacement_dcwit_repl_body_fm_def
+
+declare (in M_ZF2) replacement_instances2_defs [simp]
+
+lemma instances2_fms_type[TC]: "instances2_fms \<subseteq> formula"
+  unfolding replacement_instances2_defs instances2_fms_def
+  by (simp del:Lambda_in_M_fm_def)
+
+locale M_ZF2_trans = M_ZF1_trans + M_ZF2
+
+locale M_ZFC2 = M_ZFC1 + M_ZF2
+
+locale M_ZFC2_trans = M_ZFC1_trans + M_ZF2_trans + M_ZFC2
+
+lemma (in M_ZF2_trans) lam_replacement_domain : "lam_replacement(##M, domain)"
+  using lam_replacement_iff_lam_closed[THEN iffD2,of domain]
+    Lambda_in_M[where \<phi>="domain_fm(0,1)" and env="[]"] domain_type domain_abs
+    Lambda_in_M_replacement2(2)
+    arity_domain_fm[of 0 1] ord_simp_union transitivity domain_closed
+  by simp
+
+lemma (in M_ZF2_trans) lam_replacement_converse : "lam_replacement(##M, converse)"
+  using lam_replacement_iff_lam_closed[THEN iffD2,of converse] nonempty
+    Lambda_in_M[where \<phi>="is_converse_fm(0,1)" and env="[]"]
+    is_converse_fm_type converse_abs
+    arity_is_converse_fm[of 0 1] ord_simp_union transitivity converse_closed
+    Lambda_in_M_replacement2(6)
+  by simp
+
+lemma (in M_ZF2_trans) lam_replacement_fst : "lam_replacement(##M, fst)"
+  using lam_replacement_iff_lam_closed[THEN iffD2,of fst]
+    Lambda_in_M[where \<phi>="fst_fm(0,1)" and env="[]"]
+    fst_iff_sats[symmetric] fst_abs fst_type
+    arity_fst_fm[of 0 1] ord_simp_union transitivity fst_closed
+    Lambda_in_M_replacement2(1)
+  by simp
+
+lemma (in M_ZF2_trans) lam_replacement_snd : "lam_replacement(##M, snd)"
+  using lam_replacement_iff_lam_closed[THEN iffD2,of snd]
+    Lambda_in_M[where \<phi>="snd_fm(0,1)" and env="[]"]
+    snd_iff_sats[symmetric] snd_abs snd_type
+    arity_snd_fm[of 0 1] ord_simp_union transitivity snd_closed
+    Lambda_in_M_replacement2(3)
+  by simp
+
+lemma (in M_ZF2_trans) lam_replacement_Union : "lam_replacement(##M, Union)"
+  using lam_replacement_iff_lam_closed[THEN iffD2,of Union]
+    Lambda_in_M[where \<phi>="big_union_fm(0,1)" and env="[]"] Union_abs
+    union_fm_def big_union_iff_sats[symmetric]
+    arity_big_union_fm[of 0 1] ord_simp_union transitivity Union_closed
+    Lambda_in_M_replacement2(4)
+  by simp
+
+lemma (in M_ZF2_trans) lam_replacement_image:
+  "lam_replacement(##M, \<lambda>p. fst(p) `` snd(p))"
+  using lam_replacement2_in_ctm[where \<phi>="image_fm(0,1,2)" and env="[]"]
+    image_type image_iff_sats image_abs
+    arity_image_fm[of 0 1 2] ord_simp_union transitivity image_closed fst_snd_closed
+    LambdaPair_in_M_replacement2(1)
+  by simp
+
+lemma (in M_ZF2_trans) lam_replacement_Diff:
+  "lam_replacement(##M, \<lambda>p. fst(p) - snd(p))"
+  using lam_replacement2_in_ctm[where \<phi>="setdiff_fm(0,1,2)" and env="[]"]
+    setdiff_fm_type setdiff_iff_sats setdiff_abs
+    arity_setdiff_fm[of 0 1 2] ord_simp_union transitivity Diff_closed fst_snd_closed
+    nonempty LambdaPair_in_M_replacement2(2)
+  by simp
+
+lemma is_minimum_eq :
+  "M(R) \<Longrightarrow> M(X) \<Longrightarrow> M(u) \<Longrightarrow> is_minimum(M,R,X,u) \<longleftrightarrow> is_minimum'(M,R,X,u)"
+  unfolding is_minimum_def is_minimum'_def is_The_def is_first_def by simp
+
+context M_trivial
+begin
+
+lemma first_closed:
+  "M(B) \<Longrightarrow> M(r) \<Longrightarrow> first(u,r,B) \<Longrightarrow> M(u)"
+  using transM[OF first_is_elem] by simp
+
+is_iff_rel for "first"
+  unfolding is_first_def first_rel_def by auto
+
+is_iff_rel for "minimum"
+  unfolding is_minimum_def minimum_rel_def
+  using is_first_iff The_abs nonempty
+  by force
+
+end \<comment> \<open>\<^locale>\<open>M_trivial\<close>\<close>
+
+lemma (in M_ZF2_trans) lam_replacement_minimum:
+  "lam_replacement(##M, \<lambda>p. minimum(fst(p), snd(p)))"
+  using lam_replacement2_in_ctm[where \<phi>="minimum_fm(0,1,2)" and env="[]"]
+    minimum_iff_sats[symmetric] is_minimum_iff minimum_abs is_minimum_eq
+    arity_minimum_fm[of 0 1 2] ord_simp_union minimum_fm_type
+    minimum_closed zero_in_M LambdaPair_in_M_replacement2(3)
+  by simp
+
+lemma (in M_ZF2_trans) lam_replacement_Upair: "lam_replacement(##M, \<lambda>p. Upair(fst(p), snd(p)))"
+  using lam_replacement2_in_ctm[where \<phi>="upair_fm(0,1,2)" and env="[]" and f="Upair"]
+    Upair_closed upair_type upair_iff_sats Upair_eq_cons
+    arity_upair_fm[of 0 1 2,simplified] ord_simp_union LambdaPair_in_M_replacement2(4)
+  by simp
+
+lemma (in M_ZF2_trans) lam_replacement_comp:
+  "lam_replacement(##M, \<lambda>p. comp(fst(p), snd(p)))"
+  using lam_replacement2_in_ctm[where \<phi>="composition_fm(0,1,2)" and env="[]" and f="comp"]
+    comp_closed composition_fm_type composition_iff_sats
+    arity_composition_fm[of 0 1 2] ord_simp_union LambdaPair_in_M_replacement2(6)
+  by simp
+
+lemma (in M_ZF2_trans) omega_funspace_abs:
+  "B\<in>M \<Longrightarrow> n\<in>M \<Longrightarrow> z\<in>M \<Longrightarrow> is_omega_funspace(##M,B,n,z) \<longleftrightarrow> n\<in>\<omega> \<and> is_funspace(##M,n,B,z)"
+  unfolding is_omega_funspace_def using nat_in_M by simp
+
+lemma (in M_ZF2_trans) replacement_is_omega_funspace:
+  "B\<in>M \<Longrightarrow> strong_replacement(##M, is_omega_funspace(##M,B))"
+  using strong_replacement_rel_in_ctm[where \<phi>="omega_funspace_fm(2,0,1)" and env="[B]"]
+    zero_in_M arity_omega_funspace_fm ord_simp_union replacement_ax2(1)
+  by simp
+
+lemma (in M_ZF2_trans) replacement_omega_funspace:
+  "b\<in>M\<Longrightarrow>strong_replacement(##M, \<lambda>n z. n\<in>\<omega> \<and> is_funspace(##M,n,b,z))"
+  using strong_replacement_cong[THEN iffD2,OF _ replacement_is_omega_funspace[of b]]
+    omega_funspace_abs[of b] setclass_iff[THEN iffD1]
+  by (simp del:setclass_iff)
+
+lemma (in M_ZF2_trans) replacement_HAleph_wfrec_repl_body:
+  "B\<in>M \<Longrightarrow> strong_replacement(##M, HAleph_wfrec_repl_body(##M,B))"
+  using strong_replacement_rel_in_ctm[where \<phi>="HAleph_wfrec_repl_body_fm(2,0,1)" and env="[B]"]
+    zero_in_M arity_HAleph_wfrec_repl_body_fm replacement_ax2(2) ord_simp_union
+  by simp
+
+lemma (in M_ZF2_trans) HAleph_wfrec_repl:
+  "(##M)(sa) \<Longrightarrow>
+        (##M)(esa) \<Longrightarrow>
+        (##M)(mesa) \<Longrightarrow>
+        strong_replacement
+         (##M,
+          \<lambda>x z. \<exists>y[##M].
+                   pair(##M, x, y, z) \<and>
+                   (\<exists>f[##M].
+                       (\<forall>z[##M].
+                           z \<in> f \<longleftrightarrow>
+                           (\<exists>xa[##M].
+                               \<exists>y[##M].
+                                  \<exists>xaa[##M].
+                                     \<exists>sx[##M].
+                                        \<exists>r_sx[##M].
+                                           \<exists>f_r_sx[##M].
+                                              pair(##M, xa, y, z) \<and>
+                                              pair(##M, xa, x, xaa) \<and>
+                                              upair(##M, xa, xa, sx) \<and>
+                                              pre_image(##M, mesa, sx, r_sx) \<and> restriction(##M, f, r_sx, f_r_sx) \<and> xaa \<in> mesa \<and> is_HAleph(##M, xa, f_r_sx, y))) \<and>
+                       is_HAleph(##M, x, f, y)))"
+  using replacement_HAleph_wfrec_repl_body unfolding HAleph_wfrec_repl_body_def by simp
+
+lemma dcwit_replacement:"Ord(na) \<Longrightarrow>
+    N(na) \<Longrightarrow>
+    N(A) \<Longrightarrow>
+    N(a) \<Longrightarrow>
+    N(s) \<Longrightarrow>
+    N(R) \<Longrightarrow>
+    transrec_replacement
+     (N, \<lambda>n f ntc.
+            is_nat_case
+             (N, a,
+              \<lambda>m bmfm.
+                 \<exists>fm[N]. \<exists>cp[N].
+                    is_apply(N, f, m, fm) \<and>
+                    is_Collect(N, A, \<lambda>x. \<exists>fmx[N]. (N(x) \<and> fmx \<in> R) \<and> pair(N, fm, x, fmx), cp) \<and>
+                    is_apply(N, s, cp, bmfm),
+              n, ntc),na)"
+  unfolding transrec_replacement_def wfrec_replacement_def oops
+
+lemma (in M_ZF2_trans) replacement_dcwit_repl_body:
+  "(##M)(mesa) \<Longrightarrow> (##M)(A) \<Longrightarrow> (##M)(a) \<Longrightarrow> (##M)(s) \<Longrightarrow> (##M)(R) \<Longrightarrow>
+   strong_replacement(##M, dcwit_repl_body(##M,mesa,A,a,s,R))"
+  using strong_replacement_rel_in_ctm[where \<phi>="dcwit_repl_body_fm(6,5,4,3,2,0,1)"
+      and env="[R,s,a,A,mesa]" and f="dcwit_repl_body(##M,mesa,A,a,s,R)"]
+    zero_in_M arity_dcwit_repl_body replacement_ax2(10)
+  by simp
+
+lemma (in M_ZF2_trans) dcwit_repl:
+  "(##M)(sa) \<Longrightarrow>
+        (##M)(esa) \<Longrightarrow>
+        (##M)(mesa) \<Longrightarrow> (##M)(A) \<Longrightarrow> (##M)(a) \<Longrightarrow> (##M)(s) \<Longrightarrow> (##M)(R) \<Longrightarrow>
+        strong_replacement
+              ((##M), \<lambda>x z. \<exists>y[(##M)]. pair((##M), x, y, z) \<and>
+                                is_wfrec
+                                 ((##M), \<lambda>n f. is_nat_case
+                                             ((##M), a,
+                                              \<lambda>m bmfm.
+                                                 \<exists>fm[(##M)].
+                                                    \<exists>cp[(##M)].
+                                                       is_apply((##M), f, m, fm) \<and>
+                                                       is_Collect((##M), A, \<lambda>x. \<exists>fmx[(##M)]. ((##M)(x) \<and> fmx \<in> R) \<and> pair((##M), fm, x, fmx), cp) \<and>
+                                                       is_apply((##M), s, cp, bmfm),
+                                              n),
+                                  mesa, x, y))"
+  using replacement_dcwit_repl_body unfolding dcwit_repl_body_def by simp
+
+lemma (in M_ZF2_trans) replacement_fst2_snd2: "strong_replacement(##M, \<lambda>x y. y = \<langle>fst(fst(x)), snd(snd(x))\<rangle>)"
+  using strong_replacement_in_ctm[where \<phi>="is_fst2_snd2_fm(0,1)" and env="[]"]
+    zero_in_M fst_snd_closed pair_in_M_iff
+    arity_is_fst2_snd2_fm ord_simp_union fst2_snd2_abs replacement_ax2(3)
+  unfolding fst2_snd2_def
+  by simp
+
+lemma (in M_trivial) sndfst_fst2_snd2_abs:
+  assumes "M(x)" "M(res)"
+  shows "is_sndfst_fst2_snd2(M, x, res) \<longleftrightarrow> res = sndfst_fst2_snd2(x)"
+  unfolding is_sndfst_fst2_snd2_def sndfst_fst2_snd2_def
+  using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
+  by simp
+
+lemma (in M_ZF2_trans) replacement_sndfst_fst2_snd2:
+  "strong_replacement(##M, \<lambda>x y. y = \<langle>snd(fst(x)), fst(fst(x)), snd(snd(x))\<rangle>)"
+  using strong_replacement_in_ctm[where \<phi>="is_sndfst_fst2_snd2_fm(0,1)" and env="[]"]
+    zero_in_M fst_snd_closed pair_in_M_iff
+    arity_is_sndfst_fst2_snd2_fm ord_simp_union sndfst_fst2_snd2_abs replacement_ax2(4)
+  unfolding sndfst_fst2_snd2_def
+  by simp
+
+lemmas (in M_ZF2_trans) M_replacement_ZF_instances = lam_replacement_domain
+  lam_replacement_fst lam_replacement_snd lam_replacement_Union
+  lam_replacement_Upair lam_replacement_image
+  lam_replacement_Diff lam_replacement_converse
+  replacement_fst2_snd2 replacement_sndfst_fst2_snd2
+  lam_replacement_comp
+
+lemmas (in M_ZF2_trans) M_separation_ZF_instances =  separation_fstsnd_in_sndsnd
+  separation_sndfst_eq_fstsnd
+
+sublocale M_ZF2_trans \<subseteq> M_replacement "##M"
+  using M_replacement_ZF_instances M_separation_ZF_instances
+  by unfold_locales simp
+
+lemma (in M_ZF1_trans) separation_is_dcwit_body:
+  assumes "(##M)(A)" "(##M)(a)" "(##M)(g)" "(##M)(R)"
+  shows "separation(##M,is_dcwit_body(##M, A, a, g, R))"
+  using assms separation_in_ctm[where env="[A,a,g,R]" and \<phi>="is_dcwit_body_fm(1,2,3,4,0)",
+      OF _ _ _ is_dcwit_body_iff_sats[symmetric],
+      of "\<lambda>_.A" "\<lambda>_.a" "\<lambda>_.g" "\<lambda>_.R" "\<lambda>x. x"]
+    nonempty arity_is_dcwit_body_fm is_dcwit_body_fm_type
+  by (simp add:ord_simp_union)
+
+lemma (in M_trivial) RepFun_body_abs:
+  assumes "M(u)" "M(v)" "M(res)"
+  shows "is_RepFun_body(M, u, v, res) \<longleftrightarrow> res = RepFun_body(u,v)"
+  unfolding is_RepFun_body_def RepFun_body_def
+  using fst_rel_abs[symmetric] snd_rel_abs[symmetric] fst_abs snd_abs assms
+    Replace_abs[where P="\<lambda>xa a. a = {\<langle>v, xa\<rangle>}" and A="u"]
+    univalent_triv transM[of _ u]
+  by auto
+
+lemma (in M_ZF2_trans) RepFun_SigFun_closed: "x \<in> M \<Longrightarrow> z \<in> M \<Longrightarrow> {{\<langle>z, x\<rangle>} . x \<in> x} \<in> M"
+  using lam_replacement_sing_const_id lam_replacement_imp_strong_replacement RepFun_closed
+    transitivity singleton_in_M_iff pair_in_M_iff
+  by simp
+
+lemma (in M_ZF2_trans) replacement_RepFun_body:
+  "lam_replacement(##M, \<lambda>p . {{\<langle>snd(p), x\<rangle>} . x \<in> fst(p)})"
+  using lam_replacement2_in_ctm[where \<phi>="is_RepFun_body_fm(0,1,2)" and env="[]" and f="\<lambda>p q . {{\<langle>q, x\<rangle>} . x \<in> p}"]
+    RepFun_SigFun_closed[OF fst_snd_closed[THEN conjunct1,simplified] fst_snd_closed[THEN conjunct2,simplified]]
+    arity_RepFun ord_simp_union transitivity zero_in_M RepFun_body_def RepFun_body_abs RepFun_SigFun_closed
+    LambdaPair_in_M_replacement2(5)
+  by simp
+
+sublocale M_ZF2_trans \<subseteq> M_replacement_extra "##M"
+  by unfold_locales (simp_all add: replacement_RepFun_body
+      lam_replacement_minimum del:setclass_iff)
+
+sublocale M_ZF2_trans \<subseteq> M_Perm "##M"
+  using separation_PiP_rel separation_injP_rel separation_surjP_rel
+    lam_replacement_imp_strong_replacement[OF
+      lam_replacement_Sigfun[OF lam_replacement_constant]]
+    Pi_replacement1 unfolding Sigfun_def
+  by unfold_locales simp_all
+
+lemma (in M_ZF2_trans) replacement_is_order_eq_map:
+  "A\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> strong_replacement(##M, order_eq_map(##M,A,r))"
+  using strong_replacement_rel_in_ctm[where \<phi>="order_eq_map_fm(2,3,0,1)" and env="[A,r]"  and f="order_eq_map(##M,A,r)"]
+    order_eq_map_iff_sats[where env="[_,_,A,r]"] zero_in_M fst_snd_closed pair_in_M_iff
+    arity_order_eq_map_fm ord_simp_union replacement_ax2(5)
+  by simp
+
+lemma (in M_ZF2_trans) banach_iterates:
+  assumes "X\<in>M" "Y\<in>M" "f\<in>M" "g\<in>M" "W\<in>M"
+  shows "iterates_replacement(##M, is_banach_functor(##M,X,Y,f,g), W)"
+proof -
+  have "strong_replacement(##M, \<lambda> x z . banach_body_iterates(##M,X,Y,f,g,W,n,x,z))" if "n\<in>\<omega>" for n
+    using assms that arity_banach_body_iterates_fm ord_simp_union nat_into_M
+      strong_replacement_rel_in_ctm[where \<phi>="banach_body_iterates_fm(7,6,5,4,3,2,0,1)"
+        and env="[n,W,g,f,Y,X]"] replacement_ax2(9)
+    by simp
+  then
+  show ?thesis
+    using assms nat_into_M Memrel_closed
+    unfolding iterates_replacement_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
+      is_nat_case_def iterates_MH_def banach_body_iterates_def
+    by simp
+qed
+
+lemma (in M_ZF2_trans) banach_replacement_iterates:
+  assumes "X\<in>M" "Y\<in>M" "f\<in>M" "g\<in>M" "W\<in>M"
+  shows "strong_replacement(##M, \<lambda>n y. n\<in>\<omega> \<and> is_iterates(##M,is_banach_functor(##M,X, Y, f, g),W,n,y))"
+proof -
+  have "strong_replacement(##M, \<lambda> n z . banach_is_iterates_body(##M,X,Y,f,g,W,n,z))"
+    using assms arity_banach_is_iterates_body_fm ord_simp_union nat_into_M
+      strong_replacement_rel_in_ctm[where \<phi>="banach_is_iterates_body_fm(6,5,4,3,2,0,1)"
+        and env="[W,g,f,Y,X]"] replacement_ax2(7)
+    by simp
+  then
+  show ?thesis
+    using assms nat_in_M
+    unfolding is_iterates_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
+      is_nat_case_def iterates_MH_def banach_is_iterates_body_def
+    by simp
+qed
+
+lemma (in M_ZF2_trans) banach_replacement:
+  assumes "(##M)(X)" "(##M)(Y)" "(##M)(f)" "(##M)(g)"
+  shows "strong_replacement(##M, \<lambda>n y. n\<in>nat \<and> y = banach_functor(X, Y, f, g)^n (0))"
+  using iterates_abs[OF banach_iterates banach_functor_abs,of X Y f g]
+    assms banach_functor_closed zero_in_M
+    strong_replacement_cong[THEN iffD1,OF _ banach_replacement_iterates[of X Y f g 0]]
+  by simp
+
+lemma (in M_ZF2_trans) lam_replacement_cardinal : "lam_replacement(##M, cardinal_rel(##M))"
+  using lam_replacement_iff_lam_closed[THEN iffD2,of "cardinal_rel(##M)"]
+    cardinal_rel_closed is_cardinal_iff
+    Lambda_in_M[where \<phi>="is_cardinal_fm(0,1)" and env="[]",OF is_cardinal_fm_type[of 0 1]]
+    arity_is_cardinal_fm[of 0 1] ord_simp_union cardinal_rel_closed transitivity zero_in_M
+    Lambda_in_M_replacement2(5)
+  by simp_all
+
+lemma (in M_basic) rel2_trans_apply:
+  "M(f) \<Longrightarrow> relation2(M,is_trans_apply_image(M,f),trans_apply_image(f))"
+  unfolding is_trans_apply_image_def trans_apply_image_def relation2_def
+  by auto
+
+lemma (in M_basic) apply_image_closed:
+  shows "M(f) \<Longrightarrow> \<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(trans_apply_image(f, x, g))"
+  unfolding trans_apply_image_def by simp
+
+lemma (in M_basic) apply_image_closed':
+  shows "M(f) \<Longrightarrow> \<forall>x[M]. \<forall>g[M]. M(trans_apply_image(f, x, g))"
+  unfolding trans_apply_image_def by simp
+
+lemma (in M_ZF2_trans) replacement_transrec_apply_image_body :
+  "(##M)(f) \<Longrightarrow> (##M)(mesa) \<Longrightarrow> strong_replacement(##M,transrec_apply_image_body(##M,f,mesa))"
+  using strong_replacement_rel_in_ctm[where \<phi>="transrec_apply_image_body_fm(3,2,0,1)" and env="[mesa,f]"]
+    zero_in_M arity_transrec_apply_image_body_fm ord_simp_union
+    replacement_ax2(6)
+  by simp
+
+lemma (in M_ZF2_trans) transrec_replacement_apply_image:
+  assumes "(##M)(f)" "(##M)(\<alpha>)"
+  shows "transrec_replacement(##M, is_trans_apply_image(##M, f), \<alpha>)"
+  unfolding transrec_replacement_def wfrec_replacement_def is_wfrec_def M_is_recfun_def
+  using replacement_transrec_apply_image_body[unfolded transrec_apply_image_body_def] assms
+    Memrel_closed singleton_closed eclose_closed
+  by simp
+
+lemma (in M_ZF2_trans) rec_trans_apply_image_abs:
+  assumes "(##M)(f)" "(##M)(x)" "(##M)(y)" "Ord(x)"
+  shows "is_transrec(##M,is_trans_apply_image(##M, f),x,y) \<longleftrightarrow> y = transrec(x,trans_apply_image(f))"
+  using transrec_abs[OF transrec_replacement_apply_image rel2_trans_apply] assms apply_image_closed
+  by simp
+
+lemma (in M_ZF2_trans) replacement_is_trans_apply_image:
+  "(##M)(f) \<Longrightarrow> (##M)(\<beta>) \<Longrightarrow> strong_replacement(##M, \<lambda> x z .
+    \<exists>y[##M]. pair(##M,x,y,z) \<and> x\<in>\<beta> \<and> (is_transrec(##M,is_trans_apply_image(##M, f),x,y)))"
+  unfolding is_transrec_def is_wfrec_def M_is_recfun_def
+  apply(rule_tac strong_replacement_cong[
+        where P="\<lambda> x z. M,[x,z,\<beta>,f] \<Turnstile> is_trans_apply_image_body_fm(3,2,0,1)",THEN iffD1])
+   apply(rule_tac is_trans_apply_image_body_iff_sats[symmetric,unfolded is_trans_apply_image_body_def,where env="[_,_,\<beta>,f]"])
+            apply(simp_all add:zero_in_M)
+  apply(rule_tac replacement_ax2(8)[unfolded replacement_assm_def, rule_format, where env="[\<beta>,f]",simplified])
+    apply(simp_all add: arity_is_trans_apply_image_body_fm is_trans_apply_image_body_fm_type ord_simp_union)
+  done
+
+lemma (in M_ZF2_trans) trans_apply_abs:
+  "(##M)(f) \<Longrightarrow> (##M)(\<beta>) \<Longrightarrow> Ord(\<beta>) \<Longrightarrow> (##M)(x) \<Longrightarrow> (##M)(z) \<Longrightarrow>
+    (x\<in>\<beta> \<and> z = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a)) \<rangle>) \<longleftrightarrow>
+    (\<exists>y[##M]. pair(##M,x,y,z) \<and> x\<in>\<beta> \<and> (is_transrec(##M,is_trans_apply_image(##M, f),x,y)))"
+  using rec_trans_apply_image_abs Ord_in_Ord
+    transrec_closed[OF transrec_replacement_apply_image rel2_trans_apply,of f,simplified]
+    apply_image_closed'[of f]
+  unfolding trans_apply_image_def
+  by auto
+
+lemma (in M_ZF2_trans) replacement_trans_apply_image:
+  "(##M)(f) \<Longrightarrow> (##M)(\<beta>) \<Longrightarrow> Ord(\<beta>) \<Longrightarrow>
+  strong_replacement(##M, \<lambda>x y. x\<in>\<beta> \<and> y = \<langle>x, transrec(x, \<lambda>a g. f ` (g `` a))\<rangle>)"
+  using strong_replacement_cong[THEN iffD1,OF _ replacement_is_trans_apply_image,simplified]
+    trans_apply_abs Ord_in_Ord
+  by simp
+
+definition ifrFb_body where
+  "ifrFb_body(M,b,f,x,i) \<equiv> x \<in>
+  (if b = 0 then if i \<in> range(f) then
+  if M(converse(f) ` i) then converse(f) ` i else 0 else 0 else if M(i) then i else 0)"
+
+relativize functional "ifrFb_body" "ifrFb_body_rel"
+relationalize "ifrFb_body_rel" "is_ifrFb_body"
+
+synthesize "is_ifrFb_body" from_definition assuming "nonempty"
+arity_theorem for "is_ifrFb_body_fm"
+
+definition ifrangeF_body :: "[i\<Rightarrow>o,i,i,i,i] \<Rightarrow> o" where
+  "ifrangeF_body(M,A,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body(M,b,f,x,i)\<rangle>"
+
+relativize functional "ifrangeF_body" "ifrangeF_body_rel"
+relationalize "ifrangeF_body_rel" "is_ifrangeF_body"
+
+synthesize "is_ifrangeF_body" from_definition assuming "nonempty"
+arity_theorem for "is_ifrangeF_body_fm"
+
+lemma (in M_Z_trans) separation_is_ifrangeF_body:
+  "(##M)(A) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body(##M,A,r,s))"
+  using separation_in_ctm[where \<phi>="is_ifrangeF_body_fm(1,2,3,0)" and env="[A,r,s]"]
+    zero_in_M arity_is_ifrangeF_body_fm ord_simp_union is_ifrangeF_body_fm_type
+  by simp
+
+lemma (in M_basic) is_ifrFb_body_closed: "M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body(M, r, s, x, i) \<Longrightarrow> M(i)"
+  unfolding ifrangeF_body_def is_ifrangeF_body_def is_ifrFb_body_def If_abs
+  by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
+
+lemma (in M_ZF1_trans) ifrangeF_body_abs:
+  assumes "(##M)(A)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
+  shows "is_ifrangeF_body(##M,A,r,s,x) \<longleftrightarrow> ifrangeF_body(##M,A,r,s,x)"
+proof -
+  {
+    fix a
+    assume "a\<in>M"
+    with assms
+    have "(\<mu> i. i\<in> M \<and> is_ifrFb_body(##M, r, s, z, i))= (\<mu> i. is_ifrFb_body(##M, r, s, z, i))" for z
+      using is_ifrFb_body_closed[of r s z]
+      by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body(##M,r,s,z,i)"]) auto
+    moreover
+    have "(\<mu> i. is_ifrFb_body(##M, r, s, z, i))= (\<mu> i. ifrFb_body(##M, r, s, z, i))" for z
+    proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body(##M,r,s,z,i)" "\<lambda>i. ifrFb_body(##M,r,s,z,i)"])
+      fix y
+      from assms \<open>a\<in>M\<close>
+      show "is_ifrFb_body(##M, r, s, z, y) \<longleftrightarrow> ifrFb_body(##M, r, s, z, y)"
+        using If_abs apply_0
+        unfolding ifrFb_body_def is_ifrFb_body_def
+        by (cases "y\<in>M"; cases "y\<in>range(s)"; cases "converse(s)`y \<in> M";
+            auto dest:transM split del: split_if del:iffI)
+          (auto simp flip:setclass_iff; (force simp only:setclass_iff))+
+    qed
+    moreover from \<open>a\<in>M\<close>
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body(##M, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body(##M, r, s, z,i))" for z
+      using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body(##M,r,s,z,i)" a]
+      by simp
+    ultimately
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body(##M, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i. ifrFb_body(##M, r, s, z,i))" for z
+      by simp
+  }
+  with assms
+  show ?thesis
+    using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
+    unfolding ifrangeF_body_def is_ifrangeF_body_def
+    by (auto dest:transM)
+qed
+
+lemma (in M_ZF1_trans) separation_ifrangeF_body:
+  "(##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow> separation
+        (##M, \<lambda>y.  \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. if (##M)(x) then x else 0, b, f, i)\<rangle>)"
+  using separation_is_ifrangeF_body ifrangeF_body_abs
+    separation_cong[where P="is_ifrangeF_body(##M,A,b,f)" and M="##M",THEN iffD1]
+  unfolding ifrangeF_body_def if_range_F_def if_range_F_else_F_def ifrFb_body_def
+  by simp
+
+(* (##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
+    separation(##M,
+      \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if (##M)(a) then G`a else 0, b, f, i)\<rangle>) *)
+
+definition ifrFb_body2 where
+  "ifrFb_body2(M,G,b,f,x,i) \<equiv> x \<in>
+  (if b = 0 then if i \<in> range(f) then
+  if M(converse(f) ` i) then G`(converse(f) ` i) else 0 else 0 else if M(i) then G`i else 0)"
+
+relativize functional "ifrFb_body2" "ifrFb_body2_rel"
+relationalize "ifrFb_body2_rel" "is_ifrFb_body2"
+
+synthesize "is_ifrFb_body2" from_definition assuming "nonempty"
+arity_theorem for "is_ifrFb_body2_fm"
+
+definition ifrangeF_body2 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "ifrangeF_body2(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body2(M,G,b,f,x,i)\<rangle>"
+
+relativize functional "ifrangeF_body2" "ifrangeF_body2_rel"
+relationalize "ifrangeF_body2_rel" "is_ifrangeF_body2"
+
+synthesize "is_ifrangeF_body2" from_definition assuming "nonempty"
+arity_theorem for "is_ifrangeF_body2_fm"
+
+lemma (in M_Z_trans) separation_is_ifrangeF_body2:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body2(##M,A,G,r,s))"
+  using separation_in_ctm[where \<phi>="is_ifrangeF_body2_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
+    zero_in_M arity_is_ifrangeF_body2_fm ord_simp_union is_ifrangeF_body2_fm_type
+  by simp
+
+lemma (in M_basic) is_ifrFb_body2_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body2(M, G, r, s, x, i) \<Longrightarrow> M(i)"
+  unfolding ifrangeF_body2_def is_ifrangeF_body2_def is_ifrFb_body2_def If_abs
+  by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
+
+lemma (in M_ZF1_trans) ifrangeF_body2_abs:
+  assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
+  shows "is_ifrangeF_body2(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body2(##M,A,G,r,s,x)"
+proof -
+  {
+    fix a
+    assume "a\<in>M"
+    with assms
+    have "(\<mu> i. i\<in> M \<and> is_ifrFb_body2(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body2(##M, G, r, s, z, i))" for z
+      using is_ifrFb_body2_closed[of G r s z]
+      by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body2(##M,G,r,s,z,i)"]) auto
+    moreover
+    have "(\<mu> i. is_ifrFb_body2(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body2(##M, G, r, s, z, i))" for z
+    proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body2(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body2(##M,G,r,s,z,i)"])
+      fix y
+      from assms \<open>a\<in>M\<close>
+      show "is_ifrFb_body2(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body2(##M, G, r, s, z, y)"
+        using If_abs apply_0
+        unfolding ifrFb_body2_def is_ifrFb_body2_def
+        by (cases "y\<in>M"; cases "y\<in>range(s)"; cases "converse(s)`y \<in> M";
+            auto dest:transM split del: split_if del:iffI)
+          (auto simp flip:setclass_iff; (force simp only:setclass_iff))+
+    qed
+    moreover from \<open>a\<in>M\<close>
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body2(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body2(##M, G, r, s, z,i))" for z
+      using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body2(##M,G,r,s,z,i)" a]
+      by simp
+    ultimately
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body2(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i. ifrFb_body2(##M, G, r, s, z,i))" for z
+      by simp
+  }
+  with assms
+  show ?thesis
+    using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
+    unfolding ifrangeF_body2_def is_ifrangeF_body2_def
+    by (auto dest:transM)
+qed
+
+lemma (in M_ZF1_trans) separation_ifrangeF_body2:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
+       separation
+        (##M,
+         \<lambda>y. \<exists>x\<in>A.
+                y =
+                \<langle>x, \<mu> i. x \<in>
+                         if_range_F_else_F(\<lambda>a. if (##M)(a) then G ` a else 0, b, f, i)\<rangle>)"
+  using separation_is_ifrangeF_body2 ifrangeF_body2_abs
+    separation_cong[where P="is_ifrangeF_body2(##M,A,G,b,f)" and M="##M",THEN iffD1]
+  unfolding ifrangeF_body2_def if_range_F_def if_range_F_else_F_def ifrFb_body2_def
+  by simp
+
+(* (##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow> (##M)(F) \<Longrightarrow>
+  separation(##M,
+    \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. if (##M)(a) then F -`` {a} else 0, b, f, i)\<rangle>) *)
+
+definition ifrFb_body3 where
+  "ifrFb_body3(M,G,b,f,x,i) \<equiv> x \<in>
+  (if b = 0 then if i \<in> range(f) then
+  if M(converse(f) ` i) then G-``{converse(f) ` i} else 0 else 0 else if M(i) then G-``{i} else 0)"
+
+relativize functional "ifrFb_body3" "ifrFb_body3_rel"
+relationalize "ifrFb_body3_rel" "is_ifrFb_body3"
+
+synthesize "is_ifrFb_body3" from_definition assuming "nonempty"
+arity_theorem for "is_ifrFb_body3_fm"
+
+definition ifrangeF_body3 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "ifrangeF_body3(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body3(M,G,b,f,x,i)\<rangle>"
+
+relativize functional "ifrangeF_body3" "ifrangeF_body3_rel"
+relationalize "ifrangeF_body3_rel" "is_ifrangeF_body3"
+
+synthesize "is_ifrangeF_body3" from_definition assuming "nonempty"
+arity_theorem for "is_ifrangeF_body3_fm"
+
+lemma (in M_Z_trans) separation_is_ifrangeF_body3:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body3(##M,A,G,r,s))"
+  using separation_in_ctm[where \<phi>="is_ifrangeF_body3_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
+    zero_in_M arity_is_ifrangeF_body3_fm ord_simp_union is_ifrangeF_body3_fm_type
+  by simp
+
+lemma (in M_basic) is_ifrFb_body3_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body3(M, G, r, s, x, i) \<Longrightarrow> M(i)"
+  unfolding ifrangeF_body3_def is_ifrangeF_body3_def is_ifrFb_body3_def If_abs
+  by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
+
+lemma (in M_ZF1_trans) ifrangeF_body3_abs:
+  assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
+  shows "is_ifrangeF_body3(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body3(##M,A,G,r,s,x)"
+proof -
+  {
+    fix a
+    assume "a\<in>M"
+    with assms
+    have "(\<mu> i. i\<in> M \<and> is_ifrFb_body3(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body3(##M, G, r, s, z, i))" for z
+      using is_ifrFb_body3_closed[of G r s z]
+      by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body3(##M,G,r,s,z,i)"]) auto
+    moreover
+    have "(\<mu> i. is_ifrFb_body3(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body3(##M, G, r, s, z, i))" for z
+    proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body3(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body3(##M,G,r,s,z,i)"])
+      fix y
+      from assms \<open>a\<in>M\<close>
+      show "is_ifrFb_body3(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body3(##M, G, r, s, z, y)"
+        using If_abs apply_0
+        unfolding ifrFb_body3_def is_ifrFb_body3_def
+        by (cases "y\<in>M"; cases "y\<in>range(s)"; cases "converse(s)`y \<in> M";
+            auto dest:transM split del: split_if del:iffI)
+          (auto simp flip:setclass_iff; (force simp only:setclass_iff))+
+    qed
+    moreover from \<open>a\<in>M\<close>
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body3(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body3(##M, G, r, s, z,i))" for z
+      using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body3(##M,G,r,s,z,i)" a]
+      by simp
+    ultimately
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body3(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i. ifrFb_body3(##M, G, r, s, z,i))" for z
+      by simp
+  }
+  with assms
+  show ?thesis
+    using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
+    unfolding ifrangeF_body3_def is_ifrangeF_body3_def
+    by (auto dest:transM)
+qed
+
+lemma (in M_ZF1_trans) separation_ifrangeF_body3:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
+       separation
+        (##M,
+         \<lambda>y. \<exists>x\<in>A.
+                y =
+                \<langle>x, \<mu> i. x \<in>
+                         if_range_F_else_F(\<lambda>a. if (##M)(a) then G-``{a} else 0, b, f, i)\<rangle>)"
+  using separation_is_ifrangeF_body3 ifrangeF_body3_abs
+    separation_cong[where P="is_ifrangeF_body3(##M,A,G,b,f)" and M="##M",THEN iffD1]
+  unfolding ifrangeF_body3_def if_range_F_def if_range_F_else_F_def ifrFb_body3_def
+  by simp
+
+(* (##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow> (##M)(A') \<Longrightarrow>
+    separation(##M, \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F((`)(A), b, f, i)\<rangle>) *)
+
+definition ifrFb_body4 where
+  "ifrFb_body4(G,b,f,x,i) \<equiv> x \<in>
+  (if b = 0 then if i \<in> range(f) then G`(converse(f) ` i) else 0 else G`i)"
+
+relativize functional "ifrFb_body4" "ifrFb_body4_rel"
+relationalize "ifrFb_body4_rel" "is_ifrFb_body4"
+
+synthesize "is_ifrFb_body4" from_definition assuming "nonempty"
+arity_theorem for "is_ifrFb_body4_fm"
+
+definition ifrangeF_body4 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "ifrangeF_body4(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body4(G,b,f,x,i)\<rangle>"
+
+relativize functional "ifrangeF_body4" "ifrangeF_body4_rel"
+relationalize "ifrangeF_body4_rel" "is_ifrangeF_body4"
+
+synthesize "is_ifrangeF_body4" from_definition assuming "nonempty"
+arity_theorem for "is_ifrangeF_body4_fm"
+
+lemma (in M_Z_trans) separation_is_ifrangeF_body4:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body4(##M,A,G,r,s))"
+  using separation_in_ctm[where \<phi>="is_ifrangeF_body4_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
+    zero_in_M arity_is_ifrangeF_body4_fm ord_simp_union is_ifrangeF_body4_fm_type
+  by simp
+
+lemma (in M_basic) is_ifrFb_body4_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body4(M, G, r, s, x, i) \<Longrightarrow> M(i)"
+  using If_abs
+  unfolding ifrangeF_body4_def is_ifrangeF_body4_def is_ifrFb_body4_def fun_apply_def
+  by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
+
+lemma (in M_ZF1_trans) ifrangeF_body4_abs:
+  assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
+  shows "is_ifrangeF_body4(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body4(##M,A,G,r,s,x)"
+proof -
+  {
+    fix a
+    assume "a\<in>M"
+    with assms
+    have "(\<mu> i. i\<in> M \<and> is_ifrFb_body4(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body4(##M, G, r, s, z, i))" for z
+      using is_ifrFb_body4_closed[of G r s z]
+      by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body4(##M,G,r,s,z,i)"]) auto
+    moreover
+    have "(\<mu> i. is_ifrFb_body4(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body4(G, r, s, z, i))" if "z\<in>M" for z
+    proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body4(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body4(G,r,s,z,i)"])
+      fix y
+      from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
+      show "is_ifrFb_body4(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body4(G, r, s, z, y)"
+        using If_abs apply_0
+        unfolding ifrFb_body4_def is_ifrFb_body4_def
+        apply (cases "y\<in>M"; cases "y\<in>range(s)"; cases "r=0"; cases "y\<in>domain(G)";
+            auto dest:transM split del: split_if del:iffI)
+        by (auto simp flip:setclass_iff; (force simp only: fun_apply_def setclass_iff))
+          (auto simp flip:setclass_iff simp: fun_apply_def )
+    qed
+    moreover from \<open>a\<in>M\<close>
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body4(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body4(##M, G, r, s, z,i))" for z
+      using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body4(##M,G,r,s,z,i)" a]
+      by simp
+    ultimately
+    have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body4(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i. ifrFb_body4(G, r, s, z,i))" for z
+      by simp
+  }
+  with assms
+  show ?thesis
+    using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
+    unfolding ifrangeF_body4_def is_ifrangeF_body4_def
+    by (auto dest:transM)
+qed
+
+lemma (in M_ZF1_trans) separation_ifrangeF_body4:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
+       separation(##M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F((`)(G), b, f, i)\<rangle>)"
+  using separation_is_ifrangeF_body4 ifrangeF_body4_abs
+    separation_cong[where P="is_ifrangeF_body4(##M,A,G,b,f)" and M="##M",THEN iffD1]
+  unfolding ifrangeF_body4_def if_range_F_def if_range_F_else_F_def ifrFb_body4_def
+  by simp
+
+(* (##M)(G) \<Longrightarrow> (##M)(A) \<Longrightarrow>
+    separation(##M,
+      \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. {xa \<in> G . x \<in> xa}, b, f, i)\<rangle>) *)
+
+definition ifrFb_body5 where
+  "ifrFb_body5(G,b,f,x,i) \<equiv> x \<in>
+  (if b = 0 then if i \<in> range(f) then {xa \<in> G . converse(f) ` i \<in> xa} else 0 else {xa \<in> G . i \<in> xa})"
+
+relativize functional "ifrFb_body5" "ifrFb_body5_rel"
+relationalize "ifrFb_body5_rel" "is_ifrFb_body5"
+
+synthesize "is_ifrFb_body5" from_definition assuming "nonempty"
+arity_theorem for "is_ifrFb_body5_fm"
+
+definition ifrangeF_body5 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "ifrangeF_body5(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body5(G,b,f,x,i)\<rangle>"
+
+relativize functional "ifrangeF_body5" "ifrangeF_body5_rel"
+relationalize "ifrangeF_body5_rel" "is_ifrangeF_body5"
+
+synthesize "is_ifrangeF_body5" from_definition assuming "nonempty"
+arity_theorem for "is_ifrangeF_body5_fm"
+
+lemma (in M_Z_trans) separation_is_ifrangeF_body5:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body5(##M,A,G,r,s))"
+  using separation_in_ctm[where \<phi>="is_ifrangeF_body5_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
+    zero_in_M arity_is_ifrangeF_body5_fm ord_simp_union is_ifrangeF_body5_fm_type
+  by simp
+
+lemma (in M_basic) is_ifrFb_body5_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body5(M, G, r, s, x, i) \<Longrightarrow> M(i)"
+  using If_abs
+  unfolding ifrangeF_body5_def is_ifrangeF_body5_def is_ifrFb_body5_def fun_apply_def
+  by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
+
+lemma (in M_ZF1_trans) ifrangeF_body5_abs:
+  assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
+  shows "is_ifrangeF_body5(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body5(##M,A,G,r,s,x)"
+proof -
+  {
+    fix a
+    assume "a\<in>M"
+    with assms
+    have "(\<mu> i. i\<in> M \<and> is_ifrFb_body5(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body5(##M, G, r, s, z, i))" for z
+      using is_ifrFb_body5_closed[of G r s z]
+      by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body5(##M,G,r,s,z,i)"]) auto
+    moreover
+    have "(\<mu> i. is_ifrFb_body5(##M, G, r, s, z, i))= (\<mu> i. ifrFb_body5(G, r, s, z, i))" if "z\<in>M" for z
+    proof (rule_tac Least_cong[of "\<lambda>i. is_ifrFb_body5(##M,G,r,s,z,i)" "\<lambda>i. ifrFb_body5(G,r,s,z,i)"])
+      fix y
+      from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
+      show "is_ifrFb_body5(##M, G, r, s, z, y) \<longleftrightarrow> ifrFb_body5(G, r, s, z, y)"
+        using If_abs apply_0 separation_in_constant separation_in_rev
+        unfolding ifrFb_body5_def is_ifrFb_body5_def
+        apply (cases "y\<in>M"; cases "y\<in>range(s)"; cases "r=0"; cases "y\<in>domain(G)";
+            auto dest:transM split del: split_if del:iffI)
+              apply (auto simp flip:setclass_iff; (force simp only: fun_apply_def setclass_iff))
+             apply (auto simp flip:setclass_iff simp: fun_apply_def)
+        apply (auto dest:transM)
+        done
+    qed
+    moreover from \<open>a\<in>M\<close>
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body5(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body5(##M, G, r, s, z,i))" for z
+      using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body5(##M,G,r,s,z,i)" a]
+      by simp
+    ultimately
+    have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body5(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i. ifrFb_body5(G, r, s, z,i))" for z
+      by simp
+  }
+  with assms
+  show ?thesis
+    using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
+    unfolding ifrangeF_body5_def is_ifrangeF_body5_def
+    by (auto dest:transM)
+qed
+
+lemma (in M_ZF1_trans) separation_ifrangeF_body5:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
+       separation(##M, \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>x. {xa \<in> G . x \<in> xa}, b, f, i)\<rangle>)"
+  using separation_is_ifrangeF_body5 ifrangeF_body5_abs
+    separation_cong[where P="is_ifrangeF_body5(##M,A,G,b,f)" and M="##M",THEN iffD1]
+  unfolding ifrangeF_body5_def if_range_F_def if_range_F_else_F_def ifrFb_body5_def
+  by simp
+
+(* (##M)(A) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
+    separation(##M,
+      \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. {p \<in> A . domain(p) = a}, b, f, i)\<rangle>) *)
+
+definition ifrFb_body6 where
+  "ifrFb_body6(G,b,f,x,i) \<equiv> x \<in>
+  (if b = 0 then if i \<in> range(f) then {p\<in>G . domain(p) = converse(f) ` i} else 0 else {p\<in>G . domain(p) = i})"
+
+relativize functional "ifrFb_body6" "ifrFb_body6_rel"
+relationalize "ifrFb_body6_rel" "is_ifrFb_body6"
+
+synthesize "is_ifrFb_body6" from_definition assuming "nonempty"
+arity_theorem for "is_ifrFb_body6_fm"
+
+definition ifrangeF_body6 :: "[i\<Rightarrow>o,i,i,i,i,i] \<Rightarrow> o" where
+  "ifrangeF_body6(M,A,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body6(G,b,f,x,i)\<rangle>"
+
+relativize functional "ifrangeF_body6" "ifrangeF_body6_rel"
+relationalize "ifrangeF_body6_rel" "is_ifrangeF_body6"
+
+synthesize "is_ifrangeF_body6" from_definition assuming "nonempty"
+arity_theorem for "is_ifrangeF_body6_fm"
+
+lemma (in M_Z_trans) separation_is_ifrangeF_body6:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body6(##M,A,G,r,s))"
+  using separation_in_ctm[where \<phi>="is_ifrangeF_body6_fm(1,2,3,4,0)" and env="[A,G,r,s]"]
+    zero_in_M arity_is_ifrangeF_body6_fm ord_simp_union is_ifrangeF_body6_fm_type
+  by simp
+
+lemma (in M_basic) ifrFb_body6_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> ifrFb_body6(G, r, s, x, i) \<longleftrightarrow>  M(i) \<and> ifrFb_body6(G, r, s, x, i)"
+  using If_abs
+  unfolding ifrangeF_body6_def is_ifrangeF_body6_def ifrFb_body6_def fun_apply_def
+  by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
+
+lemma (in M_basic) is_ifrFb_body6_closed: "M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow> is_ifrFb_body6(M, G, r, s, x, i) \<Longrightarrow> M(i)"
+  using If_abs
+  unfolding ifrangeF_body6_def is_ifrangeF_body6_def is_ifrFb_body6_def fun_apply_def
+  by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
+
+lemma (in M_ZF2_trans) ifrangeF_body6_abs:
+  assumes "(##M)(A)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
+  shows "is_ifrangeF_body6(##M,A,G,r,s,x) \<longleftrightarrow> ifrangeF_body6(##M,A,G,r,s,x)"
+proof -
+  {
+    fix a
+    assume "a\<in>M"
+    with assms
+    have "(\<mu> i. i\<in> M \<and> is_ifrFb_body6(##M, G, r, s, z, i))= (\<mu> i. is_ifrFb_body6(##M, G, r, s, z, i))" for z
+      using is_ifrFb_body6_closed[of G r s z]
+      by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body6(##M,G,r,s,z,i)"]) auto
+    moreover
+    have "(\<mu> i. i\<in>M \<and> is_ifrFb_body6(##M, G, r, s, z, i))= (\<mu> i. i\<in>M \<and>  ifrFb_body6(G, r, s, z, i))" if "z\<in>M" for z
+    proof (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body6(##M,G,r,s,z,i)" "\<lambda>i. i\<in>M \<and> ifrFb_body6(G,r,s,z,i)"])
+      fix y
+      from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
+      show "y\<in>M \<and> is_ifrFb_body6(##M, G, r, s, z, y) \<longleftrightarrow> y\<in>M \<and> ifrFb_body6(G, r, s, z, y)"
+        using If_abs apply_0 separation_in_constant transitivity[of _ G]
+          separation_closed converse_closed apply_closed range_closed zero_in_M
+          separation_cong[OF eq_commute,THEN iffD1,OF domain_eq_separation]
+        unfolding ifrFb_body6_def is_ifrFb_body6_def
+        by auto
+    qed
+    moreover from \<open>a\<in>M\<close>
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body6(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body6(##M, G, r, s, z,i))" for z
+      using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body6(##M,G,r,s,z,i)" a]
+      by simp
+    ultimately
+    have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body6(##M, G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i. ifrFb_body6(G, r, s, z,i))" for z
+      using Least_cong[OF ifrFb_body6_closed[of G r s]] assms
+      by simp
+  }
+  with assms
+  show ?thesis
+    using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
+    unfolding ifrangeF_body6_def is_ifrangeF_body6_def
+    by (auto dest:transM)
+qed
+
+lemma (in M_ZF2_trans) separation_ifrangeF_body6:
+  "(##M)(A) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
+       separation(##M,
+      \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(\<lambda>a. {p \<in> G . domain(p) = a}, b, f, i)\<rangle>)"
+  using separation_is_ifrangeF_body6 ifrangeF_body6_abs
+    separation_cong[where P="is_ifrangeF_body6(##M,A,G,b,f)" and M="##M",THEN iffD1]
+  unfolding ifrangeF_body6_def if_range_F_def if_range_F_else_F_def ifrFb_body6_def
+  by simp
+
+
+
+(* (##M)(A) \<Longrightarrow> (##M)(f) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(D) \<Longrightarrow> (##M)(r') \<Longrightarrow> (##M)(A') \<Longrightarrow>
+    separation(##M,
+      \<lambda>y. \<exists>x\<in>A'. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(drSR_Y(r', D, A), b, f, i)\<rangle>) *)
+
+definition ifrFb_body7 where
+  "ifrFb_body7(B,D,A,b,f,x,i) \<equiv> x \<in>
+    (if b = 0 then if i \<in> range(f) then
+        {d \<in> D . \<exists>r\<in>A. restrict(r, B) = converse(f) ` i \<and> d = domain(r)} else 0
+       else {d \<in> D . \<exists>r\<in>A. restrict(r, B) = i \<and> d = domain(r)})"
+
+relativize functional "ifrFb_body7" "ifrFb_body7_rel"
+relationalize "ifrFb_body7_rel" "is_ifrFb_body7"
+
+synthesize "is_ifrFb_body7" from_definition assuming "nonempty"
+arity_theorem for "is_ifrFb_body7_fm"
+
+definition ifrangeF_body7 :: "[i\<Rightarrow>o,i,i,i,i,i,i,i] \<Rightarrow> o" where
+  "ifrangeF_body7(M,A,B,D,G,b,f) \<equiv> \<lambda>y. \<exists>x\<in>A. y = \<langle>x,\<mu> i. ifrFb_body7(B,D,G,b,f,x,i)\<rangle>"
+
+relativize functional "ifrangeF_body7" "ifrangeF_body7_rel"
+relationalize "ifrangeF_body7_rel" "is_ifrangeF_body7"
+
+synthesize "is_ifrangeF_body7" from_definition assuming "nonempty"
+arity_theorem for "is_ifrangeF_body7_fm"
+
+lemma (in M_Z_trans) separation_is_ifrangeF_body7:
+  "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> (##M)(D) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(s) \<Longrightarrow> separation(##M, is_ifrangeF_body7(##M,A,B,D,G,r,s))"
+  using separation_in_ctm[where \<phi>="is_ifrangeF_body7_fm(1,2,3,4,5,6,0)" and env="[A,B,D,G,r,s]"]
+    zero_in_M arity_is_ifrangeF_body7_fm ord_simp_union is_ifrangeF_body7_fm_type
+  by simp
+
+lemma (in M_basic) ifrFb_body7_closed: "M(B) \<Longrightarrow> M(D) \<Longrightarrow> M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow>
+  ifrFb_body7(B,D,G, r, s, x, i) \<longleftrightarrow>  M(i) \<and> ifrFb_body7(B,D,G, r, s, x, i)"
+  using If_abs
+  unfolding ifrangeF_body7_def is_ifrangeF_body7_def ifrFb_body7_def fun_apply_def
+  by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
+
+lemma (in M_basic) is_ifrFb_body7_closed: "M(B) \<Longrightarrow> M(D) \<Longrightarrow> M(G) \<Longrightarrow> M(r) \<Longrightarrow> M(s) \<Longrightarrow>
+  is_ifrFb_body7(M, B,D,G, r, s, x, i) \<Longrightarrow> M(i)"
+  using If_abs
+  unfolding ifrangeF_body7_def is_ifrangeF_body7_def is_ifrFb_body7_def fun_apply_def
+  by (cases "i\<in>range(s)"; cases "r=0"; auto dest:transM)
+
+lemma (in M_ZF2_trans) ifrangeF_body7_abs:
+  assumes "(##M)(A)"  "(##M)(B)" "(##M)(D)" "(##M)(G)" "(##M)(r)" "(##M)(s)" "(##M)(x)"
+  shows "is_ifrangeF_body7(##M,A,B,D,G,r,s,x) \<longleftrightarrow> ifrangeF_body7(##M,A,B,D,G,r,s,x)"
+proof -
+  from assms
+  have sep_dr: "y\<in>M \<Longrightarrow> separation(##M, \<lambda>d . \<exists>r\<in>M . r\<in>G\<and> y = restrict(r, B) \<and> d = domain(r))" for y
+    by(rule_tac separation_cong[where P'="\<lambda>d . \<exists>r\<in> M . r\<in>G \<and> y = restrict(r, B) \<and> d = domain(r)",THEN iffD1,OF _
+          separation_restrict_eq_dom_eq[rule_format,of G B y]],auto simp:transitivity[of _ G])
+
+  from assms
+  have sep_dr'': "y\<in>M \<Longrightarrow> separation(##M, \<lambda>d . \<exists>r\<in>M. r \<in> G \<and> d = domain(r) \<and> converse(s) ` y = restrict(r, B))" for y
+    apply(rule_tac separation_cong[where P'="\<lambda>d . \<exists>r\<in> M . r\<in>G \<and> d = domain(r) \<and> converse(s) ` y = restrict(r, B)",THEN iffD1,OF _ separation_restrict_eq_dom_eq[rule_format,of G B "converse(s) ` y "]])
+    by(auto simp:transitivity[of _ G] apply_closed[simplified] converse_closed[simplified])
+  from assms
+  have sep_dr':"separation(##M, \<lambda>x. \<exists>r\<in>M. r \<in> G \<and> x = domain(r) \<and> 0 = restrict(r, B))"
+    apply(rule_tac separation_cong[where P'="\<lambda>d . \<exists>r\<in> M . r\<in>G \<and> d = domain(r) \<and> 0 = restrict(r, B)",THEN iffD1,OF _ separation_restrict_eq_dom_eq[rule_format,of G B 0]])
+    by(auto simp:transitivity[of _ G] zero_in_M)
+  {
+    fix a
+    assume "a\<in>M"
+    with assms
+    have "(\<mu> i. i\<in> M \<and> is_ifrFb_body7(##M, B,D,G, r, s, z, i))= (\<mu> i. is_ifrFb_body7(##M,B,D, G, r, s, z, i))" for z
+      using is_ifrFb_body7_closed[of B D G r s z]
+      by (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body7(##M,B,D,G,r,s,z,i)"]) auto
+    moreover from this
+    have "(\<mu> i. i\<in>M \<and> is_ifrFb_body7(##M, B,D,G, r, s, z, i))= (\<mu> i. i\<in>M \<and>  ifrFb_body7(B,D,G, r, s, z, i))" if "z\<in>M" for z
+    proof (rule_tac Least_cong[of "\<lambda>i. i\<in>M \<and> is_ifrFb_body7(##M,B,D,G,r,s,z,i)" "\<lambda>i. i\<in>M \<and> ifrFb_body7(B,D,G,r,s,z,i)"])
+      from assms \<open>a\<in>M\<close> \<open>z\<in>M\<close>
+      have "is_ifrFb_body7(##M, B,D,G, r, s, z, y) \<longleftrightarrow> ifrFb_body7(B,D,G, r, s, z, y)" if "y\<in>M" for y
+        using If_abs apply_0
+          separation_closed converse_closed apply_closed range_closed zero_in_M
+          separation_restrict_eq_dom_eq
+          transitivity[of _ D] transitivity[of _ G]  that sep_dr sep_dr' sep_dr''
+        unfolding ifrFb_body7_def is_ifrFb_body7_def
+        by auto
+      then
+      show " y \<in> M \<and> is_ifrFb_body7(##M, B, D, G, r, s, z, y) \<longleftrightarrow> y \<in> M \<and> ifrFb_body7(B, D, G, r, s, z, y)" for y
+        using conj_cong
+        by simp
+    qed
+    moreover from \<open>a\<in>M\<close>
+    have "least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body7(##M, B,D,G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i.  i\<in> M \<and> is_ifrFb_body7(##M,B,D,G, r, s, z,i))" for z
+      using If_abs least_abs'[of "\<lambda>i. (##M)(i) \<and> is_ifrFb_body7(##M,B,D,G,r,s,z,i)" a]
+      by simp
+    ultimately
+    have "z\<in>M \<Longrightarrow> least(##M, \<lambda>i. i \<in> M \<and> is_ifrFb_body7(##M,B,D,G, r, s, z, i), a)
+      \<longleftrightarrow> a = (\<mu> i. ifrFb_body7(B,D,G, r, s, z,i))" for z
+      using Least_cong[OF ifrFb_body7_closed[of B D G r s]] assms
+      by simp
+  }
+  with assms
+  show ?thesis
+    using  pair_in_M_iff apply_closed zero_in_M transitivity[of _ A]
+    unfolding ifrangeF_body7_def is_ifrangeF_body7_def
+    by (auto dest:transM)
+qed
+
+lemma (in M_ZF2_trans) separation_ifrangeF_body7:
+  "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> (##M)(D) \<Longrightarrow> (##M)(G) \<Longrightarrow> (##M)(b) \<Longrightarrow> (##M)(f) \<Longrightarrow>
+    separation(##M,
+      \<lambda>y. \<exists>x\<in>A. y = \<langle>x, \<mu> i. x \<in> if_range_F_else_F(drSR_Y(B, D, G), b, f, i)\<rangle>)"
+  using separation_is_ifrangeF_body7 ifrangeF_body7_abs drSR_Y_equality
+    separation_cong[where P="is_ifrangeF_body7(##M,A,B,D,G,b,f)" and M="##M",THEN iffD1]
+  unfolding ifrangeF_body7_def if_range_F_def if_range_F_else_F_def ifrFb_body7_def
+  by simp
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Separation_Axiom.thy b/thys/Independence_CH/Separation_Axiom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Separation_Axiom.thy
@@ -0,0 +1,399 @@
+section\<open>The Axiom of Separation in $M[G]$\<close>
+theory Separation_Axiom
+  imports Forcing_Theorems Separation_Rename
+begin
+
+context G_generic1
+begin
+
+lemma map_val :
+  assumes "env\<in>list(M[G])"
+  shows "\<exists>nenv\<in>list(M). env = map(val(P,G),nenv)"
+  using assms
+  proof(induct env)
+    case Nil
+    have "map(val(P,G),Nil) = Nil" by simp
+    then show ?case by force
+  next
+    case (Cons a l)
+    then obtain a' l' where
+      "l' \<in> list(M)" "l=map(val(P,G),l')" "a = val(P,G,a')"
+      "Cons(a,l) = map(val(P,G),Cons(a',l'))" "Cons(a',l') \<in> list(M)"
+      using \<open>a\<in>M[G]\<close> GenExtD
+      by force
+    then show ?case by force
+qed
+
+lemma Collect_sats_in_MG :
+  assumes
+    "c\<in>M[G]"
+    "\<phi> \<in> formula" "env\<in>list(M[G])" "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)"
+  shows
+    "{x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)}\<in> M[G]"
+proof -
+  from \<open>c\<in>M[G]\<close>
+  obtain \<pi> where "\<pi> \<in> M" "val(P,G, \<pi>) = c"
+    using GenExt_def by auto
+  let ?\<chi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>" and ?Pl1="[P,leq,\<one>]"
+  let ?new_form="sep_ren(length(env),forces(?\<chi>))"
+  let ?\<psi>="Exists(Exists(And(pair_fm(0,1,2),?new_form)))"
+  note phi = \<open>\<phi>\<in>formula\<close> \<open>arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)\<close>
+  then
+  have "?\<chi>\<in>formula" by simp
+  with \<open>env\<in>_\<close> phi
+  have "arity(?\<chi>) \<le> 2+\<^sub>\<omega>length(env) "
+    using ord_simp_union leI FOL_arities by simp
+  with \<open>env\<in>list(_)\<close> phi
+  have "arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)"
+    using  arity_forces_le by simp
+  then
+  have "arity(forces(?\<chi>)) \<le> 7 +\<^sub>\<omega> length(env)"
+    using ord_simp_union arity_forces leI by simp
+  with \<open>arity(forces(?\<chi>)) \<le>7 +\<^sub>\<omega> _\<close> \<open>env \<in> _\<close> \<open>\<phi> \<in> formula\<close>
+  have "arity(?new_form) \<le> 7 +\<^sub>\<omega> length(env)" "?new_form \<in> formula"
+    using arity_rensep[OF definability[of "?\<chi>"]]  definability[of "?\<chi>"] type_rensep
+    by auto
+  then
+  have "pred(pred(arity(?new_form))) \<le> 5 +\<^sub>\<omega> length(env)" "?\<psi>\<in>formula"
+    unfolding pair_fm_def upair_fm_def
+    using ord_simp_union length_type[OF \<open>env\<in>list(M[G])\<close>]
+        pred_mono[OF _ pred_mono[OF _ \<open>arity(?new_form) \<le> _\<close>]]
+    by auto
+  with \<open>arity(?new_form) \<le> _\<close> \<open>?new_form \<in> formula\<close>
+  have "arity(?\<psi>) \<le> 5 +\<^sub>\<omega> length(env)"
+    unfolding pair_fm_def upair_fm_def
+    using ord_simp_union arity_forces
+    by (auto simp:arity)
+  from \<open>\<phi>\<in>formula\<close>
+  have "forces(?\<chi>) \<in> formula"
+    using definability by simp
+  from \<open>\<pi>\<in>M\<close> P_in_M
+  have "domain(\<pi>)\<in>M" "domain(\<pi>) \<times> P \<in> M"
+    by (simp_all flip:setclass_iff)
+  from \<open>env \<in> _\<close>
+  obtain nenv where "nenv\<in>list(M)" "env = map(val(P,G),nenv)" "length(nenv) = length(env)"
+    using map_val by auto
+  from \<open>arity(\<phi>) \<le> _\<close> \<open>env\<in>_\<close> \<open>\<phi>\<in>_\<close>
+  have "arity(\<phi>) \<le> 2+\<^sub>\<omega> length(env)"
+    using le_trans[OF \<open>arity(\<phi>)\<le>_\<close>] add_le_mono[of 1 2,OF _ le_refl]
+    by auto
+  with \<open>nenv\<in>_\<close> \<open>env\<in>_\<close> \<open>\<pi>\<in>M\<close> \<open>\<phi>\<in>_\<close> \<open>length(nenv) = length(env)\<close>
+  have "arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])" for \<theta>
+    using union_abs2[OF \<open>arity(\<phi>) \<le> 2+\<^sub>\<omega> _\<close>] ord_simp_union FOL_arities
+    by simp
+  note in_M = \<open>\<pi>\<in>M\<close> \<open>domain(\<pi>) \<times> P \<in> M\<close>  P_in_M one_in_M leq_in_M
+  {
+    fix u
+    assume "u \<in> domain(\<pi>) \<times> P" "u \<in> M"
+    with in_M \<open>?new_form \<in> formula\<close> \<open>?\<psi>\<in>formula\<close> \<open>nenv \<in> _\<close>
+    have Eq1: "(M, [u] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
+                        (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
+                          (M, [\<theta>,p,u]@?Pl1@[\<pi>] @ nenv \<Turnstile> ?new_form))"
+      by (auto simp add: transitivity)
+    have Eq3: "\<theta>\<in>M \<Longrightarrow> p\<in>P \<Longrightarrow>
+       (M, [\<theta>,p,u]@?Pl1@[\<pi>]@nenv \<Turnstile> ?new_form) \<longleftrightarrow>
+          (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> (M[F],  map(val(P,F), [\<theta>] @ nenv@[\<pi>]) \<Turnstile>  ?\<chi>))"
+      for \<theta> p
+    proof -
+      fix p \<theta>
+      assume "\<theta> \<in> M" "p\<in>P"
+      then
+      have "p\<in>M" using P_in_M by (simp add: transitivity)
+      note in_M' = in_M \<open>\<theta> \<in> M\<close> \<open>p\<in>M\<close> \<open>u \<in> domain(\<pi>) \<times> P\<close> \<open>u \<in> M\<close> \<open>nenv\<in>_\<close>
+      then
+      have "[\<theta>,u] \<in> list(M)" by simp
+      let ?env="[p]@?Pl1@[\<theta>] @ nenv @ [\<pi>,u]"
+      let ?new_env=" [\<theta>,p,u,P,leq,\<one>,\<pi>] @ nenv"
+      let ?\<psi>="Exists(Exists(And(pair_fm(0,1,2),?new_form)))"
+      have "[\<theta>, p, u, \<pi>, leq, \<one>, \<pi>] \<in> list(M)"
+        using in_M' by simp
+      have "?\<chi> \<in> formula" "forces(?\<chi>)\<in> formula"
+        using phi by simp_all
+      from in_M'
+      have "?Pl1 \<in> list(M)" by simp
+      from in_M' have "?env \<in> list(M)" by simp
+      have Eq1': "?new_env \<in> list(M)" using in_M'  by simp
+      then
+      have "(M, [\<theta>,p,u]@?Pl1@[\<pi>] @ nenv \<Turnstile> ?new_form) \<longleftrightarrow> (M, ?new_env \<Turnstile> ?new_form)"
+        by simp
+      from in_M' \<open>env \<in> _\<close> Eq1' \<open>length(nenv) = length(env)\<close>
+        \<open>arity(forces(?\<chi>)) \<le> 7 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>)\<in> formula\<close>
+        \<open>[\<theta>, p, u, \<pi>, leq, \<one>, \<pi>] \<in> list(M)\<close>
+      have "... \<longleftrightarrow> M, ?env \<Turnstile> forces(?\<chi>)"
+        using sepren_action[of "forces(?\<chi>)"  "nenv",OF _ _ \<open>nenv\<in>list(M)\<close>]
+        by simp
+      also from in_M'
+      have "... \<longleftrightarrow> M,  ([p,P, leq, \<one>,\<theta>]@nenv@ [\<pi>])@[u] \<Turnstile> forces(?\<chi>)"
+        using app_assoc by simp
+      also
+      from in_M' \<open>env\<in>_\<close> phi \<open>length(nenv) = length(env)\<close>
+        \<open>arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>)\<in>formula\<close>
+      have "... \<longleftrightarrow> M,  [p,P, leq, \<one>,\<theta>]@ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)"
+        by (rule_tac arity_sats_iff,auto)
+      also
+      from \<open>arity(forces(?\<chi>)) \<le> 6 +\<^sub>\<omega> length(env)\<close> \<open>forces(?\<chi>)\<in>formula\<close> in_M' phi
+      have " ... \<longleftrightarrow> (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
+                           M[F],  map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>)"
+      proof (intro iffI)
+        assume a1: "M,  [p,P, leq, \<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile>  forces(?\<chi>)"
+        note \<open>arity(\<phi>)\<le> 1+\<^sub>\<omega>_\<close>
+        with \<open>nenv\<in>_\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close> \<open>env\<in>_\<close>
+        have "p \<in> P \<Longrightarrow> ?\<chi>\<in>formula \<Longrightarrow> [\<theta>,\<pi>] \<in> list(M) \<Longrightarrow>
+                  M, [p,P, leq, \<one>] @ [\<theta>]@ nenv@[\<pi>] \<Turnstile> forces(?\<chi>) \<Longrightarrow>
+              \<forall>G. M_generic(G) \<and> p \<in> G \<longrightarrow> M[G],  map(val(P,G), [\<theta>] @ nenv @[\<pi>]) \<Turnstile> ?\<chi>"
+          using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
+          by auto
+        then
+        show "\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
+                  M[F],  map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>"
+          using  \<open>?\<chi>\<in>formula\<close> \<open>p\<in>P\<close> a1 \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> by simp
+      next
+        assume "\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
+                   M[F],  map(val(P,F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile>  ?\<chi>"
+        with \<open>?\<chi>\<in>formula\<close> \<open>p\<in>P\<close> in_M'
+          \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
+        show "M,  [p, P, leq, \<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile>  forces(?\<chi>)"
+          using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>",
+              THEN iffD2] by auto
+      qed
+      finally
+      show "(M, [\<theta>,p,u]@?Pl1@[\<pi>]@nenv \<Turnstile> ?new_form) \<longleftrightarrow> (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
+                           M[F],  map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>)"
+        by simp
+    qed
+    with Eq1
+    have "(M, [u] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
+         (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
+          (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> M[F],  map(val(P,F), [\<theta>] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>))"
+      by auto
+  }
+  then
+  have Equivalence: "u\<in> domain(\<pi>) \<times> P \<Longrightarrow> u \<in> M \<Longrightarrow>
+       (M, [u] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longleftrightarrow>
+         (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
+          (\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow> M[F],   map(val(P,F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile>  ?\<chi>))"
+    for u
+    by simp
+  moreover from \<open>env = _\<close> \<open>\<pi>\<in>M\<close> \<open>nenv\<in>list(M)\<close>
+  have map_nenv:"map(val(P,G), nenv@[\<pi>]) = env @ [val(P,G,\<pi>)]"
+    using map_app_distrib append1_eq_iff by auto
+  ultimately
+  have aux:"(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> M[G], [val(P,G,\<theta>)] @ env @ [val(P,G,\<pi>)] \<Turnstile> ?\<chi>))"
+   (is "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. _ ( _ \<longrightarrow> _, ?vals(\<theta>) \<Turnstile> _))")
+   if "u \<in> domain(\<pi>) \<times> P" "u \<in> M"  "M, [u]@ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
+    using Equivalence[THEN iffD1, OF that] generic by force
+  moreover
+  have "\<theta>\<in>M \<Longrightarrow> val(P,G,\<theta>)\<in>M[G]" for \<theta>
+    using GenExt_def by auto
+  moreover
+  have "\<theta>\<in> M \<Longrightarrow> [val(P,G, \<theta>)] @ env @ [val(P,G, \<pi>)] \<in> list(M[G])" for \<theta>
+  proof -
+    from \<open>\<pi>\<in>M\<close>
+    have "val(P,G,\<pi>)\<in> M[G]" using GenExtI by simp
+    moreover
+    assume "\<theta> \<in> M"
+    moreover
+    note \<open>env \<in> list(M[G])\<close>
+    ultimately
+    show ?thesis
+      using GenExtI by simp
+  qed
+  ultimately
+  have "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u=\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> val(P,G,\<theta>)\<in>nth(1 +\<^sub>\<omega> length(env),[val(P,G, \<theta>)] @ env @ [val(P,G, \<pi>)])
+        \<and> (M[G], ?vals(\<theta>) \<Turnstile>  \<phi>)))"
+    if "u \<in> domain(\<pi>) \<times> P" "u \<in> M"  "M, [u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
+    using aux[OF that] by simp
+  moreover from \<open>env \<in> _\<close> \<open>\<pi>\<in>M\<close>
+  have nth:"nth(1 +\<^sub>\<omega> length(env),[val(P,G, \<theta>)] @ env @ [val(P,G, \<pi>)]) = val(P,G,\<pi>)"
+    if "\<theta>\<in>M" for \<theta>
+    using nth_concat[of "val(P,G,\<theta>)" "val(P,G,\<pi>)" "M[G]"] using that GenExtI by simp
+  ultimately
+  have "(\<exists>\<theta>\<in>M. \<exists>p\<in>P. u=\<langle>\<theta>,p\<rangle> \<and> (p\<in>G \<longrightarrow> val(P,G,\<theta>)\<in>val(P,G,\<pi>) \<and> (M[G],?vals(\<theta>) \<Turnstile>  \<phi>)))"
+    if "u \<in> domain(\<pi>) \<times> P" "u \<in> M"  "M, [u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>" for u
+    using that \<open>\<pi>\<in>M\<close> \<open>env \<in> _\<close> by simp
+  with \<open>domain(\<pi>)\<times>P\<in>M\<close>
+  have "\<forall>u\<in>domain(\<pi>)\<times>P . (M, [u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>) \<longrightarrow> (\<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
+        (p \<in> G \<longrightarrow> val(P,G, \<theta>)\<in>val(P,G, \<pi>) \<and> (M[G],?vals(\<theta>) \<Turnstile>  \<phi>)))"
+    by (simp add:transitivity)
+  then
+  have "{u\<in>domain(\<pi>)\<times>P . (M,[u] @ ?Pl1 @[\<pi>] @ nenv \<Turnstile> ?\<psi>) } \<subseteq>
+     {u\<in>domain(\<pi>)\<times>P . \<exists>\<theta>\<in>M. \<exists>p\<in>P. u =\<langle>\<theta>,p\<rangle> \<and>
+       (p \<in> G \<longrightarrow> val(P,G, \<theta>)\<in>val(P,G, \<pi>) \<and> (M[G], ?vals(\<theta>) \<Turnstile> \<phi>))}"
+    (is "?n\<subseteq>?m")
+    by auto
+  with val_mono
+  have first_incl: "val(P,G,?n) \<subseteq> val(P,G,?m)"
+    by simp
+  note  \<open>val(P,G,\<pi>) = c\<close> (* from the assumptions *)
+  with \<open>?\<psi>\<in>formula\<close>  \<open>arity(?\<psi>) \<le> _\<close> in_M \<open>nenv \<in> _\<close> \<open>env \<in> _\<close> \<open>length(nenv) = _\<close>
+  have "?n\<in>M"
+    using separation_ax leI separation_iff by auto
+  from generic
+  have "filter(G)" "G\<subseteq>P"
+    unfolding M_generic_def filter_def by simp_all
+  from \<open>val(P,G,\<pi>) = c\<close>
+  have "val(P,G,?m) =
+               {z . t\<in>domain(\<pi>) , (\<exists>q\<in>P .
+                    (\<exists>\<theta>\<in>M. \<exists>p\<in>P. \<langle>t,q\<rangle> = \<langle>\<theta>, p\<rangle> \<and>
+            (p \<in> G \<longrightarrow> val(P,G, \<theta>) \<in> c \<and> (M[G],  [val(P,G, \<theta>)] @ env @ [c] \<Turnstile>  \<phi>)) \<and> q \<in> G)) \<and>
+           z=val(P,G,t)}"
+    using val_of_name by auto
+  also
+  have "... =  {z . t\<in>domain(\<pi>) , (\<exists>q\<in>P.
+                   val(P,G, t) \<in> c \<and> (M[G],  [val(P,G, t)] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G) \<and> z=val(P,G,t)}"
+  proof -
+    have "t\<in>M \<Longrightarrow>
+      (\<exists>q\<in>P. (\<exists>\<theta>\<in>M. \<exists>p\<in>P. \<langle>t,q\<rangle> = \<langle>\<theta>, p\<rangle> \<and>
+              (p \<in> G \<longrightarrow> val(P,G, \<theta>) \<in> c \<and> (M[G],  [val(P,G, \<theta>)] @ env @ [c] \<Turnstile>  \<phi>)) \<and> q \<in> G))
+      \<longleftrightarrow>
+      (\<exists>q\<in>P. val(P,G, t) \<in> c \<and> ( M[G], [val(P,G, t)]@env@[c]\<Turnstile> \<phi> ) \<and> q \<in> G)" for t
+      by auto
+    then show ?thesis using \<open>domain(\<pi>)\<in>M\<close> by (auto simp add:transitivity)
+  qed
+  also
+  have "... =  {x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G}"
+  proof
+    show "... \<subseteq> {x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G}"
+      by auto
+  next
+    (* Now we show the other inclusion:
+      {x .. x\<in>c , \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x, w, c] \<Turnstile>  \<phi>) \<and> q \<in> G}
+      \<subseteq>
+      {val(P,G,t)..t\<in>domain(\<pi>),\<exists>q\<in>P.val(P,G,t)\<in>c\<and>(M[G], [val(P,G,t),w] \<Turnstile> \<phi>)\<and>q\<in>G}
+    *)
+    {
+      fix x
+      assume "x\<in>{x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G}"
+      then
+      have "\<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G"
+        by simp
+      with \<open>val(P,G,\<pi>) = c\<close>
+      have "\<exists>q\<in>P. \<exists>t\<in>domain(\<pi>). val(P,G,t) =x \<and> (M[G],  [val(P,G,t)] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G"
+        using elem_of_val by auto
+    }
+    then
+    show " {x\<in>c . \<exists>q\<in>P. x \<in> c \<and> (M[G],  [x] @ env @ [c] \<Turnstile>  \<phi>) \<and> q \<in> G} \<subseteq> ..."
+      by force
+  qed
+  also
+  have " ... = {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}"
+    using \<open>G\<subseteq>P\<close> G_nonempty by force
+  finally
+  have val_m: "val(P,G,?m) = {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}" by simp
+  have "val(P,G,?m) \<subseteq> val(P,G,?n)"
+  proof
+    fix x
+    assume "x \<in> val(P,G,?m)"
+    with val_m
+    have Eq4: "x \<in> {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}" by simp
+    with \<open>val(P,G,\<pi>) = c\<close>
+    have "x \<in> val(P,G,\<pi>)" by simp
+    then
+    have "\<exists>\<theta>. \<exists>q\<in>G. \<langle>\<theta>,q\<rangle>\<in>\<pi> \<and> val(P,G,\<theta>) =x"
+      using elem_of_val_pair by auto
+    then obtain \<theta> q where
+      "\<langle>\<theta>,q\<rangle>\<in>\<pi>" "q\<in>G" "val(P,G,\<theta>)=x" by auto
+    from \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close>
+    have "\<theta>\<in>M"
+      using domain_trans[OF trans_M \<open>\<pi>\<in>_\<close>] by auto
+    with \<open>\<pi>\<in>M\<close> \<open>nenv \<in> _\<close> \<open>env = _\<close>
+    have "[val(P,G,\<theta>), val(P,G,\<pi>)] @ env \<in>list(M[G])"
+      using GenExt_def by auto
+    with  Eq4 \<open>val(P,G,\<theta>)=x\<close> \<open>val(P,G,\<pi>) = c\<close> \<open>x \<in> val(P,G,\<pi>)\<close> nth \<open>\<theta>\<in>M\<close>
+    have Eq5: "M[G],  [val(P,G,\<theta>)] @ env @[val(P,G,\<pi>)] \<Turnstile> And(Member(0,1 +\<^sub>\<omega> length(env)),\<phi>)"
+      by auto
+        (* Recall ?\<chi> = And(Member(0,1 +\<^sub>\<omega> length(env)),\<phi>) *)
+    with \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close>  Eq5 \<open>M_generic(G)\<close> \<open>\<phi>\<in>formula\<close> \<open>nenv \<in> _ \<close> \<open>env = _ \<close> map_nenv
+      \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
+    have "(\<exists>r\<in>G. M,  [r,P,leq,\<one>,\<theta>] @ nenv @[\<pi>] \<Turnstile> forces(?\<chi>))"
+      using truth_lemma[of "\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
+      by auto
+    then obtain r where      (* I can't "obtain" this directly *)
+      "r\<in>G" "M,  [r,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)" by auto
+    with \<open>filter(G)\<close> and \<open>q\<in>G\<close> obtain p where
+      "p\<in>G" "p\<preceq>q" "p\<preceq>r"
+      unfolding filter_def compat_in_def by force
+    with \<open>r\<in>G\<close>  \<open>q\<in>G\<close> \<open>G\<subseteq>P\<close>
+    have "p\<in>P" "r\<in>P" "q\<in>P" "p\<in>M"
+      using  P_in_M  by (auto simp add:transitivity)
+    with \<open>\<phi>\<in>formula\<close> \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close>  \<open>p\<preceq>r\<close> \<open>nenv \<in> _\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
+      \<open>M, [r,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)\<close> \<open>env\<in>_\<close>
+    have "M,  [p,P,leq,\<one>,\<theta>] @ nenv @ [\<pi>] \<Turnstile> forces(?\<chi>)"
+      using strengthening_lemma
+      by simp
+    with \<open>p\<in>P\<close> \<open>\<phi>\<in>formula\<close> \<open>\<theta>\<in>M\<close> \<open>\<pi>\<in>M\<close> \<open>nenv \<in> _\<close> \<open>arity(?\<chi>) \<le> length([\<theta>] @ nenv @ [\<pi>])\<close>
+    have "\<forall>F. M_generic(F) \<and> p \<in> F \<longrightarrow>
+                 M[F],   map(val(P,F), [\<theta>] @ nenv @[\<pi>]) \<Turnstile>  ?\<chi>"
+      using definition_of_forcing[where \<phi>="\<cdot>\<cdot> 0 \<in> (1 +\<^sub>\<omega> length(env)) \<cdot> \<and> \<phi> \<cdot>"]
+      by simp
+    with \<open>p\<in>P\<close> \<open>\<theta>\<in>M\<close>
+    have Eq6: "\<exists>\<theta>'\<in>M. \<exists>p'\<in>P.  \<langle>\<theta>,p\<rangle> = <\<theta>',p'> \<and> (\<forall>F. M_generic(F) \<and> p' \<in> F \<longrightarrow>
+                 M[F],   map(val(P,F), [\<theta>'] @ nenv @ [\<pi>]) \<Turnstile>  ?\<chi>)" by auto
+    from \<open>\<pi>\<in>M\<close> \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close>
+    have "\<langle>\<theta>,q\<rangle> \<in> M" by (simp add:transitivity)
+    from \<open>\<langle>\<theta>,q\<rangle>\<in>\<pi>\<close> \<open>\<theta>\<in>M\<close> \<open>p\<in>P\<close>  \<open>p\<in>M\<close>
+    have "\<langle>\<theta>,p\<rangle>\<in>M" "\<langle>\<theta>,p\<rangle>\<in>domain(\<pi>)\<times>P"
+      using pair_in_M_iff by auto
+    with \<open>\<theta>\<in>M\<close> Eq6 \<open>p\<in>P\<close>
+    have "M, [\<langle>\<theta>,p\<rangle>] @ ?Pl1 @ [\<pi>] @ nenv \<Turnstile> ?\<psi>"
+      using Equivalence  by auto
+    with \<open>\<langle>\<theta>,p\<rangle>\<in>domain(\<pi>)\<times>P\<close>
+    have "\<langle>\<theta>,p\<rangle>\<in>?n" by simp
+    with \<open>p\<in>G\<close> \<open>p\<in>P\<close>
+    have "val(P,G,\<theta>)\<in>val(P,G,?n)"
+      using  val_of_elem[of \<theta> p] by simp
+    with \<open>val(P,G,\<theta>)=x\<close>
+    show "x\<in>val(P,G,?n)" by simp
+  qed (* proof of "val(P,G,?m) \<subseteq> val(P,G,?n)" *)
+  with val_m first_incl
+  have "val(P,G,?n) = {x\<in>c. (M[G], [x] @ env @ [c] \<Turnstile> \<phi>)}" by auto
+  also
+  have " ... = {x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)}"
+  proof -
+    {
+      fix x
+      assume "x\<in>c"
+      moreover from assms
+      have "c\<in>M[G]"
+        unfolding GenExt_def by auto
+      moreover from this and \<open>x\<in>c\<close>
+      have "x\<in>M[G]"
+        using transitivity_MG
+        by simp
+      ultimately
+      have "(M[G],  ([x] @ env) @[c] \<Turnstile>  \<phi>) \<longleftrightarrow> (M[G],  [x] @ env \<Turnstile>  \<phi>)"
+        using phi \<open>env \<in> _\<close> by (rule_tac arity_sats_iff, simp_all)   (* Enhance this *)
+    }
+    then show ?thesis by auto
+  qed
+  finally
+  show "{x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)}\<in> M[G]"
+    using \<open>?n\<in>M\<close> GenExt_def by force
+qed
+
+theorem separation_in_MG:
+  assumes
+    "\<phi>\<in>formula" and "arity(\<phi>) \<le> 1 +\<^sub>\<omega> length(env)" and "env\<in>list(M[G])"
+  shows
+    "separation(##M[G],\<lambda>x. (M[G], [x] @ env \<Turnstile> \<phi>))"
+proof -
+  {
+    fix c
+    assume "c\<in>M[G]"
+    moreover from \<open>env \<in> _\<close>
+    obtain nenv where  "nenv\<in>list(M)"
+      "env = map(val(P,G),nenv)" "length(env) = length(nenv)"
+      using GenExt_def map_val[of env] by auto
+    moreover note \<open>\<phi> \<in> _\<close> \<open>arity(\<phi>) \<le> _\<close> \<open>env \<in> _\<close>
+    ultimately
+    have Eq1: "{x\<in>c. (M[G], [x] @ env \<Turnstile> \<phi>)} \<in> M[G]"
+      using Collect_sats_in_MG  by auto
+  }
+  then
+  show ?thesis
+    using separation_iff rev_bexI unfolding is_Collect_def by force
+qed
+
+end \<comment> \<open>\<^locale>\<open>G_generic1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Separation_Instances.thy b/thys/Independence_CH/Separation_Instances.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Separation_Instances.thy
@@ -0,0 +1,234 @@
+subsection\<open>More Instances of Separation\<close>
+
+theory Separation_Instances
+  imports
+    Names
+begin
+
+text\<open>The following instances are mostly the same repetitive task; and we just
+copied and pasted, tweaking some lemmas if needed (for example, we might have
+needed to use some closedness results).
+\<close>
+
+definition radd_body :: "[i,i,i] \<Rightarrow> o" where
+  "radd_body(R,S) \<equiv> \<lambda>z. (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>) \<or>
+                  (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x', x\<rangle> \<in> R) \<or>
+                  (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y', y\<rangle> \<in> S)"
+
+relativize functional "radd_body" "radd_body_rel"
+relationalize "radd_body_rel" "is_radd_body"
+
+synthesize "is_radd_body" from_definition
+arity_theorem for "is_radd_body_fm"
+
+lemma (in M_ZF1_trans) radd_body_abs:
+  assumes "(##M)(R)" "(##M)(S)" "(##M)(x)"
+  shows "is_radd_body(##M,R,S,x) \<longleftrightarrow> radd_body(R,S,x)"
+  using assms pair_in_M_iff Inl_in_M_iff Inr_in_M_iff
+  unfolding radd_body_def is_radd_body_def
+  by (auto)
+
+lemma (in M_ZF1_trans) separation_radd_body:
+ "(##M)(R) \<Longrightarrow> (##M)(S) \<Longrightarrow> separation
+        (##M, \<lambda>z. (\<exists>x y. z = \<langle>Inl(x), Inr(y)\<rangle>) \<or>
+                  (\<exists>x' x. z = \<langle>Inl(x'), Inl(x)\<rangle> \<and> \<langle>x', x\<rangle> \<in> R) \<or>
+                  (\<exists>y' y. z = \<langle>Inr(y'), Inr(y)\<rangle> \<and> \<langle>y', y\<rangle> \<in> S))"
+  using separation_in_ctm[where \<phi>="is_radd_body_fm(1,2,0)" and env="[R,S]"]
+    is_radd_body_def arity_is_radd_body_fm ord_simp_union is_radd_body_fm_type radd_body_abs
+  unfolding radd_body_def
+  by simp
+
+definition rmult_body :: "[i,i,i] \<Rightarrow> o" where
+  "rmult_body(b,d) \<equiv> \<lambda>z. \<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in>
+b \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> d)"
+
+relativize functional "rmult_body" "rmult_body_rel"
+relationalize "rmult_body_rel" "is_rmult_body"
+
+synthesize "is_rmult_body" from_definition
+arity_theorem for "is_rmult_body_fm"
+
+lemma (in M_ZF1_trans) rmult_body_abs:
+  assumes "(##M)(b)" "(##M)(d)" "(##M)(x)"
+  shows "is_rmult_body(##M,b,d,x) \<longleftrightarrow> rmult_body(b,d,x)"
+  using assms pair_in_M_iff apply_closed
+  unfolding rmult_body_def is_rmult_body_def
+  by (auto)
+
+lemma (in M_ZF1_trans) separation_rmult_body:
+ "(##M)(b) \<Longrightarrow> (##M)(d) \<Longrightarrow> separation
+        (##M, \<lambda>z. \<exists>x' y' x y. z = \<langle>\<langle>x', y'\<rangle>, x, y\<rangle> \<and> (\<langle>x', x\<rangle> \<in> b \<or> x' = x \<and> \<langle>y', y\<rangle> \<in> d))"
+  using separation_in_ctm[where \<phi>="is_rmult_body_fm(1,2,0)" and env="[b,d]"]
+    is_rmult_body_def arity_is_rmult_body_fm ord_simp_union is_rmult_body_fm_type rmult_body_abs
+  unfolding rmult_body_def
+  by simp
+
+lemma (in M_replacement) separation_well_ord:
+  "(M)(f) \<Longrightarrow> (M)(r) \<Longrightarrow> (M)(A) \<Longrightarrow> separation
+        (M, \<lambda>x. x \<in> A \<longrightarrow> (\<exists>y[M]. \<exists>p[M]. is_apply(M, f, x, y) \<and> pair(M, y, x, p) \<and> p \<in> r))"
+  using separation_imp  separation_in lam_replacement_identity lam_replacement_constant
+    lam_replacement_apply[of f] lam_replacement_Pair[THEN [5] lam_replacement_hcomp2]
+  by simp
+
+definition is_obase_body :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
+  "is_obase_body(N,A,r,x) \<equiv> x \<in> A \<longrightarrow>
+                  \<not> (\<exists>y[N].
+                         \<exists>g[N].
+                            ordinal(N, y) \<and>
+                            (\<exists>my[N].
+                                \<exists>pxr[N].
+                                   membership(N, y, my) \<and>
+                                   pred_set(N, A, x, r, pxr) \<and>
+                                   order_isomorphism(N, pxr, r, y, my, g)))"
+
+synthesize "is_obase_body" from_definition
+arity_theorem for "is_obase_body_fm"
+
+lemma (in M_ZF1_trans) separation_is_obase:
+ "(##M)(f) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(A) \<Longrightarrow> separation
+        (##M, \<lambda>x. x \<in> A \<longrightarrow>
+                  \<not> (\<exists>y[##M].
+                         \<exists>g[##M].
+                            ordinal(##M, y) \<and>
+                            (\<exists>my[##M].
+                                \<exists>pxr[##M].
+                                   membership(##M, y, my) \<and>
+                                   pred_set(##M, A, x, r, pxr) \<and>
+                                   order_isomorphism(##M, pxr, r, y, my, g))))"
+  using separation_in_ctm[where \<phi>="is_obase_body_fm(1,2,0)" and env="[A,r]"]
+    is_obase_body_def arity_is_obase_body_fm ord_simp_union is_obase_body_fm_type
+  by simp
+
+definition is_obase_equals :: "[i\<Rightarrow>o,i,i,i] \<Rightarrow> o" where
+  "is_obase_equals(N,A,r,a) \<equiv> \<exists>x[N].
+                     \<exists>g[N].
+                        \<exists>mx[N].
+                           \<exists>par[N].
+                              ordinal(N, x) \<and>
+                              membership(N, x, mx) \<and>
+                              pred_set(N, A, a, r, par) \<and> order_isomorphism(N, par, r, x, mx, g)"
+
+synthesize "is_obase_equals" from_definition
+arity_theorem for "is_obase_equals_fm"
+
+lemma (in M_ZF1_trans) separation_obase_equals:
+ "(##M)(f) \<Longrightarrow> (##M)(r) \<Longrightarrow> (##M)(A) \<Longrightarrow> separation
+        (##M, \<lambda>a. \<exists>x[##M].
+                     \<exists>g[##M].
+                        \<exists>mx[##M].
+                           \<exists>par[##M].
+                              ordinal(##M, x) \<and>
+                              membership(##M, x, mx) \<and>
+                              pred_set(##M, A, a, r, par) \<and> order_isomorphism(##M, par, r, x, mx, g))"
+  using separation_in_ctm[where \<phi>="is_obase_equals_fm(1,2,0)" and env="[A,r]"]
+    is_obase_equals_def arity_is_obase_equals_fm ord_simp_union is_obase_equals_fm_type
+  by simp
+
+synthesize "PiP_rel" from_definition assuming "nonempty"
+arity_theorem for "PiP_rel_fm"
+
+lemma (in M_ZF1_trans) separation_PiP_rel:
+ "(##M)(A) \<Longrightarrow> separation(##M, PiP_rel(##M,A))"
+  using separation_in_ctm[where env="[A]" and \<phi>="PiP_rel_fm(1,0)"]
+    nonempty PiP_rel_iff_sats[symmetric] arity_PiP_rel_fm PiP_rel_fm_type
+  by(simp_all add: ord_simp_union)
+
+synthesize "injP_rel" from_definition assuming "nonempty"
+arity_theorem for "injP_rel_fm"
+
+lemma (in M_ZF1_trans) separation_injP_rel:
+ "(##M)(A) \<Longrightarrow> separation(##M, injP_rel(##M,A))"
+  using separation_in_ctm[where env="[A]" and \<phi>="injP_rel_fm(1,0)"]
+    nonempty injP_rel_iff_sats[symmetric] arity_injP_rel_fm injP_rel_fm_type
+  by(simp_all add: ord_simp_union)
+
+synthesize "surjP_rel" from_definition assuming "nonempty"
+arity_theorem for "surjP_rel_fm"
+
+lemma (in M_ZF1_trans) separation_surjP_rel:
+ "(##M)(A) \<Longrightarrow> (##M)(B) \<Longrightarrow> separation(##M, surjP_rel(##M,A,B))"
+  using separation_in_ctm[where env="[A,B]" and \<phi>="surjP_rel_fm(1,2,0)"]
+    nonempty surjP_rel_iff_sats[symmetric] arity_surjP_rel_fm surjP_rel_fm_type
+  by(simp_all add: ord_simp_union)
+
+synthesize "cons_like_rel" from_definition assuming "nonempty"
+arity_theorem for "cons_like_rel_fm"
+
+lemma (in M_ZF1_trans) separation_cons_like_rel:
+ "separation(##M, cons_like_rel(##M))"
+  using separation_in_ctm[where env="[]" and \<phi>="cons_like_rel_fm(0)"]
+    nonempty cons_like_rel_iff_sats[symmetric] arity_cons_like_rel_fm cons_like_rel_fm_type
+  by simp
+
+lemma (in M_ZF1_trans) separation_is_function:
+ "separation(##M, is_function(##M))"
+  using separation_in_ctm[where env="[]" and \<phi>="function_fm(0)"] arity_function_fm
+  by simp
+
+(* Instances in M_replacement*)
+
+definition fstsnd_in_sndsnd :: "[i] \<Rightarrow> o" where
+  "fstsnd_in_sndsnd \<equiv> \<lambda>x. fst(snd(x)) \<in> snd(snd(x))"
+relativize "fstsnd_in_sndsnd" "is_fstsnd_in_sndsnd"
+synthesize "is_fstsnd_in_sndsnd" from_definition assuming "nonempty"
+arity_theorem for "is_fstsnd_in_sndsnd_fm"
+
+lemma (in M_ZF1_trans) fstsnd_in_sndsnd_abs:
+  assumes "(##M)(x)"
+  shows "is_fstsnd_in_sndsnd(##M,x) \<longleftrightarrow> fstsnd_in_sndsnd(x)"
+  using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
+  unfolding fstsnd_in_sndsnd_def is_fstsnd_in_sndsnd_def
+  by auto
+
+lemma (in M_ZF1_trans) separation_fstsnd_in_sndsnd:
+ "separation(##M, \<lambda>x. fst(snd(x)) \<in> snd(snd(x)))"
+  using separation_in_ctm[where env="[]" and \<phi>="is_fstsnd_in_sndsnd_fm(0)" and Q=fstsnd_in_sndsnd]
+    nonempty fstsnd_in_sndsnd_abs arity_is_fstsnd_in_sndsnd_fm
+  unfolding fstsnd_in_sndsnd_def
+  by simp
+
+definition sndfst_eq_fstsnd :: "[i] \<Rightarrow> o" where
+  "sndfst_eq_fstsnd \<equiv> \<lambda>x. snd(fst(x)) = fst(snd(x))"
+relativize "sndfst_eq_fstsnd" "is_sndfst_eq_fstsnd"
+synthesize "is_sndfst_eq_fstsnd" from_definition assuming "nonempty"
+arity_theorem for "is_sndfst_eq_fstsnd_fm"
+
+lemma (in M_ZF1_trans) sndfst_eq_fstsnd_abs:
+  assumes "(##M)(x)"
+  shows "is_sndfst_eq_fstsnd(##M,x) \<longleftrightarrow> sndfst_eq_fstsnd(x)"
+  using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
+  unfolding sndfst_eq_fstsnd_def is_sndfst_eq_fstsnd_def
+  by auto
+
+lemma (in M_ZF1_trans) separation_sndfst_eq_fstsnd:
+ "separation(##M, \<lambda>x. snd(fst(x)) = fst(snd(x)))"
+  using separation_in_ctm[where env="[]" and \<phi>="is_sndfst_eq_fstsnd_fm(0)" and Q=sndfst_eq_fstsnd]
+    nonempty sndfst_eq_fstsnd_abs arity_is_sndfst_eq_fstsnd_fm
+  unfolding sndfst_eq_fstsnd_def
+  by simp
+
+(*  "M(G) \<Longrightarrow> M(Q) \<Longrightarrow> separation(M, \<lambda>p. \<forall>x\<in>G. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> Q))" *)
+definition insnd_ballPair :: "[i,i,i] \<Rightarrow> o" where
+  "insnd_ballPair(B,A) \<equiv> \<lambda>p. \<forall>x\<in>B. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> A)"
+
+relativize "insnd_ballPair" "is_insnd_ballPair"
+synthesize "is_insnd_ballPair" from_definition assuming "nonempty"
+arity_theorem for "is_insnd_ballPair_fm"
+
+lemma (in M_ZF1_trans) insnd_ballPair_abs:
+  assumes "(##M)(B)" "(##M)(A)" "(##M)(x)"
+  shows "is_insnd_ballPair(##M,B,A,x) \<longleftrightarrow> insnd_ballPair(B,A,x)"
+  using assms pair_in_M_iff fst_abs snd_abs fst_snd_closed
+    transM[of _ B] transM[of _ "snd(x)"] transM[of _ "fst(x)"]
+  unfolding insnd_ballPair_def is_insnd_ballPair_def
+  by (auto)
+
+lemma (in M_ZF1_trans) separation_insnd_ballPair:
+ "(##M)(B) \<Longrightarrow> (##M)(A) \<Longrightarrow> separation(##M, \<lambda>p. \<forall>x\<in>B. x \<in> snd(p) \<longleftrightarrow> (\<forall>s\<in>fst(p). \<langle>s, x\<rangle> \<in> A))"
+  using insnd_ballPair_abs nonempty
+    separation_in_ctm[where \<phi>="is_insnd_ballPair_fm(2,1,0)" and env="[A,B]"]
+    arity_is_insnd_ballPair_fm ord_simp_union is_insnd_ballPair_fm_type
+  unfolding insnd_ballPair_def
+  by simp
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Separation_Rename.thy b/thys/Independence_CH/Separation_Rename.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Separation_Rename.thy
@@ -0,0 +1,519 @@
+section\<open>Auxiliary renamings for Separation\<close>
+theory Separation_Rename
+  imports
+    Interface
+begin
+
+lemmas apply_fun = apply_iff[THEN iffD1]
+
+lemma nth_concat : "[p,t] \<in> list(A) \<Longrightarrow> env\<in> list(A) \<Longrightarrow> nth(1 +\<^sub>\<omega> length(env),[p]@ env @ [t]) = t"
+  by(auto simp add:nth_append)
+
+lemma nth_concat2 : "env\<in> list(A) \<Longrightarrow> nth(length(env),env @ [p,t]) = p"
+  by(auto simp add:nth_append)
+
+lemma nth_concat3 : "env\<in> list(A) \<Longrightarrow> u = nth(succ(length(env)), env @ [pi, u])"
+  by(auto simp add:nth_append)
+
+definition
+  sep_var :: "i \<Rightarrow> i" where
+  "sep_var(n) \<equiv> {\<langle>0,1\<rangle>,\<langle>1,3\<rangle>,\<langle>2,4\<rangle>,\<langle>3,5\<rangle>,\<langle>4,0\<rangle>,\<langle>5+\<^sub>\<omega>n,6\<rangle>,\<langle>6+\<^sub>\<omega>n,2\<rangle>}"
+
+definition
+  sep_env :: "i \<Rightarrow> i" where
+  "sep_env(n) \<equiv> \<lambda> i \<in> (5+\<^sub>\<omega>n)-5 . i+\<^sub>\<omega>2"
+
+definition weak :: "[i, i] \<Rightarrow> i" where
+  "weak(n,m) \<equiv> {i+\<^sub>\<omega>m . i \<in> n}"
+
+lemma weakD :
+  assumes "n \<in> nat" "k\<in>nat" "x \<in> weak(n,k)"
+  shows "\<exists> i \<in> n . x = i+\<^sub>\<omega>k"
+  using assms unfolding weak_def by blast
+
+lemma weak_equal :
+  assumes "n\<in>nat" "m\<in>nat"
+  shows "weak(n,m) = (m+\<^sub>\<omega>n) - m"
+proof -
+  have "weak(n,m)\<subseteq>(m+\<^sub>\<omega>n)-m"
+  proof(intro subsetI)
+    fix x
+    assume "x\<in>weak(n,m)"
+    with assms
+    obtain i where
+      "i\<in>n" "x=i+\<^sub>\<omega>m"
+      using weakD by blast
+    then
+    have "m\<le>i+\<^sub>\<omega>m" "i<n"
+      using add_le_self2[of m i] \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> ltI[OF \<open>i\<in>n\<close>] by simp_all
+    then
+    have "\<not>i+\<^sub>\<omega>m<m"
+      using not_lt_iff_le in_n_in_nat[OF \<open>n\<in>nat\<close> \<open>i\<in>n\<close>] \<open>m\<in>nat\<close> by simp
+    with \<open>x=i+\<^sub>\<omega>m\<close>
+    have "x\<notin>m"
+      using ltI \<open>m\<in>nat\<close> by auto
+    moreover
+    from assms \<open>x=i+\<^sub>\<omega>m\<close> \<open>i<n\<close>
+    have "x<m+\<^sub>\<omega>n"
+      using add_lt_mono1[OF \<open>i<n\<close> \<open>n\<in>nat\<close>] by simp
+    ultimately
+    show "x\<in>(m+\<^sub>\<omega>n)-m"
+      using ltD DiffI by simp
+  qed
+  moreover
+  have "(m+\<^sub>\<omega>n)-m\<subseteq>weak(n,m)"
+  proof (intro subsetI)
+    fix x
+    assume "x\<in>(m+\<^sub>\<omega>n)-m"
+    then
+    have "x\<in>m+\<^sub>\<omega>n" "x\<notin>m"
+      using DiffD1[of x "n+\<^sub>\<omega>m" m] DiffD2[of x "n+\<^sub>\<omega>m" m] by simp_all
+    then
+    have "x<m+\<^sub>\<omega>n" "x\<in>nat"
+      using ltI in_n_in_nat[OF add_type[of m n]] by simp_all
+    then
+    obtain i where
+      "m+\<^sub>\<omega>n = succ(x+\<^sub>\<omega>i)"
+      using less_iff_succ_add[OF \<open>x\<in>nat\<close>,of "m+\<^sub>\<omega>n"] add_type by auto
+    then
+    have "x+\<^sub>\<omega>i<m+\<^sub>\<omega>n" using succ_le_iff by simp
+    with \<open>x\<notin>m\<close>
+    have "\<not>x<m" using ltD by blast
+    with \<open>m\<in>nat\<close> \<open>x\<in>nat\<close>
+    have "m\<le>x" using not_lt_iff_le by simp
+    with \<open>x<m+\<^sub>\<omega>n\<close>  \<open>n\<in>nat\<close>
+    have "x-\<^sub>\<omega>m<m+\<^sub>\<omega>n-\<^sub>\<omega>m"
+      using diff_mono[OF \<open>x\<in>nat\<close> _ \<open>m\<in>nat\<close>] by simp
+    have "m+\<^sub>\<omega>n-\<^sub>\<omega>m =  n" using diff_cancel2 \<open>m\<in>nat\<close> \<open>n\<in>nat\<close> by simp
+    with \<open>x-\<^sub>\<omega>m<m+\<^sub>\<omega>n-\<^sub>\<omega>m\<close> \<open>x\<in>nat\<close>
+    have "x-\<^sub>\<omega>m \<in> n" "x=x-\<^sub>\<omega>m+\<^sub>\<omega>m"
+      using ltD add_diff_inverse2[OF \<open>m\<le>x\<close>] by simp_all
+    then
+    show "x\<in>weak(n,m)"
+      unfolding weak_def by auto
+  qed
+  ultimately
+  show ?thesis by auto
+qed
+
+lemma weak_zero:
+  shows "weak(0,n) = 0"
+  unfolding weak_def by simp
+
+lemma weakening_diff :
+  assumes "n \<in> nat"
+  shows "weak(n,7) - weak(n,5) \<subseteq> {5+\<^sub>\<omega>n, 6+\<^sub>\<omega>n}"
+  unfolding weak_def using assms
+proof(auto)
+  {
+    fix i
+    assume "i\<in>n" "succ(succ(natify(i)))\<noteq>n" "\<forall>w\<in>n. succ(succ(natify(i))) \<noteq> natify(w)"
+    then
+    have "i<n"
+      using ltI \<open>n\<in>nat\<close> by simp
+    from \<open>n\<in>nat\<close> \<open>i\<in>n\<close> \<open>succ(succ(natify(i)))\<noteq>n\<close>
+    have "i\<in>nat" "succ(succ(i))\<noteq>n" using in_n_in_nat by simp_all
+    from \<open>i<n\<close>
+    have "succ(i)\<le>n" using succ_leI by simp
+    with \<open>n\<in>nat\<close>
+    consider (a) "succ(i) = n" | (b) "succ(i) < n"
+      using leD by auto
+    then have "succ(i) = n"
+    proof cases
+      case a
+      then show ?thesis .
+    next
+      case b
+      then
+      have "succ(succ(i))\<le>n" using succ_leI by simp
+      with \<open>n\<in>nat\<close>
+      consider (a) "succ(succ(i)) = n" | (b) "succ(succ(i)) < n"
+        using leD by auto
+      then have "succ(i) = n"
+      proof cases
+        case a
+        with \<open>succ(succ(i))\<noteq>n\<close> show ?thesis by blast
+      next
+        case b
+        then
+        have "succ(succ(i))\<in>n" using ltD by simp
+        with \<open>i\<in>nat\<close>
+        have "succ(succ(natify(i))) \<noteq> natify(succ(succ(i)))"
+          using  \<open>\<forall>w\<in>n. succ(succ(natify(i))) \<noteq> natify(w)\<close> by auto
+        then
+        have "False" using \<open>i\<in>nat\<close> by auto
+        then show ?thesis by blast
+      qed
+      then show ?thesis .
+    qed
+    with \<open>i\<in>nat\<close> have "succ(natify(i)) = n" by simp
+  }
+  then
+  show "n \<in> nat \<Longrightarrow>
+    succ(succ(natify(y))) \<noteq> n \<Longrightarrow>
+    \<forall>x\<in>n. succ(succ(natify(y))) \<noteq> natify(x) \<Longrightarrow>
+    y \<in> n \<Longrightarrow> succ(natify(y)) = n" for y
+    by blast
+qed
+
+lemma in_add_del :
+  assumes "x\<in>j+\<^sub>\<omega>n" "n\<in>nat" "j\<in>nat"
+  shows "x < j \<or> x \<in> weak(n,j)"
+proof (cases "x<j")
+  case True
+  then show ?thesis ..
+next
+  case False
+  have "x\<in>nat" "j+\<^sub>\<omega>n\<in>nat"
+    using in_n_in_nat[OF _ \<open>x\<in>j+\<^sub>\<omega>n\<close>] assms by simp_all
+  then
+  have "j \<le> x" "x < j+\<^sub>\<omega>n"
+    using not_lt_iff_le False \<open>j\<in>nat\<close> \<open>n\<in>nat\<close> ltI[OF \<open>x\<in>j+\<^sub>\<omega>n\<close>] by auto
+  then
+  have "x-\<^sub>\<omega>j < (j +\<^sub>\<omega> n) -\<^sub>\<omega> j" "x = j +\<^sub>\<omega> (x -\<^sub>\<omega>j)"
+    using diff_mono \<open>x\<in>nat\<close> \<open>j+\<^sub>\<omega>n\<in>nat\<close> \<open>j\<in>nat\<close> \<open>n\<in>nat\<close>
+      add_diff_inverse[OF \<open>j\<le>x\<close>] by simp_all
+  then
+  have "x-\<^sub>\<omega>j < n" "x = (x -\<^sub>\<omega>j ) +\<^sub>\<omega> j"
+    using diff_add_inverse \<open>n\<in>nat\<close> add_commute by simp_all
+  then
+  have "x-\<^sub>\<omega>j \<in>n" using ltD by simp
+  then
+  have "x \<in> weak(n,j)"
+    unfolding weak_def
+    using \<open>x= (x-\<^sub>\<omega>j) +\<^sub>\<omega>j\<close> RepFunI[OF \<open>x-\<^sub>\<omega>j\<in>n\<close>] add_commute by force
+  then show ?thesis  ..
+qed
+
+
+lemma sep_env_action:
+  assumes
+    "[t,p,u,P,leq,o,pi] \<in> list(M)"
+    "env \<in> list(M)"
+  shows "\<forall> i . i \<in> weak(length(env),5) \<longrightarrow>
+      nth(sep_env(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
+proof -
+  from assms
+  have A: "5+\<^sub>\<omega>length(env)\<in>nat" "[p, P, leq, o, t] \<in>list(M)"
+    by simp_all
+  let ?f="sep_env(length(env))"
+  have EQ: "weak(length(env),5) = 5+\<^sub>\<omega>length(env) - 5"
+    using weak_equal length_type[OF \<open>env\<in>list(M)\<close>] by simp
+  let ?tgt="[t,p,u,P,leq,o,pi]@env"
+  let ?src="[p,P,leq,o,t] @ env @ [pi,u]"
+  have "nth(?f`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
+    if "i \<in> (5+\<^sub>\<omega>length(env)-5)" for i
+  proof -
+    from that
+    have 2: "i \<in> 5+\<^sub>\<omega>length(env)"  "i \<notin> 5" "i \<in> nat" "i-\<^sub>\<omega>5\<in>nat" "i+\<^sub>\<omega>2\<in>nat"
+      using in_n_in_nat[OF \<open>5+\<^sub>\<omega>length(env)\<in>nat\<close>] by simp_all
+    then
+    have 3: "\<not> i < 5" using ltD by force
+    then
+    have "5 \<le> i" "2 \<le> 5"
+      using  not_lt_iff_le \<open>i\<in>nat\<close> by simp_all
+    then have "2 \<le> i" using le_trans[OF \<open>2\<le>5\<close>] by simp
+    from A \<open>i \<in> 5+\<^sub>\<omega>length(env)\<close>
+    have "i < 5+\<^sub>\<omega>length(env)" using ltI by simp
+    with \<open>i\<in>nat\<close> \<open>2\<le>i\<close> A
+    have C:"i+\<^sub>\<omega>2 < 7+\<^sub>\<omega>length(env)"  by simp
+    with that
+    have B: "?f`i = i+\<^sub>\<omega>2" unfolding sep_env_def by simp
+    from 3 assms(1) \<open>i\<in>nat\<close>
+    have "\<not> i+\<^sub>\<omega>2 < 7" using not_lt_iff_le add_le_mono by simp
+    from \<open>i < 5+\<^sub>\<omega>length(env)\<close> 3 \<open>i\<in>nat\<close>
+    have "i-\<^sub>\<omega>5 < 5+\<^sub>\<omega>length(env) -\<^sub>\<omega> 5"
+      using diff_mono[of i "5+\<^sub>\<omega>length(env)" 5,OF _ _ _ \<open>i < 5+\<^sub>\<omega>length(env)\<close>]
+        not_lt_iff_le[THEN iffD1] by force
+    with assms(2)
+    have "i-\<^sub>\<omega>5 < length(env)" using diff_add_inverse length_type by simp
+    have "nth(i,?src) =nth(i-\<^sub>\<omega>5,env@[pi,u])"
+      using nth_append[OF A(2) \<open>i\<in>nat\<close>] 3 by simp
+    also
+    have "... = nth(i-\<^sub>\<omega>5, env)"
+      using nth_append[OF \<open>env \<in>list(M)\<close> \<open>i-\<^sub>\<omega>5\<in>nat\<close>] \<open>i-\<^sub>\<omega>5 < length(env)\<close> by simp
+    also
+    have "... = nth(i+\<^sub>\<omega>2, ?tgt)"
+      using nth_append[OF assms(1) \<open>i+\<^sub>\<omega>2\<in>nat\<close>] \<open>\<not> i+\<^sub>\<omega>2 <7\<close> by simp
+    ultimately
+    have "nth(i,?src) = nth(?f`i,?tgt)"
+      using B by simp
+    then show ?thesis using that by simp
+  qed
+  then show ?thesis using EQ by force
+qed
+
+lemma sep_env_type :
+  assumes "n \<in> nat"
+  shows "sep_env(n) : (5+\<^sub>\<omega>n)-5 \<rightarrow> (7+\<^sub>\<omega>n)-7"
+proof -
+  let ?h="sep_env(n)"
+  from \<open>n\<in>nat\<close>
+  have "(5+\<^sub>\<omega>n)+\<^sub>\<omega>2 = 7+\<^sub>\<omega>n" "7+\<^sub>\<omega>n\<in>nat" "5+\<^sub>\<omega>n\<in>nat" by simp_all
+  have
+    D: "sep_env(n)`x \<in> (7+\<^sub>\<omega>n)-7" if "x \<in> (5+\<^sub>\<omega>n)-5" for x
+  proof -
+    from \<open>x\<in>5+\<^sub>\<omega>n-5\<close>
+    have "?h`x = x+\<^sub>\<omega>2" "x<5+\<^sub>\<omega>n" "x\<in>nat"
+      unfolding sep_env_def using ltI in_n_in_nat[OF \<open>5+\<^sub>\<omega>n\<in>nat\<close>] by simp_all
+    then
+    have "x+\<^sub>\<omega>2 < 7+\<^sub>\<omega>n" by simp
+    then
+    have "x+\<^sub>\<omega>2 \<in> 7+\<^sub>\<omega>n" using ltD by simp
+    from \<open>x\<in>5+\<^sub>\<omega>n-5\<close>
+    have "x\<notin>5" by simp
+    then have "\<not>x<5" using ltD by blast
+    then have "5\<le>x" using not_lt_iff_le \<open>x\<in>nat\<close> by simp
+    then have "7\<le>x+\<^sub>\<omega>2" using add_le_mono \<open>x\<in>nat\<close> by simp
+    then have "\<not>x+\<^sub>\<omega>2<7" using not_lt_iff_le \<open>x\<in>nat\<close> by simp
+    then have "x+\<^sub>\<omega>2 \<notin> 7" using ltI \<open>x\<in>nat\<close> by force
+    with \<open>x+\<^sub>\<omega>2 \<in> 7+\<^sub>\<omega>n\<close> show ?thesis using  \<open>?h`x = x+\<^sub>\<omega>2\<close> DiffI by simp
+  qed
+  then show ?thesis unfolding sep_env_def using lam_type by simp
+qed
+
+lemma sep_var_fin_type :
+  assumes "n \<in> nat"
+  shows "sep_var(n) : 7+\<^sub>\<omega>n  -||> 7+\<^sub>\<omega>n"
+  unfolding sep_var_def
+  using consI ltD emptyI by force
+
+lemma sep_var_domain :
+  assumes "n \<in> nat"
+  shows "domain(sep_var(n)) =  7+\<^sub>\<omega>n - weak(n,5)"
+proof -
+  let ?A="weak(n,5)"
+  have A:"domain(sep_var(n)) \<subseteq> (7+\<^sub>\<omega>n)"
+    unfolding sep_var_def
+    by(auto simp add: le_natE)
+  have C: "x=5+\<^sub>\<omega>n \<or> x=6+\<^sub>\<omega>n \<or> x \<le> 4" if "x\<in>domain(sep_var(n))" for x
+    using that unfolding sep_var_def by auto
+  have D : "x<n+\<^sub>\<omega>7" if "x\<in>7+\<^sub>\<omega>n" for x
+    using that \<open>n\<in>nat\<close> ltI by simp
+  have "\<not> 5+\<^sub>\<omega>n < 5+\<^sub>\<omega>n" using \<open>n\<in>nat\<close>  lt_irrefl[of _ False] by force
+  have "\<not> 6+\<^sub>\<omega>n < 5+\<^sub>\<omega>n" using \<open>n\<in>nat\<close> by force
+  have R: "x < 5+\<^sub>\<omega>n" if "x\<in>?A" for x
+  proof -
+    from that
+    obtain i where
+      "i<n" "x=5+\<^sub>\<omega>i"
+      unfolding weak_def
+      using ltI \<open>n\<in>nat\<close> RepFun_iff by force
+    with \<open>n\<in>nat\<close>
+    have "5+\<^sub>\<omega>i < 5+\<^sub>\<omega>n" using add_lt_mono2 by simp
+    with \<open>x=5+\<^sub>\<omega>i\<close>
+    show "x < 5+\<^sub>\<omega>n" by simp
+  qed
+  then
+  have 1:"x\<notin>?A" if "\<not>x <5+\<^sub>\<omega>n" for x using that by blast
+  have "5+\<^sub>\<omega>n \<notin> ?A" "6+\<^sub>\<omega>n\<notin>?A"
+  proof -
+    show "5+\<^sub>\<omega>n \<notin> ?A" using 1 \<open>\<not>5+\<^sub>\<omega>n<5+\<^sub>\<omega>n\<close> by blast
+    with 1 show "6+\<^sub>\<omega>n \<notin> ?A" using  \<open>\<not>6+\<^sub>\<omega>n<5+\<^sub>\<omega>n\<close> by blast
+  qed
+  then
+  have E:"x\<notin>?A" if "x\<in>domain(sep_var(n))" for x
+    unfolding weak_def
+    using C that by force
+  then
+  have F: "domain(sep_var(n)) \<subseteq> 7+\<^sub>\<omega>n - ?A" using A by auto
+  from assms
+  have "x<7 \<or> x\<in>weak(n,7)" if "x\<in>7+\<^sub>\<omega>n" for x
+    using in_add_del[OF \<open>x\<in>7+\<^sub>\<omega>n\<close>] by simp
+  moreover
+  {
+    fix x
+    assume asm:"x\<in>7+\<^sub>\<omega>n"  "x\<notin>?A"  "x\<in>weak(n,7)"
+    then
+    have "x\<in>domain(sep_var(n))"
+    proof -
+      from \<open>n\<in>nat\<close>
+      have "weak(n,7)-weak(n,5)\<subseteq>{n+\<^sub>\<omega>5,n+\<^sub>\<omega>6}"
+        using weakening_diff by simp
+      with  \<open>x\<notin>?A\<close> asm
+      have "x\<in>{n+\<^sub>\<omega>5,n+\<^sub>\<omega>6}" using  subsetD DiffI by blast
+      then
+      show ?thesis unfolding sep_var_def by simp
+    qed
+  }
+  moreover
+  {
+    fix x
+    assume asm:"x\<in>7+\<^sub>\<omega>n"  "x\<notin>?A" "x<7"
+    then have "x\<in>domain(sep_var(n))"
+    proof (cases "2 \<le> n")
+      case True
+      moreover
+      have "0<n" using  leD[OF \<open>n\<in>nat\<close> \<open>2\<le>n\<close>] lt_imp_0_lt by auto
+      ultimately
+      have "x<5"
+        using \<open>x<7\<close> \<open>x\<notin>?A\<close> \<open>n\<in>nat\<close> in_n_in_nat
+        unfolding weak_def
+        by (clarsimp simp add:not_lt_iff_le, auto simp add:lt_def)
+      then
+      show ?thesis unfolding sep_var_def
+        by (clarsimp simp add:not_lt_iff_le, auto simp add:lt_def)
+    next
+      case False
+      then
+      show ?thesis
+      proof (cases "n=0")
+        case True
+        then show ?thesis
+          unfolding sep_var_def using ltD asm \<open>n\<in>nat\<close> by auto
+      next
+        case False
+        then
+        have "n < 2" using  \<open>n\<in>nat\<close> not_lt_iff_le \<open>\<not> 2 \<le> n\<close>  by force
+        then
+        have "\<not> n <1" using \<open>n\<noteq>0\<close> by simp
+        then
+        have "n=1" using not_lt_iff_le \<open>n<2\<close> le_iff by auto
+        then show ?thesis
+          using \<open>x\<notin>?A\<close>
+          unfolding weak_def sep_var_def
+          using ltD asm \<open>n\<in>nat\<close> by force
+      qed
+    qed
+  }
+  ultimately
+  have "w\<in>domain(sep_var(n))" if "w\<in> 7+\<^sub>\<omega>n - ?A" for w
+    using that by blast
+  then
+  have "7+\<^sub>\<omega>n - ?A \<subseteq> domain(sep_var(n))" by blast
+  with F
+  show ?thesis by auto
+qed
+
+lemma sep_var_type :
+  assumes "n \<in> nat"
+  shows "sep_var(n) : (7+\<^sub>\<omega>n)-weak(n,5) \<rightarrow> 7+\<^sub>\<omega>n"
+  using FiniteFun_is_fun[OF sep_var_fin_type[OF \<open>n\<in>nat\<close>]]
+    sep_var_domain[OF \<open>n\<in>nat\<close>] by simp
+
+lemma sep_var_action :
+  assumes
+    "[t,p,u,P,leq,o,pi] \<in> list(M)"
+    "env \<in> list(M)"
+  shows "\<forall> i . i \<in> (7+\<^sub>\<omega>length(env)) - weak(length(env),5) \<longrightarrow>
+    nth(sep_var(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
+  using assms
+proof (subst sep_var_domain[OF length_type[OF \<open>env\<in>list(M)\<close>],symmetric],auto)
+  fix i y
+  assume "\<langle>i, y\<rangle> \<in> sep_var(length(env))"
+  with assms
+  show "nth(sep_var(length(env)) ` i,
+               Cons(t, Cons(p, Cons(u, Cons(P, Cons(leq, Cons(o, Cons(pi, env)))))))) =
+           nth(i, Cons(p, Cons(P, Cons(leq, Cons(o, Cons(t, env @ [pi, u]))))))"
+    using apply_fun[OF sep_var_type] assms
+    unfolding sep_var_def
+    using nth_concat2[OF \<open>env\<in>list(M)\<close>]  nth_concat3[OF \<open>env\<in>list(M)\<close>,symmetric]
+    by force
+qed
+
+definition
+  rensep :: "i \<Rightarrow> i" where
+  "rensep(n) \<equiv> union_fun(sep_var(n),sep_env(n),7+\<^sub>\<omega>n-weak(n,5),weak(n,5))"
+
+lemma rensep_aux :
+  assumes "n\<in>nat"
+  shows "(7+\<^sub>\<omega>n-weak(n,5)) \<union> weak(n,5) = 7+\<^sub>\<omega>n" "7+\<^sub>\<omega>n \<union> ( 7 +\<^sub>\<omega> n - 7) = 7+\<^sub>\<omega>n"
+proof -
+  from \<open>n\<in>nat\<close>
+  have "weak(n,5) = n+\<^sub>\<omega>5-5"
+    using weak_equal by simp
+  with  \<open>n\<in>nat\<close>
+  show "(7+\<^sub>\<omega>n-weak(n,5)) \<union> weak(n,5) = 7+\<^sub>\<omega>n" "7+\<^sub>\<omega>n \<union> ( 7 +\<^sub>\<omega> n - 7) = 7+\<^sub>\<omega>n"
+    using Diff_partition le_imp_subset by auto
+qed
+
+lemma rensep_type :
+  assumes "n\<in>nat"
+  shows "rensep(n) \<in> 7+\<^sub>\<omega>n \<rightarrow> 7+\<^sub>\<omega>n"
+proof -
+  from \<open>n\<in>nat\<close>
+  have "rensep(n) \<in> (7+\<^sub>\<omega>n-weak(n,5)) \<union> weak(n,5) \<rightarrow> 7+\<^sub>\<omega>n \<union> (7+\<^sub>\<omega>n - 7)"
+    unfolding rensep_def
+    using union_fun_type  sep_var_type \<open>n\<in>nat\<close> sep_env_type weak_equal
+    by force
+  then
+  show ?thesis using rensep_aux \<open>n\<in>nat\<close> by auto
+qed
+
+lemma rensep_action :
+  assumes "[t,p,u,P,leq,o,pi] @ env \<in> list(M)"
+  shows "\<forall> i . i < 7+\<^sub>\<omega>length(env) \<longrightarrow> nth(rensep(length(env))`i,[t,p,u,P,leq,o,pi]@env) = nth(i,[p,P,leq,o,t] @ env @ [pi,u])"
+proof -
+  let ?tgt="[t,p,u,P,leq,o,pi]@env"
+  let ?src="[p,P,leq,o,t] @ env @ [pi,u]"
+  let ?m="7 +\<^sub>\<omega> length(env) - weak(length(env),5)"
+  let ?p="weak(length(env),5)"
+  let ?f="sep_var(length(env))"
+  let ?g="sep_env(length(env))"
+  let ?n="length(env)"
+  from assms
+  have 1 : "[t,p,u,P,leq,o,pi] \<in> list(M)" " env \<in> list(M)"
+    "?src \<in> list(M)" "?tgt \<in> list(M)"
+    "7+\<^sub>\<omega>?n = (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)"
+    " length(?src) = (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)"
+    using Diff_partition le_imp_subset rensep_aux by auto
+  then
+  have "nth(i, ?src) = nth(union_fun(?f, ?g, ?m, ?p) ` i, ?tgt)" if "i < 7+\<^sub>\<omega>length(env)" for i
+  proof -
+    from \<open>i<7+\<^sub>\<omega>?n\<close>
+    have "i \<in> (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)"
+      using ltD by simp
+    then show ?thesis
+      unfolding rensep_def using
+        union_fun_action[OF \<open>?src\<in>list(M)\<close> \<open>?tgt\<in>list(M)\<close> \<open>length(?src) = (7+\<^sub>\<omega>?n-weak(?n,5)) \<union> weak(?n,5)\<close>
+          sep_var_action[OF \<open>[t,p,u,P,leq,o,pi] \<in> list(M)\<close> \<open>env\<in>list(M)\<close>]
+          sep_env_action[OF \<open>[t,p,u,P,leq,o,pi] \<in> list(M)\<close> \<open>env\<in>list(M)\<close>]
+          ] that
+      by simp
+  qed
+  then show ?thesis unfolding rensep_def by simp
+qed
+
+definition sep_ren :: "[i,i] \<Rightarrow> i" where
+  "sep_ren(n,\<phi>) \<equiv> ren(\<phi>)`(7+\<^sub>\<omega>n)`(7+\<^sub>\<omega>n)`rensep(n)"
+
+lemma arity_rensep: assumes "\<phi>\<in>formula" "env \<in> list(M)"
+  "arity(\<phi>) \<le> 7+\<^sub>\<omega>length(env)"
+shows "arity(sep_ren(length(env),\<phi>)) \<le> 7+\<^sub>\<omega>length(env)"
+  unfolding sep_ren_def
+  using arity_ren rensep_type assms
+  by simp
+
+lemma type_rensep [TC]:
+  assumes "\<phi>\<in>formula" "env\<in>list(M)"
+  shows "sep_ren(length(env),\<phi>) \<in> formula"
+  unfolding sep_ren_def
+  using ren_tc rensep_type assms
+  by simp
+
+lemma sepren_action:
+  assumes "arity(\<phi>) \<le> 7 +\<^sub>\<omega> length(env)"
+    "[t,p,u,P,leq,o,pi] \<in> list(M)"
+    "env\<in>list(M)"
+    "\<phi>\<in>formula"
+  shows "sats(M, sep_ren(length(env),\<phi>),[t,p,u,P,leq,o,pi] @ env) \<longleftrightarrow> sats(M, \<phi>,[p,P,leq,o,t] @ env @ [pi,u])"
+proof -
+  from assms
+  have 1: "[t, p, u, P, leq, o, pi] @ env \<in> list(M)"
+    by simp_all
+  then
+  have 2: "[p,P,leq,o,t] @ env @ [pi,u] \<in> list(M)"
+    using app_type by simp
+  show ?thesis
+    unfolding sep_ren_def
+    using sats_iff_sats_ren[OF \<open>\<phi>\<in>formula\<close>
+        add_type[of 7 "length(env)"]
+        add_type[of 7 "length(env)"]
+        2 1
+        rensep_type[OF length_type[OF \<open>env\<in>list(M)\<close>]]
+        \<open>arity(\<phi>) \<le> 7 +\<^sub>\<omega> length(env)\<close>]
+      rensep_action[OF 1,rule_format,symmetric]
+    by simp
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Succession_Poset.thy b/thys/Independence_CH/Succession_Poset.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Succession_Poset.thy
@@ -0,0 +1,240 @@
+section\<open>A poset of successions\<close>
+
+theory Succession_Poset
+  imports
+    Replacement_Instances
+    Proper_Extension
+begin
+
+text\<open>In this theory we define a separative poset. Its underlying set is the
+set of finite binary sequences (that is, with codomain $2={0,1}$);
+of course, one can see that set as
+the set \<^term>\<open>\<omega>-||>2\<close> or equivalently as the set of partial functions
+\<^term>\<open>Fn(\<omega>,\<omega>,2)\<close>, i.e. the set of partial functions bounded by \<^term>\<open>\<omega>\<close>.
+
+The order relation of the poset is that of being less defined as functions
+(cf. \<^term>\<open>Fnlerel(A\<^bsup><\<omega>\<^esup>)\<close>), so it could be surprising that we have not used
+\<^term>\<open>Fn(\<omega>,\<omega>,2)\<close> for the set. The only reason why we keep this alternative
+definition is because we can prove \<^term>\<open>A\<^bsup><\<omega>\<^esup> \<in> M\<close> (and therefore
+\<^term>\<open>Fnlerel(A\<^bsup><\<omega>\<^esup>) \<in> M\<close>) using only one instance of replacement.\<close>
+
+sublocale M_ZF2_trans \<subseteq> M_seqspace "##M"
+  by (unfold_locales, simp add:replacement_omega_funspace)
+
+definition seq_upd :: "i \<Rightarrow> i \<Rightarrow> i" where
+  "seq_upd(f,a) \<equiv> \<lambda> j \<in> succ(domain(f)) . if j < domain(f) then f`j else a"
+
+lemma seq_upd_succ_type :
+  assumes "n\<in>nat" "f\<in>n\<rightarrow>A" "a\<in>A"
+  shows "seq_upd(f,a)\<in> succ(n) \<rightarrow> A"
+proof -
+  from assms
+  have equ: "domain(f) = n"
+    using domain_of_fun by simp
+  {
+    fix j
+    assume "j\<in>succ(domain(f))"
+    with equ \<open>n\<in>_\<close>
+    have "j\<le>n"
+      using ltI by auto
+    with \<open>n\<in>_\<close>
+    consider (lt) "j<n" | (eq) "j=n"
+      using leD by auto
+    then
+    have "(if j < n then f`j else a) \<in> A"
+    proof cases
+      case lt
+      with \<open>f\<in>_\<close>
+      show ?thesis
+        using apply_type ltD[OF lt] by simp
+    next
+      case eq
+      with \<open>a\<in>_\<close>
+      show ?thesis
+        by auto
+    qed
+  }
+  with equ
+  show ?thesis
+    unfolding seq_upd_def
+    using lam_type[of "succ(domain(f))"]
+    by auto
+qed
+
+lemma seq_upd_type :
+  assumes "f\<in>A\<^bsup><\<omega>\<^esup>" "a\<in>A"
+  shows "seq_upd(f,a) \<in> A\<^bsup><\<omega>\<^esup>"
+proof -
+  from \<open>f\<in>_\<close>
+  obtain y where "y\<in>nat" "f\<in>y\<rightarrow>A"
+    unfolding seqspace_def by blast
+  with \<open>a\<in>A\<close>
+  have "seq_upd(f,a)\<in>succ(y)\<rightarrow>A"
+    using seq_upd_succ_type by simp
+  with \<open>y\<in>_\<close>
+  show ?thesis
+    unfolding seqspace_def by auto
+qed
+
+lemma seq_upd_apply_domain [simp]:
+  assumes "f:n\<rightarrow>A" "n\<in>nat"
+  shows "seq_upd(f,a)`n = a"
+  unfolding seq_upd_def using assms domain_of_fun by auto
+
+lemma zero_in_seqspace :
+  shows "0 \<in> A\<^bsup><\<omega>\<^esup>"
+  unfolding seqspace_def
+  by force
+
+definition
+  seqlerel :: "i \<Rightarrow> i" where
+  "seqlerel(A) \<equiv> Fnlerel(A\<^bsup><\<omega>\<^esup>)"
+
+definition
+  seqle :: "i" where
+  "seqle \<equiv> seqlerel(2)"
+
+lemma seqleI[intro!]:
+  "\<langle>f,g\<rangle> \<in> 2\<^bsup><\<omega>\<^esup>\<times>2\<^bsup><\<omega>\<^esup> \<Longrightarrow> g \<subseteq> f  \<Longrightarrow> \<langle>f,g\<rangle> \<in> seqle"
+  unfolding seqle_def seqlerel_def seqspace_def Rrel_def Fnlerel_def
+  by blast
+
+lemma seqleD[dest!]:
+  "z \<in> seqle \<Longrightarrow> \<exists>x y. \<langle>x,y\<rangle> \<in> 2\<^bsup><\<omega>\<^esup>\<times>2\<^bsup><\<omega>\<^esup> \<and> y \<subseteq> x \<and> z = \<langle>x,y\<rangle>"
+  unfolding Rrel_def seqle_def seqlerel_def Fnlerel_def
+  by blast
+
+lemma upd_leI :
+  assumes "f\<in>2\<^bsup><\<omega>\<^esup>" "a\<in>2"
+  shows "\<langle>seq_upd(f,a),f\<rangle>\<in>seqle"  (is "\<langle>?f,_\<rangle>\<in>_")
+proof
+  show " \<langle>?f, f\<rangle> \<in> 2\<^bsup><\<omega>\<^esup> \<times> 2\<^bsup><\<omega>\<^esup>"
+    using assms seq_upd_type by auto
+next
+  show  "f \<subseteq> seq_upd(f,a)"
+  proof
+    fix x
+    assume "x \<in> f"
+    moreover from \<open>f \<in> 2\<^bsup><\<omega>\<^esup>\<close>
+    obtain n where "n\<in>nat" "f : n \<rightarrow> 2"
+      by blast
+    moreover from calculation
+    obtain y where "y\<in>n" "x=\<langle>y,f`y\<rangle>"
+      using Pi_memberD[of f n "\<lambda>_ . 2"]
+      by blast
+    moreover from \<open>f:n\<rightarrow>2\<close>
+    have "domain(f) = n"
+      using domain_of_fun by simp
+    ultimately
+    show "x \<in> seq_upd(f,a)"
+      unfolding seq_upd_def lam_def
+      by (auto intro:ltI)
+  qed
+qed
+
+lemma preorder_on_seqle: "preorder_on(2\<^bsup><\<omega>\<^esup>,seqle)"
+  unfolding preorder_on_def refl_def trans_on_def by blast
+
+lemma zero_seqle_max: "x\<in>2\<^bsup><\<omega>\<^esup> \<Longrightarrow> \<langle>x,0\<rangle> \<in> seqle"
+  using zero_in_seqspace
+  by auto
+
+interpretation sp:forcing_notion "2\<^bsup><\<omega>\<^esup>" "seqle" "0"
+  using preorder_on_seqle zero_seqle_max zero_in_seqspace
+  by unfold_locales simp_all
+
+notation sp.Leq (infixl "\<preceq>s" 50)
+notation sp.Incompatible (infixl "\<bottom>s" 50)
+notation sp.GenExt_at_P ("_\<^bsup>s\<^esup>[_]" [71,1])
+
+lemma seqspace_separative:
+  assumes "f\<in>2\<^bsup><\<omega>\<^esup>"
+  shows "seq_upd(f,0) \<bottom>s seq_upd(f,1)" (is "?f \<bottom>s ?g")
+proof
+  assume "sp.compat(?f, ?g)"
+  then
+  obtain h where "h \<in> 2\<^bsup><\<omega>\<^esup>" "?f \<subseteq> h" "?g \<subseteq> h"
+    by blast
+  moreover from \<open>f\<in>_\<close>
+  obtain y where "y\<in>nat" "f:y\<rightarrow>2"
+    by blast
+  moreover from this
+  have "?f: succ(y) \<rightarrow> 2" "?g: succ(y) \<rightarrow> 2"
+    using seq_upd_succ_type by blast+
+  moreover from this
+  have "\<langle>y,?f`y\<rangle> \<in> ?f" "\<langle>y,?g`y\<rangle> \<in> ?g"
+    using apply_Pair by auto
+  ultimately
+  have "\<langle>y,0\<rangle> \<in> h" "\<langle>y,1\<rangle> \<in> h"
+    by auto
+  moreover from \<open>h \<in> 2\<^bsup><\<omega>\<^esup>\<close>
+  obtain n where "n\<in>nat" "h:n\<rightarrow>2"
+    by blast
+  ultimately
+  show "False"
+    using fun_is_function[of h n "\<lambda>_. 2"]
+    unfolding seqspace_def function_def by auto
+qed
+
+definition seqleR_fm :: "i \<Rightarrow> i" where
+  "seqleR_fm(fg) \<equiv> Exists(Exists(And(pair_fm(0,1,fg+\<^sub>\<omega>2),subset_fm(1,0))))"
+
+lemma type_seqleR_fm : "fg \<in> nat \<Longrightarrow> seqleR_fm(fg) \<in> formula"
+  unfolding seqleR_fm_def
+  by simp
+
+arity_theorem for "seqleR_fm"
+
+lemma (in M_ctm1) seqleR_fm_sats :
+  assumes "fg\<in>nat" "env\<in>list(M)"
+  shows "(M, env \<Turnstile> seqleR_fm(fg)) \<longleftrightarrow> (\<exists>f[##M]. \<exists>g[##M]. pair(##M,f,g,nth(fg,env)) \<and> f \<supseteq> g)"
+  unfolding seqleR_fm_def
+  using assms trans_M sats_subset_fm pair_iff_sats
+  by auto
+
+locale M_ctm2 = M_ctm1 + M_ZF2_trans
+
+locale M_ctm2_AC = M_ctm2 + M_ZFC2_trans
+
+locale forcing_data2 = forcing_data1 + M_ctm2
+
+context M_ctm2
+begin
+
+lemma seqle_in_M: "seqle \<in> M"
+  using arity_seqleR_fm seqleR_fm_sats type_seqleR_fm
+    cartprod_closed seqspace_closed nat_into_M nat_in_M pair_in_M_iff
+  unfolding seqle_def seqlerel_def Rrel_def Fnlerel_def
+  by (rule_tac Collect_in_M[of "seqleR_fm(0)" "[]"],auto)
+
+subsection\<open>Cohen extension is proper\<close>
+
+interpretation ctm_separative "2\<^bsup><\<omega>\<^esup>" seqle 0
+proof (unfold_locales)
+  fix f
+  let ?q="seq_upd(f,0)" and ?r="seq_upd(f,1)"
+  assume "f \<in> 2\<^bsup><\<omega>\<^esup>"
+  then
+  have "?q \<preceq>s f \<and> ?r \<preceq>s f \<and> ?q \<bottom>s ?r"
+    using upd_leI seqspace_separative by auto
+  moreover from calculation
+  have "?q \<in> 2\<^bsup><\<omega>\<^esup>"  "?r \<in> 2\<^bsup><\<omega>\<^esup>"
+    using seq_upd_type[of f 2] by auto
+  ultimately
+  show "\<exists>q\<in>2\<^bsup><\<omega>\<^esup>. \<exists>r\<in>2\<^bsup><\<omega>\<^esup>. q \<preceq>s f \<and> r \<preceq>s f \<and> q \<bottom>s r"
+    by (rule_tac bexI)+ \<comment> \<open>why the heck auto-tools don't solve this?\<close>
+next
+  show "2\<^bsup><\<omega>\<^esup> \<in> M"
+    using nat_into_M seqspace_closed by simp
+next
+  show "seqle \<in> M"
+    using seqle_in_M .
+qed
+
+lemma cohen_extension_is_proper: "\<exists>G. M_generic(G) \<and> M \<noteq> M\<^bsup>2\<^bsup><\<omega>\<^esup>\<^esup>[G]"
+  using proper_extension generic_filter_existence zero_in_seqspace
+  by force
+
+end \<comment> \<open>\<^locale>\<open>M_ctm2\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/Union_Axiom.thy b/thys/Independence_CH/Union_Axiom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/Union_Axiom.thy
@@ -0,0 +1,201 @@
+section\<open>The Axiom of Unions in $M[G]$\<close>
+theory Union_Axiom
+  imports Names
+begin
+
+definition Union_name_body :: "[i,i,i,i] \<Rightarrow> o" where
+  "Union_name_body(P,leq,\<tau>,x) \<equiv> \<exists> \<sigma> . \<exists>q\<in>P . \<exists>r\<in>P .
+      \<langle>\<sigma>,q\<rangle> \<in> \<tau> \<and> \<langle>fst(x),r\<rangle> \<in> \<sigma> \<and> \<langle>snd(x),r\<rangle> \<in> leq \<and> \<langle>snd(x),q\<rangle> \<in> leq"
+
+relativize relational "Union_name_body" "is_Union_name_body"
+reldb_add functional "Union_name_body" "is_Union_name_body"
+synthesize "is_Union_name_body" from_definition assuming "nonempty"
+arity_theorem for "is_Union_name_body_fm"
+
+definition Union_name :: "[i,i,i] \<Rightarrow> i" where
+  "Union_name(P,leq,\<tau>) \<equiv> {u \<in> domain(\<Union>(domain(\<tau>))) \<times> P . Union_name_body(P,leq,\<tau>,u)}"
+
+relativize functional "Union_name" "Union_name_rel"
+relativize relational "Union_name" "is_Union_name"
+synthesize "is_Union_name" from_definition assuming "nonempty"
+arity_theorem for "is_Union_name_fm"
+
+context M_basic
+begin
+
+is_iff_rel for "Union_name"
+  using transM[OF _ cartprod_closed] domain_closed Union_closed
+  unfolding is_Union_name_def Union_name_rel_def
+  by simp
+
+lemma Union_name_body_iff:
+  assumes "M(x)" "M(leq)" "M(P)" "M(\<tau>)"
+  shows "is_Union_name_body(M, P, leq, \<tau>, x) \<longleftrightarrow> Union_name_body(P, leq, \<tau>, x)"
+proof -
+  from \<open>M(\<tau>)\<close>
+  have "M(\<sigma>)" if "\<langle>\<sigma>,q\<rangle>\<in>\<tau>" for \<sigma> q
+    using transM[of _ \<tau>] transM[of _ "\<langle>\<sigma>,q\<rangle>"] that
+    unfolding Pair_def
+    by auto
+  then
+  show ?thesis
+    using assms transM[OF _ cartprod_closed] pair_abs fst_abs snd_abs
+    unfolding is_Union_name_body_def Union_name_body_def
+    by auto
+qed
+
+lemma Union_name_abs :
+  assumes "M(P)" "M(leq)" "M(\<tau>)"
+  shows "Union_name_rel(M,P,leq,\<tau>) = Union_name(P,leq,\<tau>)"
+  using assms transM[OF _ cartprod_closed] Union_name_body_iff
+  unfolding Union_name_rel_def Union_name_def
+  by auto
+
+end \<comment> \<open>\<^locale>\<open>M_basic\<close>\<close>
+
+context forcing_data1
+begin
+
+lemma Union_name_closed :
+  assumes "\<tau> \<in> M"
+  shows "Union_name(P,leq,\<tau>) \<in> M"
+proof -
+  let ?\<phi>="is_Union_name_body_fm(3,2,1,0)"
+  let ?P="\<lambda> x . M,[x,\<tau>,leq,P] \<Turnstile> ?\<phi>"
+  let ?Q="Union_name_body(P,leq,\<tau>)"
+  from \<open>\<tau>\<in>M\<close>
+  have "domain(\<Union>(domain(\<tau>)))\<in>M" (is "?d \<in> _")
+    using domain_closed Union_closed by simp
+  then
+  have "?d \<times> P \<in> M"
+    using cartprod_closed P_in_M by simp
+  note types = leq_in_M P_in_M assms \<open>?d\<times>P \<in> M\<close> \<open>?d\<in>M\<close>
+  moreover
+  have "arity(?\<phi>)\<le>4"
+    using arity_is_Union_name_body_fm ord_simp_union by simp
+  moreover from calculation
+  have "separation(##M,?P)"
+    using separation_ax by simp
+  moreover from calculation
+  have closed:"{ u \<in> ?d \<times> P . ?P(u) } \<in> M"
+    using separation_iff by force
+  moreover from calculation
+  have "?P(x)\<longleftrightarrow> x\<in>M \<and> ?Q(x)" if "x\<in>?d\<times>P" for x
+  proof -
+    note calculation that
+    moreover from this
+    have "x = \<langle>fst(x),snd(x)\<rangle>" "x\<in>M"  "fst(x) \<in> M" "snd(x) \<in> M"
+      using Pair_fst_snd_eq transitivity[of x "?d\<times>P"] fst_snd_closed
+      by simp_all
+    ultimately
+    show "?P(x) \<longleftrightarrow> x\<in>M \<and> ?Q(x)"
+      using types zero_in_M is_Union_name_body_iff_sats Union_name_body_iff
+      by simp
+  qed
+  with \<open>?d \<times> P \<in> M\<close> types
+  have "Union_name_rel(##M,P,leq,\<tau>) \<in> M"
+    unfolding Union_name_rel_def
+    using transitivity[OF _ \<open>?d\<times>P\<in>_\<close>] Collect_cong closed Union_name_body_iff
+    by simp
+  ultimately
+  show ?thesis
+    using Union_name_abs
+    by simp
+qed
+
+lemma Union_MG_Eq :
+  assumes "a \<in> M[G]" and "a = val(P,G,\<tau>)" and "filter(G)" and "\<tau> \<in> M"
+  shows "\<Union> a = val(P,G,Union_name(P,leq,\<tau>))"
+proof (intro equalityI subsetI)
+  fix x
+  assume "x \<in> \<Union> a"
+  with \<open>a=_\<close>
+  have "x\<in> \<Union> (val(P,G,\<tau>))"
+    by simp
+  then
+  obtain i where "i \<in> val(P,G,\<tau>)" "x \<in> i"
+    by blast
+  with \<open>\<tau> \<in> M\<close>
+  obtain \<sigma> q where "q \<in> G" "\<langle>\<sigma>,q\<rangle> \<in> \<tau>" "val(P,G,\<sigma>) = i" "\<sigma> \<in> M"
+    using elem_of_val_pair domain_trans[OF trans_M]
+    by blast
+  moreover from this \<open>x \<in> i\<close>
+  obtain \<theta> r where "r \<in> G" "\<langle>\<theta>,r\<rangle> \<in> \<sigma>" "val(P,G,\<theta>) = x" "\<theta> \<in> M"
+    using elem_of_val_pair domain_trans[OF trans_M] by blast
+  moreover from calculation
+  have "\<theta> \<in> domain(\<Union>(domain(\<tau>)))"
+    by auto
+  moreover from calculation \<open>filter(G)\<close>
+  obtain p where "p \<in> G" "\<langle>p,r\<rangle> \<in> leq" "\<langle>p,q\<rangle> \<in> leq" "p \<in> P" "r \<in> P" "q \<in> P"
+    using low_bound_filter filterD by blast
+  moreover from this
+  have "p \<in> M" "q\<in>M" "r\<in>M"
+    using P_in_M by (auto dest:transM)
+  moreover from calculation
+  have "\<langle>\<theta>,p\<rangle> \<in> Union_name(P,leq,\<tau>)"
+    unfolding Union_name_def Union_name_body_def
+    by auto
+  moreover from this \<open>p\<in>P\<close> \<open>p\<in>G\<close>
+  have "val(P,G,\<theta>) \<in> val(P,G,Union_name(P,leq,\<tau>))"
+    using val_of_elem by simp
+  ultimately
+  show "x \<in> val(P,G,Union_name(P,leq,\<tau>))"
+    by simp
+next
+  fix x
+  assume "x \<in> (val(P,G,Union_name(P,leq,\<tau>)))"
+  moreover
+  note \<open>filter(G)\<close> \<open>a=val(P,G,\<tau>)\<close>
+  moreover from calculation
+  obtain \<theta> p where "p \<in> G" "\<langle>\<theta>,p\<rangle> \<in> Union_name(P,leq,\<tau>)" "val(P,G,\<theta>) = x"
+    using elem_of_val_pair by blast
+  moreover from calculation
+  have "p\<in>P"
+    using filterD by simp
+  moreover from calculation
+  obtain \<sigma> q r where "\<langle>\<sigma>,q\<rangle> \<in> \<tau>" "\<langle>\<theta>,r\<rangle> \<in> \<sigma>" "\<langle>p,r\<rangle> \<in> leq" "\<langle>p,q\<rangle> \<in> leq" "r\<in>P" "q\<in>P"
+    unfolding Union_name_def Union_name_body_def
+    by force
+  moreover from calculation
+  have "r \<in> G" "q \<in> G"
+    using filter_leqD by auto
+  moreover from this \<open>\<langle>\<theta>,r\<rangle> \<in> \<sigma>\<close> \<open>\<langle>\<sigma>,q\<rangle>\<in>\<tau>\<close> \<open>q\<in>P\<close> \<open>r\<in>P\<close>
+  have "val(P,G,\<sigma>) \<in> val(P,G,\<tau>)" "val(P,G,\<theta>) \<in> val(P,G,\<sigma>)"
+    using val_of_elem by simp+
+  moreover from this
+  have "val(P,G,\<theta>) \<in> \<Union> val(P,G,\<tau>)"
+    by blast
+  ultimately
+  show "x \<in> \<Union> a"
+    by simp
+qed
+
+lemma union_in_MG :
+  assumes "filter(G)"
+  shows "Union_ax(##M[G])"
+  unfolding Union_ax_def
+proof(clarsimp)
+  fix a
+  assume "a \<in> M[G]"
+  moreover
+  note \<open>filter(G)\<close>
+  moreover from calculation
+  interpret mgtrans : M_trans "##M[G]"
+    using transitivity_MG by (unfold_locales; auto)
+  from calculation
+  obtain \<tau> where "\<tau> \<in> M" "a=val(P,G,\<tau>)"
+    using GenExtD by blast
+  moreover from this
+  have "val(P,G,Union_name(P,leq,\<tau>)) \<in> M[G]"
+    using GenExtI Union_name_closed P_in_M leq_in_M by simp
+  ultimately
+  show "\<exists>z\<in>M[G] . big_union(##M[G],a,z)"
+    using Union_MG_Eq by auto
+qed
+
+theorem Union_MG : "M_generic(G) \<Longrightarrow> Union_ax(##M[G])"
+  by (simp add:M_generic_def union_in_MG)
+
+end \<comment> \<open>\<^locale>\<open>forcing_data1\<close>\<close>
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/ZF_Trans_Interpretations.thy b/thys/Independence_CH/ZF_Trans_Interpretations.thy
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/ZF_Trans_Interpretations.thy
@@ -0,0 +1,622 @@
+section\<open>Further instances of axiom-schemes\<close>
+
+theory ZF_Trans_Interpretations
+  imports
+    Internal_ZFC_Axioms
+    Succession_Poset
+begin
+
+locale M_ZF3 = M_ZF2 +
+  assumes
+    replacement_ax3:
+    "replacement_assm(M,env,replacement_is_order_body_fm)"
+    "replacement_assm(M,env,wfrec_replacement_order_pred_fm)"
+    "replacement_assm(M,env,replacement_is_jump_cardinal_body_fm)"
+    "replacement_assm(M,env,replacement_is_aleph_fm)"
+    and
+    LambdaPair_in_M_replacement3:
+    "replacement_assm(M,env,LambdaPair_in_M_fm(is_inj_fm(0,1,2),0))"
+
+definition instances3_fms where "instances3_fms \<equiv>
+  { replacement_is_order_body_fm,
+    wfrec_replacement_order_pred_fm,
+    replacement_is_jump_cardinal_body_fm,
+    replacement_is_aleph_fm,
+    LambdaPair_in_M_fm(is_inj_fm(0,1,2),0) }"
+
+txt\<open>This set has 5 internalized formulas.\<close>
+
+lemmas replacement_instances3_defs =
+  replacement_is_order_body_fm_def wfrec_replacement_order_pred_fm_def
+  replacement_is_jump_cardinal_body_fm_def
+  replacement_is_aleph_fm_def
+
+declare (in M_ZF3) replacement_instances3_defs [simp]
+
+locale M_ZF3_trans = M_ZF2_trans + M_ZF3
+
+locale M_ZFC3 = M_ZFC2 + M_ZF3
+
+locale M_ZFC3_trans = M_ZFC2_trans + M_ZF3_trans
+
+locale M_ctm3 = M_ctm2 + M_ZF3_trans + M_ZF2_trans
+
+locale M_ctm3_AC = M_ctm3 + M_ctm1_AC + M_ZFC3_trans
+
+locale forcing_data3 = forcing_data2 + M_ctm3_AC
+
+lemmas (in M_ZF2_trans) separation_instances =
+  separation_well_ord
+  separation_obase_equals separation_is_obase
+  separation_PiP_rel separation_surjP_rel
+  separation_radd_body separation_rmult_body
+
+lemma (in M_ZF3_trans) lam_replacement_inj_rel:
+  shows
+    "lam_replacement(##M, \<lambda>p. inj\<^bsup>##M\<^esup>(fst(p),snd(p)))"
+  using lam_replacement_iff_lam_closed[THEN iffD2,of "\<lambda>p. inj\<^bsup>M\<^esup>(fst(p),snd(p))"]
+    LambdaPair_in_M[where \<phi>="is_inj_fm(0,1,2)" and is_f="is_inj(##M)" and env="[]",OF
+      is_inj_fm_type _ is_inj_iff_sats[symmetric] inj_rel_iff,simplified]
+    arity_is_inj_fm[of 0 1 2] ord_simp_union transitivity fst_snd_closed
+    inj_rel_closed zero_in_M LambdaPair_in_M_replacement3
+  by simp
+
+arity_theorem for "is_transitive_fm"
+arity_theorem for "is_linear_fm"
+arity_theorem for "is_wellfounded_on_fm"
+arity_theorem for "is_well_ord_fm"
+
+arity_theorem for "pred_set_fm"
+arity_theorem for "image_fm"
+definition omap_wfrec_body where
+  "omap_wfrec_body(A,r) \<equiv> (\<cdot>\<exists>\<cdot>image_fm(2, 0, 1) \<and>
+               pred_set_fm
+                (succ(succ(succ(succ(succ(succ(succ(succ(succ(A))))))))), 3,
+                 succ(succ(succ(succ(succ(succ(succ(succ(succ(r))))))))), 0) \<cdot>\<cdot>)"
+
+lemma type_omap_wfrec_body_fm :"A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> omap_wfrec_body(A,r)\<in>formula"
+  unfolding omap_wfrec_body_def by simp
+
+lemma arity_aux : "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow> arity(omap_wfrec_body(A,r)) = (9+\<^sub>\<omega>A) \<union> (9+\<^sub>\<omega>r)"
+  unfolding omap_wfrec_body_def
+  using arity_image_fm arity_pred_set_fm pred_Un_distrib union_abs2[of 3] union_abs1
+  by (simp add:FOL_arities, auto simp add:Un_assoc[symmetric] union_abs1)
+
+lemma arity_omap_wfrec: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>
+  arity(is_wfrec_fm(omap_wfrec_body(A,r),succ(succ(succ(r))), 1, 0)) =
+  (4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)"
+  using Arities.arity_is_wfrec_fm[OF _ _ _ _ _ arity_aux,of A r "3+\<^sub>\<omega>r" 1 0] pred_Un_distrib
+    union_abs1 union_abs2 type_omap_wfrec_body_fm
+  by auto
+
+lemma arity_isordermap: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
+   arity(is_ordermap_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
+  unfolding is_ordermap_fm_def
+  using arity_lambda_fm[where i="(4+\<^sub>\<omega>A) \<union> (4+\<^sub>\<omega>r)",OF _ _ _ _ arity_omap_wfrec,
+      unfolded omap_wfrec_body_def] pred_Un_distrib union_abs1
+  by auto
+
+lemma arity_is_ordertype: "A\<in>nat \<Longrightarrow> r\<in>nat \<Longrightarrow>d\<in>nat\<Longrightarrow>
+   arity(is_ordertype_fm(A,r,d)) = succ(d) \<union> (succ(A) \<union> succ(r))"
+  unfolding is_ordertype_fm_def
+  using arity_isordermap arity_image_fm pred_Un_distrib FOL_arities
+  by auto
+
+arity_theorem for "is_order_body_fm"
+
+lemma arity_is_order_body: "arity(is_order_body_fm(2,0,1)) = 3"
+  using arity_is_order_body_fm arity_is_ordertype ord_simp_union
+  by (simp add:FOL_arities)
+
+lemma (in M_ZF3_trans) replacement_is_order_body:
+  "X\<in>M \<Longrightarrow> strong_replacement(##M, is_order_body(##M,X))"
+  apply(rule_tac strong_replacement_cong[
+        where P="\<lambda> x f. M,[x,f,X] \<Turnstile> is_order_body_fm(2,0,1)",THEN iffD1])
+   apply(rule_tac is_order_body_iff_sats[where env="[_,_,X]",symmetric])
+          apply(simp_all add:zero_in_M)
+  apply(rule_tac replacement_ax3(1)[unfolded replacement_assm_def, rule_format, where env="[X]",simplified])
+    apply(simp_all add: arity_is_order_body )
+  done
+
+lemma (in M_pre_cardinal_arith) is_order_body_abs :
+  "M(X) \<Longrightarrow> M(x) \<Longrightarrow> M(z) \<Longrightarrow> is_order_body(M, X, x, z) \<longleftrightarrow>
+   M(z) \<and> M(x) \<and> x\<in>Pow_rel(M,X\<times>X) \<and> well_ord(X, x) \<and> z = ordertype(X, x)"
+  using well_ord_abs is_well_ord_iff_wellordered is_ordertype_iff' ordertype_rel_abs
+    well_ord_is_linear subset_abs Pow_rel_char
+  unfolding is_order_body_def
+  by simp
+
+
+definition H_order_pred where
+  "H_order_pred(A,r) \<equiv>  \<lambda>x f . f `` Order.pred(A, x, r)"
+
+relationalize "H_order_pred" "is_H_order_pred"
+
+lemma (in M_basic) H_order_pred_abs :
+  "M(A) \<Longrightarrow> M(r) \<Longrightarrow> M(x) \<Longrightarrow> M(f) \<Longrightarrow> M(z) \<Longrightarrow>
+    is_H_order_pred(M,A,r,x,f,z) \<longleftrightarrow> z = H_order_pred(A,r,x,f)"
+  unfolding is_H_order_pred_def H_order_pred_def
+  by simp
+
+synthesize "is_H_order_pred" from_definition assuming "nonempty"
+
+lemma (in M_ZF3_trans) wfrec_replacement_order_pred:
+  "A\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> wfrec_replacement(##M, \<lambda>x g z. is_H_order_pred(##M,A,r,x,g,z) , r)"
+  unfolding wfrec_replacement_def is_wfrec_def M_is_recfun_def is_H_order_pred_def
+  apply(rule_tac strong_replacement_cong[
+        where P="\<lambda> x f. M,[x,f,r,A] \<Turnstile> order_pred_wfrec_body_fm(3,2,1,0)",THEN iffD1])
+   apply(subst order_pred_wfrec_body_def[symmetric])
+   apply(rule_tac order_pred_wfrec_body_iff_sats[where env="[_,_,r,A]",symmetric])
+           apply(simp_all add:zero_in_M)
+  apply(rule_tac replacement_ax3(2)[unfolded replacement_assm_def, rule_format, where env="[r,A]",simplified])
+    apply(simp_all add: arity_order_pred_wfrec_body_fm ord_simp_union)
+  done
+
+lemma (in M_ZF3_trans) wfrec_replacement_order_pred':
+  "A\<in>M \<Longrightarrow> r\<in>M \<Longrightarrow> wfrec_replacement(##M, \<lambda>x g z. z = H_order_pred(A,r,x,g) , r)"
+  using wfrec_replacement_cong[OF H_order_pred_abs[of A r,rule_format] refl,THEN iffD1,
+      OF _ _ _ _ _ wfrec_replacement_order_pred[of A r]]
+  by simp
+
+sublocale M_ZF3_trans \<subseteq> M_pre_cardinal_arith "##M"
+  using separation_instances wfrec_replacement_order_pred'[unfolded H_order_pred_def]
+    replacement_is_order_eq_map[unfolded order_eq_map_def] banach_replacement
+  by unfold_locales simp_all
+
+lemma (in M_ZF3_trans) replacement_ordertype:
+  "X\<in>M \<Longrightarrow> strong_replacement(##M, \<lambda>x z. z \<in> M \<and> x \<in> M \<and> x \<in> Pow\<^bsup>M\<^esup>(X \<times> X) \<and> well_ord(X, x) \<and> z = ordertype(X, x))"
+  using strong_replacement_cong[THEN iffD1,OF _ replacement_is_order_body,simplified] is_order_body_abs
+  unfolding is_order_body_def
+  by simp
+
+lemma arity_is_jump_cardinal_body: "arity(is_jump_cardinal_body'_fm(0,1)) = 2"
+  unfolding is_jump_cardinal_body'_fm_def
+  using arity_is_ordertype arity_is_well_ord_fm arity_is_Pow_fm arity_cartprod_fm
+    arity_Replace_fm[where i=5] ord_simp_union FOL_arities
+  by simp
+
+lemma (in M_ZF3_trans) replacement_is_jump_cardinal_body:
+  "strong_replacement(##M, is_jump_cardinal_body'(##M))"
+  apply(rule_tac strong_replacement_cong[
+        where P="\<lambda> x f. M,[x,f] \<Turnstile> is_jump_cardinal_body'_fm(0,1)",THEN iffD1])
+   apply(rule_tac is_jump_cardinal_body'_iff_sats[where env="[_,_]",symmetric])
+        apply(simp_all add:zero_in_M)
+  apply(rule_tac replacement_ax3(3)[unfolded replacement_assm_def, rule_format, where env="[]",simplified])
+   apply(simp_all add: arity_is_jump_cardinal_body )
+  done
+
+lemma (in M_pre_cardinal_arith) univalent_aux2: "M(X) \<Longrightarrow> univalent(M,Pow_rel(M,X\<times>X),
+  \<lambda>r z. M(z) \<and> M(r) \<and> is_well_ord(M, X, r) \<and> is_ordertype(M, X, r, z))"
+  using is_well_ord_iff_wellordered
+    is_ordertype_iff[of _ X]
+    trans_on_subset[OF well_ord_is_trans_on]
+    well_ord_is_wf[THEN wf_on_subset_A] mem_Pow_rel_abs
+  unfolding univalent_def
+  by (simp)
+
+lemma (in M_pre_cardinal_arith) is_jump_cardinal_body_abs :
+  "M(X) \<Longrightarrow> M(c) \<Longrightarrow> is_jump_cardinal_body'(M, X, c) \<longleftrightarrow> c = jump_cardinal_body'_rel(M,X)"
+  using well_ord_abs is_well_ord_iff_wellordered is_ordertype_iff' ordertype_rel_abs
+    well_ord_is_linear subset_abs Pow_rel_iff Replace_abs[of "Pow_rel(M,X\<times>X)",OF _ _
+      univalent_aux2]
+  unfolding is_jump_cardinal_body'_def jump_cardinal_body'_rel_def
+  by simp
+
+lemma (in M_ZF3_trans) replacement_jump_cardinal_body:
+  "strong_replacement(##M, \<lambda>x z. z \<in> M \<and> x \<in> M \<and> z = jump_cardinal_body(##M, x))"
+  using strong_replacement_cong[THEN iffD1,OF _ replacement_is_jump_cardinal_body,simplified]
+    jump_cardinal_body_eq is_jump_cardinal_body_abs
+  by simp
+
+sublocale M_ZF3_trans \<subseteq> M_pre_aleph "##M"
+  using replacement_ordertype replacement_jump_cardinal_body HAleph_wfrec_repl
+  by unfold_locales (simp_all add: transrec_replacement_def
+      wfrec_replacement_def is_wfrec_def M_is_recfun_def flip:setclass_iff)
+
+arity_theorem intermediate for "is_HAleph_fm"
+lemma arity_is_HAleph_fm: "arity(is_HAleph_fm(2, 1, 0)) = 3"
+  using arity_fun_apply_fm[of "11" 0 1,simplified]
+    arity_is_HAleph_fm' arity_ordinal_fm arity_is_If_fm
+    arity_empty_fm arity_is_Limit_fm
+    arity_is_If_fm
+    arity_is_Limit_fm arity_empty_fm
+    arity_Replace_fm[where i="12" and v=10 and n=3]
+    pred_Un_distrib ord_simp_union
+  by (simp add:FOL_arities)
+
+lemma arity_is_Aleph: "arity(is_Aleph_fm(0, 1)) = 2"
+  unfolding is_Aleph_fm_def
+  using arity_transrec_fm[OF _ _ _ _ arity_is_HAleph_fm] ord_simp_union
+  by simp
+
+lemma (in M_ZF3_trans) replacement_is_aleph:
+  "strong_replacement(##M, \<lambda>x y. Ord(x) \<and> is_Aleph(##M,x,y))"
+  apply(rule_tac strong_replacement_cong[
+        where P="\<lambda> x y. M,[x,y] \<Turnstile> And(ordinal_fm(0),is_Aleph_fm(0,1))",THEN iffD1])
+   apply (auto simp add: ordinal_iff_sats[where env="[_,_]",symmetric])
+    apply(rule_tac is_Aleph_iff_sats[where env="[_,_]",THEN iffD2],simp_all add:zero_in_M)
+   apply(rule_tac is_Aleph_iff_sats[where env="[_,_]",THEN iffD1],simp_all add:zero_in_M)
+  apply(rule_tac replacement_ax3(4)[unfolded replacement_assm_def, rule_format, where env="[]",simplified])
+   apply(simp_all add:arity_is_Aleph FOL_arities arity_ordinal_fm ord_simp_union is_Aleph_fm_type)
+  done
+
+lemma (in M_ZF3_trans) replacement_aleph_rel:
+  shows  "strong_replacement(##M, \<lambda>x y. Ord(x) \<and> y = \<aleph>\<^bsub>x\<^esub>\<^bsup>M\<^esup>)"
+  using strong_replacement_cong[THEN iffD2,OF _ replacement_is_aleph,where P1="\<lambda>x y . Ord(x) \<and> y=Aleph_rel(##M,x)"]
+    is_Aleph_iff
+  by auto
+
+sublocale M_ZF3_trans \<subseteq> M_aleph "##M"
+  by (unfold_locales,simp add: replacement_aleph_rel)
+
+sublocale M_ZF2_trans \<subseteq> M_FiniteFun "##M"
+  using separation_cons_like_rel separation_is_function
+  by unfold_locales simp
+
+sublocale M_ZFC1_trans \<subseteq> M_AC "##M"
+  using choice_ax by (unfold_locales, simp_all)
+
+sublocale M_ZFC3_trans \<subseteq> M_cardinal_AC "##M" ..
+
+(* TopLevel *)
+
+lemma (in M_ZF2_trans) separation_cardinal_rel_lesspoll_rel:
+  "(##M)(\<kappa>) \<Longrightarrow> separation(##M, \<lambda>x. x \<prec>\<^bsup>M\<^esup> \<kappa>)"
+  using separation_in_ctm[where \<phi>="( \<cdot>0 \<prec> 1\<cdot> )" and env="[\<kappa>]"]
+    is_lesspoll_iff nonempty
+    arity_is_cardinal_fm arity_is_lesspoll_fm arity_is_bij_fm ord_simp_union
+  by (simp add:FOL_arities)
+
+sublocale M_ZFC3_trans \<subseteq> M_library "##M"
+  using separation_cardinal_rel_lesspoll_rel
+  by unfold_locales simp_all
+
+locale M_ZF4 = M_ZF3 +
+  assumes
+    ground_replacements4:
+    "ground_replacement_assm(M,env,replacement_is_order_body_fm)"
+    "ground_replacement_assm(M,env,wfrec_replacement_order_pred_fm)"
+    "ground_replacement_assm(M,env,replacement_is_jump_cardinal_body_fm)"
+    "ground_replacement_assm(M,env,replacement_is_aleph_fm)"
+    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(is_inj_fm(0,1,2),0))"
+    "ground_replacement_assm(M,env,wfrec_Hfrc_at_fm)"
+    "ground_replacement_assm(M,env,list_repl1_intf_fm)"
+    "ground_replacement_assm(M,env,list_repl2_intf_fm)"
+    "ground_replacement_assm(M,env,formula_repl2_intf_fm)"
+    "ground_replacement_assm(M,env,eclose_repl2_intf_fm)"
+    "ground_replacement_assm(M,env,powapply_repl_fm)"
+    "ground_replacement_assm(M,env,phrank_repl_fm)"
+    "ground_replacement_assm(M,env,wfrec_rank_fm)"
+    "ground_replacement_assm(M,env,trans_repl_HVFrom_fm)"
+    "ground_replacement_assm(M,env,wfrec_Hcheck_fm)"
+    "ground_replacement_assm(M,env,repl_PHcheck_fm)"
+    "ground_replacement_assm(M,env,check_replacement_fm)"
+    "ground_replacement_assm(M,env,G_dot_in_M_fm)"
+    "ground_replacement_assm(M,env,repl_opname_check_fm)"
+    "ground_replacement_assm(M,env,tl_repl_intf_fm)"
+    "ground_replacement_assm(M,env,formula_repl1_intf_fm)"
+    "ground_replacement_assm(M,env,eclose_repl1_intf_fm)"
+    "ground_replacement_assm(M,env,replacement_is_omega_funspace_fm)"
+    "ground_replacement_assm(M,env,replacement_HAleph_wfrec_repl_body_fm)"
+    "ground_replacement_assm(M,env,replacement_is_fst2_snd2_fm)"
+    "ground_replacement_assm(M,env,replacement_is_sndfst_fst2_snd2_fm)"
+    "ground_replacement_assm(M,env,replacement_is_order_eq_map_fm)"
+    "ground_replacement_assm(M,env,replacement_transrec_apply_image_body_fm)"
+    "ground_replacement_assm(M,env,banach_replacement_iterates_fm)"
+    "ground_replacement_assm(M,env,replacement_is_trans_apply_image_fm)"
+    "ground_replacement_assm(M,env,banach_iterates_fm)"
+    "ground_replacement_assm(M,env,dcwit_repl_body_fm(6,5,4,3,2,0,1))"
+    "ground_replacement_assm(M,env,Lambda_in_M_fm(fst_fm(0,1),0))"
+    "ground_replacement_assm(M,env,Lambda_in_M_fm(big_union_fm(0,1),0))"
+    "ground_replacement_assm(M,env,Lambda_in_M_fm(is_cardinal_fm(0,1),0))"
+    "ground_replacement_assm(M,env,Lambda_in_M_fm(snd_fm(0,1),0))"
+    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(image_fm(0,1,2),0))"
+    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(setdiff_fm(0,1,2),0))"
+    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(minimum_fm(0,1,2),0))"
+    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(upair_fm(0,1,2),0))"
+    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0))"
+    "ground_replacement_assm(M,env,LambdaPair_in_M_fm(composition_fm(0,1,2),0))"
+    "ground_replacement_assm(M,env,Lambda_in_M_fm(is_converse_fm(0,1),0))"
+    "ground_replacement_assm(M,env,Lambda_in_M_fm(domain_fm(0,1),0))"
+
+definition instances4_fms where "instances4_fms \<equiv>
+  { ground_repl_fm(replacement_is_order_body_fm),
+    ground_repl_fm(wfrec_replacement_order_pred_fm),
+    ground_repl_fm(replacement_is_jump_cardinal_body_fm),
+    ground_repl_fm(replacement_is_aleph_fm),
+    ground_repl_fm(LambdaPair_in_M_fm(is_inj_fm(0,1,2),0)),
+    ground_repl_fm(wfrec_Hfrc_at_fm),
+    ground_repl_fm(list_repl1_intf_fm),
+    ground_repl_fm(list_repl2_intf_fm),
+    ground_repl_fm(formula_repl2_intf_fm),
+    ground_repl_fm(eclose_repl2_intf_fm),
+    ground_repl_fm(powapply_repl_fm),
+    ground_repl_fm(phrank_repl_fm),
+    ground_repl_fm(wfrec_rank_fm),
+    ground_repl_fm(trans_repl_HVFrom_fm),
+    ground_repl_fm(wfrec_Hcheck_fm),
+    ground_repl_fm(repl_PHcheck_fm),
+    ground_repl_fm(check_replacement_fm),
+    ground_repl_fm(G_dot_in_M_fm),
+    ground_repl_fm(repl_opname_check_fm),
+    ground_repl_fm(tl_repl_intf_fm),
+    ground_repl_fm(formula_repl1_intf_fm),
+    ground_repl_fm(eclose_repl1_intf_fm),
+    ground_repl_fm(replacement_is_omega_funspace_fm),
+    ground_repl_fm(replacement_HAleph_wfrec_repl_body_fm),
+    ground_repl_fm(replacement_is_fst2_snd2_fm),
+    ground_repl_fm(replacement_is_sndfst_fst2_snd2_fm),
+    ground_repl_fm(replacement_is_order_eq_map_fm),
+    ground_repl_fm(replacement_transrec_apply_image_body_fm),
+    ground_repl_fm(banach_replacement_iterates_fm),
+    ground_repl_fm(replacement_is_trans_apply_image_fm),
+    ground_repl_fm(banach_iterates_fm),
+    ground_repl_fm(dcwit_repl_body_fm(6,5,4,3,2,0,1)),
+    ground_repl_fm(Lambda_in_M_fm(fst_fm(0,1),0)),
+    ground_repl_fm(Lambda_in_M_fm(big_union_fm(0,1),0)),
+    ground_repl_fm(Lambda_in_M_fm(is_cardinal_fm(0,1),0)),
+    ground_repl_fm(Lambda_in_M_fm(snd_fm(0,1),0)),
+    ground_repl_fm(LambdaPair_in_M_fm(image_fm(0,1,2),0)),
+    ground_repl_fm(LambdaPair_in_M_fm(setdiff_fm(0,1,2),0)),
+    ground_repl_fm(LambdaPair_in_M_fm(minimum_fm(0,1,2),0)),
+    ground_repl_fm(LambdaPair_in_M_fm(upair_fm(0,1,2),0)),
+    ground_repl_fm(LambdaPair_in_M_fm(is_RepFun_body_fm(0,1,2),0)),
+    ground_repl_fm(LambdaPair_in_M_fm(composition_fm(0,1,2),0)),
+    ground_repl_fm(Lambda_in_M_fm(is_converse_fm(0,1),0)),
+    ground_repl_fm(Lambda_in_M_fm(domain_fm(0,1),0)) }"
+
+txt\<open>This set has 44 internalized formulas, corresponding to the total count
+of previous replacement instances.\<close>
+
+definition overhead where
+  "overhead \<equiv> instances1_fms \<union> instances2_fms \<union> instances3_fms \<union> instances4_fms"
+
+txt\<open>Hence, the “overhead” to force $\CH$ and its negation consists
+of 88 replacement instances.\<close>
+
+lemma instances3_fms_type[TC] : "instances3_fms \<subseteq> formula"
+  unfolding instances3_fms_def replacement_is_order_body_fm_def
+    wfrec_replacement_order_pred_fm_def replacement_is_jump_cardinal_body_fm_def
+    replacement_is_aleph_fm_def
+  by (auto simp del: Lambda_in_M_fm_def
+      ccc_fun_closed_lemma_aux2_fm_def ccc_fun_closed_lemma_fm_def)
+
+lemma overhead_type: "overhead \<subseteq> formula"
+  using instances1_fms_type instances2_fms_type
+  unfolding overhead_def instances3_fms_def instances4_fms_def
+    replacement_instances1_defs replacement_instances2_defs replacement_instances3_defs
+  using ground_repl_fm_type Lambda_in_M_fm_type
+  by (auto simp del: Lambda_in_M_fm_def
+      ccc_fun_closed_lemma_aux2_fm_def ccc_fun_closed_lemma_fm_def)
+
+locale M_ZF4_trans = M_ZF3_trans + M_ZF4
+
+locale M_ZFC4 = M_ZFC3 + M_ZF4
+
+locale M_ZFC4_trans = M_ZFC3_trans + M_ZF4_trans
+
+locale M_ctm4 = M_ctm3 + M_ZF4_trans
+
+locale M_ctm4_AC = M_ctm4 + M_ctm1_AC + M_ZFC4_trans
+
+locale forcing_data4 = forcing_data3 + M_ctm4_AC
+
+lemma M_satT_imp_M_ZF2: "(M \<Turnstile> ZF) \<Longrightarrow> M_ZF2(M)"
+proof -
+  assume "M \<Turnstile> ZF"
+  then
+  have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
+    "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
+    unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
+    using ZFC_fm_sats[of M] by simp_all
+  {
+    fix \<phi> env
+    assume "\<phi> \<in> formula" "env\<in>list(M)"
+    moreover from \<open>M \<Turnstile> ZF\<close>
+    have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
+      "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
+      unfolding ZF_def ZF_schemes_def by auto
+    moreover from calculation
+    have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
+      "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
+      using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
+  }
+  with fin
+  show "M_ZF2(M)"
+    by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
+qed
+
+lemma M_satT_imp_M_ZFC2:
+  shows "(M \<Turnstile> ZFC) \<longrightarrow> M_ZFC2(M)"
+proof -
+  have "(M \<Turnstile> ZF) \<and> choice_ax(##M) \<longrightarrow> M_ZFC2(M)"
+    using M_satT_imp_M_ZF2[of M] unfolding M_ZF2_def M_ZFC1_def M_ZFC2_def
+      M_ZC_basic_def M_ZF1_def M_AC_def by auto
+  then
+  show ?thesis
+    unfolding ZFC_def by auto
+qed
+
+lemma M_satT_instances12_imp_M_ZF2:
+  assumes "(M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms})"
+  shows "M_ZF2(M)"
+proof -
+  from assms
+  have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
+    "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
+    unfolding ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
+    using ZFC_fm_sats[of M] by simp_all
+  moreover
+  {
+    fix \<phi> env
+    from \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
+    have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
+      unfolding Zermelo_fms_def ZF_def instances1_fms_def
+        instances2_fms_def by auto
+    moreover
+    assume "\<phi> \<in> formula" "env\<in>list(M)"
+    ultimately
+    have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
+      using sats_ZF_separation_fm_iff by simp_all
+  }
+  moreover
+  {
+    fix \<phi> env
+    assume "\<phi> \<in> instances1_fms \<union> instances2_fms" "env\<in>list(M)"
+    moreover from this and \<open>M \<Turnstile> \<cdot>Z\<cdot> \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> instances1_fms \<union> instances2_fms}\<close>
+    have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
+    ultimately
+    have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
+      using sats_ZF_replacement_fm_iff[of \<phi>] instances1_fms_type instances2_fms_type by auto
+  }
+  ultimately
+  show ?thesis
+    unfolding instances1_fms_def instances2_fms_def
+    by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
+qed
+
+lemma (in M_Z_basic) M_satT_Zermelo_fms: "M \<Turnstile> \<cdot>Z\<cdot>"
+  using upair_ax Union_ax power_ax extensionality foundation_ax
+    infinity_ax separation_ax sats_ZF_separation_fm_iff
+  unfolding Zermelo_fms_def ZF_fin_def
+  by auto
+
+lemma (in M_ZFC1) M_satT_ZC: "M \<Turnstile> ZC"
+  using upair_ax Union_ax power_ax extensionality foundation_ax
+    infinity_ax separation_ax sats_ZF_separation_fm_iff choice_ax
+  unfolding ZC_def Zermelo_fms_def ZF_fin_def
+  by auto
+
+locale M_ZF = M_Z_basic +
+  assumes
+    replacement_ax:"replacement_assm(M,env,\<phi>)"
+
+lemma M_satT_imp_M_ZF: " M \<Turnstile> ZF \<Longrightarrow> M_ZF(M)"
+proof -
+  assume "M \<Turnstile> ZF"
+  then
+  have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
+    "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
+    unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
+    using ZFC_fm_sats[of M] by simp_all
+  {
+    fix \<phi> env
+    assume "\<phi> \<in> formula" "env\<in>list(M)"
+    moreover from \<open>M \<Turnstile> ZF\<close>
+    have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
+      "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
+      unfolding ZF_def ZF_schemes_def by auto
+    moreover from calculation
+    have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
+      "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
+      using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
+  }
+  with fin
+  show "M_ZF(M)"
+    unfolding M_ZF_def M_Z_basic_def M_ZF_axioms_def replacement_assm_def by simp
+qed
+
+lemma (in M_ZF) M_satT_ZF: "M \<Turnstile> ZF"
+  using upair_ax Union_ax power_ax extensionality foundation_ax
+    infinity_ax separation_ax sats_ZF_separation_fm_iff
+    replacement_ax sats_ZF_replacement_fm_iff
+  unfolding ZF_def ZF_schemes_def ZF_fin_def replacement_assm_def
+  by auto
+
+lemma M_ZF_iff_M_satT: "M_ZF(M) \<longleftrightarrow> (M \<Turnstile> ZF)"
+  using M_ZF.M_satT_ZF M_satT_imp_M_ZF
+  by auto
+
+locale M_ZFC = M_ZF + M_ZC_basic
+
+lemma M_ZFC_iff_M_satT:
+  notes iff_trans[trans]
+  shows "M_ZFC(M) \<longleftrightarrow> (M \<Turnstile> ZFC)"
+proof -
+  have "M_ZFC(M) \<longleftrightarrow> (M \<Turnstile> ZF) \<and> choice_ax(##M)"
+    using M_ZF_iff_M_satT
+    unfolding M_ZFC_def M_ZC_basic_def M_AC_def M_ZF_def by auto
+  also
+  have " \<dots> \<longleftrightarrow> M \<Turnstile> ZFC"
+    unfolding ZFC_def by auto
+  ultimately
+  show ?thesis by simp
+qed
+
+lemma M_satT_imp_M_ZF4: "(M \<Turnstile> ZF) \<longrightarrow> M_ZF4(M)"
+proof
+  assume "M \<Turnstile> ZF"
+  then
+  have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)"
+    "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
+    unfolding ZF_def ZF_fin_def ZFC_fm_defs satT_def
+    using ZFC_fm_sats[of M] by simp_all
+  {
+    fix \<phi> env
+    assume "\<phi> \<in> formula" "env\<in>list(M)"
+    moreover from \<open>M \<Turnstile> ZF\<close>
+    have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
+      "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_replacement_fm(p)))"
+      unfolding ZF_def ZF_schemes_def by auto
+    moreover from calculation
+    have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
+      "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
+      using sats_ZF_separation_fm_iff sats_ZF_replacement_fm_iff by simp_all
+  }
+  with fin
+  show "M_ZF4(M)"
+    by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
+qed
+
+lemma M_satT_imp_M_ZFC4:
+  shows "(M \<Turnstile> ZFC) \<longrightarrow> M_ZFC4(M)"
+proof -
+  have "(M \<Turnstile> ZF) \<and> choice_ax(##M) \<longrightarrow> M_ZFC4(M)"
+    using M_satT_imp_M_ZF4[of M] unfolding M_ZF4_def M_ZFC1_def M_ZFC4_def
+      M_ZF3_def M_ZFC3_def M_ZF2_def M_ZFC2_def
+      M_ZC_basic_def M_ZF1_def M_AC_def by auto
+  then
+  show ?thesis
+    unfolding ZFC_def by auto
+qed
+
+lemma M_satT_overhead_imp_M_ZF4:
+  "(M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}) \<longrightarrow> M_ZFC4(M)"
+proof
+  assume "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}"
+  then
+  have fin: "upair_ax(##M)" "Union_ax(##M)" "power_ax(##M)" "choice_ax(##M)"
+    "extensionality(##M)" "foundation_ax(##M)" "infinity_ax(##M)"
+    unfolding ZC_def ZF_fin_def Zermelo_fms_def ZFC_fm_defs satT_def
+    using ZFC_fm_sats[of M] by simp_all
+  moreover
+  {
+    fix \<phi> env
+    from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
+    have "\<forall>p\<in>formula. (M, [] \<Turnstile> (ZF_separation_fm(p)))"
+      unfolding ZC_def Zermelo_fms_def ZF_def overhead_def instances1_fms_def
+        instances2_fms_def instances3_fms_def instances4_fms_def by auto
+    moreover
+    assume "\<phi> \<in> formula" "env\<in>list(M)"
+    ultimately
+    have "arity(\<phi>) \<le> succ(length(env)) \<Longrightarrow> separation(##M, \<lambda>x. (M, Cons(x, env) \<Turnstile> \<phi>))"
+      using sats_ZF_separation_fm_iff by simp_all
+  }
+  moreover
+  {
+    fix \<phi> env
+    assume "\<phi> \<in> overhead" "env\<in>list(M)"
+    moreover from this and \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead}\<close>
+    have "M, [] \<Turnstile> \<cdot>Replacement(\<phi>)\<cdot>" by auto
+    ultimately
+    have "arity(\<phi>) \<le> succ(succ(length(env))) \<Longrightarrow> strong_replacement(##M,\<lambda>x y. sats(M,\<phi>,Cons(x,Cons(y, env))))"
+      using sats_ZF_replacement_fm_iff[of \<phi>] overhead_type by auto
+  }
+  ultimately
+  show "M_ZFC4(M)"
+    unfolding overhead_def instances1_fms_def
+      instances2_fms_def instances3_fms_def instances4_fms_def
+    by unfold_locales (simp_all add:replacement_assm_def ground_replacement_assm_def)
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Independence_CH/document/root.bib b/thys/Independence_CH/document/root.bib
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/document/root.bib
@@ -0,0 +1,75 @@
+@article{DBLP:journals/jar/PaulsonG96,
+  author    = {Lawrence C. Paulson and
+               Krzysztof Grabczewski},
+  title     = {Mechanizing Set Theory},
+  journal   = {J. Autom. Reasoning},
+  volume    = {17},
+  number    = {3},
+  pages     = {291--323},
+  year      = {1996},
+  xurl       = {https://doi.org/10.1007/BF00283132},
+  doi       = {10.1007/BF00283132},
+  timestamp = {Sat, 20 May 2017 00:22:31 +0200},
+  biburl    = {https://dblp.org/rec/bib/journals/jar/PaulsonG96},
+  bibsource = {dblp computer science bibliography, https://dblp.org}
+}
+
+@inproceedings{2018arXiv180705174G,
+       author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
+  title     = {First Steps Towards a Formalization of Forcing},
+  booktitle = {Proceedings of the 13th Workshop on Logical and Semantic Frameworks
+               with Applications, {LSFA} 2018, Fortaleza, Brazil, September 26-28,
+               2018},
+  pages     = {119--136},
+  year      = {2018},
+  url       = {https://doi.org/10.1016/j.entcs.2019.07.008},
+  doi       = {10.1016/j.entcs.2019.07.008},
+  timestamp = {Wed, 05 Feb 2020 13:47:23 +0100},
+  biburl    = {https://dblp.org/rec/journals/entcs/GuntherPT19.bib},
+  bibsource = {dblp computer science bibliography, https://dblp.org}
+}
+
+
+@ARTICLE{2019arXiv190103313G,
+       author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
+        title = "{Mechanization of Separation in Generic Extensions}",
+      journal = {arXiv e-prints},
+     keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1},
+         year = 2019,
+        month = Jan,
+          eid = {arXiv:1901.03313},
+       volume = {1901.03313},
+archivePrefix = {arXiv},
+       eprint = {1901.03313},
+ primaryClass = {cs.LO},
+       adsurl = {https://ui.adsabs.harvard.edu/\#abs/2019arXiv190103313G},
+      adsnote = {Provided by the SAO/NASA Astrophysics Data System},
+     abstract = {We mechanize, in the proof assistant Isabelle, a proof of the axiom-scheme of Separation in generic extensions of models of set theory by using the fundamental theorems of forcing. We also formalize the satisfaction of the axioms of Extensionality, Foundation, Union, and Powerset. The axiom of Infinity is likewise treated, under additional assumptions on the ground model. In order to achieve these goals, we extended Paulson's library on constructibility with renaming of variables for internalized formulas, improved results on definitions by recursion on well-founded relations, and sharpened hypotheses in his development of relativization and absoluteness.}
+}
+
+@inproceedings{2020arXiv200109715G,
+       author = {Gunther, Emmanuel and Pagano, Miguel and S{\'a}nchez Terraf, Pedro},
+        title = "{Formalization of Forcing in Isabelle/ZF}",
+    isbn      = {978-3-662-45488-6},
+    booktitle = {Automated Reasoning. 10th International Joint Conference, IJCAR 2020, Paris, France, July 1--4, 2020, Proceedings, Part II},
+    volume    = 12167,
+    series    = {Lecture Notes in Artificial Intelligence},
+    editor    = {Peltier, Nicolas and  Sofronie-Stokkermans, Viorica},
+    publisher = {Springer International Publishing},
+    doi       = {10.1007/978-3-030-51054-1},
+    pages     = {221--235},
+      journal = {arXiv e-prints},
+     keywords = {Computer Science - Logic in Computer Science, Mathematics - Logic, 03B35 (Primary) 03E40, 03B70, 68T15 (Secondary), F.4.1},
+         year = 2020,
+          eid = {arXiv:2001.09715},
+archivePrefix = {arXiv},
+       eprint = {2001.09715},
+ primaryClass = {cs.LO},
+       adsurl = {https://ui.adsabs.harvard.edu/abs/2020arXiv200109715G},
+     abstract = {We formalize the theory of forcing in the set theory framework of
+Isabelle/ZF. Under the assumption of the existence of a countable
+transitive model of $\mathit{ZFC}$, we construct a proper generic extension and show
+that the latter also satisfies $\mathit{ZFC}$. In doing so, we remodularized
+Paulson's ZF-Constructibility library.},
+      adsnote = {Provided by the SAO/NASA Astrophysics Data System}
+}
diff --git a/thys/Independence_CH/document/root.bst b/thys/Independence_CH/document/root.bst
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/document/root.bst
@@ -0,0 +1,1440 @@
+%% 
+%% by pedro
+%% Based on file `model1b-num-names.bst'
+%% 
+%%
+%%
+ENTRY
+  { address
+    author
+    booktitle
+    chapter
+    edition
+    editor
+    howpublished
+    institution
+    journal
+    key
+    month
+    note
+    number
+    organization
+    pages
+    publisher
+    school
+    series
+    title
+    type
+    volume
+    year
+  }
+  {}
+  { label extra.label sort.label short.list }
+INTEGERS { output.state before.all mid.sentence after.sentence after.block }
+FUNCTION {init.state.consts}
+{ #0 'before.all :=
+  #1 'mid.sentence :=
+  #2 'after.sentence :=
+  #3 'after.block :=
+}
+STRINGS { s t}
+FUNCTION {output.nonnull}
+{ 's :=
+  output.state mid.sentence =
+    { ", " * write$ }
+    { output.state after.block =
+        { add.period$ write$
+          newline$
+          "\newblock " write$
+        }
+        { output.state before.all =
+            'write$
+            { add.period$ " " * write$ }
+          if$
+        }
+      if$
+      mid.sentence 'output.state :=
+    }
+  if$
+  s
+}
+FUNCTION {output}
+{ duplicate$ empty$
+    'pop$
+    'output.nonnull
+  if$
+}
+FUNCTION {output.check}
+{ 't :=
+  duplicate$ empty$
+    { pop$ "empty " t * " in " * cite$ * warning$ }
+    'output.nonnull
+  if$
+}
+FUNCTION {fin.entry}
+{ add.period$
+  write$
+  newline$
+}
+
+FUNCTION {new.block}
+{ output.state before.all =
+    'skip$
+    { after.block 'output.state := }
+  if$
+}
+FUNCTION {new.sentence}
+{ output.state after.block =
+    'skip$
+    { output.state before.all =
+        'skip$
+        { after.sentence 'output.state := }
+      if$
+    }
+  if$
+}
+FUNCTION {add.blank}
+{  " " * before.all 'output.state :=
+}
+
+FUNCTION {date.block}
+{
+  skip$
+}
+
+FUNCTION {not}
+{   { #0 }
+    { #1 }
+  if$
+}
+FUNCTION {and}
+{   'skip$
+    { pop$ #0 }
+  if$
+}
+FUNCTION {or}
+{   { pop$ #1 }
+    'skip$
+  if$
+}
+FUNCTION {new.block.checkb}
+{ empty$
+  swap$ empty$
+  and
+    'skip$
+    'new.block
+  if$
+}
+FUNCTION {field.or.null}
+{ duplicate$ empty$
+    { pop$ "" }
+    'skip$
+  if$
+}
+FUNCTION {emphasize}
+{ duplicate$ empty$
+    { pop$ "" }
+    { "\textit{" swap$ * "}" * }
+  if$
+}
+%% by pedro
+FUNCTION {slanted}
+{ duplicate$ empty$
+    { pop$ "" }
+    { "\textsl{" swap$ * "}" * }
+  if$
+}
+FUNCTION {smallcaps}
+{ duplicate$ empty$
+    { pop$ "" }
+    { "\textsc{" swap$ * "}" * }
+  if$
+}
+FUNCTION {bold}
+{ duplicate$ empty$
+    { pop$ "" }
+    { "\textbf{" swap$ * "}" * }
+  if$
+}
+
+
+FUNCTION {tie.or.space.prefix}
+{ duplicate$ text.length$ #3 <
+    { "~" }
+    { " " }
+  if$
+  swap$
+}
+
+FUNCTION {capitalize}
+{ "u" change.case$ "t" change.case$ }
+
+FUNCTION {space.word}
+{ " " swap$ * " " * }
+ % Here are the language-specific definitions for explicit words.
+ % Each function has a name bbl.xxx where xxx is the English word.
+ % The language selected here is ENGLISH
+FUNCTION {bbl.and}
+{ "and"}
+
+FUNCTION {bbl.etal}
+{ "et~al." }
+
+FUNCTION {bbl.editors}
+{ "eds." }
+
+FUNCTION {bbl.editor}
+{ "ed." }
+
+FUNCTION {bbl.edby}
+{ "edited by" }
+
+FUNCTION {bbl.edition}
+{ "edition" }
+
+FUNCTION {bbl.volume}
+{ "volume" }
+
+FUNCTION {bbl.of}
+{ "of" }
+
+FUNCTION {bbl.number}
+{ "number" }
+
+FUNCTION {bbl.nr}
+{ "no." }
+
+FUNCTION {bbl.in}
+{ "in" }
+
+FUNCTION {bbl.pages}
+{ "pp." }
+
+FUNCTION {bbl.page}
+{ "p." }
+
+FUNCTION {bbl.chapter}
+{ "chapter" }
+
+FUNCTION {bbl.techrep}
+{ "Technical Report" }
+
+FUNCTION {bbl.mthesis}
+{ "Master's thesis" }
+
+FUNCTION {bbl.phdthesis}
+{ "Ph.D. thesis" }
+
+MACRO {jan} {"January"}
+
+MACRO {feb} {"February"}
+
+MACRO {mar} {"March"}
+
+MACRO {apr} {"April"}
+
+MACRO {may} {"May"}
+
+MACRO {jun} {"June"}
+
+MACRO {jul} {"July"}
+
+MACRO {aug} {"August"}
+
+MACRO {sep} {"September"}
+
+MACRO {oct} {"October"}
+
+MACRO {nov} {"November"}
+
+MACRO {dec} {"December"}
+
+MACRO {acmcs} {"ACM Comput. Surv."}
+
+MACRO {acta} {"Acta Inf."}
+
+MACRO {cacm} {"Commun. ACM"}
+
+MACRO {ibmjrd} {"IBM J. Res. Dev."}
+
+MACRO {ibmsj} {"IBM Syst.~J."}
+
+MACRO {ieeese} {"IEEE Trans. Software Eng."}
+
+MACRO {ieeetc} {"IEEE Trans. Comput."}
+
+MACRO {ieeetcad}
+ {"IEEE Trans. Comput. Aid. Des."}
+
+MACRO {ipl} {"Inf. Process. Lett."}
+
+MACRO {jacm} {"J.~ACM"}
+
+MACRO {jcss} {"J.~Comput. Syst. Sci."}
+
+MACRO {scp} {"Sci. Comput. Program."}
+
+MACRO {sicomp} {"SIAM J. Comput."}
+
+MACRO {tocs} {"ACM Trans. Comput. Syst."}
+
+MACRO {tods} {"ACM Trans. Database Syst."}
+
+MACRO {tog} {"ACM Trans. Graphic."}
+
+MACRO {toms} {"ACM Trans. Math. Software"}
+
+MACRO {toois} {"ACM Trans. Office Inf. Syst."}
+
+MACRO {toplas} {"ACM Trans. Progr. Lang. Syst."}
+
+MACRO {tcs} {"Theor. Comput. Sci."}
+
+FUNCTION {bibinfo.check}
+{ swap$
+  duplicate$ missing$
+    {
+      pop$ pop$
+      ""
+    }
+    { duplicate$ empty$
+        {
+          swap$ pop$
+        }
+        { swap$
+          "\bibinfo{" swap$ * "}{" * swap$ * "}" *
+        }
+      if$
+    }
+  if$
+}
+FUNCTION {bibinfo.warn}
+{ swap$
+  duplicate$ missing$
+    {
+      swap$ "missing " swap$ * " in " * cite$ * warning$ pop$
+      ""
+    }
+    { duplicate$ empty$
+        {
+          swap$ "empty " swap$ * " in " * cite$ * warning$
+        }
+        { swap$
+          pop$
+        }
+      if$
+    }
+  if$
+}
+STRINGS  { bibinfo}
+INTEGERS { nameptr namesleft numnames }
+
+FUNCTION {format.names}
+{ 'bibinfo :=
+  duplicate$ empty$ 'skip$ {
+  's :=
+  "" 't :=
+  #1 'nameptr :=
+  s num.names$ 'numnames :=
+  numnames 'namesleft :=
+    { namesleft #0 > }
+    { s nameptr
+      "{f{.}.~}{vv~}{ll}{, jj}"
+      format.name$
+      bibinfo bibinfo.check
+      't :=
+      nameptr #1 >
+        {
+          namesleft #1 >
+            { ", " * t * }
+            {
+              "," *
+              s nameptr "{ll}" format.name$ duplicate$ "others" =
+                { 't := }
+                { pop$ }
+              if$
+              t "others" =
+                {
+                  " " * bbl.etal *
+                }
+                { " " * t * }
+              if$
+            }
+          if$
+        }
+        't
+      if$
+      nameptr #1 + 'nameptr :=
+      namesleft #1 - 'namesleft :=
+    }
+  while$
+  } if$
+}
+FUNCTION {format.names.ed}
+{
+  format.names
+}
+FUNCTION {format.key}
+{ empty$
+    { key field.or.null }
+    { "" }
+  if$
+}
+
+FUNCTION {format.authors}
+{ author "author" format.names smallcaps
+}
+FUNCTION {get.bbl.editor}
+{ editor num.names$ #1 > 'bbl.editors 'bbl.editor if$ }
+
+FUNCTION {format.editors}
+{ editor "editor" format.names duplicate$ empty$ 'skip$
+    {
+      " " *
+      get.bbl.editor
+      capitalize
+   "(" swap$ * ")" *
+      *
+    }
+  if$
+}
+FUNCTION {format.note}
+{
+ note empty$
+    { "" }
+    { note #1 #1 substring$
+      duplicate$ "{" =
+        'skip$
+        { output.state mid.sentence =
+          { "l" }
+          { "u" }
+        if$
+        change.case$
+        }
+      if$
+      note #2 global.max$ substring$ * "note" bibinfo.check
+    }
+  if$
+}
+
+FUNCTION {format.title}
+{ title
+  duplicate$ empty$ 'skip$
+    { "t" change.case$ }
+  if$
+  "title" bibinfo.check
+}
+FUNCTION {format.full.names}
+{'s :=
+ "" 't :=
+  #1 'nameptr :=
+  s num.names$ 'numnames :=
+  numnames 'namesleft :=
+    { namesleft #0 > }
+    { s nameptr
+      "{vv~}{ll}" format.name$
+      't :=
+      nameptr #1 >
+        {
+          namesleft #1 >
+            { ", " * t * }
+            {
+              s nameptr "{ll}" format.name$ duplicate$ "others" =
+                { 't := }
+                { pop$ }
+              if$
+              t "others" =
+                {
+                  " " * bbl.etal *
+                }
+                {
+                  bbl.and
+                  space.word * t *
+                }
+              if$
+            }
+          if$
+        }
+        't
+      if$
+      nameptr #1 + 'nameptr :=
+      namesleft #1 - 'namesleft :=
+    }
+  while$
+}
+
+FUNCTION {author.editor.key.full}
+{ author empty$
+    { editor empty$
+        { key empty$
+            { cite$ #1 #3 substring$ }
+            'key
+          if$
+        }
+        { editor format.full.names }
+      if$
+    }
+    { author format.full.names }
+  if$
+}
+
+FUNCTION {author.key.full}
+{ author empty$
+    { key empty$
+         { cite$ #1 #3 substring$ }
+          'key
+      if$
+    }
+    { author format.full.names }
+  if$
+}
+
+FUNCTION {editor.key.full}
+{ editor empty$
+    { key empty$
+         { cite$ #1 #3 substring$ }
+          'key
+      if$
+    }
+    { editor format.full.names }
+  if$
+}
+
+FUNCTION {make.full.names}
+{ type$ "book" =
+  type$ "inbook" =
+  or
+    'author.editor.key.full
+    { type$ "proceedings" =
+        'editor.key.full
+        'author.key.full
+      if$
+    }
+  if$
+}
+
+FUNCTION {output.bibitem}
+{ newline$
+  "\bibitem[{" write$
+  label write$
+  ")" make.full.names duplicate$ short.list =
+     { pop$ }
+     { * }
+   if$
+  "}]{" * write$
+  cite$ write$
+  "}" write$
+  newline$
+  ""
+  before.all 'output.state :=
+}
+
+FUNCTION {n.dashify}
+{
+  't :=
+  ""
+    { t empty$ not }
+    { t #1 #1 substring$ "-" =
+        { t #1 #2 substring$ "--" = not
+            { "--" *
+              t #2 global.max$ substring$ 't :=
+            }
+            {   { t #1 #1 substring$ "-" = }
+                { "-" *
+                  t #2 global.max$ substring$ 't :=
+                }
+              while$
+            }
+          if$
+        }
+        { t #1 #1 substring$ *
+          t #2 global.max$ substring$ 't :=
+        }
+      if$
+    }
+  while$
+}
+
+FUNCTION {word.in}
+{ bbl.in
+  ":" *
+  " " * }
+
+FUNCTION {format.date}
+{ year "year" bibinfo.check duplicate$ empty$
+    {
+      "empty year in " cite$ * "; set to ????" * warning$
+       pop$ "????"
+    }
+    'skip$
+  if$
+  %  extra.label *
+  %% by pedro
+  " (" swap$ * ")" *
+}
+FUNCTION{format.year}
+{ year "year" bibinfo.check duplicate$ empty$
+    {  "empty year in " cite$ *
+       "; set to ????" *
+       warning$
+       pop$ "????"
+    }
+    {
+    }
+  if$
+  % extra.label *
+  " (" swap$ * ")" *
+}
+FUNCTION {format.btitle}
+{ title "title" bibinfo.check
+  duplicate$ empty$ 'skip$
+    {
+    }
+  if$
+  %% by pedro
+  "``" swap$ * "''" *
+}
+FUNCTION {either.or.check}
+{ empty$
+    'pop$
+    { "can't use both " swap$ * " fields in " * cite$ * warning$ }
+  if$
+}
+FUNCTION {format.bvolume}
+{ volume empty$
+    { "" }
+    %% by pedro
+    { series "series" bibinfo.check
+      duplicate$ empty$ 'pop$
+        { %slanted
+           }
+      if$
+      "volume and number" number either.or.check
+      volume tie.or.space.prefix
+      "volume" bibinfo.check 
+      bold
+      * *
+    }
+  if$
+}
+FUNCTION {format.number.series}
+{ volume empty$
+    { number empty$
+        { series field.or.null }
+        { series empty$
+            { number "number" bibinfo.check }
+        { output.state mid.sentence =
+            { bbl.number }
+            { bbl.number capitalize }
+          if$
+          number tie.or.space.prefix "number" bibinfo.check * *
+          bbl.in space.word *
+          series "series" bibinfo.check *
+        }
+      if$
+    }
+      if$
+    }
+    { "" }
+  if$
+}
+
+FUNCTION {format.edition}
+{ edition duplicate$ empty$ 'skip$
+    {
+      output.state mid.sentence =
+        { "l" }
+        { "t" }
+      if$ change.case$
+      "edition" bibinfo.check
+      " " * bbl.edition *
+    }
+  if$
+}
+
+INTEGERS { multiresult }
+FUNCTION {multi.page.check}
+{ 't :=
+  #0 'multiresult :=
+    { multiresult not
+      t empty$ not
+      and
+    }
+    { t #1 #1 substring$
+      duplicate$ "-" =
+      swap$ duplicate$ "," =
+      swap$ "+" =
+      or or
+        { #1 'multiresult := }
+        { t #2 global.max$ substring$ 't := }
+      if$
+    }
+  while$
+  multiresult
+}
+FUNCTION {format.pages}
+{ pages duplicate$ empty$ 'skip$
+    { duplicate$ multi.page.check
+        {
+          bbl.pages swap$
+          n.dashify
+        }
+        {
+          bbl.page swap$
+        }
+      if$
+      tie.or.space.prefix
+      "pages" bibinfo.check
+      * *
+    }
+  if$
+}
+
+FUNCTION {format.pages.simple}
+{ pages duplicate$ empty$ 'skip$
+    { duplicate$ multi.page.check
+        {
+%          bbl.pages swap$
+          n.dashify
+        }
+        {
+%          bbl.page swap$
+        }
+      if$
+      tie.or.space.prefix
+      "pages" bibinfo.check
+      * 
+    }
+  if$
+}
+FUNCTION {format.journal.pages}
+{ pages duplicate$ empty$ 'pop$
+    { swap$ duplicate$ empty$
+        { pop$ pop$ format.pages }
+        {
+          ": " *
+          swap$
+          n.dashify
+          "pages" bibinfo.check
+          *
+        }
+      if$
+    }
+  if$
+}
+FUNCTION {format.vol.num.pages}
+{ volume field.or.null
+  duplicate$ empty$ 'skip$
+    {
+      "volume" bibinfo.check
+    }
+  if$
+  %% by pedro
+  bold
+  pages duplicate$ empty$ 'pop$
+  { swap$ duplicate$ empty$
+      { pop$ pop$ format.pages }
+      {
+        ": " *
+        swap$
+        n.dashify
+        "pages" bibinfo.check
+        *
+      }
+      if$
+  }
+  if$
+  format.year * 
+}
+
+FUNCTION {format.chapter.pages}
+{ chapter empty$
+    { "" }
+    { type empty$
+        { bbl.chapter }
+        { type "l" change.case$
+          "type" bibinfo.check
+        }
+      if$
+      chapter tie.or.space.prefix
+      "chapter" bibinfo.check
+      * *
+    }
+  if$
+}
+
+FUNCTION {format.booktitle}
+{
+  booktitle "booktitle" bibinfo.check
+}
+FUNCTION {format.in.ed.booktitle}
+{ format.booktitle duplicate$ empty$ 'skip$
+    {
+      editor "editor" format.names.ed duplicate$ empty$ 'pop$
+        {
+          " " *
+          get.bbl.editor
+          capitalize
+          "(" swap$ * "), " *
+          * swap$
+          * }
+      if$
+      word.in swap$ *
+    }
+  if$
+}
+FUNCTION {format.thesis.type}
+{ type duplicate$ empty$
+    'pop$
+    { swap$ pop$
+      "t" change.case$ "type" bibinfo.check
+    }
+  if$
+}
+FUNCTION {format.tr.number}
+{ number "number" bibinfo.check
+  type duplicate$ empty$
+    { pop$ bbl.techrep }
+    'skip$
+  if$
+  "type" bibinfo.check
+  swap$ duplicate$ empty$
+    { pop$ "t" change.case$ }
+    { tie.or.space.prefix * * }
+  if$
+}
+FUNCTION {format.article.crossref}
+{
+  word.in
+  " \cite{" * crossref * "}" *
+}
+FUNCTION {format.book.crossref}
+{ volume duplicate$ empty$
+    { "empty volume in " cite$ * "'s crossref of " * crossref * warning$
+      pop$ word.in
+    }
+    { bbl.volume
+      swap$ tie.or.space.prefix "volume" bibinfo.check * * bbl.of space.word *
+    }
+  if$
+  " \cite{" * crossref * "}" *
+}
+FUNCTION {format.incoll.inproc.crossref}
+{
+  word.in
+  " \cite{" * crossref * "}" *
+}
+FUNCTION {format.org.or.pub}
+{ 't :=
+  ""
+  address empty$ t empty$ and
+    'skip$
+    {
+      t empty$
+        { address "address" bibinfo.check *
+        }
+        { t *
+          address empty$
+            'skip$
+            { ", " * address "address" bibinfo.check * }
+          if$
+        }
+      if$
+    }
+  if$
+}
+FUNCTION {format.publisher.address}
+{ publisher "publisher" bibinfo.check format.org.or.pub
+}
+FUNCTION {format.publisher.address.year}
+{ publisher "publisher" bibinfo.check format.org.or.pub
+  format.journal.pages
+  format.year *
+}
+
+FUNCTION {school.address.year}
+{ school "school"  bibinfo.warn 
+  address empty$
+    'skip$
+    { ", " * address "address" bibinfo.check * }
+  if$
+ format.year * 
+}
+
+FUNCTION {format.publisher.address.pages}
+{ publisher "publisher" bibinfo.check format.org.or.pub
+  format.year *
+  
+}
+
+FUNCTION {format.organization.address}
+{ organization "organization" bibinfo.check format.org.or.pub
+}
+
+FUNCTION {format.organization.address.year}
+{ organization "organization" bibinfo.check format.org.or.pub
+  format.journal.pages
+  format.year *
+}
+
+FUNCTION {article}
+{ "%Type = Article" write$
+  output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  format.title "title" output.check
+  crossref missing$
+    {
+      journal
+      "journal" bibinfo.check
+      %% by pedro
+      emphasize
+      "journal" output.check
+      add.blank
+      format.vol.num.pages output
+    }
+    { format.article.crossref output.nonnull
+    }
+  if$
+%  format.journal.pages
+  new.sentence
+  format.note output
+  fin.entry
+}
+FUNCTION {book}
+{ "%Type = Book" write$
+  output.bibitem
+  author empty$
+    { format.editors "author and editor" output.check
+      editor format.key output
+    }
+    { format.authors output.nonnull
+      crossref missing$
+        { "author and editor" editor either.or.check }
+        'skip$
+      if$
+    }
+  if$
+  format.btitle "title" output.check
+  crossref missing$
+    { %% by pedro
+      format.bvolume output
+      format.number.series output
+      % format.bvolume output
+      format.publisher.address.year output
+    }
+    {
+      format.book.crossref output.nonnull
+    }
+  if$
+  format.edition output
+  % format.date "year" output.check
+  new.sentence
+  format.note output
+  fin.entry
+}
+FUNCTION {booklet}
+{ "%Type = Booklet" write$
+  output.bibitem
+  format.authors output
+  author format.key output
+  format.title "title" output.check
+  howpublished "howpublished" bibinfo.check output
+  address "address" bibinfo.check output
+  format.date "year" output.check
+  new.sentence
+  format.note output
+  fin.entry
+}
+
+FUNCTION {inbook}
+{ "%Type = Inbook" write$
+  output.bibitem
+  author empty$
+    { format.editors "author and editor" output.check
+      editor format.key output
+    }
+    { format.authors output.nonnull
+  format.title "title" output.check
+      crossref missing$
+        { "author and editor" editor either.or.check }
+        'skip$
+      if$
+    }
+  if$
+  format.btitle "title" output.check
+  crossref missing$
+    {
+      format.bvolume output
+      format.number.series output
+      format.publisher.address output
+      format.pages "pages" output.check
+      format.edition output
+      format.date "year" output.check
+    }
+    {
+      format.book.crossref output.nonnull
+    }
+  if$
+%  format.edition output
+%  format.pages "pages" output.check
+  new.sentence
+  format.note output
+  fin.entry
+}
+
+FUNCTION {incollection}
+{ "%Type = Incollection" write$
+  output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  format.title "title" output.check
+  crossref missing$
+    { format.in.ed.booktitle "booktitle" output.check
+      format.bvolume output
+      format.number.series output
+      format.pages "pages" output.check
+      % format.publisher.address output
+      % format.date "year" output.check
+      format.publisher.address.year output
+      format.edition output
+    }
+    { format.incoll.inproc.crossref output.nonnull
+    }
+  if$
+%  format.pages "pages" output.check
+  new.sentence
+  format.note output
+  fin.entry
+}
+FUNCTION {inproceedings}
+{ "%Type = Inproceedings" write$
+  output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  format.title "title" output.check
+  crossref missing$
+    {
+      journal
+      "journal" bibinfo.check
+      "journal" output.check
+      format.in.ed.booktitle "booktitle" output.check
+      format.bvolume output
+      format.number.series output
+      publisher empty$
+        { %format.organization.address output 
+	  format.organization.address.year output 
+%	  format.journal.pages		  
+	}
+        { organization "organization" bibinfo.check output
+          format.publisher.address.year output
+          % format.date "year" output.check
+%	  format.journal.pages
+        }
+      if$
+    }
+    { format.incoll.inproc.crossref output.nonnull
+      format.journal.pages
+    }
+  if$
+% format.pages.simple "pages" output.check
+%%% La que sigue la muevo adentro del "if"
+% format.journal.pages
+  new.sentence
+  format.note output
+  fin.entry
+}
+FUNCTION {conference} { inproceedings }
+FUNCTION {manual}
+{ "%Type = Manual" write$
+  output.bibitem
+  format.authors output
+  author format.key output
+  format.btitle "title" output.check
+  organization "organization" bibinfo.check output
+  address "address" bibinfo.check output
+  format.edition output
+  format.date "year" output.check
+  new.sentence
+  format.note output
+  fin.entry
+}
+
+FUNCTION {mastersthesis}
+{ "%Type = Masterthesis" write$
+  output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  format.btitle
+  "title" output.check
+  bbl.mthesis format.thesis.type output.nonnull
+%  school "school" bibinfo.warn output
+%  address "address" bibinfo.check output
+%  format.date "year" output.check
+  school.address.year output
+  new.sentence
+  format.note output
+  fin.entry
+}
+
+FUNCTION {misc}
+{ "%Type = Misc" write$
+  output.bibitem
+  format.authors output
+  author format.key output
+  format.title output
+  howpublished "howpublished" bibinfo.check output
+  format.date "year" output.check
+  new.sentence
+  format.note output
+  fin.entry
+}
+FUNCTION {phdthesis}
+{ "%Type = Phdthesis" write$
+  output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  format.btitle
+  "title" output.check
+  bbl.phdthesis format.thesis.type output.nonnull
+%  school "school" bibinfo.warn output
+%  address "address" bibinfo.check output
+%  format.date "year" output.check
+  school.address.year output
+  new.sentence
+  format.note output
+  fin.entry
+}
+
+FUNCTION {proceedings}
+{ "%Type = Proceedings" write$
+  output.bibitem
+  format.editors output
+  editor format.key output
+  format.btitle "title" output.check
+  format.bvolume output
+  format.number.series output
+  publisher empty$
+    { format.organization.address output }
+    { organization "organization" bibinfo.check output
+      format.publisher.address output
+    }
+  if$
+  format.date "year" output.check
+  new.sentence
+  format.note output
+  fin.entry
+}
+
+FUNCTION {techreport}
+{ "%Type = Techreport" write$
+  output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  format.btitle
+  "title" output.check
+  format.tr.number output.nonnull
+  institution "institution" bibinfo.warn output
+  address "address" bibinfo.check output
+  format.date "year" output.check
+  new.sentence
+  format.note output
+  fin.entry
+}
+
+FUNCTION {unpublished}
+{ "%Type = Unpublished" write$
+  output.bibitem
+  format.authors "author" output.check
+  author format.key output
+  format.title "title" output.check
+  format.date "year" output.check
+  new.sentence
+  format.note "note" output.check
+  fin.entry
+}
+
+FUNCTION {default.type} { misc }
+READ
+FUNCTION {sortify}
+{ purify$
+  "l" change.case$
+}
+INTEGERS { len }
+FUNCTION {chop.word}
+{ 's :=
+  'len :=
+  s #1 len substring$ =
+    { s len #1 + global.max$ substring$ }
+    's
+  if$
+}
+FUNCTION {format.lab.names}
+{ 's :=
+  "" 't :=
+  s #1 "{vv~}{ll}" format.name$
+  s num.names$ duplicate$
+  #2 >
+    { pop$
+      " " * bbl.etal *
+    }
+    { #2 <
+        'skip$
+        { s #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" =
+            {
+              " " * bbl.etal *
+            }
+            { bbl.and space.word * s #2 "{vv~}{ll}" format.name$
+              * }
+          if$
+        }
+      if$
+    }
+  if$
+}
+
+FUNCTION {author.key.label}
+{ author empty$
+    { key empty$
+        { cite$ #1 #3 substring$ }
+        'key
+      if$
+    }
+    { author format.lab.names }
+  if$
+}
+
+FUNCTION {author.editor.key.label}
+{ author empty$
+    { editor empty$
+        { key empty$
+            { cite$ #1 #3 substring$ }
+            'key
+          if$
+        }
+        { editor format.lab.names }
+      if$
+    }
+    { author format.lab.names }
+  if$
+}
+
+FUNCTION {editor.key.label}
+{ editor empty$
+    { key empty$
+        { cite$ #1 #3 substring$ }
+        'key
+      if$
+    }
+    { editor format.lab.names }
+  if$
+}
+
+FUNCTION {calc.short.authors}
+{ type$ "book" =
+  type$ "inbook" =
+  or
+    'author.editor.key.label
+    { type$ "proceedings" =
+        'editor.key.label
+        'author.key.label
+      if$
+    }
+  if$
+  'short.list :=
+}
+
+FUNCTION {calc.label}
+{ calc.short.authors
+  short.list
+  "("
+  *
+  year duplicate$ empty$
+     { pop$ "????" }
+     { purify$ #-1 #4 substring$ }
+  if$
+  *
+  'label :=
+}
+
+FUNCTION {sort.format.names}
+{ 's :=
+  #1 'nameptr :=
+  ""
+  s num.names$ 'numnames :=
+  numnames 'namesleft :=
+    { namesleft #0 > }
+    { s nameptr
+      "{ll{ }}{  f{ }}{  jj{ }}"
+      format.name$ 't :=
+      nameptr #1 >
+        {
+          "   "  *
+          namesleft #1 = t "others" = and
+            { "zzzzz" * }
+            { t sortify * }
+          if$
+        }
+        { t sortify * }
+      if$
+      nameptr #1 + 'nameptr :=
+      namesleft #1 - 'namesleft :=
+    }
+  while$
+}
+
+FUNCTION {sort.format.title}
+{ 't :=
+  "A " #2
+    "An " #3
+      "The " #4 t chop.word
+    chop.word
+  chop.word
+  sortify
+  #1 global.max$ substring$
+}
+FUNCTION {author.sort}
+{ author empty$
+    { key empty$
+        { "to sort, need author or key in " cite$ * warning$
+          ""
+        }
+        { key sortify }
+      if$
+    }
+    { author sort.format.names }
+  if$
+}
+FUNCTION {author.editor.sort}
+{ author empty$
+    { editor empty$
+        { key empty$
+            { "to sort, need author, editor, or key in " cite$ * warning$
+              ""
+            }
+            { key sortify }
+          if$
+        }
+        { editor sort.format.names }
+      if$
+    }
+    { author sort.format.names }
+  if$
+}
+FUNCTION {editor.sort}
+{ editor empty$
+    { key empty$
+        { "to sort, need editor or key in " cite$ * warning$
+          ""
+        }
+        { key sortify }
+      if$
+    }
+    { editor sort.format.names }
+  if$
+}
+FUNCTION {presort}
+{ calc.label
+  label sortify
+  "    "
+  *
+  type$ "book" =
+  type$ "inbook" =
+  or
+    'author.editor.sort
+    { type$ "proceedings" =
+        'editor.sort
+        'author.sort
+      if$
+    }
+  if$
+  #1 entry.max$ substring$
+  'sort.label :=
+  sort.label
+  *
+  "    "
+  *
+  title field.or.null
+  sort.format.title
+  *
+  #1 entry.max$ substring$
+  'sort.key$ :=
+}
+
+ITERATE {presort}
+SORT
+STRINGS { last.label next.extra }
+INTEGERS { last.extra.num number.label }
+FUNCTION {initialize.extra.label.stuff}
+{ #0 int.to.chr$ 'last.label :=
+  "" 'next.extra :=
+  #0 'last.extra.num :=
+  #0 'number.label :=
+}
+FUNCTION {forward.pass}
+{ last.label label =
+    { last.extra.num #1 + 'last.extra.num :=
+      last.extra.num int.to.chr$ 'extra.label :=
+    }
+    { "a" chr.to.int$ 'last.extra.num :=
+      "" 'extra.label :=
+      label 'last.label :=
+    }
+  if$
+  number.label #1 + 'number.label :=
+}
+FUNCTION {reverse.pass}
+{ next.extra "b" =
+    { "a" 'extra.label := }
+    'skip$
+  if$
+  extra.label 'next.extra :=
+  extra.label
+  duplicate$ empty$
+    'skip$
+    { "{\natexlab{" swap$ * "}}" * }
+  if$
+  'extra.label :=
+  label extra.label * 'label :=
+}
+EXECUTE {initialize.extra.label.stuff}
+ITERATE {forward.pass}
+REVERSE {reverse.pass}
+FUNCTION {bib.sort.order}
+{ sort.label
+  "    "
+  *
+  year field.or.null sortify
+  *
+  "    "
+  *
+  title field.or.null
+  sort.format.title
+  *
+  #1 entry.max$ substring$
+  'sort.key$ :=
+}
+ITERATE {bib.sort.order}
+SORT
+FUNCTION {begin.bib}
+{ preamble$ empty$
+    'skip$
+    { preamble$ write$ newline$ }
+  if$
+  "\begin{small}\begin{thebibliography}{" number.label int.to.str$ * "}" *
+  write$ newline$
+  "\expandafter\ifx\csname natexlab\endcsname\relax\def\natexlab#1{#1}\fi"
+  write$ newline$
+  "\providecommand{\bibinfo}[2]{#2}"
+  write$ newline$
+	"\ifx\xfnm\relax \def\xfnm[#1]{\unskip,\space#1}\fi"
+  write$ newline$
+}
+EXECUTE {begin.bib}
+EXECUTE {init.state.consts}
+ITERATE {call.type$}
+FUNCTION {end.bib}
+{ newline$
+  "\end{thebibliography}\end{small}" write$ newline$
+}
+EXECUTE {end.bib}
diff --git a/thys/Independence_CH/document/root.tex b/thys/Independence_CH/document/root.tex
new file mode 100644
--- /dev/null
+++ b/thys/Independence_CH/document/root.tex
@@ -0,0 +1,124 @@
+\documentclass[11pt,a4paper,english]{article}
+\usepackage{isabelle,isabellesym}
+\usepackage[numbers]{natbib}
+\usepackage{babel}
+
+\usepackage{relsize}
+\DeclareRobustCommand{\isactrlbsub}{\emph\bgroup\math{}\sb\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
+\DeclareRobustCommand{\isactrlesub}{\egroup\egroup\endmath\egroup}
+\DeclareRobustCommand{\isactrlbsup}{\emph\bgroup\math{}\sp\bgroup\mbox\bgroup\isaspacing\itshape\smaller}
+\DeclareRobustCommand{\isactrlesup}{\egroup\egroup\endmath\egroup}
+
+% further packages required for unusual symbols (see also
+% isabellesym.sty), use only when needed
+
+\usepackage{amssymb}
+  %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
+  %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
+  %\<triangleq>, \<yen>, \<lozenge>
+
+%\usepackage{eurosym}
+  %for \<euro>
+
+%\usepackage[only,bigsqcap]{stmaryrd}
+  %for \<Sqinter>
+
+%\usepackage{eufrak}
+  %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
+
+%\usepackage{textcomp}
+  %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
+  %\<currency>
+
+% this should be the last package used
+\usepackage{pdfsetup}
+
+% urls in roman style, theory text in math-similar italics
+\urlstyle{rm}
+\isabellestyle{it}
+
+% for uniform font size
+%\renewcommand{\isastyle}{\isastyleminor}
+\newcommand{\forces}{\Vdash}
+\newcommand{\dom}{\mathsf{dom}}
+\renewcommand{\isacharunderscorekeyword}{\mbox{\_}}
+\renewcommand{\isacharunderscore}{\mbox{\_}}
+\renewcommand{\isasymtturnstile}{\isamath{\Vdash}}
+\renewcommand{\isacharminus}{-}
+\newcommand{\session}[1]{\textit{#1}}
+\newcommand{\theory}[1]{\texttt{#1}}
+\newcommand{\axiomas}[1]{\mathit{#1}}
+\newcommand{\ZFC}{\axiomas{ZFC}}
+\newcommand{\ZF}{\axiomas{ZF}}
+\newcommand{\AC}{\axiomas{AC}}
+\newcommand{\CH}{\axiomas{CH}}
+\newcommand{\calV}{\mathcal{V}}
+
+\begin{document}
+
+\title{The Independence of the Continuum Hypothesis in Isabelle/ZF}
+\author{Emmanuel Gunther\thanks{Universidad Nacional de C\'ordoba. 
+    Facultad de Matem\'atica, Astronom\'{\i}a,  F\'{\i}sica y
+    Computaci\'on.}
+  \and
+  Miguel Pagano\footnotemark[1]
+  \and
+  Pedro S\'anchez Terraf\footnotemark[1] \thanks{Centro de Investigaci\'on y Estudios de Matem\'atica
+    (CIEM-FaMAF), Conicet. C\'ordoba. Argentina.
+    Supported by Secyt-UNC project 33620180100465CB.}
+  \and
+  Mat\'{\i}as Steinberg\footnotemark[1]
+}
+\maketitle
+
+\begin{abstract}
+  We redeveloped our formalization of forcing in the set theory framework of
+  Isabelle/ZF. Under the assumption of the existence of a countable
+  transitive model of $\ZFC$, we construct proper generic extensions 
+  that satisfy the Continuum Hypothesis and its negation.
+\end{abstract}
+
+
+\tableofcontents
+
+% sane default for proof documents
+\parindent 0pt\parskip 0.5ex
+
+\section{Introduction}
+We formalize the theory of forcing. We work on top of the Isabelle/ZF
+framework developed by \citet{DBLP:journals/jar/PaulsonG96}. Our
+mechanization is described in more detail in our papers
+\cite{2018arXiv180705174G} (LSFA 2018), \cite{2019arXiv190103313G},
+and \cite{2020arXiv200109715G} (IJCAR 2020).
+
+The main entry point of the present session is
+\theory{Definitions\_Main.thy} (Section~\ref{sec:main-definitions}),
+in which a path from fundamental set
+theoretic concepts formalized in Isabelle reaching to our main theorems
+is expounded. Cross-references to major milestones are provided there.
+
+In order to provide evidence for the correctness of several of our relativized
+definitions, we needed to assume the Axiom of Choice ($\AC$) during the
+aforementioned theory. Nevertheless, the whole of our development is
+independent of $\AC$, and the theory \theory{CH.thy} already provides
+all of our results and does not import that axiom.
+
+\subsection*{Release notes}
+\label{sec:release-notes}
+
+Previous versions of this development can be found at
+\url{https://cs.famaf.unc.edu.ar/~pedro/forcing/}.
+
+% generated text of all theories
+\input{session}
+
+% optional bibliography
+\bibliographystyle{root}
+\bibliography{root}
+
+\end{document}
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: t
+%%% End:
diff --git a/thys/ROOTS b/thys/ROOTS
--- a/thys/ROOTS
+++ b/thys/ROOTS
@@ -1,668 +1,669 @@
 ADS_Functor
 AI_Planning_Languages_Semantics
 AODV
 AVL-Trees
 AWN
 Abortable_Linearizable_Modules
 Abs_Int_ITP2012
 Abstract-Hoare-Logics
 Abstract-Rewriting
 Abstract_Completeness
 Abstract_Soundness
 Actuarial_Mathematics
 Adaptive_State_Counting
 Affine_Arithmetic
 Aggregation_Algebras
 Akra_Bazzi
 Algebraic_Numbers
 Algebraic_VCs
 Allen_Calculus
 Amicable_Numbers
 Amortized_Complexity
 AnselmGod
 Applicative_Lifting
 Approximation_Algorithms
 Architectural_Design_Patterns
 Aristotles_Assertoric_Syllogistic
 Arith_Prog_Rel_Primes
 ArrowImpossibilityGS
 Attack_Trees
 Auto2_HOL
 Auto2_Imperative_HOL
 AutoFocus-Stream
 Automated_Stateful_Protocol_Verification
 Automatic_Refinement
 AxiomaticCategoryTheory
 BDD
 BD_Security_Compositional
 BNF_CC
 BNF_Operations
 BTree
 Banach_Steinhaus
 Belief_Revision
 Bell_Numbers_Spivey
 BenOr_Kozen_Reif
 Berlekamp_Zassenhaus
 Bernoulli
 Bertrands_Postulate
 Bicategory
 BinarySearchTree
 Binding_Syntax_Theory
 Binomial-Heaps
 Binomial-Queues
 BirdKMP
 Blue_Eyes
 Bondy
 Boolean_Expression_Checkers
 Bounded_Deducibility_Security
 Buchi_Complementation
 Budan_Fourier
 Buffons_Needle
 Buildings
 BytecodeLogicJmlTypes
 C2KA_DistributedSystems
 CAVA_Automata
 CAVA_LTL_Modelchecker
 CCS
 CISC-Kernel
 CRDT
 CSP_RefTK
 CYK
 CZH_Elementary_Categories
 CZH_Foundations
 CZH_Universal_Constructions
 CakeML
 CakeML_Codegen
 Call_Arity
 Card_Equiv_Relations
 Card_Multisets
 Card_Number_Partitions
 Card_Partitions
 Cartan_FP
 Case_Labeling
 Catalan_Numbers
 Category
 Category2
 Category3
 Cauchy
 Cayley_Hamilton
 Certification_Monads
 Chandy_Lamport
 Chord_Segments
 Circus
 Clean
 ClockSynchInst
 Closest_Pair_Points
 CoCon
 CoSMeDis
 CoSMed
 CofGroups
 Coinductive
 Coinductive_Languages
 Collections
 Combinatorics_Words
 Combinatorics_Words_Graph_Lemma
 Combinatorics_Words_Lyndon
 Comparison_Sort_Lower_Bound
 Compiling-Exceptions-Correctly
 Complete_Non_Orders
 Completeness
 Complex_Bounded_Operators
 Complex_Geometry
 Complx
 ComponentDependencies
 ConcurrentGC
 ConcurrentIMP
 Concurrent_Ref_Alg
 Concurrent_Revisions
 Conditional_Simplification
 Conditional_Transfer_Rule
 Consensus_Refined
 Constructive_Cryptography
 Constructive_Cryptography_CM
 Constructor_Funs
 Containers
 CoreC++
 Core_DOM
 Core_SC_DOM
 Correctness_Algebras
 Count_Complex_Roots
 CryptHOL
 CryptoBasedCompositionalProperties
 Cubic_Quartic_Equations
 DFS_Framework
 DOM_Components
 DPT-SAT-Solver
 DataRefinementIBP
 Datatype_Order_Generator
 Decl_Sem_Fun_PL
 Decreasing-Diagrams
 Decreasing-Diagrams-II
 Deep_Learning
 Delta_System_Lemma
 Density_Compiler
 Dependent_SIFUM_Refinement
 Dependent_SIFUM_Type_Systems
 Depth-First-Search
 Derangements
 Deriving
 Descartes_Sign_Rule
 Design_Theory
 Dict_Construction
 Differential_Dynamic_Logic
 Differential_Game_Logic
 Dijkstra_Shortest_Path
 Diophantine_Eqns_Lin_Hom
 Dirichlet_L
 Dirichlet_Series
 DiscretePricing
 Discrete_Summation
 DiskPaxos
 Dominance_CHK
 DynamicArchitectures
 Dynamic_Tables
 E_Transcendental
 Echelon_Form
 EdmondsKarp_Maxflow
 Efficient-Mergesort
 Elliptic_Curves_Group_Law
 Encodability_Process_Calculi
 Epistemic_Logic
 Equivalence_Relation_Enumeration
 Ergodic_Theory
 Error_Function
 Euler_MacLaurin
 Euler_Partition
 Eval_FO
 Example-Submission
 Extended_Finite_State_Machine_Inference
 Extended_Finite_State_Machines
 FFT
 FLP
 FOL-Fitting
 FOL_Axiomatic
 FOL_Harrison
 FOL_Seq_Calc1
 FOL_Seq_Calc2
 Factor_Algebraic_Polynomial
 Factored_Transition_System_Bounding
 Falling_Factorial_Sum
 Farkas
 FeatherweightJava
 Featherweight_OCL
 Fermat3_4
 FileRefinement
 FinFun
 Finger-Trees
 Finite-Map-Extras
 Finite_Automata_HF
 Finitely_Generated_Abelian_Groups
 First_Order_Terms
 First_Welfare_Theorem
 Fishburn_Impossibility
 Fisher_Yates
 Flow_Networks
 Floyd_Warshall
 Flyspeck-Tame
 FocusStreamsCaseStudies
 Forcing
 Formal_Puiseux_Series
 Formal_SSA
 Formula_Derivatives
 Foundation_of_geometry
 Fourier
 FO_Theory_Rewriting
 Free-Boolean-Algebra
 Free-Groups
 Fresh_Identifiers
 FunWithFunctions
 FunWithTilings
 Functional-Automata
 Functional_Ordered_Resolution_Prover
 Furstenberg_Topology
 GPU_Kernel_PL
 Gabow_SCC
 GaleStewart_Games
 Gale_Shapley
 Game_Based_Crypto
 Gauss-Jordan-Elim-Fun
 Gauss_Jordan
 Gauss_Sums
 Gaussian_Integers
 GenClock
 General-Triangle
 Generalized_Counting_Sort
 Generic_Deriving
 Generic_Join
 GewirthPGCProof
 Girth_Chromatic
 GoedelGod
 Goedel_HFSet_Semantic
 Goedel_HFSet_Semanticless
 Goedel_Incompleteness
 Goodstein_Lambda
 GraphMarkingIBP
 Graph_Saturation
 Graph_Theory
 Green
 Groebner_Bases
 Groebner_Macaulay
 Gromov_Hyperbolicity
 Grothendieck_Schemes
 Group-Ring-Module
 HOL-CSP
 HOLCF-Prelude
 HRB-Slicing
 Hahn_Jordan_Decomposition
 Heard_Of
 Hello_World
 HereditarilyFinite
 Hermite
 Hermite_Lindemann
 Hidden_Markov_Models
 Higher_Order_Terms
 Hoare_Time
 Hood_Melville_Queue
 HotelKeyCards
 Huffman
 Hybrid_Logic
 Hybrid_Multi_Lane_Spatial_Logic
 Hybrid_Systems_VCs
 HyperCTL
 Hyperdual
 IEEE_Floating_Point
 IFC_Tracking
 IMAP-CRDT
 IMO2019
 IMP2
 IMP2_Binary_Heap
 IMP_Compiler
 IP_Addresses
 Imperative_Insertion_Sort
 Impossible_Geometry
 Incompleteness
 Incredible_Proof_Machine
+Independence_CH
 Inductive_Confidentiality
 Inductive_Inference
 InfPathElimination
 InformationFlowSlicing
 InformationFlowSlicing_Inter
 Integration
 Interpolation_Polynomials_HOL_Algebra
 Interpreter_Optimizations
 Interval_Arithmetic_Word32
 Intro_Dest_Elim
 Iptables_Semantics
 Irrational_Series_Erdos_Straus
 Irrationality_J_Hancl
 Irrationals_From_THEBOOK
 IsaGeoCoq
 Isabelle_C
 Isabelle_Marries_Dirac
 Isabelle_Meta_Model
 Jacobson_Basic_Algebra
 Jinja
 JinjaDCI
 JinjaThreads
 JiveDataStoreModel
 Jordan_Hoelder
 Jordan_Normal_Form
 KAD
 KAT_and_DRA
 KBPs
 KD_Tree
 Key_Agreement_Strong_Adversaries
 Kleene_Algebra
 Knights_Tour
 Knot_Theory
 Knuth_Bendix_Order
 Knuth_Morris_Pratt
 Koenigsberg_Friendship
 Kruskal
 Kuratowski_Closure_Complement
 LLL_Basis_Reduction
 LLL_Factorization
 LOFT
 LTL
 LTL_Master_Theorem
 LTL_Normal_Form
 LTL_to_DRA
 LTL_to_GBA
 Lam-ml-Normalization
 LambdaAuth
 LambdaMu
 Lambda_Free_EPO
 Lambda_Free_KBOs
 Lambda_Free_RPOs
 Lambert_W
 Landau_Symbols
 Laplace_Transform
 Latin_Square
 LatticeProperties
 Launchbury
 Laws_of_Large_Numbers
 Lazy-Lists-II
 Lazy_Case
 Lehmer
 Lifting_Definition_Option
 Lifting_the_Exponent
 LightweightJava
 LinearQuantifierElim
 Linear_Inequalities
 Linear_Programming
 Linear_Recurrences
 Liouville_Numbers
 List-Index
 List-Infinite
 List_Interleaving
 List_Inversions
 List_Update
 LocalLexing
 Localization_Ring
 Locally-Nameless-Sigma
 Logging_Independent_Anonymity
 Lowe_Ontological_Argument
 Lower_Semicontinuous
 Lp
 LP_Duality
 Lucas_Theorem
 MDP-Algorithms
 MDP-Rewards
 MFMC_Countable
 MFODL_Monitor_Optimized
 MFOTL_Monitor
 MSO_Regex_Equivalence
 Markov_Models
 Marriage
 Mason_Stothers
 Matrices_for_ODEs
 Matrix
 Matrix_Tensor
 Matroids
 Max-Card-Matching
 Median_Method
 Median_Of_Medians_Selection
 Menger
 Mereology
 Mersenne_Primes
 Metalogic_ProofChecker
 MiniML
 MiniSail
 Minimal_SSA
 Minkowskis_Theorem
 Minsky_Machines
 Modal_Logics_for_NTS
 Modular_Assembly_Kit_Security
 Modular_arithmetic_LLL_and_HNF_algorithms
 Monad_Memo_DP
 Monad_Normalisation
 MonoBoolTranAlgebra
 MonoidalCategory
 Monomorphic_Monad
 MuchAdoAboutTwo
 Multi_Party_Computation
 Multirelations
 Myhill-Nerode
 Name_Carrying_Type_Inference
 Nash_Williams
 Nat-Interval-Logic
 Native_Word
 Nested_Multisets_Ordinals
 Network_Security_Policy_Verification
 Neumann_Morgenstern_Utility
 No_FTL_observers
 Nominal2
 Noninterference_CSP
 Noninterference_Concurrent_Composition
 Noninterference_Generic_Unwinding
 Noninterference_Inductive_Unwinding
 Noninterference_Ipurge_Unwinding
 Noninterference_Sequential_Composition
 NormByEval
 Nullstellensatz
 Octonions
 OpSets
 Open_Induction
 Optics
 Optimal_BST
 Orbit_Stabiliser
 Order_Lattice_Props
 Ordered_Resolution_Prover
 Ordinal
 Ordinal_Partitions
 Ordinals_and_Cardinals
 Ordinary_Differential_Equations
 PAC_Checker
 PAL
 PCF
 PLM
 POPLmark-deBruijn
 PSemigroupsConvolution
 Padic_Ints
 Pairing_Heap
 Paraconsistency
 Parity_Game
 Partial_Function_MR
 Partial_Order_Reduction
 Password_Authentication_Protocol
 Pell
 Perfect-Number-Thm
 Perron_Frobenius
 Physical_Quantities
 Pi_Calculus
 Pi_Transcendental
 Planarity_Certificates
 Poincare_Bendixson
 Poincare_Disc
 Polynomial_Factorization
 Polynomial_Interpolation
 Polynomials
 Pop_Refinement
 Posix-Lexing
 Possibilistic_Noninterference
 Power_Sum_Polynomials
 Pratt_Certificate
 Presburger-Automata
 Prim_Dijkstra_Simple
 Prime_Distribution_Elementary
 Prime_Harmonic_Series
 Prime_Number_Theorem
 Priority_Queue_Braun
 Priority_Search_Trees
 Probabilistic_Noninterference
 Probabilistic_Prime_Tests
 Probabilistic_System_Zoo
 Probabilistic_Timed_Automata
 Probabilistic_While
 Program-Conflict-Analysis
 Progress_Tracking
 Projective_Geometry
 Projective_Measurements
 Promela
 Proof_Strategy_Language
 PropResPI
 Propositional_Proof_Systems
 Prpu_Maxflow
 PseudoHoops
 Psi_Calculi
 Ptolemys_Theorem
 Public_Announcement_Logic
 QHLProver
 QR_Decomposition
 Quantales
 Quasi_Borel_Spaces
 Quaternions
 Quick_Sort_Cost
 RIPEMD-160-SPARK
 ROBDD
 RSAPSS
 Ramsey-Infinite
 Random_BSTs
 Random_Graph_Subgraph_Threshold
 Randomised_BSTs
 Randomised_Social_Choice
 Rank_Nullity_Theorem
 Real_Impl
 Real_Power
 Recursion-Addition
 Recursion-Theory-I
 Refine_Imperative_HOL
 Refine_Monadic
 RefinementReactive
 Regex_Equivalence
 Registers
 Regression_Test_Selection
 Regular-Sets
 Regular_Algebras
 Regular_Tree_Relations
 Relation_Algebra
 Relational-Incorrectness-Logic
 Relational_Disjoint_Set_Forests
 Relational_Forests
 Relational_Method
 Relational_Minimum_Spanning_Trees
 Relational_Paths
 Rep_Fin_Groups
 ResiduatedTransitionSystem
 Residuated_Lattices
 Resolution_FOL
 Rewriting_Z
 Ribbon_Proofs
 Robbins-Conjecture
 Robinson_Arithmetic
 Root_Balanced_Tree
 Roth_Arithmetic_Progressions
 Routing
 Roy_Floyd_Warshall
 SATSolverVerification
 SC_DOM_Components
 SDS_Impossibility
 SIFPL
 SIFUM_Type_Systems
 SPARCv8
 Safe_Distance
 Safe_OCL
 Saturation_Framework
 Saturation_Framework_Extensions
 Schutz_Spacetime
 Secondary_Sylow
 Security_Protocol_Refinement
 Selection_Heap_Sort
 SenSocialChoice
 Separata
 Separation_Algebra
 Separation_Logic_Imperative_HOL
 SequentInvertibility
 Shadow_DOM
 Shadow_SC_DOM
 Shivers-CFA
 ShortestPath
 Show
 Sigma_Commit_Crypto
 Signature_Groebner
 Simpl
 Simple_Firewall
 Simplex
 Simplicial_complexes_and_boolean_functions
 SimplifiedOntologicalArgument
 Skew_Heap
 Skip_Lists
 Slicing
 Sliding_Window_Algorithm
 Smith_Normal_Form
 Smooth_Manifolds
 Sort_Encodings
 Source_Coding_Theorem
 SpecCheck
 Special_Function_Bounds
 Splay_Tree
 Sqrt_Babylonian
 Stable_Matching
 Statecharts
 Stateful_Protocol_Composition_and_Typing
 Stellar_Quorums
 Stern_Brocot
 Stewart_Apollonius
 Stirling_Formula
 Stochastic_Matrices
 Stone_Algebras
 Stone_Kleene_Relation_Algebras
 Stone_Relation_Algebras
 Store_Buffer_Reduction
 Stream-Fusion
 Stream_Fusion_Code
 Strong_Security
 Sturm_Sequences
 Sturm_Tarski
 Stuttering_Equivalence
 Subresultants
 Subset_Boolean_Algebras
 SumSquares
 Sunflowers
 SuperCalc
 Surprise_Paradox
 Symmetric_Polynomials
 Syntax_Independent_Logic
 Szemeredi_Regularity
 Szpilrajn
 TESL_Language
 TLA
 Tail_Recursive_Functions
 Tarskis_Geometry
 Taylor_Models
 Three_Circles
 Timed_Automata
 Topological_Semantics
 Topology
 TortoiseHare
 Transcendence_Series_Hancl_Rucki
 Transformer_Semantics
 Transition_Systems_and_Automata
 Transitive-Closure
 Transitive-Closure-II
 Transitive_Models
 Treaps
 Tree-Automata
 Tree_Decomposition
 Triangle
 Trie
 Twelvefold_Way
 Tycon
 Types_Tableaus_and_Goedels_God
 Types_To_Sets_Extension
 UPF
 UPF_Firewall
 UTP
 Universal_Hash_Families
 Universal_Turing_Machine
 UpDown_Scheme
 Valuation
 Van_Emde_Boas_Trees
 Van_der_Waerden
 VectorSpace
 VeriComp
 Verified-Prover
 Verified_SAT_Based_AI_Planning
 VerifyThis2018
 VerifyThis2019
 Vickrey_Clarke_Groves
 Virtual_Substitution
 VolpanoSmith
 VYDRA_MDL
 WHATandWHERE_Security
 WOOT_Strong_Eventual_Consistency
 WebAssembly
 Weight_Balanced_Trees
 Weighted_Path_Order
 Well_Quasi_Orders
 Wetzels_Problem
 Winding_Number_Eval
 Word_Lib
 WorkerWrapper
 X86_Semantics
 XML
 Youngs_Inequality
 ZFC_in_HOL
 Zeta_3_Irrational
 Zeta_Function
 pGCL