diff --git a/thys/Algebraic_Numbers/Algebraic_Numbers.thy b/thys/Algebraic_Numbers/Algebraic_Numbers.thy
--- a/thys/Algebraic_Numbers/Algebraic_Numbers.thy
+++ b/thys/Algebraic_Numbers/Algebraic_Numbers.thy
@@ -1,1338 +1,1349 @@
 (*  
     Author:       René Thiemann 
                   Akihisa Yamada
     Contributors: Manuel Eberl (algebraic integers)
     License:      BSD
 *)
 section \<open>Algebraic Numbers: Addition and Multiplication\<close>
 
 text \<open>This theory contains the remaining field operations for algebraic numbers, namely
   addition and multiplication.\<close>
 
 theory Algebraic_Numbers
   imports
   Algebraic_Numbers_Prelim
   Resultant
   Polynomial_Factorization.Polynomial_Divisibility
 begin
 
 interpretation coeff_hom: monoid_add_hom "\<lambda>p. coeff p i" by (unfold_locales, auto)
 interpretation coeff_hom: comm_monoid_add_hom "\<lambda>p. coeff p i"..
 interpretation coeff_hom: group_add_hom "\<lambda>p. coeff p i"..
 interpretation coeff_hom: ab_group_add_hom "\<lambda>p. coeff p i"..
 interpretation coeff_0_hom: monoid_mult_hom "\<lambda>p. coeff p 0" by (unfold_locales, auto simp: coeff_mult)
 interpretation coeff_0_hom: semiring_hom "\<lambda>p. coeff p 0"..
 interpretation coeff_0_hom: comm_monoid_mult_hom "\<lambda>p. coeff p 0"..
 interpretation coeff_0_hom: comm_semiring_hom "\<lambda>p. coeff p 0"..
 
 subsection \<open>Addition of Algebraic Numbers\<close>
 
 definition "x_y \<equiv> [: [: 0, 1 :], -1 :]"
 
 definition "poly_x_minus_y p = poly_lift p \<circ>\<^sub>p x_y"
 
 lemma coeff_xy_power:
   assumes "k \<le> n"
   shows  "coeff (x_y ^ n :: 'a :: comm_ring_1 poly poly) k =
           monom (of_nat (n choose (n - k)) * (- 1) ^ k) (n - k)"
 proof -
   define X :: "'a poly poly" where "X = monom (monom 1 1) 0"
   define Y :: "'a poly poly" where "Y = monom (-1) 1"
 
   have [simp]: "monom 1 b * (-1) ^ k = monom ((-1)^k :: 'a) b" for b k
     by (auto simp: monom_altdef minus_one_power_iff)
 
   have "(X + Y) ^ n = (\<Sum>i\<le>n. of_nat (n choose i) * X ^ i * Y ^ (n - i))"
     by (subst binomial_ring) auto
   also have "\<dots> = (\<Sum>i\<le>n. of_nat (n choose i) * monom (monom ((-1) ^ (n - i)) i) (n - i))"
     by (simp add: X_def Y_def monom_power mult_monom mult.assoc) 
   also have "\<dots> = (\<Sum>i\<le>n. monom (monom (of_nat (n choose i) * (-1) ^ (n - i)) i) (n - i))"
     by (simp add: of_nat_poly smult_monom)
   also have "coeff \<dots> k =
     (\<Sum>i\<le>n. if n - i = k then monom (of_nat (n choose i) * (- 1) ^ (n - i)) i else 0)"
     by (simp add: of_nat_poly coeff_sum)
   also have "\<dots> = (\<Sum>i\<in>{n-k}. monom (of_nat (n choose i) * (- 1) ^ (n - i)) i)"
     using \<open>k \<le> n\<close> by (intro sum.mono_neutral_cong_right) auto
   also have "X + Y = x_y"
     by (simp add: X_def Y_def x_y_def monom_altdef)
   finally show ?thesis
     using \<open>k \<le> n\<close> by simp
 qed
 
 
 text \<open>The following polynomial represents the sum of two algebraic numbers.\<close>
 
 definition poly_add :: "'a :: comm_ring_1 poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly" where
   "poly_add p q = resultant (poly_x_minus_y p) (poly_lift q)"
 
 subsubsection \<open>@{term poly_add} has desired root\<close>
 
 interpretation poly_x_minus_y_hom:
   comm_ring_hom poly_x_minus_y by (unfold_locales; simp add: poly_x_minus_y_def hom_distribs)
 
 lemma poly2_x_y[simp]:
   fixes x :: "'a :: comm_ring_1"
   shows "poly2 x_y x y = x - y" unfolding poly2_def by (simp add: x_y_def)
 
 lemma degree_poly_x_minus_y[simp]:
   fixes p :: "'a::idom poly"
   shows "degree (poly_x_minus_y p) = degree p" unfolding poly_x_minus_y_def x_y_def by auto
 
 lemma poly_x_minus_y_pCons[simp]:
   "poly_x_minus_y (pCons a p) = [:[: a :]:] + poly_x_minus_y p * x_y"
   unfolding poly_x_minus_y_def x_y_def by simp
 
 lemma poly_poly_poly_x_minus_y[simp]:
   fixes p :: "'a :: comm_ring_1 poly"
   shows "poly (poly (poly_x_minus_y p) q) x = poly p (x - poly q x)"
   by (induct p; simp add: ring_distribs x_y_def)
 
 lemma poly2_poly_x_minus_y[simp]:
   fixes p :: "'a :: comm_ring_1 poly"
   shows "poly2 (poly_x_minus_y p) x y = poly p (x-y)" unfolding poly2_def by simp
 
 interpretation x_y_mult_hom: zero_hom_0 "\<lambda>p :: 'a :: comm_ring_1 poly poly. x_y * p"
 proof (unfold_locales)
   fix p :: "'a poly poly"
   assume "x_y * p = 0"
   then show "p = 0" apply (simp add: x_y_def)
     by (metis eq_neg_iff_add_eq_0 minus_equation_iff minus_pCons synthetic_div_unique_lemma)
 qed
 
 lemma x_y_nonzero[simp]: "x_y \<noteq> 0" by (simp add: x_y_def)
 
 lemma degree_x_y[simp]: "degree x_y = 1" by (simp add: x_y_def)
 
 interpretation x_y_mult_hom: inj_comm_monoid_add_hom "\<lambda>p :: 'a :: idom poly poly. x_y * p"
 proof (unfold_locales)
   show "x_y * p = x_y * q \<Longrightarrow> p = q" for p q :: "'a poly poly"
   proof (induct p arbitrary:q)
     case 0
     then show ?case by simp
   next
     case p: (pCons a p)
     from p(3)[unfolded mult_pCons_right]
     have "x_y * (monom a 0 + pCons 0 1 * p) = x_y * q"
       apply (subst(asm) pCons_0_as_mult)
       apply (subst(asm) smult_prod) by (simp only: field_simps distrib_left)
     then have "monom a 0 + pCons 0 1 * p = q" by simp
     then show "pCons a p = q" using pCons_as_add by (simp add: monom_0 monom_Suc)
   qed
 qed
 
 interpretation poly_x_minus_y_hom: inj_idom_hom poly_x_minus_y
 proof
   fix p :: "'a poly"
   assume 0: "poly_x_minus_y p = 0"
   then have "poly_lift p \<circ>\<^sub>p x_y = 0" by (simp add: poly_x_minus_y_def)
   then show "p = 0"
   proof (induct p)
     case 0
     then show ?case by simp
   next
     case (pCons a p)
     note p = this[unfolded poly_lift_pCons pcompose_pCons]
     show ?case
     proof (cases "a=0")
       case a0: True
       with p have "x_y * poly_lift p \<circ>\<^sub>p x_y = 0" by simp
       then have "poly_lift p \<circ>\<^sub>p x_y = 0" by simp
       then show ?thesis using p by simp
     next
       case a0: False
       with p have p0: "p \<noteq> 0" by auto
       from p have "[:[:a:]:] = - x_y * poly_lift p \<circ>\<^sub>p x_y" by (simp add: eq_neg_iff_add_eq_0)
       then have "degree [:[:a:]:] = degree (x_y * poly_lift p \<circ>\<^sub>p x_y)" by simp
       also have "... = degree (x_y::'a poly poly) + degree (poly_lift p \<circ>\<^sub>p x_y)"
         apply (subst degree_mult_eq)
           apply simp
          apply (subst pcompose_eq_0)
           apply (simp add: x_y_def)
          apply (simp add: p0)
         apply simp
        done
       finally have False by simp 
       then show ?thesis..
     qed
   qed
 qed
 
 lemma poly_add:
   fixes p q :: "'a ::comm_ring_1 poly"
   assumes q0: "q \<noteq> 0" and x: "poly p x = 0" and y: "poly q y = 0"
   shows "poly (poly_add p q) (x+y) = 0"
 proof (unfold poly_add_def, rule poly_resultant_zero[OF disjI2])
   have "degree q > 0" using poly_zero q0 y by auto
   thus degq: "degree (poly_lift q) > 0" by auto
 qed (insert x y, simp_all)
 
 
 subsubsection \<open>@{const poly_add} is nonzero\<close>
 
 text \<open>
   We first prove that @{const poly_lift} preserves factorization. The result will be essential
   also in the next section for division of algebraic numbers.
 \<close>
 
 interpretation poly_lift_hom:
   unit_preserving_hom "poly_lift :: 'a :: {comm_semiring_1,semiring_no_zero_divisors} poly \<Rightarrow> _"
 proof
   fix x :: "'a poly"
   assume "poly_lift x dvd 1"
   then have "poly_y_x (poly_lift x) dvd poly_y_x 1"
     by simp
   then show "x dvd 1"
     by (auto simp add: poly_y_x_poly_lift)
 qed
 
 interpretation poly_lift_hom:
   factor_preserving_hom "poly_lift::'a::idom poly \<Rightarrow> 'a poly poly"
 proof unfold_locales
   fix p :: "'a poly"
   assume p: "irreducible p"
   show "irreducible (poly_lift p)"
   proof(rule ccontr)
     from p have p0: "p \<noteq> 0" and "\<not> p dvd 1" by (auto dest: irreducible_not_unit)
     with poly_lift_hom.hom_dvd[of p 1] have p1: "\<not> poly_lift p dvd 1" by auto
     assume "\<not> irreducible (poly_lift p)"
     from this[unfolded irreducible_altdef,simplified] p0 p1
     obtain q where "q dvd poly_lift p" and pq: "\<not> poly_lift p dvd q" and q: "\<not> q dvd 1" by auto
     then obtain r where "q * r = poly_lift p" by (elim dvdE, auto)
     then have "poly_y_x (q * r) = poly_y_x (poly_lift p)" by auto
     also have "... = [:p:]" by (auto simp: poly_y_x_poly_lift monom_0)
     also have "poly_y_x (q * r) = poly_y_x q * poly_y_x r" by (auto simp: hom_distribs)
     finally have "... = [:p:]" by auto
     then have qp: "poly_y_x q dvd [:p:]" by (metis dvdI)
     from dvd_const[OF this] p0 have "degree (poly_y_x q) = 0" by auto
     from degree_0_id[OF this,symmetric] obtain s
       where qs: "poly_y_x q = [:s:]" by auto
     have "poly_lift s = poly_y_x (poly_y_x (poly_lift s))" by auto
       also have "... = poly_y_x [:s:]" by (auto simp: poly_y_x_poly_lift monom_0)
       also have "... = q" by (auto simp: qs[symmetric])
     finally have sq: "poly_lift s = q" by auto
     from qp[unfolded qs] have sp: "s dvd p" by (auto simp: const_poly_dvd)
     from irreducibleD'[OF p this] sq q pq show False by auto
   qed
 qed
 
 text \<open>
   We now show that @{const poly_x_minus_y} is a factor-preserving homomorphism. This is
   essential for this section. This is easy since @{const poly_x_minus_y} can be represented
   as the composition of two factor-preserving homomorphisms.
 \<close>
 
 lemma poly_x_minus_y_as_comp: "poly_x_minus_y = (\<lambda>p. p \<circ>\<^sub>p x_y) \<circ> poly_lift"
   by (intro ext, unfold poly_x_minus_y_def, auto)
 context idom_isom begin
   sublocale comm_semiring_isom..
 end
+
 interpretation poly_x_minus_y_hom:
   factor_preserving_hom "poly_x_minus_y :: 'a :: idom poly \<Rightarrow> 'a poly poly"
-proof-
-  interpret x_y_hom: bijective "\<lambda>p :: 'a poly poly. p \<circ>\<^sub>p x_y"
-  proof (unfold bijective_eq_bij, rule id_imp_bij)
-    fix p :: "'a poly poly" show "p \<circ>\<^sub>p x_y \<circ>\<^sub>p x_y = p"
-      apply (induct p,simp)
-      apply(unfold x_y_def hom_distribs pcompose_pCons) by (simp)
+proof -
+  have \<open>p \<circ>\<^sub>p x_y \<circ>\<^sub>p x_y = p\<close> for p :: \<open>'a poly poly\<close>
+  proof (induction p)
+    case 0
+    show ?case
+      by simp
+  next
+    case (pCons a p)
+    then show ?case
+      by (unfold x_y_def hom_distribs pcompose_pCons) simp
   qed
-  interpret x_y_hom: idom_isom "\<lambda>p :: 'a poly poly. p \<circ>\<^sub>p x_y" by (unfold_locales, auto)
-  show "factor_preserving_hom (poly_x_minus_y :: 'a poly \<Rightarrow> _)"
-    by (unfold poly_x_minus_y_as_comp, rule factor_preserving_hom_comp, unfold_locales)
+  then interpret x_y_hom: bijective "\<lambda>p :: 'a poly poly. p \<circ>\<^sub>p x_y"
+    by (unfold bijective_eq_bij) (rule involuntory_imp_bij)
+  interpret x_y_hom: idom_isom "\<lambda>p :: 'a poly poly. p \<circ>\<^sub>p x_y"
+    by standard simp_all
+  have \<open>factor_preserving_hom (\<lambda>p :: 'a poly poly. p \<circ>\<^sub>p x_y)\<close>
+    and \<open>factor_preserving_hom (poly_lift :: 'a poly \<Rightarrow> 'a poly poly)\<close>
+    ..
+  then show "factor_preserving_hom (poly_x_minus_y :: 'a poly \<Rightarrow> _)"
+    by (unfold poly_x_minus_y_as_comp) (rule factor_preserving_hom_comp)
 qed
 
 text \<open>
   Now we show that results of @{const poly_x_minus_y} and @{const poly_lift} are coprime.
 \<close>
 
 lemma poly_y_x_const[simp]: "poly_y_x [:[:a:]:] = [:[:a:]:]" by (simp add: poly_y_x_def monom_0)
 
 context begin
 
 private abbreviation "y_x == [: [: 0, -1 :], 1 :]"
 
 lemma poly_y_x_x_y[simp]: "poly_y_x x_y = y_x" by (simp add: x_y_def poly_y_x_def monom_Suc monom_0)
 
 private lemma y_x[simp]: fixes x :: "'a :: comm_ring_1" shows "poly2 y_x x y = y - x"
   unfolding poly2_def by simp
 
 private definition "poly_y_minus_x p \<equiv> poly_lift p \<circ>\<^sub>p y_x"
 
 private lemma poly_y_minus_x_0[simp]: "poly_y_minus_x 0 = 0" by (simp add: poly_y_minus_x_def)
 
 private lemma poly_y_minus_x_pCons[simp]:
   "poly_y_minus_x (pCons a p) = [:[: a :]:] + poly_y_minus_x p * y_x" by (simp add: poly_y_minus_x_def)
 
 private lemma poly_y_x_poly_x_minus_y:
   fixes p :: "'a :: idom poly"
   shows "poly_y_x (poly_x_minus_y p) = poly_y_minus_x p"
   apply (induct p, simp)
   apply (unfold poly_x_minus_y_pCons hom_distribs) by simp
 
 lemma degree_poly_y_minus_x[simp]:
   fixes p :: "'a :: idom poly"
   shows "degree (poly_y_x (poly_x_minus_y p)) = degree p" 
   by (simp add: poly_y_minus_x_def poly_y_x_poly_x_minus_y)
 
 end
 
 lemma dvd_all_coeffs_iff:
   fixes x :: "'a :: comm_semiring_1" (* No addition needed! *)
   shows "(\<forall>pi \<in> set (coeffs p). x dvd pi) \<longleftrightarrow> (\<forall>i. x dvd coeff p i)" (is "?l = ?r")
 proof-
   have "?r = (\<forall>i\<in>{..degree p} \<union> {Suc (degree p)..}. x dvd coeff p i)" by auto
   also have "... = (\<forall>i\<le>degree p. x dvd coeff p i)" by (auto simp add: ball_Un coeff_eq_0)
   also have "... = ?l" by (auto simp: coeffs_def)
   finally show ?thesis..
 qed
 
 lemma primitive_imp_no_constant_factor:
   fixes p :: "'a :: {comm_semiring_1, semiring_no_zero_divisors} poly"
   assumes pr: "primitive p" and F: "mset_factors F p" and fF: "f \<in># F"
   shows "degree f \<noteq> 0"
 proof
   from F fF have irr: "irreducible f" and fp: "f dvd p" by (auto dest: mset_factors_imp_dvd)
   assume deg: "degree f = 0"
   then obtain f0 where f0: "f = [:f0:]" by (auto dest: degree0_coeffs)
   with fp have "[:f0:] dvd p" by simp
   then have "f0 dvd coeff p i" for i by (simp add: const_poly_dvd_iff)
   with primitiveD[OF pr] dvd_all_coeffs_iff have "f0 dvd 1" by (auto simp: coeffs_def)
   with f0 irr show False by auto
 qed
 
 lemma coprime_poly_x_minus_y_poly_lift:
   fixes p q :: "'a :: ufd poly"
   assumes degp: "degree p > 0" and degq: "degree q > 0"
     and pr: "primitive p"
   shows "coprime (poly_x_minus_y p) (poly_lift q)"
 proof(rule ccontr)
   from degp have p: "\<not> p dvd 1" by (auto simp: dvd_const)
   from degp have p0: "p \<noteq> 0" by auto
   from mset_factors_exist[of p, OF p0 p]
   obtain F where F: "mset_factors F p" by auto
   with poly_x_minus_y_hom.hom_mset_factors
   have pF: "mset_factors (image_mset poly_x_minus_y F) (poly_x_minus_y p)" by auto
 
   from degq have q: "\<not> q dvd 1" by (auto simp: dvd_const)
   from degq have q0: "q \<noteq> 0" by auto
   from mset_factors_exist[OF q0 q]
   obtain G where G: "mset_factors G q" by auto
   with poly_lift_hom.hom_mset_factors
   have pG: "mset_factors (image_mset poly_lift G) (poly_lift q)" by auto
 
   assume "\<not> coprime (poly_x_minus_y p) (poly_lift q)"
   from this[unfolded not_coprime_iff_common_factor]
   obtain r
   where rp: "r dvd (poly_x_minus_y p)"
     and rq: "r dvd (poly_lift q)"
     and rU: "\<not> r dvd 1" by auto note poly_lift_hom.hom_dvd
   from rp p0 have r0: "r \<noteq> 0" by auto
   from mset_factors_exist[OF r0 rU]
   obtain H where H: "mset_factors H r" by auto
   then have "H \<noteq> {#}" by auto
   then obtain h where hH: "h \<in># H" by fastforce
   with H mset_factors_imp_dvd have hr: "h dvd r" and h: "irreducible h" by auto
   from irreducible_not_unit[OF h] have hU: "\<not> h dvd 1" by auto
   from hr rp have "h dvd (poly_x_minus_y p)" by (rule dvd_trans)
   from irreducible_dvd_imp_factor[OF this h pF] p0
   obtain f where f: "f \<in># F" and fh: "poly_x_minus_y f ddvd h" by auto
   from hr rq have "h dvd (poly_lift q)" by (rule dvd_trans)
   from irreducible_dvd_imp_factor[OF this h pG] q0
   obtain g where g: "g \<in># G" and gh: "poly_lift g ddvd h" by auto
   from fh gh have "poly_x_minus_y f ddvd poly_lift g" using ddvd_trans by auto
   then have "poly_y_x (poly_x_minus_y f) ddvd poly_y_x (poly_lift g)" by simp
   also have "poly_y_x (poly_lift g) = [:g:]" unfolding poly_y_x_poly_lift monom_0 by auto
   finally have ddvd: "poly_y_x (poly_x_minus_y f) ddvd [:g:]" by auto
   then have "degree (poly_y_x (poly_x_minus_y f)) = 0" by (metis degree_pCons_0 dvd_0_left_iff dvd_const)
   then have "degree f = 0" by simp
   with primitive_imp_no_constant_factor[OF pr F f] show False by auto
 qed
 
 lemma poly_add_nonzero:
   fixes p q :: "'a :: ufd poly"
   assumes p0: "p \<noteq> 0" and q0: "q \<noteq> 0" and x: "poly p x = 0" and y: "poly q y = 0"
       and pr: "primitive p"
   shows "poly_add p q \<noteq> 0"
 proof
   have degp: "degree p > 0" using le_0_eq order_degree order_root p0 x by (metis gr0I)
   have degq: "degree q > 0" using le_0_eq order_degree order_root q0 y by (metis gr0I)
   assume 0: "poly_add p q = 0"
   from resultant_zero_imp_common_factor[OF _ this[unfolded poly_add_def]] degp
    and coprime_poly_x_minus_y_poly_lift[OF degp degq pr]
   show False by auto
 qed
 
 
 subsubsection \<open>Summary for addition\<close>
 
 text \<open>Now we lift the results to one that uses @{const ipoly}, by showing some homomorphism lemmas.\<close>
 
 lemma (in comm_ring_hom) map_poly_x_minus_y:
   "map_poly (map_poly hom) (poly_x_minus_y p) = poly_x_minus_y (map_poly hom p)"
 proof-
   interpret mp: map_poly_comm_ring_hom hom..
   interpret mmp: map_poly_comm_ring_hom "map_poly hom"..
   show ?thesis
     apply (induct p, simp)
     apply(unfold x_y_def hom_distribs poly_x_minus_y_pCons, simp) done
 qed
 
 lemma (in comm_ring_hom) hom_poly_lift[simp]:
   "map_poly (map_poly hom) (poly_lift q) = poly_lift (map_poly hom q)"
 proof -
   show ?thesis
     unfolding poly_lift_def
     unfolding map_poly_map_poly[of coeff_lift,OF coeff_lift_hom.hom_zero]
     unfolding map_poly_coeff_lift_hom by simp
 qed
 
 
 lemma lead_coeff_poly_x_minus_y:
   fixes p :: "'a::idom poly"
   shows "lead_coeff (poly_x_minus_y p) = [:lead_coeff p * ((- 1) ^ degree p):]" (is "?l = ?r")
 proof-
   have "?l = Polynomial.smult (lead_coeff p) ((- 1) ^ degree p)"
     by (unfold poly_x_minus_y_def, subst lead_coeff_comp; simp add: x_y_def)
   also have "... = ?r" by (unfold hom_distribs, simp add: smult_as_map_poly[symmetric])
   finally show ?thesis.
 qed
 
 lemma degree_coeff_poly_x_minus_y:
   fixes p q :: "'a :: {idom, semiring_char_0} poly"
   shows "degree (coeff (poly_x_minus_y p) i) = degree p - i"
 proof -
   consider "i = degree p" | "i > degree p" | "i < degree p"
     by force
   thus ?thesis
   proof cases
     assume "i > degree p"
     thus ?thesis by (subst coeff_eq_0) auto
   next
     assume "i = degree p"
     thus ?thesis using lead_coeff_poly_x_minus_y[of p]
       by (simp add: lead_coeff_poly_x_minus_y)
   next
     assume "i < degree p"
     define n where "n = degree p"
     have "degree (coeff (poly_x_minus_y p) i) =
             degree (\<Sum>j\<le>n. [:coeff p j:] * coeff (x_y ^ j) i)" (is "_ = degree (sum ?f _)")
       by (simp add: poly_x_minus_y_def pcompose_conv_poly poly_altdef coeff_sum n_def)
     also have "{..n} = insert n {..<n}"
       by auto
     also have "sum ?f \<dots> = ?f n + sum ?f {..<n}"
       by (subst sum.insert) auto
     also have "degree \<dots> = n - i"
     proof -
       have "degree (?f n) = n - i"
         using \<open>i < degree p\<close> by (simp add: n_def coeff_xy_power degree_monom_eq)
       moreover have "degree (sum ?f {..<n}) < n - i"
       proof (intro degree_sum_smaller)
         fix j assume "j \<in> {..<n}"
         have "degree ([:coeff p j:] * coeff (x_y ^ j) i) \<le> j - i"
         proof (cases "i \<le> j")
           case True
           thus ?thesis
             by (auto simp: n_def coeff_xy_power degree_monom_eq)
         next
           case False
           hence "coeff (x_y ^ j :: 'a poly poly) i = 0"
             by (subst coeff_eq_0) (auto simp: degree_power_eq)
           thus ?thesis by simp
         qed
         also have "\<dots> < n - i"
           using \<open>j \<in> {..<n}\<close> \<open>i < degree p\<close> by (auto simp: n_def)
         finally show "degree ([:coeff p j:] * coeff (x_y ^ j) i) < n - i" .
       qed (use \<open>i < degree p\<close> in \<open>auto simp: n_def\<close>)
       ultimately show ?thesis
         by (subst degree_add_eq_left) auto
     qed
     finally show ?thesis
       by (simp add: n_def)
   qed
 qed
 
 lemma coeff_0_poly_x_minus_y [simp]: "coeff (poly_x_minus_y p) 0 = p"
   by (induction p) (auto simp: poly_x_minus_y_def x_y_def)
 
 lemma (in idom_hom) poly_add_hom:
   assumes p0: "hom (lead_coeff p) \<noteq> 0" and q0: "hom (lead_coeff q) \<noteq> 0"
   shows "map_poly hom (poly_add p q) = poly_add (map_poly hom p) (map_poly hom q)"
 proof -
   interpret mh: map_poly_idom_hom..
   show ?thesis unfolding poly_add_def
     apply (subst mh.resultant_map_poly(1)[symmetric])
        apply (subst degree_map_poly_2)
        apply (unfold lead_coeff_poly_x_minus_y, unfold hom_distribs, simp add: p0)
       apply simp
      apply (subst degree_map_poly_2)
       apply (simp_all add: q0 map_poly_x_minus_y)
     done
 qed
 
 lemma(in zero_hom) hom_lead_coeff_nonzero_imp_map_poly_hom:
   assumes "hom (lead_coeff p) \<noteq> 0"
   shows "map_poly hom p \<noteq> 0"
 proof
   assume "map_poly hom p = 0"
   then have "coeff (map_poly hom p) (degree p) = 0" by simp
   with assms show False by simp
 qed
 
 lemma ipoly_poly_add:
   fixes x y :: "'a :: idom"
   assumes p0: "(of_int (lead_coeff p) :: 'a) \<noteq> 0" and q0: "(of_int (lead_coeff q) :: 'a) \<noteq> 0"
       and x: "ipoly p x = 0" and y: "ipoly q y = 0"
   shows "ipoly (poly_add p q) (x+y) = 0"
   using assms of_int_hom.hom_lead_coeff_nonzero_imp_map_poly_hom[OF q0]
   by (auto intro: poly_add simp: of_int_hom.poly_add_hom[OF p0 q0])
 
 lemma (in comm_monoid_gcd) gcd_list_eq_0_iff[simp]: "listgcd xs = 0 \<longleftrightarrow> (\<forall>x \<in> set xs. x = 0)"
   by (induct xs, auto)
 
 lemma primitive_field_poly[simp]: "primitive (p :: 'a :: field poly) \<longleftrightarrow> p \<noteq> 0"
   by (unfold primitive_iff_some_content_dvd_1,auto simp: dvd_field_iff coeffs_def)
 
 lemma ipoly_poly_add_nonzero:
   fixes x y :: "'a :: field"
   assumes "p \<noteq> 0" and "q \<noteq> 0" and "ipoly p x = 0" and "ipoly q y = 0"
       and "(of_int (lead_coeff p) :: 'a) \<noteq> 0" and "(of_int (lead_coeff q) :: 'a) \<noteq> 0"
   shows "poly_add p q \<noteq> 0"
 proof-
   from assms have "(of_int_poly (poly_add p q) :: 'a poly) \<noteq> 0"
     apply (subst of_int_hom.poly_add_hom,simp,simp)
     by (rule poly_add_nonzero, auto dest:of_int_hom.hom_lead_coeff_nonzero_imp_map_poly_hom)
   then show ?thesis by auto
 qed
 
 lemma represents_add:
   assumes x: "p represents x" and y: "q represents y"
   shows "(poly_add p q) represents (x + y)"
   using assms by (intro representsI ipoly_poly_add ipoly_poly_add_nonzero, auto)
 
 subsection \<open>Division of Algebraic Numbers\<close>
 
 definition poly_x_mult_y where
   [code del]: "poly_x_mult_y p \<equiv> (\<Sum> i \<le> degree p. monom (monom (coeff p i) i) i)"
 
 lemma coeff_poly_x_mult_y:
   shows "coeff (poly_x_mult_y p) i = monom (coeff p i) i" (is "?l = ?r")
 proof(cases "degree p < i")
   case i: False
   have "?l = sum (\<lambda>j. if j = i then (monom (coeff p j) j) else 0) {..degree p}"
    (is "_ = sum ?f ?A") by (simp add: poly_x_mult_y_def coeff_sum)
   also have "... = sum ?f {i}" using i by (intro sum.mono_neutral_right, auto)
   also have "... = ?f i" by simp
   also have "... = ?r" by auto
   finally show ?thesis.
 next
   case True then show ?thesis by (auto simp: poly_x_mult_y_def coeff_eq_0 coeff_sum)
 qed
 
 lemma poly_x_mult_y_code[code]: "poly_x_mult_y p = (let cs = coeffs p
   in poly_of_list (map (\<lambda> (i, ai). monom ai i) (zip [0 ..< length cs] cs)))" 
   unfolding Let_def poly_of_list_def 
 proof (rule poly_eqI, unfold coeff_poly_x_mult_y)
   fix n
   let ?xs = "zip [0..<length (coeffs p)] (coeffs p)" 
   let ?f = "(\<lambda>(i, ai). monom ai i)" 
   show "monom (coeff p n) n = coeff (Poly (map ?f ?xs)) n" 
   proof (cases "n < length (coeffs p)")
     case True
     hence n: "n < length (map ?f ?xs)" and nn: "n < length ?xs" 
       unfolding degree_eq_length_coeffs by auto
     show ?thesis unfolding coeff_Poly nth_default_nth[OF n] nth_map[OF nn]
       using True by (simp add: nth_coeffs_coeff)
   next
     case False
     hence id: "coeff (Poly (map ?f ?xs)) n = 0" unfolding coeff_Poly
       by (subst nth_default_beyond, auto)
     from False have "n > degree p \<or> p = 0" unfolding degree_eq_length_coeffs by (cases n, auto)
     hence "monom (coeff p n) n = 0" using coeff_eq_0[of p n] by auto
     thus ?thesis unfolding id by simp
   qed
 qed
 
 definition poly_div :: "'a :: comm_ring_1 poly \<Rightarrow> 'a poly \<Rightarrow> 'a poly" where
   "poly_div p q = resultant (poly_x_mult_y p) (poly_lift q)"
 
 text \<open>@{const poly_div} has desired roots.\<close>
 
 lemma poly2_poly_x_mult_y:
   fixes p :: "'a :: comm_ring_1 poly"
   shows "poly2 (poly_x_mult_y p) x y = poly p (x * y)"
   apply (subst(3) poly_as_sum_of_monoms[symmetric])
   apply (unfold poly_x_mult_y_def hom_distribs)
   by (auto simp: poly2_monom poly_monom power_mult_distrib ac_simps)
 
 lemma poly_div:
   fixes p q :: "'a ::field poly"
   assumes q0: "q \<noteq> 0" and x: "poly p x = 0" and y: "poly q y = 0" and y0: "y \<noteq> 0"
   shows "poly (poly_div p q) (x/y) = 0"
 proof (unfold poly_div_def, rule poly_resultant_zero[OF disjI2])
   have "degree q > 0" using poly_zero q0 y by auto
   thus degq: "degree (poly_lift q) > 0" by auto
 qed (insert x y y0, simp_all add: poly2_poly_x_mult_y)
 
 
 text \<open>@{const poly_div} is nonzero.\<close>
 
 interpretation poly_x_mult_y_hom: ring_hom "poly_x_mult_y :: 'a :: {idom,ring_char_0} poly \<Rightarrow> _"
   by (unfold_locales, auto intro: poly2_ext simp: poly2_poly_x_mult_y hom_distribs)
 
 interpretation poly_x_mult_y_hom: inj_ring_hom "poly_x_mult_y :: 'a :: {idom,ring_char_0} poly \<Rightarrow> _"
 proof
   let ?h = poly_x_mult_y
   fix f :: "'a poly"
   assume "?h f = 0"
   then have "poly2 (?h f) x 1 = 0" for x by simp
   from this[unfolded poly2_poly_x_mult_y]
   show "f = 0" by auto
 qed
 
 lemma degree_poly_x_mult_y[simp]:
   fixes p :: "'a :: {idom, ring_char_0} poly"
   shows "degree (poly_x_mult_y p) = degree p" (is "?l = ?r")
 proof(rule antisym)
   show "?r \<le> ?l" by (cases "p=0", auto intro: le_degree simp: coeff_poly_x_mult_y)
   show "?l \<le> ?r" unfolding poly_x_mult_y_def
     by (auto intro: degree_sum_le le_trans[OF degree_monom_le])
 qed
 
 interpretation poly_x_mult_y_hom: unit_preserving_hom "poly_x_mult_y :: 'a :: field_char_0 poly \<Rightarrow> _"
 proof(unfold_locales)
   let ?h = "poly_x_mult_y :: 'a poly \<Rightarrow> _"
   fix f :: "'a poly"
   assume unit: "?h f dvd 1"
   then have "degree (?h f) = 0" and "coeff (?h f) 0 dvd 1" unfolding poly_dvd_1 by auto
   then have deg: "degree f = 0" by (auto simp add: degree_monom_eq)
   with unit show "f dvd 1" by(cases "f = 0", auto)
 qed
 
 lemmas poly_y_x_o_poly_lift = o_def[of poly_y_x poly_lift, unfolded poly_y_x_poly_lift]
 
 lemma irreducible_dvd_degree: assumes "(f::'a::field poly) dvd g"
  "irreducible g"
  "degree f > 0"
  shows "degree f = degree g"
   using assms
  by (metis irreducible_altdef degree_0 dvd_refl is_unit_field_poly linorder_neqE_nat poly_divides_conv0)
 
 lemma coprime_poly_x_mult_y_poly_lift:
   fixes p q :: "'a :: field_char_0 poly"
   assumes degp: "degree p > 0" and degq: "degree q > 0"
     and nz: "poly p 0 \<noteq> 0 \<or> poly q 0 \<noteq> 0" 
   shows "coprime (poly_x_mult_y p) (poly_lift q)"
 proof(rule ccontr)
   from degp have p: "\<not> p dvd 1" by (auto simp: dvd_const)
   from degp have p0: "p \<noteq> 0" by auto
   from mset_factors_exist[of p, OF p0 p]
   obtain F where F: "mset_factors F p" by auto
   then have pF: "prod_mset (image_mset poly_x_mult_y F) = poly_x_mult_y p"
     by (auto simp: hom_distribs)
 
   from degq have q: "\<not> is_unit q" by (auto simp: dvd_const)
   from degq have q0: "q \<noteq> 0" by auto
   from mset_factors_exist[OF q0 q]
   obtain G where G: "mset_factors G q" by auto
   with poly_lift_hom.hom_mset_factors
   have pG: "mset_factors (image_mset poly_lift G) (poly_lift q)" by auto
   from poly_y_x_hom.hom_mset_factors[OF this]
   have pG: "mset_factors (image_mset coeff_lift G) [:q:]"
     by (auto simp: poly_y_x_poly_lift monom_0 image_mset.compositionality poly_y_x_o_poly_lift)
 
   assume "\<not> coprime (poly_x_mult_y p) (poly_lift q)"
   then have "\<not> coprime (poly_y_x (poly_x_mult_y p)) (poly_y_x (poly_lift q))"
     by (simp del: coprime_iff_coprime)
   from this[unfolded not_coprime_iff_common_factor]
   obtain r
   where rp: "r dvd poly_y_x (poly_x_mult_y p)"
     and rq: "r dvd poly_y_x (poly_lift q)"
     and rU: "\<not> r dvd 1" by auto
   from rp p0 have r0: "r \<noteq> 0" by auto
   from mset_factors_exist[OF r0 rU]
   obtain H where H: "mset_factors H r" by auto
   then have "H \<noteq> {#}" by auto
   then obtain h where hH: "h \<in># H" by fastforce
   with H mset_factors_imp_dvd have hr: "h dvd r" and h: "irreducible h" by auto
   from irreducible_not_unit[OF h] have hU: "\<not> h dvd 1" by auto
   from hr rp have "h dvd poly_y_x (poly_x_mult_y p)" by (rule dvd_trans)
   note this[folded pF,unfolded poly_y_x_hom.hom_prod_mset image_mset.compositionality]
   from prime_elem_dvd_prod_mset[OF h[folded prime_elem_iff_irreducible] this]
   obtain f where f: "f \<in># F" and hf: "h dvd poly_y_x (poly_x_mult_y f)" by auto
   have irrF: "irreducible f" using f F by blast
     from dvd_trans[OF hr rq] have "h dvd [:q:]" by (simp add: poly_y_x_poly_lift monom_0)
     from irreducible_dvd_imp_factor[OF this h pG] q0
     obtain g where g: "g \<in># G" and gh: "[:g:] dvd h" by auto
     from dvd_trans[OF gh hf] have *: "[:g:] dvd poly_y_x (poly_x_mult_y f)" using dvd_trans by auto
   show False
   proof (cases "poly f 0 = 0")
     case f_0: False
     from poly_hom.hom_dvd[OF *]
     have "g dvd poly (poly_y_x (poly_x_mult_y f)) [:0:]" by simp
     also have "... = [:poly f 0:]" by (intro poly_ext, fold poly2_def, simp add: poly2_poly_x_mult_y)
     also have "... dvd 1" using f_0 by auto
     finally have "g dvd 1".
     with g G show False by (auto elim!: mset_factorsE dest!: irreducible_not_unit)
   next
     case True
     hence "[:0,1:] dvd f" by (unfold dvd_iff_poly_eq_0, simp)
     from irreducible_dvd_degree[OF this irrF]
     have "degree f = 1" by auto
     from degree1_coeffs[OF this] True obtain c where c: "c \<noteq> 0" and f: "f = [:0,c:]" by auto
     from g G have irrG: "irreducible g" by auto
     from poly_hom.hom_dvd[OF *]
     have "g dvd poly (poly_y_x (poly_x_mult_y f)) 1" by simp
     also have "\<dots> = f" by (auto simp: f poly_x_mult_y_code Let_def c poly_y_x_pCons map_poly_monom poly_monom poly_lift_def)
     also have "\<dots> dvd [:0,1:]" unfolding f dvd_def using c 
       by (intro exI[of _ "[: inverse c :]"], auto)
     finally have g01: "g dvd [:0,1:]" .
     from divides_degree[OF this] irrG have "degree g = 1" by auto
     from degree1_coeffs[OF this] obtain a b where g: "g = [:b,a:]" and a: "a \<noteq> 0" by auto
     from g01[unfolded dvd_def] g obtain k where id: "[:0,1:] = g * k" by auto
     from id have 0: "g \<noteq> 0" "k \<noteq> 0" by auto
     from arg_cong[OF id, of degree] have "degree k = 0" unfolding degree_mult_eq[OF 0] 
       unfolding g using a by auto
     from degree0_coeffs[OF this] obtain kk where k: "k = [:kk:]" by auto
     from id[unfolded g k] a have "b = 0" by auto
     hence "poly g 0 = 0" by (auto simp: g)
     from True this nz \<open>f \<in># F\<close> \<open>g \<in># G\<close> F G
     show False by (auto dest!:mset_factors_imp_dvd elim:dvdE)
   qed
 qed
 
 lemma poly_div_nonzero:
   fixes p q :: "'a :: field_char_0 poly"
   assumes p0: "p \<noteq> 0" and q0: "q \<noteq> 0" and x: "poly p x = 0" and y: "poly q y = 0"
       and p_0: "poly p 0 \<noteq> 0 \<or> poly q 0 \<noteq> 0"
   shows "poly_div p q \<noteq> 0"
 proof
   have degp: "degree p > 0" using le_0_eq order_degree order_root p0 x by (metis gr0I)
   have degq: "degree q > 0" using le_0_eq order_degree order_root q0 y by (metis gr0I)
   assume 0: "poly_div p q = 0"
   from resultant_zero_imp_common_factor[OF _ this[unfolded poly_div_def]] degp
    and coprime_poly_x_mult_y_poly_lift[OF degp degq] p_0
   show False by auto
 qed
 
 subsubsection \<open>Summary for division\<close>
 
 text \<open>Now we lift the results to one that uses @{const ipoly}, by showing some homomorphism lemmas.\<close>
 
 lemma (in inj_comm_ring_hom) poly_x_mult_y_hom:
   "poly_x_mult_y (map_poly hom p) = map_poly (map_poly hom) (poly_x_mult_y p)"
 proof -
   interpret mh: map_poly_inj_comm_ring_hom..
   interpret mmh: map_poly_inj_comm_ring_hom "map_poly hom"..
   show ?thesis unfolding poly_x_mult_y_def by (simp add: hom_distribs)
 qed
 
 lemma (in inj_comm_ring_hom) poly_div_hom:
   "map_poly hom (poly_div p q) = poly_div (map_poly hom p) (map_poly hom q)"
 proof -
   have zero: "\<forall>x. hom x = 0 \<longrightarrow> x = 0" by simp
   interpret mh: map_poly_inj_comm_ring_hom..
   show ?thesis unfolding poly_div_def mh.resultant_hom[symmetric]
     by (simp add: poly_x_mult_y_hom)
 qed
 
 lemma ipoly_poly_div:
   fixes x y :: "'a :: field_char_0"
   assumes "q \<noteq> 0" and "ipoly p x = 0" and "ipoly q y = 0" and "y \<noteq> 0"
   shows "ipoly (poly_div p q) (x/y) = 0"
   by (unfold of_int_hom.poly_div_hom, rule poly_div, insert assms, auto)
 
 lemma ipoly_poly_div_nonzero:
   fixes x y :: "'a :: field_char_0"
   assumes "p \<noteq> 0" and "q \<noteq> 0" and "ipoly p x = 0" and "ipoly q y = 0" and "poly p 0 \<noteq> 0 \<or> poly q 0 \<noteq> 0"
   shows "poly_div p q \<noteq> 0"
 proof-
   from assms have "(of_int_poly (poly_div p q) :: 'a poly) \<noteq> 0" using of_int_hom.poly_map_poly[of p]
     by (subst of_int_hom.poly_div_hom, subst poly_div_nonzero, auto) 
   then show ?thesis by auto
 qed
 
 lemma represents_div:
   fixes x y :: "'a :: field_char_0"
   assumes "p represents x" and "q represents y" and "poly q 0 \<noteq> 0"
   shows "(poly_div p q) represents (x / y)"
   using assms by (intro representsI ipoly_poly_div ipoly_poly_div_nonzero, auto)
 
 
 subsection \<open>Multiplication of Algebraic Numbers\<close>
 
 definition poly_mult where "poly_mult p q \<equiv> poly_div p (reflect_poly q)"
 
 lemma represents_mult:
   assumes px: "p represents x" and qy: "q represents y" and q_0: "poly q 0 \<noteq> 0" 
   shows "(poly_mult p q) represents (x * y)"
 proof-
   from q_0 qy have y0: "y \<noteq> 0" by auto
   from represents_inverse[OF y0 qy] y0 px q_0
   have "poly_mult p q represents x / (inverse y)"
     unfolding poly_mult_def by (intro represents_div, auto)
   with y0 show ?thesis by (simp add: field_simps)
 qed
 
 subsection \<open>Summary: Closure Properties of Algebraic Numbers\<close>
 
 lemma algebraic_representsI: "p represents x \<Longrightarrow> algebraic x"
   unfolding represents_def algebraic_altdef_ipoly by auto
 
 lemma algebraic_of_rat: "algebraic (of_rat x)"
   by (rule algebraic_representsI[OF poly_rat_represents_of_rat])
 
 lemma algebraic_uminus: "algebraic x \<Longrightarrow> algebraic (-x)"
   by (auto dest: algebraic_imp_represents_irreducible intro: algebraic_representsI represents_uminus)
 
 lemma algebraic_inverse: "algebraic x \<Longrightarrow> algebraic (inverse x)"
   using algebraic_of_rat[of 0]
   by (cases "x = 0", auto dest: algebraic_imp_represents_irreducible intro: algebraic_representsI represents_inverse)
 
 lemma algebraic_plus: "algebraic x \<Longrightarrow> algebraic y \<Longrightarrow> algebraic (x + y)"
   by (auto dest!: algebraic_imp_represents_irreducible_cf_pos intro!: algebraic_representsI[OF represents_add])
 
 lemma algebraic_div:
   assumes x: "algebraic x" and y: "algebraic y" shows "algebraic (x/y)"
 proof(cases "y = 0 \<or> x = 0")
   case True
   then show ?thesis using algebraic_of_rat[of 0] by auto
 next
   case False
   then have x0: "x \<noteq> 0" and y0: "y \<noteq> 0" by auto
   from x y obtain p q
   where px: "p represents x" and irr: "irreducible q" and qy: "q represents y"
     by (auto dest!: algebraic_imp_represents_irreducible)
   show ?thesis
     using False px represents_irr_non_0[OF irr qy]
     by (auto intro!: algebraic_representsI[OF represents_div] qy)
 qed
 
 lemma algebraic_times: "algebraic x \<Longrightarrow> algebraic y \<Longrightarrow> algebraic (x * y)"
   using algebraic_div[OF _ algebraic_inverse, of x y] by (simp add: field_simps)
 
 lemma algebraic_root: "algebraic x \<Longrightarrow> algebraic (root n x)"
 proof -
   assume "algebraic x"
   then obtain p where p: "p represents x" by (auto dest: algebraic_imp_represents_irreducible_cf_pos)
   from 
     algebraic_representsI[OF represents_nth_root_neg_real[OF _ this, of n]]
     algebraic_representsI[OF represents_nth_root_pos_real[OF _ this, of n]]
     algebraic_of_rat[of 0]
   show ?thesis by (cases "n = 0", force, cases "n > 0", force, cases "n < 0", auto)
 qed
 
 lemma algebraic_nth_root: "n \<noteq> 0 \<Longrightarrow> algebraic x \<Longrightarrow> y^n = x \<Longrightarrow> algebraic y"
   by (auto dest: algebraic_imp_represents_irreducible_cf_pos intro: algebraic_representsI represents_nth_root)
 
 
 subsection \<open>More on algebraic integers\<close>
 
 (* TODO: this is actually equal to @{term "(-1)^(m*n)"}, but we need a bit more theory on
    permutations to show this with a reasonable amount of effort. *)
 definition poly_add_sign :: "nat \<Rightarrow> nat \<Rightarrow> 'a :: comm_ring_1" where
   "poly_add_sign m n = signof (\<lambda>i. if i < n then m + i else if i < m + n then i - n else i)"
 
 lemma lead_coeff_poly_add:
   fixes p q :: "'a :: {idom, semiring_char_0} poly"
   defines "m \<equiv> degree p" and "n \<equiv> degree q"
   assumes "lead_coeff p = 1" "lead_coeff q = 1" "m > 0" "n > 0"
   shows "lead_coeff (poly_add p q :: 'a poly) = poly_add_sign m n"
 proof -
   from assms have [simp]: "p \<noteq> 0" "q \<noteq> 0"
     by auto
   define M where "M = sylvester_mat (poly_x_minus_y p) (poly_lift q)"
   define \<pi> :: "nat \<Rightarrow> nat" where
     "\<pi> = (\<lambda>i. if i < n then m + i else if i < m + n then i - n else i)"
   have \<pi>: "\<pi> permutes {0..<m+n}"
     by (rule inj_on_nat_permutes) (auto simp: \<pi>_def inj_on_def)
   have nz: "M $$ (i, \<pi> i) \<noteq> 0" if "i < m + n" for i
     using that by (auto simp: M_def \<pi>_def sylvester_index_mat m_def n_def)
 
 (*
   have "{(i,j). i \<in> {..<m+n} \<and> j \<in> {..<m+n} \<and> i < j \<and> \<pi> i > \<pi> j} =
         {..<n} \<times> {n..<m+n}" (is "?lhs = ?rhs")
   proof (intro equalityI subsetI)
     fix ij assume "ij \<in> ?lhs"
     thus "ij \<in> ?rhs"
       by (simp add: \<pi>_def split: prod.splits if_splits) auto
   qed (auto simp: \<pi>_def)
   hence "inversions_on {..<m+n} \<pi> = n * m"
     by (simp add: inversions_on_def)
   hence "signof \<pi> = (-1)^(m*n)"
     using \<pi> by (simp add: signof_def sign_def evenperm_iff_even_inversions)
 *)
 
   have indices_eq: "{0..<m+n} = {..<n} \<union> (+) n ` {..<m}"
     by (auto simp flip: atLeast0LessThan)
 
   define f where "f = (\<lambda> \<sigma>. signof \<sigma> * (\<Prod>i=0..<m+n. M $$ (i, \<sigma> i)))"
   have "degree (f \<pi>) = degree (\<Prod>i=0..<m + n. M $$ (i, \<pi> i))"
     using nz by (auto simp: f_def degree_mult_eq signof_def)
   also have "\<dots> = (\<Sum>i=0..<m+n. degree (M $$ (i, \<pi> i)))"
     using nz by (subst degree_prod_eq_sum_degree) auto
   also have "\<dots> = (\<Sum>i<n. degree (M $$ (i, \<pi> i))) + (\<Sum>i<m. degree (M $$ (n + i, \<pi> (n + i))))"
     by (subst indices_eq, subst sum.union_disjoint) (auto simp: sum.reindex)
   also have "(\<Sum>i<n. degree (M $$ (i, \<pi> i))) = (\<Sum>i<n. m)"
     by (intro sum.cong) (auto simp: M_def sylvester_index_mat \<pi>_def m_def n_def)
   also have "(\<Sum>i<m. degree (M $$ (n + i, \<pi> (n + i)))) = (\<Sum>i<m. 0)"
     by (intro sum.cong) (auto simp: M_def sylvester_index_mat \<pi>_def m_def n_def)
   finally have deg_f1: "degree (f \<pi>) = m * n"
     by simp
 
   have deg_f2: "degree (f \<sigma>) < m * n" if "\<sigma> permutes {0..<m+n}" "\<sigma> \<noteq> \<pi>" for \<sigma>
   proof (cases "\<exists>i\<in>{0..<m+n}. M $$ (i, \<sigma> i) = 0")
     case True
     hence *: "(\<Prod>i = 0..<m + n. M $$ (i, \<sigma> i)) = 0"
       by auto
     show ?thesis using \<open>m > 0\<close> \<open>n > 0\<close>
       by (simp add: f_def *)
   next
     case False
     note nz = this
     from that have \<sigma>_less: "\<sigma> i < m + n" if "i < m + n" for i
       using permutes_in_image[OF \<open>\<sigma> permutes _\<close>] that by auto
     have "degree (f \<sigma>) = degree (\<Prod>i=0..<m + n. M $$ (i, \<sigma> i))"
       using nz by (auto simp: f_def degree_mult_eq signof_def)
     also have "\<dots> = (\<Sum>i=0..<m+n. degree (M $$ (i, \<sigma> i)))"
       using nz by (subst degree_prod_eq_sum_degree) auto
     also have "\<dots> = (\<Sum>i<n. degree (M $$ (i, \<sigma> i))) + (\<Sum>i<m. degree (M $$ (n + i, \<sigma> (n + i))))"
       by (subst indices_eq, subst sum.union_disjoint) (auto simp: sum.reindex)
     also have "(\<Sum>i<m. degree (M $$ (n + i, \<sigma> (n + i)))) = (\<Sum>i<m. 0)"
       using \<sigma>_less by (intro sum.cong) (auto simp: M_def sylvester_index_mat \<pi>_def m_def n_def)
     also have "(\<Sum>i<n. degree (M $$ (i, \<sigma> i))) < (\<Sum>i<n. m)"
     proof (rule sum_strict_mono_ex1)
       show "\<forall>x\<in>{..<n}. degree (M $$ (x, \<sigma> x)) \<le> m" using \<sigma>_less
         by (auto simp: M_def sylvester_index_mat \<pi>_def m_def n_def degree_coeff_poly_x_minus_y)
     next
 
       have "\<exists>i<n. \<sigma> i \<noteq> \<pi> i"
       proof (rule ccontr)
         assume nex: "~(\<exists>i<n. \<sigma> i \<noteq> \<pi> i)"
         have "\<forall>i\<ge>m+n-k. \<sigma> i = \<pi> i" if "k \<le> m" for k
           using that
         proof (induction k)
           case 0
           thus ?case using \<open>\<pi> permutes _\<close> \<open>\<sigma> permutes _\<close>
             by (fastforce simp: permutes_def)
         next
           case (Suc k)
           have IH: "\<sigma> i = \<pi> i" if "i \<ge> m+n-k" for i
             using Suc.prems Suc.IH that by auto
           from nz have "M $$ (m + n - Suc k, \<sigma> (m + n - Suc k)) \<noteq> 0"
             using Suc.prems by auto
           moreover have "m + n - Suc k \<ge> n"
             using Suc.prems by auto
           ultimately have "\<sigma> (m+n-Suc k) \<ge> m-Suc k"
             using assms \<sigma>_less[of "m+n-Suc k"] Suc.prems
             by (auto simp: M_def sylvester_index_mat m_def n_def split: if_splits)
           have "\<not>(\<sigma> (m+n-Suc k) > m - Suc k)"
           proof
             assume *: "\<sigma> (m+n-Suc k) > m - Suc k"
             have less: "\<sigma> (m+n-Suc k) < m"
             proof (rule ccontr)
               assume *: "\<not>\<sigma> (m + n - Suc k) < m"
               define j where "j = \<sigma> (m + n - Suc k) - m"
               have "\<sigma> (m + n - Suc k) = m + j"
                 using * by (simp add: j_def)
               moreover {
                 have "j < n"
                   using \<sigma>_less[of "m+n-Suc k"] \<open>m > 0\<close> \<open>n > 0\<close> by (simp add: j_def)
                 hence "\<sigma> j = \<pi> j"
                   using nex by auto
                 with \<open>j < n\<close> have "\<sigma> j = m + j"
                   by (auto simp: \<pi>_def)
               }
               ultimately have "\<sigma> (m + n - Suc k) = \<sigma> j"
                 by simp
               hence "m + n - Suc k = j"
                 using permutes_inj[OF \<open>\<sigma> permutes _\<close>] unfolding inj_def by blast
               thus False using \<open>n \<le> m + n - Suc k\<close> \<sigma>_less[of "m+n-Suc k"] \<open>n > 0\<close> 
                 unfolding j_def by linarith
             qed
           
             define j where "j = \<sigma> (m+n-Suc k) - (m - Suc k)"
             from * have j: "\<sigma> (m+n-Suc k) = m - Suc k + j" "j > 0"
               by (auto simp: j_def)
             have "\<sigma> (m+n-Suc k + j) = \<pi> (m+n - Suc k + j)"
               using * by (intro IH) (auto simp: j_def)
             also {
               have "j < Suc k"
                 using less by (auto simp: j_def algebra_simps)
               hence "m + n - Suc k + j < m + n"
                 using \<open>m > 0\<close> \<open>n > 0\<close> Suc.prems by linarith
               hence "\<pi> (m +n - Suc k + j) = m - Suc k + j"
                 unfolding \<pi>_def using Suc.prems by (simp add: \<pi>_def)
             }
             finally have "\<sigma> (m + n - Suc k + j) = \<sigma> (m + n - Suc k)"
               using j by simp
             hence "m + n - Suc k + j = m + n - Suc k"
               using permutes_inj[OF \<open>\<sigma> permutes _\<close>] unfolding inj_def by blast
             thus False using \<open>j > 0\<close> by simp
           qed
           with \<open>\<sigma> (m+n-Suc k) \<ge> m-Suc k\<close> have eq: "\<sigma> (m+n-Suc k) = m - Suc k"
             by linarith
 
           show ?case
           proof safe
             fix i :: nat
             assume i: "i \<ge> m + n - Suc k"
             show "\<sigma> i = \<pi> i"
               using eq Suc.prems \<open>m > 0\<close> IH i
             proof (cases "i = m + n - Suc k")
               case True
               thus ?thesis using eq Suc.prems \<open>m > 0\<close>
                 by (auto simp: \<pi>_def)
             qed (use IH i in auto)
           qed
         qed
         from this[of m] and nex have "\<sigma> i = \<pi> i" for i
           by (cases "i \<ge> n") auto
         hence "\<sigma> = \<pi>" by force
         thus False using \<open>\<sigma> \<noteq> \<pi>\<close> by contradiction
       qed
 
       then obtain i where i: "i < n" "\<sigma> i \<noteq> \<pi> i"
         by auto
       have "\<sigma> i < m + n"
         using i by (intro \<sigma>_less) auto
       moreover have "\<pi> i = m + i"
         using i by (auto simp: \<pi>_def)
       ultimately have "degree (M $$ (i, \<sigma> i)) < m" using i \<open>m > 0\<close>
         by (auto simp: M_def m_def n_def sylvester_index_mat degree_coeff_poly_x_minus_y)
       thus "\<exists>i\<in>{..<n}. degree (M $$ (i, \<sigma> i)) < m"
         using i by blast
     qed auto
     finally show "degree (f \<sigma>) < m * n"
       by (simp add: mult_ac)
   qed
 
   have "lead_coeff (f \<pi>) = poly_add_sign m n"
   proof -
     have "lead_coeff (f \<pi>) = signof \<pi> * (\<Prod>i=0..<m + n. lead_coeff (M $$ (i, \<pi> i)))"
       by (simp add: f_def signof_def lead_coeff_prod)
     also have "(\<Prod>i=0..<m + n. lead_coeff (M $$ (i, \<pi> i))) =
                (\<Prod>i<n. lead_coeff (M $$ (i, \<pi> i))) * (\<Prod>i<m. lead_coeff (M $$ (n + i, \<pi> (n + i))))"
       by (subst indices_eq, subst prod.union_disjoint) (auto simp: prod.reindex)
     also have "(\<Prod>i<n. lead_coeff (M $$ (i, \<pi> i))) = (\<Prod>i<n. lead_coeff p)"
       by (intro prod.cong) (auto simp: M_def m_def n_def \<pi>_def sylvester_index_mat)
     also have "(\<Prod>i<m. lead_coeff (M $$ (n + i, \<pi> (n + i)))) = (\<Prod>i<m. lead_coeff q)"
       by (intro prod.cong) (auto simp: M_def m_def n_def \<pi>_def sylvester_index_mat)
     also have "signof \<pi> = poly_add_sign m n"
       by (simp add: \<pi>_def poly_add_sign_def m_def n_def cong: if_cong)
     finally show ?thesis
       using assms by simp
   qed
 
   have "lead_coeff (poly_add p q) =
           lead_coeff (det (sylvester_mat (poly_x_minus_y p) (poly_lift q)))"
     by (simp add: poly_add_def resultant_def)
   also have "det (sylvester_mat (poly_x_minus_y p) (poly_lift q)) =
                (\<Sum>\<pi> | \<pi> permutes {0..<m+n}. f \<pi>)"
     by (simp add: det_def m_def n_def M_def f_def)
   also have "{\<pi>. \<pi> permutes {0..<m+n}} = insert \<pi> ({\<pi>. \<pi> permutes {0..<m+n}} - {\<pi>})"
     using \<pi> by auto
   also have "(\<Sum>\<sigma>\<in>\<dots>. f \<sigma>) = (\<Sum>\<sigma>\<in>{\<sigma>. \<sigma> permutes {0..<m+n}}-{\<pi>}. f \<sigma>) + f \<pi>"
     by (subst sum.insert) (auto simp: finite_permutations)
   also have "lead_coeff \<dots> = lead_coeff (f \<pi>)"
   proof -
     have "degree (\<Sum>\<sigma>\<in>{\<sigma>. \<sigma> permutes {0..<m+n}}-{\<pi>}. f \<sigma>) < m * n" using assms
       by (intro degree_sum_smaller deg_f2) (auto simp: m_def n_def finite_permutations)
     with deg_f1 show ?thesis
       by (subst lead_coeff_add_le) auto
   qed
   finally show ?thesis
     using \<open>lead_coeff (f \<pi>) = _\<close> by simp
 qed
 
 lemma lead_coeff_poly_mult:
   fixes p q :: "'a :: {idom, ring_char_0} poly"
   defines "m \<equiv> degree p" and "n \<equiv> degree q"
   assumes "lead_coeff p = 1" "lead_coeff q = 1" "m > 0" "n > 0"
   assumes "coeff q 0 \<noteq> 0"
   shows "lead_coeff (poly_mult p q :: 'a poly) = 1"
 proof -
   from assms have [simp]: "p \<noteq> 0" "q \<noteq> 0"
     by auto
   have [simp]: "degree (reflect_poly q) = n"
     using assms by (subst degree_reflect_poly_eq) (auto simp: n_def)
 
   define M where "M = sylvester_mat (poly_x_mult_y p) (poly_lift (reflect_poly q))"
   have nz: "M $$ (i, i) \<noteq> 0" if "i < m + n" for i
     using that by (auto simp: M_def sylvester_index_mat m_def n_def coeff_poly_x_mult_y)
 
   have indices_eq: "{0..<m+n} = {..<n} \<union> (+) n ` {..<m}"
     by (auto simp flip: atLeast0LessThan)
 
   define f where "f = (\<lambda> \<sigma>. signof \<sigma> * (\<Prod>i=0..<m+n. M $$ (i, \<sigma> i)))"
   have "degree (f id) = degree (\<Prod>i=0..<m + n. M $$ (i, i))"
     using nz by (auto simp: f_def degree_mult_eq signof_def)
   also have "\<dots> = (\<Sum>i=0..<m+n. degree (M $$ (i, i)))"
     using nz by (subst degree_prod_eq_sum_degree) auto
   also have "\<dots> = (\<Sum>i<n. degree (M $$ (i, i))) + (\<Sum>i<m. degree (M $$ (n + i, n + i)))"
     by (subst indices_eq, subst sum.union_disjoint) (auto simp: sum.reindex)
   also have "(\<Sum>i<n. degree (M $$ (i, i))) = (\<Sum>i<n. m)"
     by (intro sum.cong)
        (auto simp: M_def sylvester_index_mat m_def n_def coeff_poly_x_mult_y degree_monom_eq)
   also have "(\<Sum>i<m. degree (M $$ (n + i, n + i))) = (\<Sum>i<m. 0)"
     by (intro sum.cong) (auto simp: M_def sylvester_index_mat m_def n_def)
   finally have deg_f1: "degree (f id) = m * n"
     by (simp add: mult_ac id_def)
 
   have deg_f2: "degree (f \<sigma>) < m * n" if "\<sigma> permutes {0..<m+n}" "\<sigma> \<noteq> id" for \<sigma>
   proof (cases "\<exists>i\<in>{0..<m+n}. M $$ (i, \<sigma> i) = 0")
     case True
     hence *: "(\<Prod>i = 0..<m + n. M $$ (i, \<sigma> i)) = 0"
       by auto
     show ?thesis using \<open>m > 0\<close> \<open>n > 0\<close>
       by (simp add: f_def *)
   next
     case False
     note nz = this
     from that have \<sigma>_less: "\<sigma> i < m + n" if "i < m + n" for i
       using permutes_in_image[OF \<open>\<sigma> permutes _\<close>] that by auto
     have "degree (f \<sigma>) = degree (\<Prod>i=0..<m + n. M $$ (i, \<sigma> i))"
       using nz by (auto simp: f_def degree_mult_eq signof_def)
     also have "\<dots> = (\<Sum>i=0..<m+n. degree (M $$ (i, \<sigma> i)))"
       using nz by (subst degree_prod_eq_sum_degree) auto
     also have "\<dots> = (\<Sum>i<n. degree (M $$ (i, \<sigma> i))) + (\<Sum>i<m. degree (M $$ (n + i, \<sigma> (n + i))))"
       by (subst indices_eq, subst sum.union_disjoint) (auto simp: sum.reindex)
     also have "(\<Sum>i<m. degree (M $$ (n + i, \<sigma> (n + i)))) = (\<Sum>i<m. 0)"
       using \<sigma>_less by (intro sum.cong) (auto simp: M_def sylvester_index_mat m_def n_def)
     also have "(\<Sum>i<n. degree (M $$ (i, \<sigma> i))) < (\<Sum>i<n. m)"
     proof (rule sum_strict_mono_ex1)
       show "\<forall>x\<in>{..<n}. degree (M $$ (x, \<sigma> x)) \<le> m" using \<sigma>_less
         by (auto simp: M_def sylvester_index_mat m_def n_def degree_coeff_poly_x_minus_y coeff_poly_x_mult_y
                  intro: order.trans[OF degree_monom_le])
     next
       have "\<exists>i<n. \<sigma> i \<noteq> i"
       proof (rule ccontr)
         assume nex: "\<not>(\<exists>i<n. \<sigma> i \<noteq> i)"
         have "\<sigma> i = i" for i
           using that
         proof (induction i rule: less_induct)
           case (less i)
           consider "i < n" | "i \<in> {n..<m+n}" | "i \<ge> m + n"
             by force
           thus ?case
           proof cases
             assume "i < n"
             thus ?thesis using nex by auto
           next
             assume "i \<ge> m + n"
             thus ?thesis using \<open>\<sigma> permutes _\<close>
               by (auto simp: permutes_def)
           next
             assume i: "i \<in> {n..<m+n}"
             have IH: "\<sigma> j = j" if "j < i" for j
               using that less.prems by (intro less.IH) auto
 
             from nz have "M $$ (i, \<sigma> i) \<noteq> 0"
               using i by auto
             hence "\<sigma> i \<le> i"
               using i \<sigma>_less[of i] by (auto simp: M_def sylvester_index_mat m_def n_def)
             moreover have "\<sigma> i \<ge> i"
             proof (rule ccontr)
               assume *: "\<not>\<sigma> i \<ge> i"
               from * have "\<sigma> (\<sigma> i) = \<sigma> i"
                 by (subst IH) auto
               hence "\<sigma> i = i"
                 using permutes_inj[OF \<open>\<sigma> permutes _\<close>] unfolding inj_def by blast
               with * show False by simp
             qed
             ultimately show ?case by simp
           qed
         qed
         hence "\<sigma> = id"
           by force
         with \<open>\<sigma> \<noteq> id\<close> show False
           by contradiction
       qed
 
       then obtain i where i: "i < n" "\<sigma> i \<noteq> i"
         by auto
       have "\<sigma> i < m + n"
         using i by (intro \<sigma>_less) auto
       hence "degree (M $$ (i, \<sigma> i)) < m" using i \<open>m > 0\<close>
         by (auto simp: M_def m_def n_def sylvester_index_mat degree_coeff_poly_x_minus_y
                        coeff_poly_x_mult_y intro: le_less_trans[OF degree_monom_le])
       thus "\<exists>i\<in>{..<n}. degree (M $$ (i, \<sigma> i)) < m"
         using i by blast
     qed auto
     finally show "degree (f \<sigma>) < m * n"
       by (simp add: mult_ac)
   qed
 
   have "lead_coeff (f id) = 1"
   proof -
     have "lead_coeff (f id) = (\<Prod>i=0..<m + n. lead_coeff (M $$ (i, i)))"
       by (simp add: f_def signof_def lead_coeff_prod sign_id)
     also have "(\<Prod>i=0..<m + n. lead_coeff (M $$ (i, i))) =
                (\<Prod>i<n. lead_coeff (M $$ (i, i))) * (\<Prod>i<m. lead_coeff (M $$ (n + i, n + i)))"
       by (subst indices_eq, subst prod.union_disjoint) (auto simp: prod.reindex)
     also have "(\<Prod>i<n. lead_coeff (M $$ (i, i))) = (\<Prod>i<n. lead_coeff p)" using assms
       by (intro prod.cong) (auto simp: M_def m_def n_def sylvester_index_mat
                                        coeff_poly_x_mult_y degree_monom_eq)
     also have "(\<Prod>i<m. lead_coeff (M $$ (n + i, n + i))) = (\<Prod>i<m. lead_coeff q)"
       by (intro prod.cong) (auto simp: M_def m_def n_def sylvester_index_mat)
     finally show ?thesis
       using assms by (simp add: id_def)
   qed
 
   have "lead_coeff (poly_mult p q) = lead_coeff (det M)"
     by (simp add: poly_mult_def resultant_def M_def poly_div_def)
   also have "det M = (\<Sum>\<pi> | \<pi> permutes {0..<m+n}. f \<pi>)"
     by (simp add: det_def m_def n_def M_def f_def)
   also have "{\<pi>. \<pi> permutes {0..<m+n}} = insert id ({\<pi>. \<pi> permutes {0..<m+n}} - {id})"
     by (auto simp: permutes_id)
   also have "(\<Sum>\<sigma>\<in>\<dots>. f \<sigma>) = (\<Sum>\<sigma>\<in>{\<sigma>. \<sigma> permutes {0..<m+n}}-{id}. f \<sigma>) + f id"
     by (subst sum.insert) (auto simp: finite_permutations)
   also have "lead_coeff \<dots> = lead_coeff (f id)"
   proof -
     have "degree (\<Sum>\<sigma>\<in>{\<sigma>. \<sigma> permutes {0..<m+n}}-{id}. f \<sigma>) < m * n" using assms
       by (intro degree_sum_smaller deg_f2) (auto simp: m_def n_def finite_permutations)
     with deg_f1 show ?thesis
       by (subst lead_coeff_add_le) auto
   qed
   finally show ?thesis
     using \<open>lead_coeff (f id) = 1\<close> by simp
 qed
 
 lemma algebraic_int_plus [intro]:
   fixes x y :: "'a :: field_char_0"
   assumes "algebraic_int x" "algebraic_int y"
   shows   "algebraic_int (x + y)"
 proof -
   from assms(1) obtain p where p: "lead_coeff p = 1" "ipoly p x = 0"
     by (auto simp: algebraic_int_altdef_ipoly)
   from assms(2) obtain q where q: "lead_coeff q = 1" "ipoly q y = 0"
     by (auto simp: algebraic_int_altdef_ipoly)
   have deg_pos: "degree p > 0" "degree q > 0"
     using p q by (auto intro!: Nat.gr0I elim!: degree_eq_zeroE)
   define r where "r = poly_add_sign (degree p) (degree q) * poly_add p q"
 
   have "lead_coeff r = 1" using p q deg_pos
     by (simp add: r_def lead_coeff_mult poly_add_sign_def signof_def lead_coeff_poly_add)
   moreover have "ipoly r (x + y) = 0"
     using p q by (simp add: ipoly_poly_add r_def of_int_poly_hom.hom_mult)
   ultimately show ?thesis
     by (auto simp: algebraic_int_altdef_ipoly)
 qed
 
 lemma algebraic_int_times [intro]:
   fixes x y :: "'a :: field_char_0"
   assumes "algebraic_int x" "algebraic_int y"
   shows   "algebraic_int (x * y)"
 proof (cases "y = 0")
   case [simp]: False
   from assms(1) obtain p where p: "lead_coeff p = 1" "ipoly p x = 0"
     by (auto simp: algebraic_int_altdef_ipoly)
   from assms(2) obtain q where q: "lead_coeff q = 1" "ipoly q y = 0"
     by (auto simp: algebraic_int_altdef_ipoly)
   have deg_pos: "degree p > 0" "degree q > 0"
     using p q by (auto intro!: Nat.gr0I elim!: degree_eq_zeroE)
   have [simp]: "q \<noteq> 0"
     using q by auto
 
   define n where "n = Polynomial.order 0 q"
   have "monom 1 n dvd q"
     by (simp add: n_def monom_1_dvd_iff)
   then obtain q' where q_split: "q = q' * monom 1 n"
     by auto
   have "Polynomial.order 0 q = Polynomial.order 0 q' + n"
     using \<open>q \<noteq> 0\<close> unfolding q_split by (subst order_mult) auto
   hence "poly q' 0 \<noteq> 0"
     unfolding n_def using \<open>q \<noteq> 0\<close> by (simp add: q_split order_root)    
 
   have q': "ipoly q' y = 0" "lead_coeff q' = 1" using q_split q
     by (auto simp: of_int_poly_hom.hom_mult poly_monom lead_coeff_mult degree_monom_eq)
   from this have deg_pos': "degree q' > 0"
     by (intro Nat.gr0I) (auto elim!: degree_eq_zeroE)
   from \<open>poly q' 0 \<noteq> 0\<close> have [simp]: "coeff q' 0 \<noteq> 0"
     by (auto simp: monom_1_dvd_iff' poly_0_coeff_0)
 
   have "p represents x" "q' represents y"
     using p q' by (auto simp: represents_def)
   hence "poly_mult p q' represents x * y"
     by (rule represents_mult) (simp add: poly_0_coeff_0)
   moreover have "lead_coeff (poly_mult p q') = 1" using p deg_pos q' deg_pos'
     by (simp add: lead_coeff_mult lead_coeff_poly_mult)
   ultimately show ?thesis
     by (auto simp: algebraic_int_altdef_ipoly represents_def)
 qed auto
 
 lemma algebraic_int_power [intro]:
   "algebraic_int (x :: 'a :: field_char_0) \<Longrightarrow> algebraic_int (x ^ n)"
   by (induction n) auto
 
 lemma algebraic_int_diff [intro]:
   fixes x y :: "'a :: field_char_0"
   assumes "algebraic_int x" "algebraic_int y"
   shows   "algebraic_int (x - y)"
   using algebraic_int_plus[OF assms(1) algebraic_int_minus[OF assms(2)]] by simp
 
 lemma algebraic_int_sum [intro]:
   "(\<And>x. x \<in> A \<Longrightarrow> algebraic_int (f x :: 'a :: field_char_0))
     \<Longrightarrow> algebraic_int (sum f A)"
   by (induction A rule: infinite_finite_induct) auto
 
 lemma algebraic_int_prod [intro]:
   "(\<And>x. x \<in> A \<Longrightarrow> algebraic_int (f x :: 'a :: field_char_0))
     \<Longrightarrow> algebraic_int (prod f A)"
   by (induction A rule: infinite_finite_induct) auto
 
 lemma algebraic_int_nth_root_real_iff:
   "algebraic_int (root n x) \<longleftrightarrow> n = 0 \<or> algebraic_int x"
 proof -
   have "algebraic_int x" if "algebraic_int (root n x)" "n \<noteq> 0"
   proof -
     from that(1) have "algebraic_int (root n x ^ n)"
       by auto
     also have "root n x ^ n = (if even n then \<bar>x\<bar> else x)"
       using sgn_power_root[of n x] that(2) by (auto simp: sgn_if split: if_splits)
     finally show ?thesis
       by (auto split: if_splits)
   qed
   thus ?thesis by auto
 qed
 
 lemma algebraic_int_power_iff:
   "algebraic_int (x ^ n :: 'a :: field_char_0) \<longleftrightarrow> n = 0 \<or> algebraic_int x"
 proof -
   have "algebraic_int x" if "algebraic_int (x ^ n)" "n > 0"
   proof (rule algebraic_int_root)
     show "poly (monom 1 n) x = x ^ n"
       by (auto simp: poly_monom)
   qed (use that in \<open>auto simp: degree_monom_eq\<close>)
   thus ?thesis by auto
 qed
 
 lemma algebraic_int_power_iff' [simp]:
   "n > 0 \<Longrightarrow> algebraic_int (x ^ n :: 'a :: field_char_0) \<longleftrightarrow> algebraic_int x"
   by (subst algebraic_int_power_iff) auto
 
 lemma algebraic_int_sqrt_iff [simp]: "algebraic_int (sqrt x) \<longleftrightarrow> algebraic_int x"
   by (simp add: sqrt_def algebraic_int_nth_root_real_iff)
 
 lemma algebraic_int_csqrt_iff [simp]: "algebraic_int (csqrt x) \<longleftrightarrow> algebraic_int x"
 proof
   assume "algebraic_int (csqrt x)"
   hence "algebraic_int (csqrt x ^ 2)"
     by (rule algebraic_int_power)
   thus "algebraic_int x"
     by simp
 qed auto
 
 lemma algebraic_int_norm_complex [intro]:
   assumes "algebraic_int (z :: complex)"
   shows   "algebraic_int (norm z)"
 proof -
   from assms have "algebraic_int (z * cnj z)"
     by auto
   also have "z * cnj z = of_real (norm z ^ 2)"
     by (rule complex_norm_square [symmetric])
   finally show ?thesis
     by simp
 qed
 
 hide_const (open) x_y
 
 end
diff --git a/thys/Berlekamp_Zassenhaus/Missing_Multiset2.thy b/thys/Berlekamp_Zassenhaus/More_Missing_Multiset.thy
rename from thys/Berlekamp_Zassenhaus/Missing_Multiset2.thy
rename to thys/Berlekamp_Zassenhaus/More_Missing_Multiset.thy
--- a/thys/Berlekamp_Zassenhaus/Missing_Multiset2.thy
+++ b/thys/Berlekamp_Zassenhaus/More_Missing_Multiset.thy
@@ -1,270 +1,149 @@
-theory Missing_Multiset2
-  imports "HOL-Combinatorics.Permutations"
-    Containers.Containers_Auxiliary (* only for a lemma *)
+theory More_Missing_Multiset
+  imports
+    "HOL-Combinatorics.Permutations"
+    Polynomial_Factorization.Missing_Multiset
 begin
 
-subsubsection \<open>Missing muiltiset\<close>
-
-lemma id_imp_bij:
-  assumes id: "\<And>x. f (f x) = x" shows "bij f"
-proof (intro bijI injI surjI[of f, OF id])
-  fix x y assume "f x = f y"
-  then have "f (f x) = f (f y)" by auto
-  with id show "x = y" by auto
-qed
-
-lemma rel_mset_Zero_iff[simp]:
-  shows "rel_mset rel {#} Y \<longleftrightarrow> Y = {#}" and "rel_mset rel X {#} \<longleftrightarrow> X = {#}"
-  using rel_mset_Zero rel_mset_size by (fastforce, fastforce)
-
-definition "is_mset_set X \<equiv> \<forall>x \<in># X. count X x = 1"
-
-lemma is_mset_setD[dest]: "is_mset_set X \<Longrightarrow> x \<in># X \<Longrightarrow> count X x = 1"
-  unfolding is_mset_set_def by auto
-
-lemma is_mset_setI[intro]:
-  assumes "\<And>x. x \<in># X \<Longrightarrow> count X x = 1"
-  shows "is_mset_set X"
-  using assms unfolding is_mset_set_def by auto
-
-lemma is_mset_set[simp]: "is_mset_set (mset_set X)"
-  unfolding is_mset_set_def
-  by (meson count_mset_set(1) count_mset_set(2) count_mset_set(3) not_in_iff)
-
-lemma is_mset_set_add[simp]:
-  "is_mset_set (X + {#x#}) \<longleftrightarrow> is_mset_set X \<and> x \<notin># X" (is "?L \<longleftrightarrow> ?R")
-proof(intro iffI conjI)
-  assume L: ?L
-  with count_eq_zero_iff count_single show "is_mset_set X"
-    unfolding is_mset_set_def
-    by (metis (no_types, hide_lams) add_mset_add_single count_add_mset nat.inject set_mset_add_mset_insert union_single_eq_member)
-  show "x \<notin># X"
-  proof
-    assume "x \<in># X"
-    then have "count (X + {#x#}) x > 1" by auto
-    with L show False by (auto simp: is_mset_set_def)
-  qed
-next
-  assume R: ?R show ?L
-  proof
-    fix x' assume x': "x' \<in># X + {#x#}"
-    show "count (X + {#x#}) x' = 1"
-    proof(cases "x' \<in># X")
-      case True with R have "count X x' = 1" by auto
-        moreover from True R have "count {#x#} x' = 0" by auto
-        ultimately show ?thesis by auto
-    next
-      case False then have "count X x' = 0" by (simp add: not_in_iff)
-        with R x' show ?thesis by auto
-    qed
-  qed
+lemma rel_mset_free:
+  assumes rel: "rel_mset rel X Y" and xs: "mset xs = X"
+  shows "\<exists>ys. mset ys = Y \<and> list_all2 rel xs ys"
+proof-
+  from rel[unfolded rel_mset_def] obtain xs' ys'
+    where xs': "mset xs' = X" and ys': "mset ys' = Y" and xsys': "list_all2 rel xs' ys'" by auto
+  from xs' xs have "mset xs = mset xs'" by auto
+  from mset_eq_permutation[OF this]
+  obtain f where perm: "f permutes {..<length xs'}" and xs': "permute_list f xs' = xs".
+  then have [simp]: "length xs' = length xs" by auto
+  from permute_list_nth[OF perm, unfolded xs'] have *: "\<And>i. i < length xs \<Longrightarrow> xs ! i = xs' ! f i" by auto
+  note [simp] = list_all2_lengthD[OF xsys',symmetric]
+  note [simp] = atLeast0LessThan[symmetric]
+  note bij =  permutes_bij[OF perm]
+  define ys where "ys \<equiv> map (nth ys' \<circ> f) [0..<length ys']"
+  then have [simp]: "length ys = length ys'" by auto 
+  have "mset ys = mset (map (nth ys') (map f [0..<length ys']))"
+   unfolding ys_def by auto
+  also have "... = image_mset (nth ys') (image_mset f (mset [0..<length ys']))"
+    by (simp add: multiset.map_comp)
+  also have "(mset [0..<length ys']) = mset_set {0..<length ys'}"
+    by (metis mset_sorted_list_of_multiset sorted_list_of_mset_set sorted_list_of_set_range) 
+  also have "image_mset f (...) = mset_set (f ` {..<length ys'})"
+    using subset_inj_on[OF bij_is_inj[OF bij]] by (subst image_mset_mset_set, auto)
+  also have "... = mset [0..<length ys']" using perm by (simp add: permutes_image)
+  also have "image_mset (nth ys') ... = mset ys'" by(fold mset_map, unfold map_nth, auto)
+  finally have "mset ys = Y" using ys' by auto
+  moreover have "list_all2 rel xs ys"
+  proof(rule list_all2_all_nthI)
+    fix i assume i: "i < length xs"
+    with * have "xs ! i = xs' ! f i" by auto
+    also from i permutes_in_image[OF perm]
+    have "rel (xs' ! f i) (ys' ! f i)" by (intro list_all2_nthD[OF xsys'], auto)
+    finally show "rel (xs ! i) (ys ! i)" unfolding ys_def using i by simp
+  qed simp
+  ultimately show ?thesis by auto
 qed
 
-
-lemma mset_set_id[simp]:
-  assumes "is_mset_set X"
-  shows "mset_set (set_mset X) = X"
-  using assms unfolding is_mset_set_def
-  by (metis count_eq_zero_iff count_mset_set(1) count_mset_set(3) finite_set_mset multiset_eqI)
-
-lemma count_image_mset:
-  shows "count (image_mset f X) y = (\<Sum>x | x \<in># X \<and> y = f x. count X x)"
-proof(induct X)
-  case empty show ?case by auto
-next
-  case (add x X)
-    define X' where "X' \<equiv> X + {#x#}"
-    have "(\<Sum>z | z \<in># X' \<and> y = f z. count (X + {#x#}) z) =
-          (\<Sum>z | z \<in># X' \<and> y = f z. count X z) + (\<Sum>z | z \<in># X' \<and> y = f z. count {#x#} z)"
-      unfolding plus_multiset.rep_eq sum.distrib..
-    also have split:
-      "{z. z \<in># X' \<and> y = f z} =
-       {z. z \<in># X' \<and> y = f z \<and> z \<noteq> x} \<union> {z. z \<in># X' \<and> y = f z \<and> z = x}" by blast
-    then have "(\<Sum>z | z \<in># X' \<and> y = f z. count {#x#} z) =
-      (\<Sum>z | z \<in># X' \<and> y = f z \<and> z = x. count {#x#} z)"
-      unfolding split by (subst sum.union_disjoint, auto)
-    also have "... = (if y = f x then 1 else 0)" using card_eq_Suc_0_ex1 by (auto simp: X'_def)
-    also have "(\<Sum>z | z \<in># X' \<and> y = f z. count X z) = (\<Sum>z | z \<in># X \<and> y = f z. count X z)"
-    proof(cases "x \<in># X")
-      case True then have "z \<in># X' \<longleftrightarrow> z \<in># X" for z by (auto simp: X'_def)
-      then show ?thesis by auto 
-    next
-      case False
-        have split: "{z. z \<in># X' \<and> y = f z} = {z. z \<in># X \<and> y = f z} \<union> {z. z = x \<and> y = f z}"
-          by (auto simp: X'_def)
-        also have "sum (count X) ... = (\<Sum>z | z \<in># X \<and> y = f z. count X z) + (\<Sum>z | z = x \<and> y = f z. count X z)"
-          by (subst sum.union_disjoint, auto simp: False)
-        also with False have "\<And>z. z = x \<and> y = f z \<Longrightarrow> count X z = 0" by (meson count_inI)
-        with sum.neutral_const have "(\<Sum>z | z = x \<and> y = f z. count X z) = 0" by auto
-        finally show ?thesis by auto
-    qed
-    also have "... = count (image_mset f X) y" using add by auto
-    finally show ?case by (simp add: X'_def)  
+lemma rel_mset_split:
+  assumes rel: "rel_mset rel (X1+X2) Y"
+  shows "\<exists>Y1 Y2. Y = Y1 + Y2 \<and> rel_mset rel X1 Y1 \<and> rel_mset rel X2 Y2"
+proof-
+  obtain xs1 where xs1: "mset xs1 = X1" using ex_mset by auto
+  obtain xs2 where xs2: "mset xs2 = X2" using ex_mset by auto
+  from xs1 xs2 have "mset (xs1 @ xs2) = X1 + X2" by auto
+  from rel_mset_free[OF rel this] obtain ys
+    where ys: "mset ys = Y" "list_all2 rel (xs1 @ xs2) ys" by auto
+  then obtain ys1 ys2
+    where ys12: "ys = ys1 @ ys2"
+      and xs1ys1: "list_all2 rel xs1 ys1"
+      and xs2ys2: "list_all2 rel xs2 ys2"
+    using list_all2_append1 by blast
+  from ys12 ys have "Y = mset ys1 + mset ys2" by auto
+  moreover from xs1 xs1ys1 have "rel_mset rel X1 (mset ys1)" unfolding rel_mset_def by auto
+  moreover from xs2 xs2ys2 have "rel_mset rel X2 (mset ys2)" unfolding rel_mset_def by auto
+  ultimately show ?thesis by (subst exI[of _ "mset ys1"], subst exI[of _ "mset ys2"],auto)
 qed
 
-lemma is_mset_set_image:
-  assumes "inj_on f (set_mset X)" and "is_mset_set X"
-  shows "is_mset_set (image_mset f X)"
-proof (cases X)
-  case empty then show ?thesis by auto
-next
-  case (add x X)
-    define X' where "X' \<equiv> add_mset x X"
-    with assms add have inj:"inj_on f (set_mset X')"
-          and X': "is_mset_set X'" by auto
-  show ?thesis
-  proof(unfold add, intro is_mset_setI, fold X'_def)
-    fix y assume "y \<in># image_mset f X'"
-    then have "y \<in> f ` set_mset X'" by auto 
-    with inj have "\<exists>!x'. x' \<in># X' \<and> y = f x'" by (meson imageE inj_onD)
-    then obtain x' where x': "{x'. x' \<in># X' \<and> y = f x'} = {x'}" by auto
-    then have "count (image_mset f X') y = count X' x'"
-      unfolding count_image_mset by auto
-    also from X' x' have "... = 1" by auto
-    finally show "count (image_mset f X') y = 1".
-  qed
+lemma rel_mset_OO:
+  assumes AB: "rel_mset R A B" and BC: "rel_mset S B C"
+  shows "rel_mset (R OO S) A C"
+proof-
+  from AB obtain as bs where A_as: "A = mset as" and B_bs: "B = mset bs" and as_bs: "list_all2 R as bs"
+    by (auto simp: rel_mset_def)
+  from rel_mset_free[OF BC] B_bs obtain cs where C_cs: "C = mset cs" and bs_cs: "list_all2 S bs cs"
+    by auto
+  from list_all2_trans[OF _ as_bs bs_cs, of "R OO S"] A_as C_cs
+  show ?thesis by (auto simp: rel_mset_def)
 qed
 
 (* a variant for "right" *)
 lemma ex_mset_zip_right:
   assumes "length xs = length ys" "mset ys' = mset ys"
   shows "\<exists>xs'. length ys' = length xs' \<and> mset (zip xs' ys') = mset (zip xs ys)"
 using assms
 proof (induct xs ys arbitrary: ys' rule: list_induct2)
   case Nil
   thus ?case
     by auto
 next
   case (Cons x xs y ys ys')
   obtain j where j_len: "j < length ys'" and nth_j: "ys' ! j = y"
     by (metis Cons.prems in_set_conv_nth list.set_intros(1) mset_eq_setD)
 
   define ysa where "ysa = take j ys' @ drop (Suc j) ys'"
   have "mset ys' = {#y#} + mset ysa"
     unfolding ysa_def using j_len nth_j
     by (metis Cons_nth_drop_Suc union_mset_add_mset_right add_mset_remove_trivial add_diff_cancel_left'
         append_take_drop_id mset.simps(2) mset_append)
   hence ms_y: "mset ysa = mset ys"
     by (simp add: Cons.prems)
   then obtain xsa where
     len_a: "length ysa = length xsa" and ms_a: "mset (zip xsa ysa) = mset (zip xs ys)"
     using Cons.hyps(2) by blast
 
   define xs' where "xs' = take j xsa @ x # drop j xsa"
   have ys': "ys' = take j ysa @ y # drop j ysa"
     using ms_y j_len nth_j Cons.prems ysa_def
     by (metis append_eq_append_conv append_take_drop_id diff_Suc_Suc Cons_nth_drop_Suc length_Cons
       length_drop size_mset)
   have j_len': "j \<le> length ysa"
     using j_len ys' ysa_def
     by (metis add_Suc_right append_take_drop_id length_Cons length_append less_eq_Suc_le not_less)
   have "length ys' = length xs'"
     unfolding xs'_def using Cons.prems len_a ms_y
     by (metis add_Suc_right append_take_drop_id length_Cons length_append mset_eq_length)
   moreover have "mset (zip xs' ys') = mset (zip (x # xs) (y # ys))"
     unfolding ys' xs'_def
     apply (rule HOL.trans[OF mset_zip_take_Cons_drop_twice])
     using j_len' by (auto simp: len_a ms_a)
   ultimately show ?case
     by blast
 qed
 
 lemma list_all2_reorder_right_invariance:
   assumes rel: "list_all2 R xs ys" and ms_y: "mset ys' = mset ys"
   shows "\<exists>xs'. list_all2 R xs' ys' \<and> mset xs' = mset xs"
 proof -
   have len: "length xs = length ys"
     using rel list_all2_conv_all_nth by auto
   obtain xs' where
     len': "length xs' = length ys'" and ms_xy: "mset (zip xs' ys') = mset (zip xs ys)"
     using len ms_y by (metis ex_mset_zip_right)
   have "list_all2 R xs' ys'"
     using assms(1) len' ms_xy unfolding list_all2_iff by (blast dest: mset_eq_setD)
   moreover have "mset xs' = mset xs"
     using len len' ms_xy map_fst_zip mset_map by metis
   ultimately show ?thesis
     by blast
 qed
 
 lemma rel_mset_via_perm: "rel_mset rel (mset xs) (mset ys) \<longleftrightarrow> (\<exists>zs. mset xs = mset zs \<and> list_all2 rel zs ys)"
 proof (unfold rel_mset_def, intro iffI, goal_cases)
   case 1
   then obtain zs ws where zs: "mset zs = mset xs" and ws: "mset ws = mset ys" and zsws: "list_all2 rel zs ws" by auto
   note list_all2_reorder_right_invariance[OF zsws ws[symmetric], unfolded zs]
   then show ?case by (auto dest: sym)
 next
   case 2
   from this show ?case by force
 qed
 
-lemma rel_mset_free:
-  assumes rel: "rel_mset rel X Y" and xs: "mset xs = X"
-  shows "\<exists>ys. mset ys = Y \<and> list_all2 rel xs ys"
-proof-
-  from rel[unfolded rel_mset_def] obtain xs' ys'
-    where xs': "mset xs' = X" and ys': "mset ys' = Y" and xsys': "list_all2 rel xs' ys'" by auto
-  from xs' xs have "mset xs = mset xs'" by auto
-  from mset_eq_permutation[OF this]
-  obtain f where perm: "f permutes {..<length xs'}" and xs': "permute_list f xs' = xs".
-  then have [simp]: "length xs' = length xs" by auto
-  from permute_list_nth[OF perm, unfolded xs'] have *: "\<And>i. i < length xs \<Longrightarrow> xs ! i = xs' ! f i" by auto
-  note [simp] = list_all2_lengthD[OF xsys',symmetric]
-  note [simp] = atLeast0LessThan[symmetric]
-  note bij =  permutes_bij[OF perm]
-  define ys where "ys \<equiv> map (nth ys' \<circ> f) [0..<length ys']"
-  then have [simp]: "length ys = length ys'" by auto 
-  have "mset ys = mset (map (nth ys') (map f [0..<length ys']))"
-   unfolding ys_def by auto
-  also have "... = image_mset (nth ys') (image_mset f (mset [0..<length ys']))"
-    by (simp add: multiset.map_comp)
-  also have "(mset [0..<length ys']) = mset_set {0..<length ys'}"
-    by (metis mset_sorted_list_of_multiset sorted_list_of_mset_set sorted_list_of_set_range) 
-  also have "image_mset f (...) = mset_set (f ` {..<length ys'})"
-    using subset_inj_on[OF bij_is_inj[OF bij]] by (subst image_mset_mset_set, auto)
-  also have "... = mset [0..<length ys']" using perm by (simp add: permutes_image)
-  also have "image_mset (nth ys') ... = mset ys'" by(fold mset_map, unfold map_nth, auto)
-  finally have "mset ys = Y" using ys' by auto
-  moreover have "list_all2 rel xs ys"
-  proof(rule list_all2_all_nthI)
-    fix i assume i: "i < length xs"
-    with * have "xs ! i = xs' ! f i" by auto
-    also from i permutes_in_image[OF perm]
-    have "rel (xs' ! f i) (ys' ! f i)" by (intro list_all2_nthD[OF xsys'], auto)
-    finally show "rel (xs ! i) (ys ! i)" unfolding ys_def using i by simp
-  qed simp
-  ultimately show ?thesis by auto
-qed
-
-lemma rel_mset_split:
-  assumes rel: "rel_mset rel (X1+X2) Y"
-  shows "\<exists>Y1 Y2. Y = Y1 + Y2 \<and> rel_mset rel X1 Y1 \<and> rel_mset rel X2 Y2"
-proof-
-  obtain xs1 where xs1: "mset xs1 = X1" using ex_mset by auto
-  obtain xs2 where xs2: "mset xs2 = X2" using ex_mset by auto
-  from xs1 xs2 have "mset (xs1 @ xs2) = X1 + X2" by auto
-  from rel_mset_free[OF rel this] obtain ys
-    where ys: "mset ys = Y" "list_all2 rel (xs1 @ xs2) ys" by auto
-  then obtain ys1 ys2
-    where ys12: "ys = ys1 @ ys2"
-      and xs1ys1: "list_all2 rel xs1 ys1"
-      and xs2ys2: "list_all2 rel xs2 ys2"
-    using list_all2_append1 by blast
-  from ys12 ys have "Y = mset ys1 + mset ys2" by auto
-  moreover from xs1 xs1ys1 have "rel_mset rel X1 (mset ys1)" unfolding rel_mset_def by auto
-  moreover from xs2 xs2ys2 have "rel_mset rel X2 (mset ys2)" unfolding rel_mset_def by auto
-  ultimately show ?thesis by (subst exI[of _ "mset ys1"], subst exI[of _ "mset ys2"],auto)
-qed
-
-lemma rel_mset_OO:
-  assumes AB: "rel_mset R A B" and BC: "rel_mset S B C"
-  shows "rel_mset (R OO S) A C"
-proof-
-  from AB obtain as bs where A_as: "A = mset as" and B_bs: "B = mset bs" and as_bs: "list_all2 R as bs"
-    by (auto simp: rel_mset_def)
-  from rel_mset_free[OF BC] B_bs obtain cs where C_cs: "C = mset cs" and bs_cs: "list_all2 S bs cs"
-    by auto
-  from list_all2_trans[OF _ as_bs bs_cs, of "R OO S"] A_as C_cs
-  show ?thesis by (auto simp: rel_mset_def)
-qed
-
 end
diff --git a/thys/Berlekamp_Zassenhaus/Poly_Mod_Finite_Field.thy b/thys/Berlekamp_Zassenhaus/Poly_Mod_Finite_Field.thy
--- a/thys/Berlekamp_Zassenhaus/Poly_Mod_Finite_Field.thy
+++ b/thys/Berlekamp_Zassenhaus/Poly_Mod_Finite_Field.thy
@@ -1,615 +1,615 @@
 (*
     Authors:      Jose Divasón
                   Sebastiaan Joosten
                   René Thiemann
                   Akihisa Yamada
 *)
 subsection \<open>Polynomials in a Finite Field\<close>
 text \<open>We connect polynomials in a prime field with integer polynomials modulo some prime.\<close>
 
 theory Poly_Mod_Finite_Field
   imports
   Finite_Field
   Polynomial_Interpolation.Ring_Hom_Poly
   "HOL-Types_To_Sets.Types_To_Sets"
-  Missing_Multiset2
+  More_Missing_Multiset
   Poly_Mod
 begin
 
 (* TODO: Move -- General transfer rule *)
 declare rel_mset_Zero[transfer_rule]
 
 lemma mset_transfer[transfer_rule]: "(list_all2 rel ===> rel_mset rel) mset mset"
 proof (intro rel_funI)
   show "list_all2 rel xs ys \<Longrightarrow> rel_mset rel (mset xs) (mset ys)" for xs ys
   proof (induct xs arbitrary: ys)
     case Nil
     then show ?case by auto
   next
     case IH: (Cons x xs)
     then show ?case by (auto dest!:msed_rel_invL simp: list_all2_Cons1 intro!:rel_mset_Plus)
   qed
 qed
 
 
 abbreviation to_int_poly :: "'a :: finite mod_ring poly \<Rightarrow> int poly" where
   "to_int_poly \<equiv> map_poly to_int_mod_ring"
 
 interpretation to_int_poly_hom: map_poly_inj_zero_hom to_int_mod_ring ..
 
 lemma irreducible\<^sub>d_def_0:
   fixes f :: "'a :: {comm_semiring_1,semiring_no_zero_divisors} poly"
   shows "irreducible\<^sub>d f = (degree f \<noteq> 0 \<and> 
   (\<forall> g h. degree g \<noteq> 0 \<longrightarrow> degree h \<noteq> 0 \<longrightarrow> f \<noteq> g * h))"
 proof-
   have "degree g \<noteq> 0 \<Longrightarrow> g \<noteq> 0" for g :: "'a poly" by auto
   note 1 = degree_mult_eq[OF this this, simplified]
   then show ?thesis by (force elim!: irreducible\<^sub>dE)
 qed
 
 subsection \<open>Transferring to class-based mod-ring\<close>
 
 locale poly_mod_type = poly_mod m
   for m and ty :: "'a :: nontriv itself" +
   assumes m: "m = CARD('a)"
 begin
 
 lemma m1: "m > 1" using nontriv[where 'a = 'a] by (auto simp:m)
 
 sublocale poly_mod_2 using m1 by unfold_locales
 
 definition MP_Rel :: "int poly \<Rightarrow> 'a mod_ring poly \<Rightarrow> bool"
   where "MP_Rel f f' \<equiv> (Mp f = to_int_poly f')"
 
 definition M_Rel :: "int \<Rightarrow> 'a mod_ring \<Rightarrow> bool"
   where "M_Rel x x' \<equiv> (M x = to_int_mod_ring x')"
 
 definition "MF_Rel \<equiv> rel_prod M_Rel (rel_mset MP_Rel)"
 
 lemma to_int_mod_ring_plus: "to_int_mod_ring ((x :: 'a mod_ring) + y) = M (to_int_mod_ring x + to_int_mod_ring y)"
   unfolding M_def using m by (transfer, auto)
 
 lemma to_int_mod_ring_times: "to_int_mod_ring ((x :: 'a mod_ring) * y) = M (to_int_mod_ring x * to_int_mod_ring y)"
   unfolding M_def using m by (transfer, auto)
 
 lemma degree_MP_Rel [transfer_rule]: "(MP_Rel ===> (=)) degree_m degree"
   unfolding MP_Rel_def rel_fun_def 
   by (auto intro!: degree_map_poly)
 
 lemma eq_M_Rel[transfer_rule]: "(M_Rel ===> M_Rel ===> (=)) (\<lambda> x y. M x = M y) (=)"
   unfolding M_Rel_def rel_fun_def by auto
 
 interpretation to_int_mod_ring_hom: map_poly_inj_zero_hom to_int_mod_ring..
 
 lemma eq_MP_Rel[transfer_rule]: "(MP_Rel ===> MP_Rel ===> (=)) (=m) (=)"
   unfolding MP_Rel_def rel_fun_def by auto
 
 lemma eq_Mf_Rel[transfer_rule]: "(MF_Rel ===> MF_Rel ===> (=)) (\<lambda> x y. Mf x = Mf y) (=)"
 proof (intro rel_funI, goal_cases)
   case (1 cfs Cfs dgs Dgs)
   obtain c fs where cfs: "cfs = (c,fs)" by force
   obtain C Fs where Cfs: "Cfs = (C,Fs)" by force
   obtain d gs where dgs: "dgs = (d,gs)" by force
   obtain D Gs where Dgs: "Dgs = (D,Gs)" by force
   note pairs = cfs Cfs dgs Dgs
   from 1[unfolded pairs MF_Rel_def rel_prod.simps]
   have *[transfer_rule]: "M_Rel c C" "M_Rel d D" "rel_mset MP_Rel fs Fs" "rel_mset MP_Rel gs Gs" 
     by auto  
   have eq1: "(M c = M d) = (C = D)" by transfer_prover
   from *(3)[unfolded rel_mset_def] obtain fs' Fs' where fs_eq: "mset fs' = fs" "mset Fs' = Fs"
     and rel_f: "list_all2 MP_Rel fs' Fs'" by auto
   from *(4)[unfolded rel_mset_def] obtain gs' Gs' where gs_eq: "mset gs' = gs" "mset Gs' = Gs"
     and rel_g: "list_all2 MP_Rel gs' Gs'" by auto
   have eq2: "(image_mset Mp fs = image_mset Mp gs) = (Fs = Gs)" 
     using *(3-4)
   proof (induct fs arbitrary: Fs gs Gs)
     case (empty Fs gs Gs)
     from empty(1) have Fs: "Fs = {#}" unfolding rel_mset_def by auto
     with empty show ?case by (cases gs; cases Gs; auto simp: rel_mset_def)
   next
     case (add f fs Fs' gs' Gs')
     note [transfer_rule] = add(3)
     from msed_rel_invL[OF add(2)]
     obtain Fs F where Fs': "Fs' = Fs + {#F#}" and rel[transfer_rule]: 
       "MP_Rel f F" "rel_mset MP_Rel fs Fs" by auto      
     note IH = add(1)[OF rel(2)]
     {      
       from add(3)[unfolded rel_mset_def] obtain gs Gs where id: "mset gs = gs'" "mset Gs = Gs'" 
         and rel: "list_all2 MP_Rel gs Gs" by auto
       have "Mp f \<in># image_mset Mp gs' \<longleftrightarrow> F \<in># Gs'" 
       proof -
         have "?thesis = ((Mp f \<in> Mp ` set gs) = (F \<in> set Gs))" 
           unfolding id[symmetric] by simp
         also have \<dots> using rel
         proof (induct gs Gs rule: list_all2_induct)
           case (Cons g gs G Gs)
           note [transfer_rule] = Cons(1-2)
           have id: "(Mp g = Mp f) = (F = G)" by (transfer, auto)
           show ?case using id Cons(3) by auto
         qed auto
         finally show ?thesis by simp
       qed
     } note id = this
     show ?case
     proof (cases "Mp f \<in># image_mset Mp gs'")
       case False
       have "Mp f \<in># image_mset Mp (fs + {#f#})" by auto
       with False have F: "image_mset Mp (fs + {#f#}) \<noteq> image_mset Mp gs'" by metis
       with False[unfolded id] show ?thesis unfolding Fs' by auto
     next
       case True
       then obtain g where fg: "Mp f = Mp g" and g: "g \<in># gs'" by auto
       from g obtain gs where gs': "gs' = add_mset g gs" by (rule mset_add)
       from msed_rel_invL[OF add(3)[unfolded gs']]
       obtain Gs G where Gs': "Gs' = Gs + {# G #}" and gG[transfer_rule]: "MP_Rel g G" and 
         gsGs: "rel_mset MP_Rel gs Gs" by auto
       have FG: "F = G" by (transfer, simp add: fg)
       note IH = IH[OF gsGs]
       show ?thesis unfolding gs' Fs' Gs' by (simp add: fg IH FG)
     qed
   qed
   show "(Mf cfs = Mf dgs) = (Cfs = Dgs)" unfolding pairs Mf_def split
     by (simp add: eq1 eq2)
 qed
 
 lemmas coeff_map_poly_of_int = coeff_map_poly[of of_int, OF of_int_0]
 
 lemma plus_MP_Rel[transfer_rule]: "(MP_Rel ===> MP_Rel ===> MP_Rel) (+) (+)"
   unfolding MP_Rel_def 
 proof (intro rel_funI, goal_cases)
   case (1 x f y g)
   have "Mp (x + y) = Mp (Mp x + Mp y)" by simp
   also have "\<dots> = Mp (map_poly to_int_mod_ring f + map_poly to_int_mod_ring g)" unfolding 1 ..
   also have "\<dots> = map_poly to_int_mod_ring (f + g)" unfolding poly_eq_iff Mp_coeff 
        by (auto simp: to_int_mod_ring_plus)
   finally show ?case .
 qed
 
 lemma times_MP_Rel[transfer_rule]: "(MP_Rel ===> MP_Rel ===> MP_Rel) ((*)) ((*))"
   unfolding MP_Rel_def
 proof (intro rel_funI, goal_cases)
   case (1 x f y g)
   have "Mp (x * y) = Mp (Mp x * Mp y)" by simp
   also have "\<dots> = Mp (map_poly to_int_mod_ring f * map_poly to_int_mod_ring g)" unfolding 1 ..
   also have "\<dots> = map_poly to_int_mod_ring (f * g)"
   proof -
     { fix n :: nat
       define A where "A = {.. n}" 
       have "finite A" unfolding A_def by auto
       then have "M (\<Sum>i\<le>n. to_int_mod_ring (coeff f i) * to_int_mod_ring (coeff g (n - i))) =
            to_int_mod_ring (\<Sum>i\<le>n. coeff f i * coeff g (n - i))"
         unfolding A_def[symmetric]
       proof (induct A)
         case (insert a A)
         have "?case = ?case" (is "(?l = ?r) = _") by simp
         have "?r = to_int_mod_ring (coeff f a * coeff g (n - a) + (\<Sum>i\<in> A. coeff f i * coeff g (n - i)))" 
           using insert(1-2) by auto
         note r = this[unfolded to_int_mod_ring_plus to_int_mod_ring_times]
         from insert(1-2) have "?l = M (to_int_mod_ring (coeff f a) * to_int_mod_ring (coeff g (n - a)) 
           + M (\<Sum>i\<in>A. to_int_mod_ring (coeff f i) * to_int_mod_ring (coeff g (n - i))))" 
           by simp
         also have "M (\<Sum>i\<in>A. to_int_mod_ring (coeff f i) * to_int_mod_ring (coeff g (n - i))) = to_int_mod_ring (\<Sum>i\<in>A. coeff f i * coeff g (n - i))"
           unfolding insert ..
         finally
         show ?case unfolding r by simp
       qed auto
     }
     then show ?thesis by (auto intro!:poly_eqI simp: coeff_mult  Mp_coeff)
   qed
   finally show ?case .
 qed
 
 lemma smult_MP_Rel[transfer_rule]: "(M_Rel ===> MP_Rel ===> MP_Rel) smult smult"
   unfolding MP_Rel_def M_Rel_def
 proof (intro rel_funI, goal_cases)
   case (1 x x' f f')
   thus ?case unfolding poly_eq_iff coeff Mp_coeff
     coeff_smult M_def
   proof (intro allI, goal_cases)
     case (1 n)
     have "x * coeff f n mod m = (x mod m) * (coeff f n mod m) mod m" 
       by (simp add: mod_simps)
     also have "\<dots> = to_int_mod_ring x' * (to_int_mod_ring (coeff f' n)) mod m" 
       using 1 by auto
     also have " \<dots> = to_int_mod_ring (x' * coeff f' n)" 
       unfolding to_int_mod_ring_times M_def by simp
     finally show ?case by auto
   qed
 qed
 
 lemma one_M_Rel[transfer_rule]: "M_Rel 1 1"
   unfolding M_Rel_def M_def
   unfolding m by auto
 
 lemma one_MP_Rel[transfer_rule]: "MP_Rel 1 1"
   unfolding MP_Rel_def poly_eq_iff Mp_coeff M_def 
   unfolding m by auto
 
 lemma zero_M_Rel[transfer_rule]: "M_Rel 0 0"
   unfolding M_Rel_def M_def 
   unfolding m by auto
 
 lemma zero_MP_Rel[transfer_rule]: "MP_Rel 0 0"
   unfolding MP_Rel_def poly_eq_iff Mp_coeff M_def
   unfolding m by auto
 
 lemma listprod_MP_Rel[transfer_rule]: "(list_all2 MP_Rel ===> MP_Rel) prod_list prod_list"
 proof (intro rel_funI, goal_cases)
   case (1 xs ys)
   thus ?case 
   proof (induct xs ys rule: list_all2_induct)
     case (Cons x xs y ys)
     note [transfer_rule] = this
     show ?case by simp transfer_prover
   qed (simp add: one_MP_Rel)
 qed
 
 lemma prod_mset_MP_Rel[transfer_rule]: "(rel_mset MP_Rel ===> MP_Rel) prod_mset prod_mset"
 proof (intro rel_funI, goal_cases)
   case (1 xs ys)
   have "(MP_Rel ===> MP_Rel ===> MP_Rel) ((*)) ((*))" "MP_Rel 1 1" by transfer_prover+
   from 1 this show ?case
   proof (induct xs ys rule: rel_mset_induct)
     case (add R x xs y ys)
     note [transfer_rule] = this
     show ?case by simp transfer_prover
   qed (simp add: one_MP_Rel)
 qed
 
 lemma right_unique_MP_Rel[transfer_rule]: "right_unique MP_Rel"
   unfolding right_unique_def MP_Rel_def by auto
 
 lemma M_to_int_mod_ring: "M (to_int_mod_ring (x :: 'a mod_ring)) = to_int_mod_ring x"
   unfolding M_def unfolding m by (transfer, auto)
 
 lemma Mp_to_int_poly: "Mp (to_int_poly (f :: 'a mod_ring poly)) = to_int_poly f"
   by (auto simp: poly_eq_iff Mp_coeff M_to_int_mod_ring)
 
 lemma right_total_M_Rel[transfer_rule]: "right_total M_Rel"
   unfolding right_total_def M_Rel_def using M_to_int_mod_ring by blast
 
 lemma left_total_M_Rel[transfer_rule]: "left_total M_Rel"
   unfolding left_total_def M_Rel_def[abs_def] 
 proof
   fix x
   show "\<exists> x' :: 'a mod_ring. M x = to_int_mod_ring x'"  unfolding M_def unfolding m
     by (rule exI[of _ "of_int x"], transfer, simp)
 qed
 
 lemma bi_total_M_Rel[transfer_rule]: "bi_total M_Rel" 
   using right_total_M_Rel left_total_M_Rel by (metis bi_totalI)
 
 lemma right_total_MP_Rel[transfer_rule]: "right_total MP_Rel"
   unfolding right_total_def MP_Rel_def
 proof
   fix f :: "'a mod_ring poly"
   show "\<exists>x. Mp x = to_int_poly f"
     by (intro exI[of _ "to_int_poly f"], simp add: Mp_to_int_poly)
 qed
 
 lemma to_int_mod_ring_of_int_M: "to_int_mod_ring (of_int x :: 'a mod_ring) = M x" unfolding M_def
   unfolding m by transfer auto
 
 lemma Mp_f_representative: "Mp f = to_int_poly (map_poly of_int f :: 'a mod_ring poly)"
   unfolding Mp_def by (auto intro: poly_eqI simp: coeff_map_poly to_int_mod_ring_of_int_M)
 
 lemma left_total_MP_Rel[transfer_rule]: "left_total MP_Rel"
   unfolding left_total_def MP_Rel_def[abs_def] using Mp_f_representative by blast
 
 lemma bi_total_MP_Rel[transfer_rule]: "bi_total MP_Rel"
   using right_total_MP_Rel left_total_MP_Rel by (metis bi_totalI)
 
 lemma bi_total_MF_Rel[transfer_rule]: "bi_total MF_Rel"
   unfolding MF_Rel_def[abs_def] 
   by (intro prod.bi_total_rel multiset.bi_total_rel bi_total_MP_Rel bi_total_M_Rel)
 
 lemma right_total_MF_Rel[transfer_rule]: "right_total MF_Rel"
   using bi_total_MF_Rel unfolding bi_total_alt_def by auto
 
 lemma left_total_MF_Rel[transfer_rule]: "left_total MF_Rel"
   using bi_total_MF_Rel unfolding bi_total_alt_def by auto
 
 lemma domain_RT_rel[transfer_domain_rule]: "Domainp MP_Rel = (\<lambda> f. True)"
 proof
   fix f :: "int poly"
   show "Domainp MP_Rel f = True" unfolding MP_Rel_def[abs_def] Domainp.simps
     by (auto simp: Mp_f_representative)
 qed
 
 lemma mem_MP_Rel[transfer_rule]: "(MP_Rel ===> rel_set MP_Rel ===> (=)) (\<lambda> x Y. \<exists>y \<in> Y. eq_m x y) (\<in>)"
 proof (intro rel_funI iffI)
   fix x y X Y assume xy: "MP_Rel x y" and XY: "rel_set MP_Rel X Y"
   { assume "\<exists>x' \<in> X. x =m x'"
     then obtain x' where x'X: "x' \<in> X" and xx': "x =m x'" by auto
     with xy have x'y: "MP_Rel x' y" by (auto simp: MP_Rel_def)
     from rel_setD1[OF XY x'X] obtain y' where "MP_Rel x' y'" and "y' \<in> Y" by auto
     with x'y
     show "y \<in> Y" by (auto simp: MP_Rel_def)
   }
   assume "y \<in> Y"
   from rel_setD2[OF XY this] obtain x' where x'X: "x' \<in> X" and x'y: "MP_Rel x' y" by auto
   from xy x'y have "x =m x'" by (auto simp: MP_Rel_def)
   with x'X show "\<exists>x' \<in> X. x =m x'" by auto
 qed
 
 lemma conversep_MP_Rel_OO_MP_Rel [simp]: "MP_Rel\<inverse>\<inverse> OO MP_Rel = (=)"
   using Mp_to_int_poly by (intro ext, auto simp: OO_def MP_Rel_def)
 
 lemma MP_Rel_OO_conversep_MP_Rel [simp]: "MP_Rel OO MP_Rel\<inverse>\<inverse> = eq_m"
   by (intro ext, auto simp: OO_def MP_Rel_def Mp_f_representative)
 
 lemma conversep_MP_Rel_OO_eq_m [simp]: "MP_Rel\<inverse>\<inverse> OO eq_m = MP_Rel\<inverse>\<inverse>"
   by (intro ext, auto simp: OO_def MP_Rel_def)
 
 lemma eq_m_OO_MP_Rel [simp]: "eq_m OO MP_Rel = MP_Rel"
   by (intro ext, auto simp: OO_def MP_Rel_def)
 
 lemma eq_mset_MP_Rel [transfer_rule]: "(rel_mset MP_Rel ===> rel_mset MP_Rel ===> (=)) (rel_mset eq_m) (=)"
 proof (intro rel_funI iffI)
   fix A B X Y
   assume AX: "rel_mset MP_Rel A X" and BY: "rel_mset MP_Rel B Y"
   {
     assume AB: "rel_mset eq_m A B"
     from AX have "rel_mset MP_Rel\<inverse>\<inverse> X A" by (simp add: multiset.rel_flip)
     note rel_mset_OO[OF this AB]
     note rel_mset_OO[OF this BY]
     then show "X = Y" by (simp add: multiset.rel_eq)
   }
   assume "X = Y"
   with BY have "rel_mset MP_Rel\<inverse>\<inverse> X B" by (simp add: multiset.rel_flip)
   from rel_mset_OO[OF AX this]
   show "rel_mset eq_m A B" by simp
 qed
 
 lemma dvd_MP_Rel[transfer_rule]: "(MP_Rel ===> MP_Rel ===> (=)) (dvdm) (dvd)"
   unfolding dvdm_def[abs_def] dvd_def[abs_def]
   by transfer_prover
 
 lemma irreducible_MP_Rel [transfer_rule]: "(MP_Rel ===> (=)) irreducible_m irreducible"
   unfolding irreducible_m_def irreducible_def
   by transfer_prover
 
 lemma irreducible\<^sub>d_MP_Rel [transfer_rule]: "(MP_Rel ===> (=)) irreducible\<^sub>d_m irreducible\<^sub>d"
   unfolding irreducible\<^sub>d_m_def[abs_def] irreducible\<^sub>d_def[abs_def]
   by transfer_prover
 
 lemma UNIV_M_Rel[transfer_rule]: "rel_set M_Rel {0..<m} UNIV"
   unfolding rel_set_def M_Rel_def[abs_def] M_def 
   by (auto simp: M_def m, goal_cases, metis to_int_mod_ring_of_int_mod_ring, (transfer, auto)+)
 
 lemma coeff_MP_Rel [transfer_rule]: "(MP_Rel ===> (=) ===> M_Rel) coeff coeff"
   unfolding rel_fun_def M_Rel_def MP_Rel_def Mp_coeff[symmetric] by auto
 
 lemma M_1_1: "M 1 = 1" unfolding M_def unfolding m by simp
 
 lemma square_free_MP_Rel [transfer_rule]: "(MP_Rel ===> (=)) square_free_m square_free"
   unfolding square_free_m_def[abs_def] square_free_def[abs_def]
   by (transfer_prover_start, transfer_step+, auto)
 
 lemma mset_factors_m_MP_Rel [transfer_rule]: "(rel_mset MP_Rel ===> MP_Rel ===> (=)) mset_factors_m mset_factors"
   unfolding mset_factors_def mset_factors_m_def
   by (transfer_prover_start, transfer_step+, auto dest:eq_m_irreducible_m)
 
 lemma coprime_MP_Rel [transfer_rule]: "(MP_Rel ===> MP_Rel ===> (=)) coprime_m coprime"
   unfolding coprime_m_def[abs_def] coprime_def' [abs_def]
   by (transfer_prover_start, transfer_step+, auto)
 
 lemma prime_elem_MP_Rel [transfer_rule]: "(MP_Rel ===> (=)) prime_elem_m prime_elem"
   unfolding prime_elem_m_def prime_elem_def by transfer_prover
 
 end
 
 context poly_mod_2 begin
 
 lemma non_empty: "{0..<m} \<noteq> {}" using m1 by auto
 
 lemma type_to_set:
   assumes type_def: "\<exists>(Rep :: 'b \<Rightarrow> int) Abs. type_definition Rep Abs {0 ..< m :: int}"
   shows "class.nontriv (TYPE('b))" (is ?a) and "m = int CARD('b)" (is ?b)
 proof -
   from type_def obtain rep :: "'b \<Rightarrow> int" and abs :: "int \<Rightarrow> 'b" where t: "type_definition rep abs {0 ..< m}" by auto
   have "card (UNIV :: 'b set) = card {0 ..< m}" using t by (rule type_definition.card)
   also have "\<dots> = m" using m1 by auto
   finally show ?b ..
   then show ?a unfolding class.nontriv_def using m1 by auto
 qed
 
 end
 
 locale poly_mod_prime_type = poly_mod_type m ty for m :: int and
   ty :: "'a :: prime_card itself"
 begin 
 
 lemma factorization_MP_Rel [transfer_rule]:
   "(MP_Rel ===> MF_Rel ===> (=)) factorization_m (factorization Irr_Mon)"
   unfolding rel_fun_def
 proof (intro allI impI, goal_cases)
   case (1 f F cfs Cfs)
   note [transfer_rule] = 1(1)
   obtain c fs where cfs: "cfs = (c,fs)" by force
   obtain C Fs where Cfs: "Cfs = (C,Fs)" by force
   from 1(2)[unfolded rel_prod.simps cfs Cfs MF_Rel_def] 
   have tr[transfer_rule]: "M_Rel c C" "rel_mset MP_Rel fs Fs" by auto
   have eq: "(f =m smult c (prod_mset fs) = (F = smult C (prod_mset Fs)))" 
     by transfer_prover
   have "set_mset Fs \<subseteq> Irr_Mon = (\<forall> x \<in># Fs. irreducible\<^sub>d x \<and> monic x)" unfolding Irr_Mon_def by auto
   also have "\<dots> = (\<forall>f\<in>#fs. irreducible\<^sub>d_m f \<and> monic (Mp f))"
   proof (rule sym, transfer_prover_start, transfer_step+)
     {
       fix f
       assume "f \<in># fs" 
       have "monic (Mp f) \<longleftrightarrow> M (coeff f (degree_m f)) = M 1"
         unfolding Mp_coeff[symmetric] by simp
     }
     thus "(\<forall>f\<in>#fs. irreducible\<^sub>d_m f \<and> monic (Mp f)) = 
       (\<forall>x\<in>#fs. irreducible\<^sub>d_m x \<and> M (coeff x (degree_m x)) = M 1)" by auto
   qed
   finally
   show "factorization_m f cfs = factorization Irr_Mon F Cfs" unfolding cfs Cfs
     factorization_m_def factorization_def split eq by simp
 qed
 
 lemma unique_factorization_MP_Rel [transfer_rule]: "(MP_Rel ===> MF_Rel ===> (=))
   unique_factorization_m (unique_factorization Irr_Mon)"
   unfolding rel_fun_def
 proof (intro allI impI, goal_cases)
   case (1 f F cfs Cfs)
   note [transfer_rule] = 1(1,2)
   let ?F = "factorization Irr_Mon F" 
   let ?f = "factorization_m f" 
   let ?R = "Collect ?F" 
   let ?L = "Mf ` Collect ?f"
   note X_to_x = right_total_MF_Rel[unfolded right_total_def, rule_format]
   {
     fix X
     assume "X \<in> ?R" 
     hence F: "?F X" by simp
     from X_to_x[of X] obtain x where rel[transfer_rule]: "MF_Rel x X" by blast
     from F[untransferred] have "Mf x \<in> ?L" by blast
     with rel have "\<exists> x. Mf x \<in> ?L \<and> MF_Rel x X" by blast
   } note R_to_L = this
   show "unique_factorization_m f cfs = unique_factorization Irr_Mon F Cfs" unfolding 
     unique_factorization_m_def unique_factorization_def  
   proof -
     have fF: "?F Cfs = ?f cfs" by transfer simp
     have "(?L = {Mf cfs}) = (?L \<subseteq> {Mf cfs} \<and> Mf cfs \<in> ?L)" by blast
     also have "?L \<subseteq> {Mf cfs} = (\<forall> dfs. ?f dfs \<longrightarrow> Mf dfs = Mf cfs)" by blast
     also have "\<dots> = (\<forall> y. ?F y \<longrightarrow> y = Cfs)" (is "?left = ?right")
     proof (rule; intro allI impI)
       fix Dfs
       assume *: ?left and F: "?F Dfs" 
       from X_to_x[of Dfs] obtain dfs where [transfer_rule]: "MF_Rel dfs Dfs" by auto
       from F[untransferred] have f: "?f dfs" .
       from *[rule_format, OF f] have eq: "Mf dfs = Mf cfs" by simp
       have "(Mf dfs = Mf cfs) = (Dfs = Cfs)" by (transfer_prover_start, transfer_step+, simp) 
       thus "Dfs = Cfs" using eq by simp
     next
       fix dfs
       assume *: ?right and f: "?f dfs" 
       from left_total_MF_Rel obtain Dfs where 
         rel[transfer_rule]: "MF_Rel dfs Dfs" unfolding left_total_def by blast
       have "?F Dfs" by (transfer, rule f)
       from *[rule_format, OF this] have eq: "Dfs = Cfs" .
       have "(Mf dfs = Mf cfs) = (Dfs = Cfs)" by (transfer_prover_start, transfer_step+, simp) 
       thus "Mf dfs = Mf cfs" using eq by simp
     qed    
     also have "Mf cfs \<in> ?L = (\<exists> dfs. ?f dfs \<and> Mf cfs = Mf dfs)" by auto
     also have "\<dots> = ?F Cfs"  unfolding fF
     proof
       assume "\<exists> dfs. ?f dfs \<and> Mf cfs  = Mf dfs" 
       then obtain dfs where f: "?f dfs" and id: "Mf dfs = Mf cfs" by auto
       from f have "?f (Mf dfs)" by simp
       from this[unfolded id] show "?f cfs" by simp
     qed blast
     finally show "(?L = {Mf cfs}) = (?R = {Cfs})" by auto
   qed
 qed
 
 end
 
 context begin
 private lemma 1: "poly_mod_type TYPE('a :: nontriv) m = (m = int CARD('a))"
   and 2: "class.nontriv TYPE('a) = (CARD('a) \<ge> 2)"
   unfolding poly_mod_type_def class.prime_card_def class.nontriv_def poly_mod_prime_type_def by auto
 
 private lemma 3: "poly_mod_prime_type TYPE('b) m = (m = int CARD('b))"
   and 4: "class.prime_card TYPE('b :: prime_card) = prime CARD('b :: prime_card)" 
   unfolding poly_mod_type_def class.prime_card_def class.nontriv_def poly_mod_prime_type_def by auto
 
 lemmas poly_mod_type_simps = 1 2 3 4
 end
 
 
 lemma remove_duplicate_premise: "(PROP P \<Longrightarrow> PROP P \<Longrightarrow> PROP Q) \<equiv> (PROP P \<Longrightarrow> PROP Q)" (is "?l \<equiv> ?r")
 proof (intro Pure.equal_intr_rule)
   assume p: "PROP P" and ppq: "PROP ?l"
   from ppq[OF p p] show "PROP Q".
 next
   assume p: "PROP P" and pq: "PROP ?r"
   from pq[OF p] show "PROP Q".
 qed
 
 context poly_mod_prime begin
 
 lemma type_to_set:
   assumes type_def: "\<exists>(Rep :: 'b \<Rightarrow> int) Abs. type_definition Rep Abs {0 ..< p :: int}"
   shows "class.prime_card (TYPE('b))" (is ?a) and "p = int CARD('b)" (is ?b)
 proof -
   from prime have p2: "p \<ge> 2" by (rule prime_ge_2_int)
   from type_def obtain rep :: "'b \<Rightarrow> int" and abs :: "int \<Rightarrow> 'b" where t: "type_definition rep abs {0 ..< p}" by auto
   have "card (UNIV :: 'b set) = card {0 ..< p}" using t by (rule type_definition.card)
   also have "\<dots> = p" using p2 by auto
   finally show ?b ..
   then show ?a unfolding class.prime_card_def using prime p2 by auto
 qed
 end
 
 (* it will be nice to be able to automate this *)
 
 lemmas (in poly_mod_type) prime_elem_m_dvdm_multD = prime_elem_dvd_multD
   [where 'a = "'a mod_ring poly",untransferred]
 lemmas (in poly_mod_2) prime_elem_m_dvdm_multD = poly_mod_type.prime_elem_m_dvdm_multD
   [unfolded poly_mod_type_simps, internalize_sort "'a :: nontriv", OF type_to_set, unfolded remove_duplicate_premise, cancel_type_definition, OF non_empty]
 
 lemmas(in poly_mod_prime_type) degree_m_mult_eq = degree_mult_eq
   [where 'a = "'a mod_ring", untransferred]
 lemmas(in poly_mod_prime) degree_m_mult_eq = poly_mod_prime_type.degree_m_mult_eq
   [unfolded poly_mod_type_simps, internalize_sort "'a :: prime_card", OF type_to_set, unfolded remove_duplicate_premise, cancel_type_definition, OF non_empty]
 
 lemma(in poly_mod_prime) irreducible\<^sub>d_lifting:
   assumes n: "n \<noteq> 0"
     and deg: "poly_mod.degree_m (p^n) f = degree_m f"
     and irr: "irreducible\<^sub>d_m f"
   shows "poly_mod.irreducible\<^sub>d_m (p^n) f"
 proof -
   interpret q: poly_mod_2 "p^n" unfolding poly_mod_2_def using n m1 by auto
   show "q.irreducible\<^sub>d_m f"
   proof (rule q.irreducible\<^sub>d_mI)
     from deg irr show "q.degree_m f > 0" by (auto elim: irreducible\<^sub>d_mE)
     then have pdeg_f: "degree_m f \<noteq> 0" by (simp add: deg)
     note pMp_Mp = Mp_Mp_pow_is_Mp[OF n m1]
     fix g h
     assume deg_g: "degree g < q.degree_m f" and deg_h: "degree h < q.degree_m f"
       and eq: "q.eq_m f (g * h)"
     from eq have p_f: "f =m (g * h)" using pMp_Mp by metis
     have "\<not>g =m 0" and "\<not>h =m 0"
       apply (metis degree_0 mult_zero_left Mp_0 p_f pdeg_f poly_mod.mult_Mp(1))
       by (metis degree_0 mult_eq_0_iff Mp_0 mult_Mp(2) p_f pdeg_f)
     note [simp] = degree_m_mult_eq[OF this]
     from degree_m_le[of g] deg_g
     have 2: "degree_m g < degree_m f" by (fold deg, auto)
     from degree_m_le[of h] deg_h
     have 3: "degree_m h < degree_m f" by (fold deg, auto)
     from irreducible\<^sub>d_mD(2)[OF irr 2 3] p_f
     show False by auto
   qed
 qed
 
 (* Lifting UFD properties *)
 lemmas (in poly_mod_prime_type) mset_factors_exist =
   mset_factors_exist[where 'a = "'a mod_ring poly",untransferred]
 lemmas (in poly_mod_prime) mset_factors_exist = poly_mod_prime_type.mset_factors_exist
   [unfolded poly_mod_type_simps, internalize_sort "'a :: prime_card", OF type_to_set, unfolded remove_duplicate_premise, cancel_type_definition, OF non_empty]
 
 lemmas (in poly_mod_prime_type) mset_factors_unique =
   mset_factors_unique[where 'a = "'a mod_ring poly",untransferred]
 lemmas (in poly_mod_prime) mset_factors_unique = poly_mod_prime_type.mset_factors_unique
   [unfolded poly_mod_type_simps, internalize_sort "'a :: prime_card", OF type_to_set, unfolded remove_duplicate_premise, cancel_type_definition, OF non_empty]
 
 lemmas (in poly_mod_prime_type) prime_elem_iff_irreducible =
   prime_elem_iff_irreducible[where 'a = "'a mod_ring poly",untransferred]
 lemmas (in poly_mod_prime) prime_elem_iff_irreducible[simp] = poly_mod_prime_type.prime_elem_iff_irreducible
   [unfolded poly_mod_type_simps, internalize_sort "'a :: prime_card", OF type_to_set, unfolded remove_duplicate_premise, cancel_type_definition, OF non_empty]
 
 lemmas (in poly_mod_prime_type) irreducible_connect =
   irreducible_connect_field[where 'a = "'a mod_ring", untransferred]
 lemmas (in poly_mod_prime) irreducible_connect[simp] = poly_mod_prime_type.irreducible_connect
   [unfolded poly_mod_type_simps, internalize_sort "'a :: prime_card", OF type_to_set, unfolded remove_duplicate_premise, cancel_type_definition, OF non_empty]
 
 lemmas (in poly_mod_prime_type) irreducible_degree =
   irreducible_degree_field[where 'a = "'a mod_ring", untransferred]
 lemmas (in poly_mod_prime) irreducible_degree = poly_mod_prime_type.irreducible_degree
   [unfolded poly_mod_type_simps, internalize_sort "'a :: prime_card", OF type_to_set, unfolded remove_duplicate_premise, cancel_type_definition, OF non_empty]
 
 
 end
diff --git a/thys/Berlekamp_Zassenhaus/Unique_Factorization.thy b/thys/Berlekamp_Zassenhaus/Unique_Factorization.thy
--- a/thys/Berlekamp_Zassenhaus/Unique_Factorization.thy
+++ b/thys/Berlekamp_Zassenhaus/Unique_Factorization.thy
@@ -1,971 +1,971 @@
 theory Unique_Factorization
   imports
     Polynomial_Interpolation.Ring_Hom_Poly
     Polynomial_Factorization.Polynomial_Divisibility
     "HOL-Combinatorics.Permutations" 
     "HOL-Computational_Algebra.Euclidean_Algorithm"
     Containers.Containers_Auxiliary (* only for a lemma *)
-    Missing_Multiset2
+    More_Missing_Multiset
     "HOL-Algebra.Divisibility"
 begin
 
 hide_const(open)
   Divisibility.prime
   Divisibility.irreducible
 
 hide_fact(open)
   Divisibility.irreducible_def
   Divisibility.irreducibleI
   Divisibility.irreducibleD
   Divisibility.irreducibleE
 
 hide_const (open) Rings.coprime
 
 lemma irreducible_uminus [simp]:
   fixes a::"'a::idom"
   shows "irreducible (-a) \<longleftrightarrow> irreducible a"
   using irreducible_mult_unit_left[of "-1::'a"] by auto
 
 context comm_monoid_mult begin
 
   definition coprime :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
     where coprime_def': "coprime p q \<equiv> \<forall>r. r dvd p \<longrightarrow> r dvd q \<longrightarrow> r dvd 1"
 
   lemma coprimeI:
     assumes "\<And>r. r dvd p \<Longrightarrow> r dvd q \<Longrightarrow> r dvd 1"
     shows "coprime p q" using assms by (auto simp: coprime_def')
 
   lemma coprimeE:
     assumes "coprime p q"
         and "(\<And>r. r dvd p \<Longrightarrow> r dvd q \<Longrightarrow> r dvd 1) \<Longrightarrow> thesis"
     shows thesis using assms by (auto simp: coprime_def')
 
   lemma coprime_commute [ac_simps]:
     "coprime p q \<longleftrightarrow> coprime q p"
     by (auto simp add: coprime_def')
 
   lemma not_coprime_iff_common_factor:
     "\<not> coprime p q \<longleftrightarrow> (\<exists>r. r dvd p \<and> r dvd q \<and> \<not> r dvd 1)"
     by (auto simp add: coprime_def')
 
 end
 
 lemma (in algebraic_semidom) coprime_iff_coprime [simp, code]:
   "coprime = Rings.coprime"
   by (simp add: fun_eq_iff coprime_def coprime_def')
 
 lemma (in comm_semiring_1) coprime_0 [simp]:
   "coprime p 0 \<longleftrightarrow> p dvd 1" "coprime 0 p \<longleftrightarrow> p dvd 1"
   by (auto intro: coprimeI elim: coprimeE dest: dvd_trans)
 
 (**** until here ****)
 
 
 (* TODO: move or...? *)
 lemma dvd_rewrites: "dvd.dvd ((*)) = (dvd)" by (unfold dvd.dvd_def dvd_def, rule)
 
 
 subsection \<open>Interfacing UFD properties\<close>
 hide_const (open) Divisibility.irreducible
 
 context comm_monoid_mult_isom begin
   lemma coprime_hom[simp]: "coprime (hom x) y' \<longleftrightarrow> coprime x (Hilbert_Choice.inv hom y')"
   proof-
     show ?thesis by (unfold coprime_def', fold ball_UNIV, subst surj[symmetric], simp)
   qed
   lemma coprime_inv_hom[simp]: "coprime (Hilbert_Choice.inv hom x') y \<longleftrightarrow> coprime x' (hom y)"
   proof-
     interpret inv: comm_monoid_mult_isom "Hilbert_Choice.inv hom"..
     show ?thesis by simp
   qed
 end
 
 subsubsection \<open>Original part\<close>
 
 lemma dvd_dvd_imp_smult:
   fixes p q :: "'a :: idom poly"
   assumes pq: "p dvd q" and qp: "q dvd p" shows "\<exists>c. p = smult c q"
 proof (cases "p = 0")
   case True then show ?thesis by auto
 next
   case False
   from qp obtain r where r: "p = q * r" by (elim dvdE, auto)
   with False qp have r0: "r \<noteq> 0" and q0: "q \<noteq> 0" by auto
   with divides_degree[OF pq] divides_degree[OF qp] False
   have "degree p = degree q" by auto
   with r degree_mult_eq[OF q0 r0] have "degree r = 0" by auto
   from degree_0_id[OF this] obtain c where "r = [:c:]" by metis
   from r[unfolded this] show ?thesis by auto
 qed
 
 lemma dvd_const:
   assumes pq: "(p::'a::semidom poly) dvd q" and q0: "q \<noteq> 0" and degq: "degree q = 0"
   shows "degree p = 0"
 proof-
   from dvdE[OF pq] obtain r where *: "q = p * r".
   with q0 have "p \<noteq> 0" "r \<noteq> 0" by auto
   from degree_mult_eq[OF this] degq * show "degree p = 0" by auto
 qed
 
 context Rings.dvd begin
   abbreviation ddvd (infix "ddvd" 40) where "x ddvd y \<equiv> x dvd y \<and> y dvd x"
   lemma ddvd_sym[sym]: "x ddvd y \<Longrightarrow> y ddvd x" by auto
 end
 
 context comm_monoid_mult begin
   lemma ddvd_trans[trans]: "x ddvd y \<Longrightarrow> y ddvd z \<Longrightarrow> x ddvd z" using dvd_trans by auto
   lemma ddvd_transp: "transp (ddvd)" by (intro transpI, fact ddvd_trans)
 end
 
 context comm_semiring_1 begin
 
 definition mset_factors where "mset_factors F p \<equiv>
   F \<noteq> {#} \<and> (\<forall>f. f \<in># F \<longrightarrow> irreducible f) \<and> p = prod_mset F"
 
 lemma mset_factorsI[intro!]:
   assumes "\<And>f. f \<in># F \<Longrightarrow> irreducible f" and "F \<noteq> {#}" and "prod_mset F = p"
   shows "mset_factors F p"
   unfolding mset_factors_def using assms by auto
 
 lemma mset_factorsD:
   assumes "mset_factors F p"
   shows "f \<in># F \<Longrightarrow> irreducible f" and "F \<noteq> {#}" and "prod_mset F = p"
   using assms[unfolded mset_factors_def] by auto
 
 lemma mset_factorsE[elim]:
   assumes "mset_factors F p"
       and "(\<And>f. f \<in># F \<Longrightarrow> irreducible f) \<Longrightarrow> F \<noteq> {#} \<Longrightarrow> prod_mset F = p \<Longrightarrow> thesis"
   shows thesis
   using assms[unfolded mset_factors_def] by auto
 
 lemma mset_factors_imp_not_is_unit:
   assumes "mset_factors F p"
   shows "\<not> p dvd 1"
 proof(cases F)
   case empty with assms show ?thesis by auto
 next
   case (add f F)
   with assms have "\<not> f dvd 1" "p = f * prod_mset F" by (auto intro!: irreducible_not_unit)
   then show ?thesis by auto
 qed
 
 definition primitive_poly where "primitive_poly f \<equiv> \<forall>d. (\<forall>i. d dvd coeff f i) \<longrightarrow> d dvd 1"
 
 end
 
 lemma(in semidom) mset_factors_imp_nonzero:
   assumes "mset_factors F p"
   shows "p \<noteq> 0"
 proof
   assume "p = 0"
   moreover from assms have "prod_mset F = p" by auto
   ultimately obtain f where "f \<in># F" "f = 0" by auto
   with assms show False by auto
 qed
 
 class ufd = idom +
   assumes mset_factors_exist: "\<And>x. x \<noteq> 0 \<Longrightarrow> \<not> x dvd 1 \<Longrightarrow> \<exists>F. mset_factors F x"
     and mset_factors_unique: "\<And>x F G. mset_factors F x \<Longrightarrow> mset_factors G x \<Longrightarrow> rel_mset (ddvd) F G"
 
 subsubsection \<open>Connecting to HOL/Divisibility\<close>
 
 context comm_semiring_1 begin
 
   abbreviation "mk_monoid \<equiv> \<lparr>carrier = UNIV - {0}, mult = (*), one = 1\<rparr>"
 
   lemma carrier_0[simp]: "x \<in> carrier mk_monoid \<longleftrightarrow> x \<noteq> 0" by auto
 
   lemmas mk_monoid_simps = carrier_0 monoid.simps
 
   abbreviation irred where "irred \<equiv> Divisibility.irreducible mk_monoid"
   abbreviation factor where "factor \<equiv> Divisibility.factor mk_monoid"
   abbreviation factors where "factors \<equiv> Divisibility.factors mk_monoid"
   abbreviation properfactor where "properfactor \<equiv> Divisibility.properfactor mk_monoid"
 
   lemma factors: "factors fs y \<longleftrightarrow> prod_list fs = y \<and> Ball (set fs) irred"
   proof -
     have "prod_list fs = foldr (*) fs 1" by (induct fs, auto)
     thus ?thesis unfolding factors_def by auto
   qed
 
   lemma factor: "factor x y \<longleftrightarrow> (\<exists>z. z \<noteq> 0 \<and> x * z = y)" unfolding factor_def by auto
 
   lemma properfactor_nz:
     shows "(y :: 'a) \<noteq> 0 \<Longrightarrow> properfactor x y \<longleftrightarrow> x dvd y \<and> \<not> y dvd x"
     by (auto simp: properfactor_def factor_def dvd_def)
 
   lemma mem_Units[simp]: "y \<in> Units mk_monoid \<longleftrightarrow> y dvd 1"
     unfolding dvd_def Units_def by (auto simp: ac_simps)
 
 end
 
 context idom begin
   lemma irred_0[simp]: "irred (0::'a)" by (unfold Divisibility.irreducible_def, auto simp: factor properfactor_def)
   lemma factor_idom[simp]: "factor (x::'a) y \<longleftrightarrow> (if y = 0 then x = 0 else x dvd y)"
     by (cases "y = 0"; auto intro: exI[of _ 1] elim: dvdE simp: factor)
 
   lemma associated_connect[simp]: "(\<sim>\<^bsub>mk_monoid\<^esub>) = (ddvd)" by (intro ext, unfold associated_def, auto)
 
   lemma essentially_equal_connect[simp]:
     "essentially_equal mk_monoid fs gs \<longleftrightarrow> rel_mset (ddvd) (mset fs) (mset gs)"
     by (auto simp: essentially_equal_def rel_mset_via_perm perm_iff_eq_mset)
     
 
   lemma irred_idom_nz:
     assumes x0: "(x::'a) \<noteq> 0"
     shows "irred x \<longleftrightarrow> irreducible x"
     using x0 by (auto simp: irreducible_altdef Divisibility.irreducible_def properfactor_nz)
 
 
   lemma dvd_dvd_imp_unit_mult:
     assumes xy: "x dvd y" and yx: "y dvd x"
     shows "\<exists>z. z dvd 1 \<and> y = x * z"
   proof(cases "x = 0")
     case True with xy show ?thesis by (auto intro: exI[of _ 1])
   next
     case x0: False
     from xy obtain z where z: "y = x * z" by (elim dvdE, auto)
     from yx obtain w where w: "x = y * w" by (elim dvdE, auto)
     from z w have "x * (z * w) = x" by (auto simp: ac_simps)
     then have "z * w = 1" using x0 by auto
     with z show ?thesis by (auto intro: exI[of _ z])
   qed
 
   lemma irred_inner_nz:
     assumes x0: "x \<noteq> 0"
     shows "(\<forall>b. b dvd x \<longrightarrow> \<not> x dvd b \<longrightarrow> b dvd 1) \<longleftrightarrow> (\<forall>a b. x = a * b \<longrightarrow> a dvd 1 \<or> b dvd 1)" (is "?l \<longleftrightarrow> ?r")
   proof (intro iffI allI impI)
     assume l: ?l
     fix a b
     assume xab: "x = a * b"
     then have ax: "a dvd x" and bx: "b dvd x" by auto
     { assume a1: "\<not> a dvd 1"
       with l ax have xa: "x dvd a" by auto
       from dvd_dvd_imp_unit_mult[OF ax xa] obtain z where z1: "z dvd 1" and xaz: "x = a * z" by auto
       from xab x0 have "a \<noteq> 0" by auto
       with xab xaz have "b = z" by auto
       with z1 have "b dvd 1" by auto
     }
     then show "a dvd 1 \<or> b dvd 1" by auto
   next
     assume r: ?r
     fix b assume bx: "b dvd x" and xb: "\<not> x dvd b"
     then obtain a where xab: "x = a * b" by (elim dvdE, auto simp: ac_simps)
     with r consider "a dvd 1" | "b dvd 1" by auto
     then show "b dvd 1"
     proof(cases)
       case 2 then show ?thesis by auto
     next
       case 1
       then obtain c where ac1: "a * c = 1" by (elim dvdE, auto)
       from xab have "x * c = b * (a * c)" by (auto simp: ac_simps)
       with ac1 have "x * c = b" by auto
       then have "x dvd b" by auto
       with xb show ?thesis by auto
     qed
   qed
 
   lemma irred_idom[simp]: "irred x \<longleftrightarrow> x = 0 \<or> irreducible x"
   by (cases "x = 0"; simp add: irred_idom_nz irred_inner_nz irreducible_def)
 
   lemma assumes "x \<noteq> 0" and "factors fs x" and "f \<in> set fs" shows "f \<noteq> 0"
     using assms by (auto simp: factors)
 
   lemma factors_as_mset_factors:
     assumes x0: "x \<noteq> 0" and x1: "x \<noteq> 1"
     shows "factors fs x \<longleftrightarrow> mset_factors (mset fs) x" using assms
     by (auto simp: factors prod_mset_prod_list)
 
 
 end
 
 context ufd begin
   interpretation comm_monoid_cancel: comm_monoid_cancel "mk_monoid::'a monoid"
     apply (unfold_locales)
     apply simp_all
     using mult_left_cancel
     apply (auto simp: ac_simps)
     done
   lemma factors_exist:
     assumes "a \<noteq> 0"
     and "\<not> a dvd 1"
     shows "\<exists>fs. set fs \<subseteq> UNIV - {0} \<and> factors fs a"
   proof-
     from mset_factors_exist[OF assms]
     obtain F where "mset_factors F a" by auto
     also from ex_mset obtain fs where "F = mset fs" by metis
     finally have fs: "mset_factors (mset fs) a".
     then have "factors fs a" using assms by (subst factors_as_mset_factors, auto)
     moreover have "set fs \<subseteq> UNIV - {0}" using fs by (auto elim!: mset_factorsE)
     ultimately show ?thesis by auto
   qed
 
   lemma factors_unique:
     assumes fs: "factors fs a"
        and gs: "factors gs a"
        and a0: "a \<noteq> 0"
        and a1: "\<not> a dvd 1"
     shows "rel_mset (ddvd) (mset fs) (mset gs)"
   proof-
     from a1 have "a \<noteq> 1" by auto
     with a0 fs gs have "mset_factors (mset fs) a" "mset_factors (mset gs) a" by (unfold factors_as_mset_factors)
     from mset_factors_unique[OF this] show ?thesis.
   qed
 
   lemma factorial_monoid: "factorial_monoid (mk_monoid :: 'a monoid)"
     by (unfold_locales; auto simp add: factors_exist factors_unique)
 
 end
 
 lemma (in idom) factorial_monoid_imp_ufd:
   assumes "factorial_monoid (mk_monoid :: 'a monoid)"
   shows "class.ufd ((*) :: 'a \<Rightarrow> _) 1 (+) 0 (-) uminus"
 proof (unfold_locales)
   interpret factorial_monoid "mk_monoid :: 'a monoid" by (fact assms)
   {
     fix x assume x: "x \<noteq> 0" "\<not> x dvd 1"
     note * = factors_exist[simplified, OF this]
     with x show "\<exists>F. mset_factors F x" by (subst(asm) factors_as_mset_factors, auto)
   }
   fix x F G assume FG: "mset_factors F x" "mset_factors G x"
   with mset_factors_imp_not_is_unit have x1: "\<not> x dvd 1" by auto
   from FG(1) have x0: "x \<noteq> 0" by (rule mset_factors_imp_nonzero)
   obtain fs gs where fsgs: "F = mset fs" "G = mset gs" using ex_mset by metis
   note FG = FG[unfolded this]
   then have 0: "0 \<notin> set fs" "0 \<notin> set gs" by (auto elim!: mset_factorsE)
   from x1 have "x \<noteq> 1" by auto
   note FG[folded factors_as_mset_factors[OF x0 this]]
   from factors_unique[OF this, simplified, OF x0 x1, folded fsgs] 0
   show "rel_mset (ddvd) F G" by auto
 qed
 
 
 
 
 subsection \<open>Preservation of Irreducibility\<close>
 
 
 locale comm_semiring_1_hom = comm_monoid_mult_hom hom + zero_hom hom
   for hom :: "'a :: comm_semiring_1 \<Rightarrow> 'b :: comm_semiring_1"
 
 locale irreducibility_hom = comm_semiring_1_hom +
   assumes irreducible_imp_irreducible_hom: "irreducible a \<Longrightarrow> irreducible (hom a)"
 begin
   lemma hom_mset_factors:
     assumes F: "mset_factors F p"
     shows "mset_factors (image_mset hom F) (hom p)"
   proof (unfold mset_factors_def, intro conjI allI impI)
     from F show "hom p = prod_mset (image_mset hom F)" "image_mset hom F \<noteq> {#}" by (auto simp: hom_distribs)
     fix f' assume "f' \<in># image_mset hom F"
     then obtain f where f: "f \<in># F" and f'f: "f' = hom f" by auto
     with F irreducible_imp_irreducible_hom show "irreducible f'" unfolding f'f by auto
   qed
 end
 
 locale unit_preserving_hom = comm_semiring_1_hom +
   assumes is_unit_hom_if: "\<And>x. hom x dvd 1 \<Longrightarrow> x dvd 1"
 begin
   lemma is_unit_hom_iff[simp]: "hom x dvd 1 \<longleftrightarrow> x dvd 1" using is_unit_hom_if hom_dvd by force
 
   lemma irreducible_hom_imp_irreducible:
     assumes irr: "irreducible (hom a)" shows "irreducible a"
   proof (intro irreducibleI)
     from irr show "a \<noteq> 0" by auto
     from irr show "\<not> a dvd 1" by (auto dest: irreducible_not_unit)
     fix b c assume "a = b * c"
     then have "hom a = hom b * hom c" by (simp add: hom_distribs)
     with irr have "hom b dvd 1 \<or> hom c dvd 1" by (auto dest: irreducibleD)
     then show "b dvd 1 \<or> c dvd 1" by simp
   qed
 end
 
 locale factor_preserving_hom = unit_preserving_hom + irreducibility_hom
 begin
   lemma irreducible_hom[simp]: "irreducible (hom a) \<longleftrightarrow> irreducible a"
     using irreducible_hom_imp_irreducible irreducible_imp_irreducible_hom by metis
 end
 
 lemma factor_preserving_hom_comp:
   assumes f: "factor_preserving_hom f" and g: "factor_preserving_hom g"
   shows "factor_preserving_hom (f o g)"
 proof-
   interpret f: factor_preserving_hom f by (rule f)
   interpret g: factor_preserving_hom g by (rule g)
   show ?thesis by (unfold_locales, auto simp: hom_distribs)
 qed
 
 context comm_semiring_isom begin
   sublocale unit_preserving_hom by (unfold_locales, auto)
   sublocale factor_preserving_hom
   proof (standard)
     fix a :: 'a
     assume "irreducible a"
     note a = this[unfolded irreducible_def]
     show "irreducible (hom a)"
     proof (rule ccontr)
       assume "\<not> irreducible (hom a)"
       from this[unfolded Factorial_Ring.irreducible_def,simplified] a
       obtain hb hc where eq: "hom a = hb * hc" and nu: "\<not> hb dvd 1" "\<not> hc dvd 1" by auto
       from bij obtain b where hb: "hb = hom b" by (elim bij_pointE)
       from bij obtain c where hc: "hc = hom c" by (elim bij_pointE)
       from eq[unfolded hb hc, folded hom_mult] have "a = b * c" by auto
       with nu hb hc have "a = b * c" "\<not> b dvd 1" "\<not> c dvd 1" by auto
       with a show False by auto
     qed
   qed
 end
 
 
 subsubsection\<open>Back to divisibility\<close>
 
 lemma(in comm_semiring_1) mset_factors_mult:
   assumes F: "mset_factors F a"
       and G: "mset_factors G b"
   shows "mset_factors (F+G) (a*b)"
 proof(intro mset_factorsI)
   fix f assume "f \<in># F + G"
   then consider "f \<in># F" | "f \<in># G" by auto
   then show "irreducible f" by(cases, insert F G, auto)
 qed (insert F G, auto)
 
 lemma(in ufd) dvd_imp_subset_factors:
   assumes ab: "a dvd b"
       and F: "mset_factors F a"
       and G: "mset_factors G b"
   shows "\<exists>G'. G' \<subseteq># G \<and> rel_mset (ddvd) F G'"
 proof-
   from F G have a0: "a \<noteq> 0" and b0: "b \<noteq> 0" by (simp_all add: mset_factors_imp_nonzero)
   from ab obtain c where c: "b = a * c" by (elim dvdE, auto)
   with b0 have c0: "c \<noteq> 0" by auto
   show ?thesis
   proof(cases "c dvd 1")
     case True
     show ?thesis
       proof(cases F)
         case empty with F show ?thesis by auto
       next
         case (add f F')
           with F
           have a: "f * prod_mset F' = a"
            and F': "\<And>f. f \<in># F' \<Longrightarrow> irreducible f"
            and irrf: "irreducible f" by auto
           from irrf have f0: "f \<noteq> 0" and f1: "\<not>f dvd 1" by (auto dest: irreducible_not_unit)
           from a c have "(f * c) * prod_mset F' = b" by (auto simp: ac_simps)
           moreover {
             have "irreducible (f * c)" using True irrf by (subst irreducible_mult_unit_right)
             with F' irrf have "\<And>f'. f' \<in># F' + {#f * c#} \<Longrightarrow> irreducible f'" by auto
           }
           ultimately have "mset_factors (F' + {#f * c#}) b" by (intro mset_factorsI, auto)
           from mset_factors_unique[OF this G]
           have F'G: "rel_mset (ddvd) (F' + {#f * c#}) G".
           from True add have FF': "rel_mset (ddvd) F (F' + {#f * c#})"
             by (auto simp add: multiset.rel_refl intro!: rel_mset_Plus)
           have "rel_mset (ddvd) F G"
             apply(rule transpD[OF multiset.rel_transp[OF transpI] FF' F'G])
             using ddvd_trans.
           then show ?thesis by auto
       qed
   next
     case False
       from mset_factors_exist[OF c0 this] obtain H where H: "mset_factors H c" by auto
       from c mset_factors_mult[OF F H] have "mset_factors (F + H) b" by auto
       note mset_factors_unique[OF this G]
       from rel_mset_split[OF this] obtain G1 G2
         where "G = G1 + G2" "rel_mset (ddvd) F G1" "rel_mset (ddvd) H G2" by auto
       then show ?thesis by (intro exI[of _ "G1"], auto)
   qed
 qed
 
 lemma(in idom) irreducible_factor_singleton:
   assumes a: "irreducible a"
   shows "mset_factors F a \<longleftrightarrow> F = {#a#}"
 proof(cases F)
   case empty with mset_factorsD show ?thesis by auto
 next
   case (add f F')
   show ?thesis
   proof
     assume F: "mset_factors F a"
     from add mset_factorsD[OF F] have *: "a = f * prod_mset F'" by auto
     then have fa: "f dvd a" by auto
     from * a have f0: "f \<noteq> 0" by auto
     from add have "f \<in># F" by auto
     with F have f: "irreducible f" by auto
     from add have "F' \<subseteq># F" by auto
     then have unitemp: "prod_mset F' dvd 1 \<Longrightarrow> F' = {#}"
     proof(induct F')
       case empty then show ?case by auto
     next
       case (add f F')
         from add have "f \<in># F" by (simp add: mset_subset_eq_insertD)
         with F irreducible_not_unit have "\<not> f dvd 1" by auto
         then have "\<not> (prod_mset F' * f) dvd 1" by simp
         with add show ?case by auto
     qed
     show "F = {#a#}"
     proof(cases "a dvd f")
       case True
         then obtain r where "f = a * r" by (elim dvdE, auto)
         with * have "f = (r * prod_mset F') * f" by (auto simp: ac_simps)
         with f0 have "r * prod_mset F' = 1" by auto
         then have "prod_mset F' dvd 1" by (metis dvd_triv_right)
         with unitemp * add show ?thesis by auto
     next
       case False with fa a f show ?thesis by (auto simp: irreducible_altdef)
     qed
   qed (insert a, auto)
 qed
 
 
 lemma(in ufd) irreducible_dvd_imp_factor:
   assumes ab: "a dvd b"
       and a: "irreducible a"
       and G: "mset_factors G b"
   shows "\<exists>g \<in># G. a ddvd g"
 proof-
   from a have "mset_factors {#a#} a" by auto
   from dvd_imp_subset_factors[OF ab this G]
   obtain G' where G'G: "G' \<subseteq># G" and rel: "rel_mset (ddvd) {#a#} G'" by auto
   with rel_mset_size size_1_singleton_mset size_single
   obtain g where gG': "G' = {#g#}" by fastforce
   from rel[unfolded this rel_mset_def]
   have "a ddvd g" by auto
   with gG' G'G show ?thesis by auto
 qed
 
 lemma(in idom) prod_mset_remove_units:
   "prod_mset F ddvd prod_mset {# f \<in># F. \<not>f dvd 1 #}"
 proof(induct F)
   case (add f F) then show ?case by (cases "f = 0", auto)
 qed auto
 
 lemma(in comm_semiring_1) mset_factors_imp_dvd:
   assumes "mset_factors F x" and "f \<in># F" shows "f dvd x"
   using assms by (simp add: dvd_prod_mset mset_factors_def)
 
 lemma(in ufd) prime_elem_iff_irreducible[iff]:
   "prime_elem x \<longleftrightarrow> irreducible x"
 proof (intro iffI, fact prime_elem_imp_irreducible, rule prime_elemI)
   assume r: "irreducible x"
   then show x0: "x \<noteq> 0" and x1: "\<not> x dvd 1" by (auto dest: irreducible_not_unit)
   from irreducible_factor_singleton[OF r]
   have *: "mset_factors {#x#} x" by auto
   fix a b
   assume "x dvd a * b"
   then obtain c where abxc: "a * b = x * c" by (elim dvdE, auto)
   show "x dvd a \<or> x dvd b"
   proof(cases "c = 0 \<or> a = 0 \<or> b = 0")
     case True with abxc show ?thesis by auto
   next
     case False
     then have a0: "a \<noteq> 0" and b0: "b \<noteq> 0" and c0: "c \<noteq> 0" by auto
     from x0 c0 have xc0: "x * c \<noteq> 0" by auto
     from x1 have xc1: "\<not> x * c dvd 1" by auto
     show ?thesis
     proof (cases "a dvd 1 \<or> b dvd 1")
       case False
       then have a1: "\<not> a dvd 1" and b1: "\<not> b dvd 1" by auto
       from mset_factors_exist[OF a0 a1]
       obtain F where Fa: "mset_factors F a" by auto
       then have F0: "F \<noteq> {#}" by auto
       from mset_factors_exist[OF b0 b1]
       obtain G where Gb: "mset_factors G b" by auto
       then have G0: "G \<noteq> {#}" by auto
       from mset_factors_mult[OF Fa Gb]
       have FGxc: "mset_factors (F + G) (x * c)" by (simp add: abxc)
       show ?thesis
       proof (cases "c dvd 1")
         case True
         from r irreducible_mult_unit_right[OF this] have "irreducible (x*c)" by simp
         note irreducible_factor_singleton[OF this] FGxc
         with F0 G0 have False by (cases F; cases G; auto)
         then show ?thesis by auto
       next
         case False
         from mset_factors_exist[OF c0 this] obtain H where "mset_factors H c" by auto
         with * have xHxc: "mset_factors (add_mset x H) (x * c)" by force
         note rel = mset_factors_unique[OF this FGxc]
         obtain hs where "mset hs = H" using ex_mset by auto
         then have "mset (x#hs) = add_mset x H" by auto
         from rel_mset_free[OF rel this]
         obtain jjs where jjsGH: "mset jjs = F + G" and rel: "list_all2 (ddvd) (x # hs) jjs" by auto
         then obtain j js where jjs: "jjs = j # js" by (cases jjs, auto)
         with rel have xj: "x ddvd j" by auto
         from jjs jjsGH have j: "j \<in> set_mset (F + G)" by (intro union_single_eq_member, auto)
         from j consider "j \<in># F" | "j \<in># G" by auto
         then show ?thesis
         proof(cases)
           case 1
           with Fa have "j dvd a" by (auto intro: mset_factors_imp_dvd)
           with xj dvd_trans have "x dvd a" by auto
           then show ?thesis by auto
         next
           case 2
           with Gb have "j dvd b" by (auto intro: mset_factors_imp_dvd)
           with xj dvd_trans have "x dvd b" by auto
           then show ?thesis by auto
         qed
       qed
     next
       case True
       then consider "a dvd 1" | "b dvd 1" by auto
       then show ?thesis
       proof(cases)
         case 1
         then obtain d where ad: "a * d = 1" by (elim dvdE, auto)
         from abxc have "x * (c * d) = a * b * d" by (auto simp: ac_simps)
         also have "... = a * d * b" by (auto simp: ac_simps)
         finally have "x dvd b" by (intro dvdI, auto simp: ad)
         then show ?thesis by auto
       next
         case 2
         then obtain d where bd: "b * d = 1" by (elim dvdE, auto)
         from abxc have "x * (c * d) = a * b * d" by (auto simp: ac_simps)
         also have "... = (b * d) * a" by (auto simp: ac_simps)
         finally have "x dvd a" by (intro dvdI, auto simp:bd)
         then show ?thesis by auto
       qed
     qed
   qed
 qed
 
 subsection\<open>Results for GCDs etc.\<close>
 
 lemma prod_list_remove1: "(x :: 'b :: comm_monoid_mult) \<in> set xs \<Longrightarrow> prod_list (remove1 x xs) * x = prod_list xs"
   by (induct xs, auto simp: ac_simps)
 
 (* Isabelle 2015-style and generalized gcd-class without normalization and factors *)
 class comm_monoid_gcd = gcd + comm_semiring_1 +
   assumes gcd_dvd1[iff]: "gcd a b dvd a"
       and gcd_dvd2[iff]: "gcd a b dvd b"
       and gcd_greatest: "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> c dvd gcd a b"
 begin
 
   lemma gcd_0_0[simp]: "gcd 0 0 = 0"
     using gcd_greatest[OF dvd_0_right dvd_0_right, of 0] by auto
 
   lemma gcd_zero_iff[simp]: "gcd a b = 0 \<longleftrightarrow> a = 0 \<and> b = 0"
   proof
     assume "gcd a b = 0"
     from gcd_dvd1[of a b, unfolded this] gcd_dvd2[of a b, unfolded this]
     show "a = 0 \<and> b = 0" by auto
   qed auto
 
   lemma gcd_zero_iff'[simp]: "0 = gcd a b \<longleftrightarrow> a = 0 \<and> b = 0"
     using gcd_zero_iff by metis
 
   lemma dvd_gcd_0_iff[simp]:
     shows "x dvd gcd 0 a \<longleftrightarrow> x dvd a" (is ?g1)
       and "x dvd gcd a 0 \<longleftrightarrow> x dvd a" (is ?g2)
   proof-
     have "a dvd gcd a 0" "a dvd gcd 0 a" by (auto intro: gcd_greatest)
     with dvd_refl show ?g1 ?g2 by (auto dest: dvd_trans)
   qed
 
   lemma gcd_dvd_1[simp]: "gcd a b dvd 1 \<longleftrightarrow> coprime a b"
     using dvd_trans[OF gcd_greatest[of _ a b], of _ 1]
     by (cases "a = 0 \<and> b = 0") (auto intro!: coprimeI elim: coprimeE)
 
   lemma dvd_imp_gcd_dvd_gcd: "b dvd c \<Longrightarrow> gcd a b dvd gcd a c"
     by (meson gcd_dvd1 gcd_dvd2 gcd_greatest dvd_trans)
 
   definition listgcd :: "'a list \<Rightarrow> 'a" where
     "listgcd xs = foldr gcd xs 0"
 
   lemma listgcd_simps[simp]: "listgcd [] = 0" "listgcd (x # xs) = gcd x (listgcd xs)"
     by (auto simp: listgcd_def)
 
   lemma listgcd: "x \<in> set xs \<Longrightarrow> listgcd xs dvd x" 
   proof (induct xs)
     case (Cons y ys)
     show ?case
     proof (cases "x = y")
       case False
       with Cons have dvd: "listgcd ys dvd x" by auto
       thus ?thesis unfolding listgcd_simps using dvd_trans by blast
     next
       case True
       thus ?thesis unfolding listgcd_simps using dvd_trans by blast
     qed
   qed simp
 
   lemma listgcd_greatest: "(\<And> x. x \<in> set xs \<Longrightarrow> y dvd x) \<Longrightarrow> y dvd listgcd xs"
     by (induct xs arbitrary:y, auto intro: gcd_greatest)
 
 end
 
 
 context Rings.dvd begin
 
   definition "is_gcd x a b \<equiv> x dvd a \<and> x dvd b \<and> (\<forall>y. y dvd a \<longrightarrow> y dvd b \<longrightarrow> y dvd x)"
 
   definition "some_gcd a b \<equiv> SOME x. is_gcd x a b"
 
   lemma is_gcdI[intro!]:
     assumes "x dvd a" "x dvd b" "\<And>y. y dvd a \<Longrightarrow> y dvd b \<Longrightarrow> y dvd x"
     shows "is_gcd x a b" by (insert assms, auto simp: is_gcd_def)
 
   lemma is_gcdE[elim!]:
     assumes "is_gcd x a b"
         and "x dvd a \<Longrightarrow> x dvd b \<Longrightarrow> (\<And>y. y dvd a \<Longrightarrow> y dvd b \<Longrightarrow> y dvd x) \<Longrightarrow> thesis"
     shows thesis by (insert assms, auto simp: is_gcd_def)
 
   lemma is_gcd_some_gcdI:
     assumes "\<exists>x. is_gcd x a b" shows "is_gcd (some_gcd a b) a b"
     by (unfold some_gcd_def, rule someI_ex[OF assms])
 
 end
 
 context comm_semiring_1 begin
 
   lemma some_gcd_0[intro!]: "is_gcd (some_gcd a 0) a 0" "is_gcd (some_gcd 0 b) 0 b"
     by (auto intro!: is_gcd_some_gcdI intro: exI[of _ a] exI[of _ b])
 
   lemma some_gcd_0_dvd[intro!]:
     "some_gcd a 0 dvd a" "some_gcd 0 b dvd b" using some_gcd_0 by auto
 
   lemma dvd_some_gcd_0[intro!]:
     "a dvd some_gcd a 0" "b dvd some_gcd 0 b" using some_gcd_0[of a] some_gcd_0[of b] by auto
 
 end
 
 context idom begin
 
   lemma is_gcd_connect:
     assumes "a \<noteq> 0" "b \<noteq> 0" shows "isgcd mk_monoid x a b \<longleftrightarrow> is_gcd x a b"
     using assms by (force simp: isgcd_def)
 
   lemma some_gcd_connect:
     assumes "a \<noteq> 0" and "b \<noteq> 0" shows "somegcd mk_monoid a b = some_gcd a b"
     using assms by (auto intro!: arg_cong[of _ _ Eps] simp: is_gcd_connect some_gcd_def somegcd_def)
 end
 
 context comm_monoid_gcd
 begin
   lemma is_gcd_gcd: "is_gcd (gcd a b) a b" using gcd_greatest by auto
   lemma is_gcd_some_gcd: "is_gcd (some_gcd a b) a b" by (insert is_gcd_gcd, auto intro!: is_gcd_some_gcdI)
   lemma gcd_dvd_some_gcd: "gcd a b dvd some_gcd a b" using is_gcd_some_gcd by auto
   lemma some_gcd_dvd_gcd: "some_gcd a b dvd gcd a b" using is_gcd_some_gcd by (auto intro: gcd_greatest)
   lemma some_gcd_ddvd_gcd: "some_gcd a b ddvd gcd a b" by (auto intro: gcd_dvd_some_gcd some_gcd_dvd_gcd)
   lemma some_gcd_dvd: "some_gcd a b dvd d \<longleftrightarrow> gcd a b dvd d" "d dvd some_gcd a b \<longleftrightarrow> d dvd gcd a b"
     using some_gcd_ddvd_gcd[of a b] by (auto dest:dvd_trans)
 
 end
 
 class idom_gcd = comm_monoid_gcd + idom
 begin
 
   interpretation raw: comm_monoid_cancel "mk_monoid :: 'a monoid"
     by (unfold_locales, auto intro: mult_commute mult_assoc)
 
   interpretation raw: gcd_condition_monoid "mk_monoid :: 'a monoid"
     by (unfold_locales, auto simp: is_gcd_connect intro!: exI[of _ "gcd _ _"] dest: gcd_greatest)
 
   lemma gcd_mult_ddvd:
     "d * gcd a b ddvd gcd (d * a) (d * b)"
   proof (cases "d = 0")
     case True then show ?thesis by auto
   next
     case d0: False
     show ?thesis
     proof (cases "a = 0 \<or> b = 0")
       case False
       note some_gcd_ddvd_gcd[of a b]
       with d0 have "d * gcd a b ddvd d * some_gcd a b" by auto
       also have "d * some_gcd a b ddvd some_gcd (d * a) (d * b)"
         using False d0 raw.gcd_mult by (simp add: some_gcd_connect)
       also note some_gcd_ddvd_gcd
       finally show ?thesis.
     next
       case True
       with d0 show ?thesis
         apply (elim disjE)
          apply (rule ddvd_trans[of _ "d * b"]; force)
          apply (rule ddvd_trans[of _ "d * a"]; force)
         done
     qed
   qed
 
   lemma gcd_greatest_mult: assumes cad: "c dvd a * d" and cbd: "c dvd b * d"
     shows "c dvd gcd a b * d"
   proof-
     from gcd_greatest[OF assms] have c: "c dvd gcd (d * a) (d * b)" by (auto simp: ac_simps)
     note gcd_mult_ddvd[of d a b]
     then have "gcd (d * a) (d * b) dvd gcd a b * d" by (auto simp: ac_simps)
     from dvd_trans[OF c this] show ?thesis .
   qed
 
   lemma listgcd_greatest_mult: "(\<And> x :: 'a. x \<in> set xs \<Longrightarrow> y dvd x * z) \<Longrightarrow> y dvd listgcd xs * z"
   proof (induct xs)
     case (Cons x xs)
     from Cons have "y dvd x * z" "y dvd listgcd xs * z" by auto
     thus ?case unfolding listgcd_simps by (rule gcd_greatest_mult)
   qed (simp)
 
   lemma dvd_factor_mult_gcd:
     assumes dvd: "k dvd p * q" "k dvd p * r"
       and q0: "q \<noteq> 0" and r0: "r \<noteq> 0"
     shows "k dvd p * gcd q r" 
   proof -
     from dvd gcd_greatest[of k "p * q" "p * r"]
     have "k dvd gcd (p * q) (p * r)" by simp
     also from gcd_mult_ddvd[of p q r]
     have "... dvd (p * gcd q r)" by auto
     finally show ?thesis .
   qed
 
   lemma coprime_mult_cross_dvd:
     assumes coprime: "coprime p q" and eq: "p' * p = q' * q"
     shows "p dvd q'" (is ?g1) and "q dvd p'" (is ?g2)
   proof (atomize(full), cases "p = 0 \<or> q = 0")
     case True
     then show "?g1 \<and> ?g2"
     proof
       assume p0: "p = 0" with coprime have "q dvd 1" by auto
       with eq p0 show ?thesis by auto
     next
       assume q0: "q = 0" with coprime have "p dvd 1" by auto
       with eq q0 show ?thesis by auto
     qed
   next
     case False
     {
       fix p q r p' q' :: 'a
       assume cop: "coprime p q" and eq: "p' * p = q' * q" and p: "p \<noteq> 0" and q: "q \<noteq> 0"
          and r: "r dvd p" "r dvd q"
       let ?gcd = "gcd q p"
       from eq have "p' * p dvd q' * q" by auto
       hence d1: "p dvd q' * q" by (rule dvd_mult_right)
       have d2: "p dvd q' * p" by auto
       from dvd_factor_mult_gcd[OF d1 d2 q p] have 1: "p dvd q' * ?gcd" .
       from q p have 2: "?gcd dvd q" by auto
       from q p have 3: "?gcd dvd p" by auto
       from cop[unfolded coprime_def', rule_format, OF 3 2] have "?gcd dvd 1" .
       from 1 dvd_mult_unit_iff[OF this] have "p dvd q'" by auto
     } note main = this
     from main[OF coprime eq,of 1] False coprime coprime_commute main[OF _ eq[symmetric], of 1]
     show "?g1 \<and> ?g2" by auto
   qed
 
 end
 
 subclass (in ring_gcd) idom_gcd by (unfold_locales, auto)
 
 lemma coprime_rewrites: "comm_monoid_mult.coprime ((*)) 1 = coprime"
   apply (intro ext)
   apply (subst comm_monoid_mult.coprime_def')
   apply (unfold_locales)
   apply (unfold dvd_rewrites)
   apply (fold coprime_def') ..
 
 (* TODO: incorporate into the default class hierarchy *)
 locale gcd_condition =
   fixes ty :: "'a :: idom itself"
   assumes gcd_exists: "\<And>a b :: 'a. \<exists>x. is_gcd x a b"
 begin
   sublocale idom_gcd "(*)" "1 :: 'a" "(+)" 0 "(-)" uminus some_gcd 
     rewrites "dvd.dvd ((*)) = (dvd)"
         and "comm_monoid_mult.coprime ((*) ) 1 = Unique_Factorization.coprime"
   proof-
     have "is_gcd (some_gcd a b) a b" for a b :: 'a by (intro is_gcd_some_gcdI gcd_exists)
     from this[unfolded is_gcd_def]
     show "class.idom_gcd (*) (1 :: 'a) (+) 0 (-) uminus some_gcd" by (unfold_locales, auto simp: dvd_rewrites)
   qed (simp_all add: dvd_rewrites coprime_rewrites)
 end
 
 instance semiring_gcd \<subseteq> comm_monoid_gcd by (intro_classes, auto)
 
 lemma listgcd_connect: "listgcd = gcd_list"
 proof (intro ext)
   fix xs :: "'a list"
   show "listgcd xs = gcd_list xs" by(induct xs, auto)
 qed
 
 interpretation some_gcd: gcd_condition "TYPE('a::ufd)"
 proof(unfold_locales, intro exI)
   interpret factorial_monoid "mk_monoid :: 'a monoid" by (fact factorial_monoid)
   note d = dvd.dvd_def some_gcd_def carrier_0
   fix a b :: 'a
   show "is_gcd (some_gcd a b) a b"
   proof (cases "a = 0 \<or> b = 0")
     case True
     thus ?thesis using some_gcd_0 by auto
   next
     case False
     with gcdof_exists[of a b]
     show ?thesis by (auto intro!: is_gcd_some_gcdI simp add: is_gcd_connect some_gcd_connect)
   qed
 qed
 
 lemma some_gcd_listgcd_dvd_listgcd: "some_gcd.listgcd xs dvd listgcd xs"
   by (induct xs, auto simp:some_gcd_dvd intro:dvd_imp_gcd_dvd_gcd)
 
 lemma listgcd_dvd_some_gcd_listgcd: "listgcd xs dvd some_gcd.listgcd xs"
   by (induct xs, auto simp:some_gcd_dvd intro:dvd_imp_gcd_dvd_gcd)
 
 context factorial_ring_gcd begin
 
 text \<open>Do not declare the following as subclass, to avoid conflict in
   \<open>field \<subseteq> gcd_condition\<close> vs. \<open>factorial_ring_gcd \<subseteq> gcd_condition\<close>.
 \<close>
 sublocale as_ufd: ufd
 proof(unfold_locales, goal_cases)
   case (1 x)
   from prime_factorization_exists[OF \<open>x \<noteq> 0\<close>]
   obtain F where f: "\<And>f. f \<in># F \<Longrightarrow> prime_elem f" 
              and Fx: "normalize (prod_mset F) = normalize x" by auto
   from associatedE2[OF Fx] obtain u where u: "is_unit u" "x = u * prod_mset F"
     by blast
   from \<open>\<not> is_unit x\<close> Fx have "F \<noteq> {#}" by auto
   then obtain g G where F: "F = add_mset g G" by (cases F, auto)
   then have "g \<in># F" by auto
   with f[OF this]prime_elem_iff_irreducible
     irreducible_mult_unit_left[OF unit_factor_is_unit[OF \<open>x \<noteq> 0\<close>]]
   have g: "irreducible (u * g)" using u(1)
     by (subst irreducible_mult_unit_left) simp_all
   show ?case
   proof (intro exI conjI mset_factorsI)
     show "prod_mset (add_mset (u * g) G) = x"
       using \<open>x \<noteq> 0\<close> by (simp add: F ac_simps u)
     fix f assume "f \<in># add_mset (u * g) G"
     with f[unfolded F] g prime_elem_iff_irreducible
     show "irreducible f" by auto
   qed auto
 next
   case (2 x F G)
   note transpD[OF multiset.rel_transp[OF ddvd_transp],trans]
   obtain fs where F: "F = mset fs" by (metis ex_mset)
   have "list_all2 (ddvd) fs (map normalize fs)" by (intro list_all2_all_nthI, auto)
   then have FH: "rel_mset (ddvd) F (image_mset normalize F)" by (unfold rel_mset_def F, force)
   also
   have FG: "image_mset normalize F = image_mset normalize G"
   proof (intro prime_factorization_unique'')
     from 2 have xF: "x = prod_mset F" and xG: "x = prod_mset G" by auto
     from xF have "normalize x = normalize (prod_mset (image_mset normalize F))"
       by (simp add: normalize_prod_mset_normalize)
     with xG have nFG: "\<dots> = normalize (prod_mset (image_mset normalize G))"
       by (simp_all add: normalize_prod_mset_normalize)
     then show "normalize (\<Prod>i\<in>#image_mset normalize F. i) =
                normalize (\<Prod>i\<in>#image_mset normalize G. i)" by auto
   next
     from 2 prime_elem_iff_irreducible have "f \<in># F \<Longrightarrow> prime_elem f" "g \<in># G \<Longrightarrow> prime_elem g" for f g
      by (auto intro: prime_elemI)
     then show " Multiset.Ball (image_mset normalize F) prime"
       "Multiset.Ball (image_mset normalize G) prime" by auto
   qed
   also
     obtain gs where G: "G = mset gs" by (metis ex_mset)
     have "list_all2 ((ddvd)\<inverse>\<inverse>) gs (map normalize gs)" by (intro list_all2_all_nthI, auto)
     then have "rel_mset (ddvd) (image_mset normalize G) G"
       by (subst multiset.rel_flip[symmetric], unfold rel_mset_def G, force)
   finally show ?case.
 qed
 
 end
 
 instance int :: ufd by (intro class.ufd.of_class.intro as_ufd.ufd_axioms)
 instance int :: idom_gcd by (intro_classes, auto)
 
 instance field \<subseteq> ufd by (intro_classes, auto simp: dvd_field_iff)
 
 end
diff --git a/thys/PAC_Checker/Duplicate_Free_Multiset.thy b/thys/Nested_Multisets_Ordinals/Duplicate_Free_Multiset.thy
rename from thys/PAC_Checker/Duplicate_Free_Multiset.thy
rename to thys/Nested_Multisets_Ordinals/Duplicate_Free_Multiset.thy
--- a/thys/PAC_Checker/Duplicate_Free_Multiset.thy
+++ b/thys/Nested_Multisets_Ordinals/Duplicate_Free_Multiset.thy
@@ -1,157 +1,238 @@
 (*
-  File:         Duplicate_Free_Multiset.thy
-  Author:       Mathias Fleury, Daniela Kaufmann, JKU
-  Maintainer:   Mathias Fleury, JKU
+  File:                      Duplicate_Free_Multiset.thy
+  Authors and contributors:  Mathias Fleury, Daniela Kaufmann, JKU;
+                             Jose Divasón, Sebastiaan Joosten, René Thiemann, Akihisa Yamada
 *)
+
 theory Duplicate_Free_Multiset
-imports Nested_Multisets_Ordinals.Multiset_More
+imports Multiset_More
 begin
 
-
 section \<open>Duplicate Free Multisets\<close>
 
-(* TODO Move Multiset_More *)
-lemma remove_diff_multiset[simp]: \<open>x13 \<notin># A \<Longrightarrow> A - add_mset x13 B = A - B\<close>
-  by (metis diff_intersect_left_idem inter_add_right1)
-
-
 text \<open>Duplicate free multisets are isomorphic to finite sets, but it can be useful to reason about
   duplication to speak about intermediate execution steps in the refinements.
 \<close>
+
+definition distinct_mset :: "'a multiset \<Rightarrow> bool" where
+  "distinct_mset S \<longleftrightarrow> (\<forall>a. a \<in># S \<longrightarrow> count S a = 1)"
+
+lemma distinct_mset_count_less_1: "distinct_mset S \<longleftrightarrow> (\<forall>a. count S a \<le> 1)"
+  using eq_iff nat_le_linear unfolding distinct_mset_def by fastforce
+
+lemma distinct_mset_empty[simp]: "distinct_mset {#}"
+  unfolding distinct_mset_def by auto
+
+lemma distinct_mset_singleton: "distinct_mset {#a#}"
+  unfolding distinct_mset_def by auto
+
+lemma distinct_mset_union:
+  assumes dist: "distinct_mset (A + B)"
+  shows "distinct_mset A"
+  unfolding distinct_mset_count_less_1
+proof (rule allI)
+  fix a
+  have \<open>count A a \<le> count (A + B) a\<close> by auto
+  moreover have \<open>count (A + B) a \<le> 1\<close>
+    using dist unfolding distinct_mset_count_less_1 by auto
+  ultimately show \<open>count A a \<le> 1\<close>
+    by simp
+qed
+
+lemma distinct_mset_minus[simp]: "distinct_mset A \<Longrightarrow> distinct_mset (A - B)"
+  by (metis diff_subset_eq_self mset_subset_eq_exists_conv distinct_mset_union)
+
+lemma distinct_mset_rempdups_union_mset:
+  assumes "distinct_mset A" and "distinct_mset B"
+  shows "A \<union># B = remdups_mset (A + B)"
+  using assms nat_le_linear unfolding remdups_mset_def
+  by (force simp add: multiset_eq_iff max_def count_mset_set_if distinct_mset_def not_in_iff)
+
+lemma distinct_mset_add_mset[simp]: "distinct_mset (add_mset a L) \<longleftrightarrow> a \<notin># L \<and> distinct_mset L"
+  unfolding distinct_mset_def
+  apply (rule iffI)
+   apply (auto split: if_split_asm; fail)[]
+  by (auto simp: not_in_iff; fail)
+
+lemma distinct_mset_size_eq_card: "distinct_mset C \<Longrightarrow> size C = card (set_mset C)"
+  by (induction C) auto
+
+lemma distinct_mset_add:
+  "distinct_mset (L + L') \<longleftrightarrow> distinct_mset L \<and> distinct_mset L' \<and> L \<inter># L' = {#}"
+  by (induction L arbitrary: L') auto
+
+lemma distinct_mset_set_mset_ident[simp]: "distinct_mset M \<Longrightarrow> mset_set (set_mset M) = M"
+  by (induction M) auto
+
+lemma distinct_finite_set_mset_subseteq_iff[iff]:
+  assumes "distinct_mset M" "finite N"
+  shows "set_mset M \<subseteq> N \<longleftrightarrow> M \<subseteq># mset_set N"
+  by (metis assms distinct_mset_set_mset_ident finite_set_mset msubset_mset_set_iff)
+
+lemma distinct_mem_diff_mset:
+  assumes dist: "distinct_mset M" and mem: "x \<in> set_mset (M - N)"
+  shows "x \<notin> set_mset N"
+proof -
+  have "count M x = 1"
+    using dist mem by (meson distinct_mset_def in_diffD)
+  then show ?thesis
+    using mem by (metis count_greater_eq_one_iff in_diff_count not_less)
+qed
+
+lemma distinct_set_mset_eq:
+  assumes "distinct_mset M" "distinct_mset N" "set_mset M = set_mset N"
+  shows "M = N"
+  using assms distinct_mset_set_mset_ident by fastforce
+
+lemma distinct_mset_union_mset[simp]:
+  \<open>distinct_mset (D \<union># C) \<longleftrightarrow> distinct_mset D \<and> distinct_mset C\<close>
+  unfolding distinct_mset_count_less_1 by force
+
+lemma distinct_mset_inter_mset:
+  "distinct_mset C \<Longrightarrow> distinct_mset (C \<inter># D)"
+  "distinct_mset D \<Longrightarrow> distinct_mset (C \<inter># D)"
+  by (auto simp add: distinct_mset_def min_def count_eq_zero_iff elim!: le_SucE)
+
+lemma distinct_mset_remove1_All: "distinct_mset C \<Longrightarrow> remove1_mset L C = removeAll_mset L C"
+  by (auto simp: multiset_eq_iff distinct_mset_count_less_1)
+
+lemma distinct_mset_size_2: "distinct_mset {#a, b#} \<longleftrightarrow> a \<noteq> b"
+  by auto
+
+lemma distinct_mset_filter: "distinct_mset M \<Longrightarrow> distinct_mset {# L \<in># M. P L#}"
+  by (simp add: distinct_mset_def)
+
+lemma distinct_mset_mset_distinct[simp]: \<open>distinct_mset (mset xs) = distinct xs\<close>
+  by (induction xs) auto
+
+lemma distinct_image_mset_inj:
+  \<open>inj_on f (set_mset M) \<Longrightarrow> distinct_mset (image_mset f M) \<longleftrightarrow> distinct_mset M\<close>
+  by (induction M) (auto simp: inj_on_def)
+
 lemma distinct_mset_remdups_mset_id: \<open>distinct_mset C \<Longrightarrow> remdups_mset C = C\<close>
   by (induction C)  auto
 
-lemma notin_add_mset_remdups_mset:
-  \<open>a \<notin># A \<Longrightarrow> add_mset a (remdups_mset A) = remdups_mset (add_mset a A)\<close>
-  by auto
-
 lemma distinct_mset_image_mset:
   \<open>distinct_mset (image_mset f (mset xs)) \<longleftrightarrow> distinct (map f xs)\<close>
   apply (subst mset_map[symmetric])
   apply (subst distinct_mset_mset_distinct)
   ..
 
 lemma distinct_mset_mono: \<open>D' \<subseteq># D \<Longrightarrow> distinct_mset D \<Longrightarrow> distinct_mset D'\<close>
   by (metis distinct_mset_union subset_mset.le_iff_add)
 
 lemma distinct_mset_mono_strict: \<open>D' \<subset># D \<Longrightarrow> distinct_mset D \<Longrightarrow> distinct_mset D'\<close>
   using distinct_mset_mono by auto
 
 lemma distinct_set_mset_eq_iff:
   assumes \<open>distinct_mset M\<close> \<open>distinct_mset N\<close>
   shows \<open>set_mset M = set_mset N \<longleftrightarrow> M = N\<close>
   using assms distinct_mset_set_mset_ident by fastforce
 
 lemma distinct_mset_union2:
   \<open>distinct_mset (A + B) \<Longrightarrow> distinct_mset B\<close>
   using distinct_mset_union[of B A]
   by (auto simp: ac_simps)
 
 lemma distinct_mset_mset_set: \<open>distinct_mset (mset_set A)\<close>
   unfolding distinct_mset_def count_mset_set_if by (auto simp: not_in_iff)
 
 lemma distinct_mset_inter_remdups_mset:
   assumes dist: \<open>distinct_mset A\<close>
   shows \<open>A \<inter># remdups_mset B = A \<inter># B\<close>
 proof -
   have [simp]: \<open>A' \<inter># remove1_mset a (remdups_mset Aa) = A' \<inter># Aa\<close>
     if
       \<open>A' \<inter># remdups_mset Aa = A' \<inter># Aa\<close> and
       \<open>a \<notin># A'\<close> and
       \<open>a \<in># Aa\<close>
     for A' Aa :: \<open>'a multiset\<close> and a
   by (metis insert_DiffM inter_add_right1 set_mset_remdups_mset that)
 
   show ?thesis
     using dist
     apply (induction A)
     subgoal by auto
      subgoal for a A'
        by (cases \<open>a \<in># B\<close>)
          (use multi_member_split[of a \<open>B\<close>]  multi_member_split[of a \<open>A\<close>] in
            \<open>auto simp: mset_set.insert_remove\<close>)
     done
 qed
 
-lemma finite_mset_set_inter:
-  \<open>finite A \<Longrightarrow> finite B \<Longrightarrow> mset_set (A \<inter> B) = mset_set A \<inter># mset_set B\<close>
-  apply (induction A rule: finite_induct)
-  subgoal by auto
-  subgoal for a A
-    by (cases \<open>a \<in> B\<close>; cases \<open>a \<in># mset_set B\<close>)
-      (use multi_member_split[of a \<open>mset_set B\<close>] in
-        \<open>auto simp: mset_set.insert_remove\<close>)
-  done
-
-lemma removeAll_notin: \<open>a \<notin># A \<Longrightarrow> removeAll_mset a A = A\<close>
-  using count_inI by force
-
-lemma same_mset_distinct_iff:
-  \<open>mset M = mset M' \<Longrightarrow> distinct M \<longleftrightarrow> distinct M'\<close>
-  by (auto simp: distinct_mset_mset_distinct[symmetric] simp del: distinct_mset_mset_distinct)
-
+abbreviation (input) is_mset_set :: \<open>'a multiset \<Rightarrow> bool\<close>
+  where \<open>is_mset_set \<equiv> distinct_mset\<close>
 
-subsection \<open>More Lists\<close>
-lemma in_set_conv_iff:
-  \<open>x \<in> set (take n xs) \<longleftrightarrow> (\<exists>i < n. i < length xs \<and> xs ! i = x)\<close>
-  apply (induction n)
-  subgoal by auto
-  subgoal for n
-    apply (cases \<open>Suc n < length xs\<close>)
-    subgoal by (auto simp: take_Suc_conv_app_nth less_Suc_eq dest: in_set_takeD)
-    subgoal
-      apply (cases \<open>n < length xs\<close>)
-      subgoal
-        apply (auto simp: in_set_conv_nth)
-        by (rename_tac i, rule_tac x=i in exI; auto; fail)+
-      subgoal
-        apply (auto simp: take_Suc_conv_app_nth dest: in_set_takeD)
-        by (rename_tac i, rule_tac x=i in exI; auto; fail)+
-      done
-    done
-  done
-
-lemma in_set_take_conv_nth:
-  \<open>x \<in> set (take n xs) \<longleftrightarrow> (\<exists>m<min n (length xs). xs ! m = x)\<close>
-  by (metis in_set_conv_nth length_take min.commute min.strict_boundedE nth_take)
+lemma is_mset_set_def:
+  \<open>is_mset_set X \<longleftrightarrow> (\<forall>x \<in># X. count X x = 1)\<close>
+  by (auto simp add: distinct_mset_def)
 
-lemma in_set_remove1D:
-  \<open>a \<in> set (remove1 x xs) \<Longrightarrow> a \<in> set xs\<close>
-  by (meson notin_set_remove1)
-
+lemma is_mset_setD[dest]: "is_mset_set X \<Longrightarrow> x \<in># X \<Longrightarrow> count X x = 1"
+  unfolding is_mset_set_def by auto
 
-subsection \<open>Generic Multiset\<close>
+lemma is_mset_setI[intro]:
+  assumes "\<And>x. x \<in># X \<Longrightarrow> count X x = 1"
+  shows "is_mset_set X"
+  using assms unfolding is_mset_set_def by auto
 
-lemma mset_drop_upto: \<open>mset (drop a N) = {#N!i. i \<in># mset_set {a..<length N}#}\<close>
-proof (induction N arbitrary: a)
-  case Nil
-  then show ?case by simp
+lemma is_mset_set[simp]: "is_mset_set (mset_set X)"
+  by (fact distinct_mset_mset_set)
+
+lemma is_mset_set_add[simp]:
+  "is_mset_set (X + {#x#}) \<longleftrightarrow> is_mset_set X \<and> x \<notin># X" (is "?L \<longleftrightarrow> ?R")
+proof(intro iffI conjI)
+  assume L: ?L
+  with count_eq_zero_iff count_single show "is_mset_set X"
+    unfolding is_mset_set_def
+    by (metis (no_types, hide_lams) add_mset_add_single count_add_mset nat.inject set_mset_add_mset_insert union_single_eq_member)
+  show "x \<notin># X"
+  proof
+    assume "x \<in># X"
+    then have "count (X + {#x#}) x > 1" by auto
+    with L show False by (auto simp: is_mset_set_def)
+  qed
 next
-  case (Cons c N)
-  have upt: \<open>{0..<Suc (length N)} = insert 0 {1..<Suc (length N)}\<close>
-    by auto
-  then have H: \<open>mset_set {0..<Suc (length N)} = add_mset 0 (mset_set {1..<Suc (length N)})\<close>
-    unfolding upt by auto
-  have mset_case_Suc: \<open>{#case x of 0 \<Rightarrow> c | Suc x \<Rightarrow> N ! x . x \<in># mset_set {Suc a..<Suc b}#} =
-    {#N ! (x-1) . x \<in># mset_set {Suc a..<Suc b}#}\<close> for a b
-    by (rule image_mset_cong) (auto split: nat.splits)
-  have Suc_Suc: \<open>{Suc a..<Suc b} = Suc ` {a..<b}\<close> for a b
-    by auto
-  then have mset_set_Suc_Suc: \<open>mset_set {Suc a..<Suc b} = {#Suc n. n \<in># mset_set {a..<b}#}\<close> for a b
-    unfolding Suc_Suc by (subst image_mset_mset_set[symmetric]) auto
-  have *: \<open>{#N ! (x-Suc 0) . x \<in># mset_set {Suc a..<Suc b}#} = {#N ! x . x \<in># mset_set {a..<b}#}\<close>
-    for a b
-    by (auto simp add: mset_set_Suc_Suc)
-  show ?case
-    apply (cases a)
-    using Cons[of 0] Cons by (auto simp: nth_Cons drop_Cons H mset_case_Suc *)
+  assume R: ?R show ?L
+  proof
+    fix x' assume x': "x' \<in># X + {#x#}"
+    show "count (X + {#x#}) x' = 1"
+    proof(cases "x' \<in># X")
+      case True with R have "count X x' = 1" by auto
+        moreover from True R have "count {#x#} x' = 0" by auto
+        ultimately show ?thesis by auto
+    next
+      case False then have "count X x' = 0" by (simp add: not_in_iff)
+        with R x' show ?thesis by auto
+    qed
+  qed
 qed
 
-
-subsection \<open>Other\<close>
+lemma mset_set_id:
+  assumes "is_mset_set X"
+  shows "mset_set (set_mset X) = X"
+  using assms by (fact distinct_mset_set_mset_ident)
 
-text \<open>I believe this should be added to the simplifier by default...\<close>
-lemma Collect_eq_comp': \<open> {(x, y). P x y} O {(c, a). c = f a} = {(x, a). P x (f a)}\<close>
-  by auto
+lemma is_mset_set_image:
+  assumes "inj_on f (set_mset X)" and "is_mset_set X"
+  shows "is_mset_set (image_mset f X)"
+proof (cases X)
+  case empty then show ?thesis by auto
+next
+  case (add x X)
+    define X' where "X' \<equiv> add_mset x X"
+    with assms add have inj:"inj_on f (set_mset X')"
+          and X': "is_mset_set X'" by auto
+  show ?thesis
+  proof(unfold add, intro is_mset_setI, fold X'_def)
+    fix y assume "y \<in># image_mset f X'"
+    then have "y \<in> f ` set_mset X'" by auto 
+    with inj have "\<exists>!x'. x' \<in># X' \<and> y = f x'" by (meson imageE inj_onD)
+    then obtain x' where x': "{x'. x' \<in># X' \<and> y = f x'} = {x'}" by auto
+    then have "count (image_mset f X') y = count X' x'"
+      by (simp add: count_image_mset')
+    also from X' x' have "... = 1" by auto
+    finally show "count (image_mset f X') y = 1".
+  qed
+qed
 
 end
diff --git a/thys/Nested_Multisets_Ordinals/Multiset_More.thy b/thys/Nested_Multisets_Ordinals/Multiset_More.thy
--- a/thys/Nested_Multisets_Ordinals/Multiset_More.thy
+++ b/thys/Nested_Multisets_Ordinals/Multiset_More.thy
@@ -1,1025 +1,979 @@
 (*  Title:       More about Multisets
     Author:      Mathias Fleury <mathias.fleury at mpi-inf.mpg.de>, 2015
     Author:      Jasmin Blanchette <blanchette at in.tum.de>, 2014, 2015
     Author:      Anders Schlichtkrull <andschl at dtu.dk>, 2017
     Author:      Dmitriy Traytel <traytel at in.tum.de>, 2014
     Maintainer:  Mathias Fleury <mathias.fleury at mpi-inf.mpg.de>
 *)
 
 section \<open>More about Multisets\<close>
 
 theory Multiset_More
   imports
     "HOL-Library.Multiset_Order"
     "HOL-Library.Sublist"
 begin
 
 text \<open>
 Isabelle's theory of finite multisets is not as developed as other areas, such as lists and sets.
 The present theory introduces some missing concepts and lemmas. Some of it is expected to move to
 Isabelle's library.
 \<close>
 
 
 subsection \<open>Basic Setup\<close>
 
 declare
   diff_single_trivial [simp]
   in_image_mset [iff]
   image_mset.compositionality [simp]
 
   (*To have the same rules as the set counter-part*)
   mset_subset_eqD[dest, intro?] (*@{thm subsetD}*)
 
   Multiset.in_multiset_in_set[simp]
   inter_add_left1[simp]
   inter_add_left2[simp]
   inter_add_right1[simp]
   inter_add_right2[simp]
 
   sum_mset_sum_list[simp]
 
 
 subsection \<open>Lemmas about Intersection, Union and Pointwise Inclusion\<close>
 
 lemma subset_mset_imp_subset_add_mset: "A \<subseteq># B \<Longrightarrow> A \<subseteq># add_mset x B"
   by (auto simp add: subseteq_mset_def le_SucI)
 
 lemma subset_add_mset_notin_subset_mset: \<open>A \<subseteq># add_mset b B \<Longrightarrow> b \<notin># A \<Longrightarrow> A \<subseteq># B\<close>
   by (simp add: subset_mset.le_iff_sup)
 
 lemma subset_msetE: "\<lbrakk>A \<subset># B; \<lbrakk>A \<subseteq># B; \<not> B \<subseteq># A\<rbrakk> \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
   by (simp add: subset_mset.less_le_not_le)
 
 lemma Diff_triv_mset: "M \<inter># N = {#} \<Longrightarrow> M - N = M"
   by (metis diff_intersect_left_idem diff_zero)
 
 lemma diff_intersect_sym_diff: "(A - B) \<inter># (B - A) = {#}"
   by (rule multiset_eqI) simp
 
 declare subset_msetE [elim!]
 
 lemma subseq_mset_subseteq_mset: "subseq xs ys \<Longrightarrow> mset xs \<subseteq># mset ys"
 proof (induct xs arbitrary: ys)
   case (Cons x xs)
   note Outer_Cons = this
   then show ?case
   proof (induct ys)
     case (Cons y ys)
     have "subseq xs ys"
       by (metis Cons.prems(2) subseq_Cons' subseq_Cons2_iff)
     then show ?case
       using Cons by (metis mset.simps(2) mset_subset_eq_add_mset_cancel subseq_Cons2_iff
           subset_mset_imp_subset_add_mset)
   qed simp
 qed simp
 
+lemma finite_mset_set_inter:
+  \<open>finite A \<Longrightarrow> finite B \<Longrightarrow> mset_set (A \<inter> B) = mset_set A \<inter># mset_set B\<close>
+  apply (induction A rule: finite_induct)
+  subgoal by auto
+  subgoal for a A
+    by (cases \<open>a \<in> B\<close>; cases \<open>a \<in># mset_set B\<close>)
+      (use multi_member_split[of a \<open>mset_set B\<close>] in
+        \<open>auto simp: mset_set.insert_remove\<close>)
+  done
+
 
 subsection \<open>Lemmas about Filter and Image\<close>
 
 lemma count_image_mset_ge_count: "count (image_mset f A) (f b) \<ge> count A b"
   by (induction A) auto
 
 lemma count_image_mset_inj:
   assumes \<open>inj f\<close>
   shows \<open>count (image_mset f M) (f x) = count M x\<close>
   by (induct M) (use assms in \<open>auto simp: inj_on_def\<close>)
 
 lemma count_image_mset_le_count_inj_on:
   "inj_on f (set_mset M) \<Longrightarrow> count (image_mset f M) y \<le> count M (inv_into (set_mset M) f y)"
 proof (induct M)
   case (add x M)
   note ih = this(1) and inj_xM = this(2)
 
   have inj_M: "inj_on f (set_mset M)"
     using inj_xM by simp
 
   show ?case
   proof (cases "x \<in># M")
     case x_in_M: True
     show ?thesis
     proof (cases "y = f x")
       case y_eq_fx: True
       show ?thesis
         using x_in_M ih[OF inj_M] unfolding y_eq_fx by (simp add: inj_M insert_absorb)
     next
       case y_ne_fx: False
       show ?thesis
         using x_in_M ih[OF inj_M] y_ne_fx insert_absorb by fastforce
     qed
   next
     case x_ni_M: False
     show ?thesis
     proof (cases "y = f x")
       case y_eq_fx: True
       have "f x \<notin># image_mset f M"
         using x_ni_M inj_xM by force
       thus ?thesis
         unfolding y_eq_fx
         by (metis (no_types) inj_xM count_add_mset count_greater_eq_Suc_zero_iff count_inI
           image_mset_add_mset inv_into_f_f union_single_eq_member)
     next
       case y_ne_fx: False
       show ?thesis
       proof (rule ccontr)
         assume neg_conj: "\<not> count (image_mset f (add_mset x M)) y
           \<le> count (add_mset x M) (inv_into (set_mset (add_mset x M)) f y)"
 
         have cnt_y: "count (add_mset (f x) (image_mset f M)) y = count (image_mset f M) y"
           using y_ne_fx by simp
 
         have "inv_into (set_mset M) f y \<in># add_mset x M \<Longrightarrow>
           inv_into (set_mset (add_mset x M)) f (f (inv_into (set_mset M) f y)) =
           inv_into (set_mset M) f y"
           by (meson inj_xM inv_into_f_f)
         hence "0 < count (image_mset f (add_mset x M)) y \<Longrightarrow>
           count M (inv_into (set_mset M) f y) = 0 \<or> x = inv_into (set_mset M) f y"
           using neg_conj cnt_y ih[OF inj_M]
           by (metis (no_types) count_add_mset count_greater_zero_iff count_inI f_inv_into_f
             image_mset_add_mset set_image_mset)
         thus False
           using neg_conj cnt_y x_ni_M ih[OF inj_M]
           by (metis (no_types) count_greater_zero_iff count_inI eq_iff image_mset_add_mset
             less_imp_le)
       qed
     qed
   qed
 qed simp
 
 lemma mset_filter_compl: "mset (filter p xs) + mset (filter (Not \<circ> p) xs) = mset xs"
   by (induction xs) (auto simp: ac_simps)
 
 text \<open>Near duplicate of @{thm [source] filter_eq_replicate_mset}: @{thm filter_eq_replicate_mset}.\<close>
 
 lemma filter_mset_eq: "filter_mset ((=) L) A = replicate_mset (count A L) L"
   by (auto simp: multiset_eq_iff)
 
 lemma filter_mset_cong[fundef_cong]:
   assumes "M = M'" "\<And>a. a \<in># M \<Longrightarrow> P a = Q a"
   shows "filter_mset P M = filter_mset Q M"
 proof -
   have "M - filter_mset Q M = filter_mset (\<lambda>a. \<not>Q a) M"
     by (metis multiset_partition add_diff_cancel_left')
   then show ?thesis
     by (auto simp: filter_mset_eq_conv assms)
 qed
 
 lemma image_mset_filter_swap: "image_mset f {# x \<in># M. P (f x)#} = {# x \<in># image_mset f M. P x#}"
   by (induction M) auto
 
 lemma image_mset_cong2:
   "(\<And>x. x \<in># M \<Longrightarrow> f x = g x) \<Longrightarrow> M = N \<Longrightarrow> image_mset f M = image_mset g N"
   by (hypsubst, rule image_mset_cong)
 
 lemma filter_mset_empty_conv: \<open>(filter_mset P M = {#}) = (\<forall>L\<in>#M. \<not> P L)\<close>
   by (induction M) auto
 
 lemma multiset_filter_mono2: \<open>filter_mset P A \<subseteq># filter_mset Q A \<longleftrightarrow> (\<forall>a\<in>#A. P a \<longrightarrow> Q a)\<close>
   by (induction A) (auto intro: subset_mset.trans)
 
 lemma image_filter_cong:
   assumes \<open>\<And>C. C \<in># M \<Longrightarrow> P C \<Longrightarrow> f C = g C\<close>
   shows \<open>{#f C. C \<in># {#C \<in># M. P C#}#} = {#g C | C\<in># M. P C#}\<close>
   using assms by (induction M) auto
 
 lemma image_mset_filter_swap2: \<open>{#C \<in># {#P x. x \<in># D#}. Q C #} = {#P x. x \<in># {#C| C \<in># D. Q (P C)#}#}\<close>
   by (simp add: image_mset_filter_swap)
 
 declare image_mset_cong2 [cong]
 
 lemma filter_mset_empty_if_finite_and_filter_set_empty:
   assumes
     "{x \<in> X. P x} = {}" and
     "finite X"
   shows "{#x \<in># mset_set X. P x#} = {#}"
 proof -
   have empty_empty: "\<And>Y. set_mset Y = {} \<Longrightarrow> Y = {#}"
     by auto
   from assms have "set_mset {#x \<in># mset_set X. P x#} = {}"
     by auto
   then show ?thesis
     by (rule empty_empty)
 qed
 
 
 subsection \<open>Lemmas about Sum\<close>
 
 lemma sum_image_mset_sum_map[simp]: "sum_mset (image_mset f (mset xs)) = sum_list (map f xs)"
   by (metis mset_map sum_mset_sum_list)
 
 lemma sum_image_mset_mono:
   fixes f :: "'a \<Rightarrow> 'b::canonically_ordered_monoid_add"
   assumes sub: "A \<subseteq># B"
   shows "(\<Sum>m \<in># A. f m) \<le> (\<Sum>m \<in># B. f m)"
   by (metis image_mset_union le_iff_add sub subset_mset.add_diff_inverse sum_mset.union)
 
 lemma sum_image_mset_mono_mem:
   "n \<in># M \<Longrightarrow> f n \<le> (\<Sum>m \<in># M. f m)" for f :: "'a \<Rightarrow> 'b::canonically_ordered_monoid_add"
   using le_iff_add multi_member_split by fastforce
 
 lemma count_sum_mset_if_1_0: \<open>count M a = (\<Sum>x\<in>#M. if x = a then 1 else 0)\<close>
   by (induction M) auto
 
 lemma sum_mset_dvd:
   fixes k :: "'a::comm_semiring_1_cancel"
   assumes "\<forall>m \<in># M. k dvd f m"
   shows "k dvd (\<Sum>m \<in># M. f m)"
   using assms by (induct M) auto
 
 lemma sum_mset_distrib_div_if_dvd:
   fixes k :: "'a::unique_euclidean_semiring"
   assumes "\<forall>m \<in># M. k dvd f m"
   shows "(\<Sum>m \<in># M. f m) div k = (\<Sum>m \<in># M. f m div k)"
   using assms by (induct M) (auto simp: div_plus_div_distrib_dvd_left)
 
 
 subsection \<open>Lemmas about Remove\<close>
 
 lemma set_mset_minus_replicate_mset[simp]:
   "n \<ge> count A a \<Longrightarrow> set_mset (A - replicate_mset n a) = set_mset A - {a}"
   "n < count A a \<Longrightarrow> set_mset (A - replicate_mset n a) = set_mset A"
   unfolding set_mset_def by (auto split: if_split simp: not_in_iff)
 
 abbreviation removeAll_mset :: "'a \<Rightarrow> 'a multiset \<Rightarrow> 'a multiset" where
   "removeAll_mset C M \<equiv> M - replicate_mset (count M C) C"
 
 lemma mset_removeAll[simp, code]: "removeAll_mset C (mset L) = mset (removeAll C L)"
   by (induction L) (auto simp: ac_simps multiset_eq_iff split: if_split_asm)
 
 lemma removeAll_mset_filter_mset: "removeAll_mset C M = filter_mset ((\<noteq>) C) M"
   by (induction M) (auto simp: ac_simps multiset_eq_iff)
 
 abbreviation remove1_mset :: "'a \<Rightarrow> 'a multiset \<Rightarrow> 'a multiset" where
   "remove1_mset C M \<equiv> M - {#C#}"
 
 lemma removeAll_subseteq_remove1_mset: "removeAll_mset x M \<subseteq># remove1_mset x M"
   by (auto simp: subseteq_mset_def)
 
 lemma in_remove1_mset_neq:
   assumes ab: "a \<noteq> b"
   shows "a \<in># remove1_mset b C \<longleftrightarrow> a \<in># C"
   by (metis assms diff_single_trivial in_diffD insert_DiffM insert_noteq_member)
 
 lemma size_mset_removeAll_mset_le_iff: "size (removeAll_mset x M) < size M \<longleftrightarrow> x \<in># M"
   by (auto intro: count_inI mset_subset_size simp: subset_mset_def multiset_eq_iff)
 
 lemma size_remove1_mset_If: \<open>size (remove1_mset x M) = size M - (if x \<in># M then 1 else 0)\<close>
   by (auto simp: size_Diff_subset_Int)
 
 lemma size_mset_remove1_mset_le_iff: "size (remove1_mset x M) < size M \<longleftrightarrow> x \<in># M"
   using less_irrefl
   by (fastforce intro!: mset_subset_size elim: in_countE simp: subset_mset_def multiset_eq_iff)
 
 lemma remove_1_mset_id_iff_notin: "remove1_mset a M = M \<longleftrightarrow> a \<notin># M"
   by (meson diff_single_trivial multi_drop_mem_not_eq)
 
 lemma id_remove_1_mset_iff_notin: "M = remove1_mset a M \<longleftrightarrow> a \<notin># M"
   using remove_1_mset_id_iff_notin by metis
 
 lemma remove1_mset_eqE:
   "remove1_mset L x1 = M \<Longrightarrow>
     (L \<in># x1 \<Longrightarrow> x1 = M + {#L#} \<Longrightarrow> P) \<Longrightarrow>
     (L \<notin># x1 \<Longrightarrow> x1 = M \<Longrightarrow> P) \<Longrightarrow>
   P"
   by (cases "L \<in># x1") auto
 
 lemma image_filter_ne_mset[simp]:
   "image_mset f {#x \<in># M. f x \<noteq> y#} = removeAll_mset y (image_mset f M)"
   by (induction M) simp_all
 
 lemma image_mset_remove1_mset_if:
   "image_mset f (remove1_mset a M) =
    (if a \<in># M then remove1_mset (f a) (image_mset f M) else image_mset f M)"
   by (auto simp: image_mset_Diff)
 
 lemma filter_mset_neq: "{#x \<in># M. x \<noteq> y#} = removeAll_mset y M"
   by (metis add_diff_cancel_left' filter_eq_replicate_mset multiset_partition)
 
 lemma filter_mset_neq_cond: "{#x \<in># M. P x \<and> x \<noteq> y#} = removeAll_mset y {# x\<in>#M. P x#}"
   by (metis filter_filter_mset filter_mset_neq)
 
 lemma remove1_mset_add_mset_If:
   "remove1_mset L (add_mset L' C) = (if L = L' then C else remove1_mset L C + {#L'#})"
   by (auto simp: multiset_eq_iff)
 
 lemma minus_remove1_mset_if:
   "A - remove1_mset b B = (if b \<in># B \<and> b \<in># A \<and> count A b \<ge> count B b then {#b#} + (A - B) else A - B)"
   by (auto simp: multiset_eq_iff count_greater_zero_iff[symmetric]
     simp del: count_greater_zero_iff)
 
 lemma add_mset_eq_add_mset_ne:
   "a \<noteq> b \<Longrightarrow> add_mset a A = add_mset b B \<longleftrightarrow> a \<in># B \<and> b \<in># A \<and> A = add_mset b (B - {#a#})"
   by (metis (no_types, lifting) diff_single_eq_union diff_union_swap multi_self_add_other_not_self
     remove_1_mset_id_iff_notin union_single_eq_diff)
 
 lemma add_mset_eq_add_mset: \<open>add_mset a M = add_mset b M' \<longleftrightarrow>
   (a = b \<and> M = M') \<or> (a \<noteq> b \<and> b \<in># M \<and> add_mset a (M - {#b#}) = M')\<close>
   by (metis add_mset_eq_add_mset_ne add_mset_remove_trivial union_single_eq_member)
 
 (* TODO move to Multiset: could replace add_mset_remove_trivial_eq? *)
 lemma add_mset_remove_trivial_iff: \<open>N = add_mset a (N - {#b#}) \<longleftrightarrow> a \<in># N \<and> a = b\<close>
   by (metis add_left_cancel add_mset_remove_trivial insert_DiffM2 single_eq_single
       size_mset_remove1_mset_le_iff union_single_eq_member)
 
 lemma trivial_add_mset_remove_iff: \<open>add_mset a (N - {#b#}) = N \<longleftrightarrow> a \<in># N \<and> a = b\<close>
   by (subst eq_commute) (fact add_mset_remove_trivial_iff)
 
 lemma remove1_single_empty_iff[simp]: \<open>remove1_mset L {#L'#} = {#} \<longleftrightarrow> L = L'\<close>
   using add_mset_remove_trivial_iff by fastforce
 
 lemma add_mset_less_imp_less_remove1_mset:
   assumes xM_lt_N: "add_mset x M < N"
   shows "M < remove1_mset x N"
 proof -
   have "M < N"
     using assms le_multiset_right_total mset_le_trans by blast
   then show ?thesis
     by (metis add_less_cancel_right add_mset_add_single diff_single_trivial insert_DiffM2 xM_lt_N)
 qed
 
+lemma remove_diff_multiset[simp]: \<open>x13 \<notin># A \<Longrightarrow> A - add_mset x13 B = A - B\<close>
+  by (metis diff_intersect_left_idem inter_add_right1)
+
+lemma removeAll_notin: \<open>a \<notin># A \<Longrightarrow> removeAll_mset a A = A\<close>
+  using count_inI by force
+
+lemma mset_drop_upto: \<open>mset (drop a N) = {#N!i. i \<in># mset_set {a..<length N}#}\<close>
+proof (induction N arbitrary: a)
+  case Nil
+  then show ?case by simp
+next
+  case (Cons c N)
+  have upt: \<open>{0..<Suc (length N)} = insert 0 {1..<Suc (length N)}\<close>
+    by auto
+  then have H: \<open>mset_set {0..<Suc (length N)} = add_mset 0 (mset_set {1..<Suc (length N)})\<close>
+    unfolding upt by auto
+  have mset_case_Suc: \<open>{#case x of 0 \<Rightarrow> c | Suc x \<Rightarrow> N ! x . x \<in># mset_set {Suc a..<Suc b}#} =
+    {#N ! (x-1) . x \<in># mset_set {Suc a..<Suc b}#}\<close> for a b
+    by (rule image_mset_cong) (auto split: nat.splits)
+  have Suc_Suc: \<open>{Suc a..<Suc b} = Suc ` {a..<b}\<close> for a b
+    by auto
+  then have mset_set_Suc_Suc: \<open>mset_set {Suc a..<Suc b} = {#Suc n. n \<in># mset_set {a..<b}#}\<close> for a b
+    unfolding Suc_Suc by (subst image_mset_mset_set[symmetric]) auto
+  have *: \<open>{#N ! (x-Suc 0) . x \<in># mset_set {Suc a..<Suc b}#} = {#N ! x . x \<in># mset_set {a..<b}#}\<close>
+    for a b
+    by (auto simp add: mset_set_Suc_Suc)
+  show ?case
+    apply (cases a)
+    using Cons[of 0] Cons by (auto simp: nth_Cons drop_Cons H mset_case_Suc *)
+qed
+
 
 subsection \<open>Lemmas about Replicate\<close>
 
 lemma replicate_mset_minus_replicate_mset_same[simp]:
   "replicate_mset m x - replicate_mset n x = replicate_mset (m - n) x"
   by (induct m arbitrary: n, simp, metis left_diff_repeat_mset_distrib' repeat_mset_replicate_mset)
 
 lemma replicate_mset_subset_iff_lt[simp]: "replicate_mset m x \<subset># replicate_mset n x \<longleftrightarrow> m < n"
   by (induct n m rule: diff_induct) (auto intro: subset_mset.gr_zeroI)
 
 lemma replicate_mset_subseteq_iff_le[simp]: "replicate_mset m x \<subseteq># replicate_mset n x \<longleftrightarrow> m \<le> n"
   by (induct n m rule: diff_induct) auto
 
 lemma replicate_mset_lt_iff_lt[simp]: "replicate_mset m x < replicate_mset n x \<longleftrightarrow> m < n"
   by (induct n m rule: diff_induct) (auto intro: subset_mset.gr_zeroI gr_zeroI)
 
 lemma replicate_mset_le_iff_le[simp]: "replicate_mset m x \<le> replicate_mset n x \<longleftrightarrow> m \<le> n"
   by (induct n m rule: diff_induct) auto
 
 lemma replicate_mset_eq_iff[simp]:
   "replicate_mset m x = replicate_mset n y \<longleftrightarrow> m = n \<and> (m \<noteq> 0 \<longrightarrow> x = y)"
   by (cases m; cases n; simp)
     (metis in_replicate_mset insert_noteq_member size_replicate_mset union_single_eq_diff)
 
 lemma replicate_mset_plus: "replicate_mset (a + b) C = replicate_mset a C + replicate_mset b C"
   by (induct a) (auto simp: ac_simps)
 
 lemma mset_replicate_replicate_mset: "mset (replicate n L) = replicate_mset n L"
   by (induction n) auto
 
 lemma set_mset_single_iff_replicate_mset: "set_mset U = {a} \<longleftrightarrow> (\<exists>n > 0. U = replicate_mset n a)"
   by (rule, metis count_greater_zero_iff count_replicate_mset insertI1 multi_count_eq singletonD
     zero_less_iff_neq_zero, force)
 
 lemma ex_replicate_mset_if_all_elems_eq:
   assumes "\<forall>x \<in># M. x = y"
   shows "\<exists>n. M = replicate_mset n y"
   using assms by (metis count_replicate_mset mem_Collect_eq multiset_eqI neq0_conv set_mset_def)
 
 
 subsection \<open>Multiset and Set Conversions\<close>
 
 lemma count_mset_set_if: "count (mset_set A) a = (if a \<in> A \<and> finite A then 1 else 0)"
   by auto
 
 lemma mset_set_set_mset_empty_mempty[iff]: "mset_set (set_mset D) = {#} \<longleftrightarrow> D = {#}"
   by (simp add: mset_set_empty_iff)
 
 lemma count_mset_set_le_one: "count (mset_set A) x \<le> 1"
   by (simp add: count_mset_set_if)
 
 lemma mset_set_set_mset_subseteq[simp]: "mset_set (set_mset A) \<subseteq># A"
   by (simp add: mset_set_set_mset_msubset)
 
 lemma mset_sorted_list_of_set[simp]: "mset (sorted_list_of_set A) = mset_set A"
   by (metis mset_sorted_list_of_multiset sorted_list_of_mset_set)
 
 lemma sorted_sorted_list_of_multiset[simp]:
   "sorted (sorted_list_of_multiset (M :: 'a::linorder multiset))"
   by (metis mset_sorted_list_of_multiset sorted_list_of_multiset_mset sorted_sort)
 
 lemma mset_take_subseteq: "mset (take n xs) \<subseteq># mset xs"
   apply (induct xs arbitrary: n)
    apply simp
   by (case_tac n) simp_all
 
 lemma sorted_list_of_multiset_eq_Nil[simp]: "sorted_list_of_multiset M = [] \<longleftrightarrow> M = {#}"
   by (metis mset_sorted_list_of_multiset sorted_list_of_multiset_empty)
 
 
 subsection \<open>Duplicate Removal\<close>
 
 (* TODO: use abbreviation? *)
 definition remdups_mset :: "'v multiset \<Rightarrow> 'v multiset" where
   "remdups_mset S = mset_set (set_mset S)"
 
 lemma set_mset_remdups_mset[simp]: \<open>set_mset (remdups_mset A) = set_mset A\<close>
   unfolding remdups_mset_def by auto
 
 lemma count_remdups_mset_eq_1: "a \<in># remdups_mset A \<longleftrightarrow> count (remdups_mset A) a = 1"
   unfolding remdups_mset_def by (auto simp: count_eq_zero_iff intro: count_inI)
 
 lemma remdups_mset_empty[simp]: "remdups_mset {#} = {#}"
   unfolding remdups_mset_def by auto
 
 lemma remdups_mset_singleton[simp]: "remdups_mset {#a#} = {#a#}"
   unfolding remdups_mset_def by auto
 
 lemma remdups_mset_eq_empty[iff]: "remdups_mset D = {#} \<longleftrightarrow> D = {#}"
   unfolding remdups_mset_def by blast
 
 lemma remdups_mset_singleton_sum[simp]:
   "remdups_mset (add_mset a A) = (if a \<in># A then remdups_mset A else add_mset a (remdups_mset A))"
   unfolding remdups_mset_def by (simp_all add: insert_absorb)
 
 lemma mset_remdups_remdups_mset[simp]: "mset (remdups D) = remdups_mset (mset D)"
   by (induction D) (auto simp add: ac_simps)
 
 declare mset_remdups_remdups_mset[symmetric, code]
 
-definition distinct_mset :: "'a multiset \<Rightarrow> bool" where
-  "distinct_mset S \<longleftrightarrow> (\<forall>a. a \<in># S \<longrightarrow> count S a = 1)"
-
-lemma distinct_mset_count_less_1: "distinct_mset S \<longleftrightarrow> (\<forall>a. count S a \<le> 1)"
-  using eq_iff nat_le_linear unfolding distinct_mset_def by fastforce
-
-lemma distinct_mset_empty[simp]: "distinct_mset {#}"
-  unfolding distinct_mset_def by auto
-
-lemma distinct_mset_singleton: "distinct_mset {#a#}"
-  unfolding distinct_mset_def by auto
-
-lemma distinct_mset_union:
-  assumes dist: "distinct_mset (A + B)"
-  shows "distinct_mset A"
-  unfolding distinct_mset_count_less_1
-proof (rule allI)
-  fix a
-  have \<open>count A a \<le> count (A + B) a\<close> by auto
-  moreover have \<open>count (A + B) a \<le> 1\<close>
-    using dist unfolding distinct_mset_count_less_1 by auto
-  ultimately show \<open>count A a \<le> 1\<close>
-    by simp
-qed
-
-lemma distinct_mset_minus[simp]: "distinct_mset A \<Longrightarrow> distinct_mset (A - B)"
-  by (metis diff_subset_eq_self mset_subset_eq_exists_conv distinct_mset_union)
-
 lemma count_remdups_mset_If: \<open>count (remdups_mset A) a = (if a \<in># A then 1 else 0)\<close>
   unfolding remdups_mset_def by auto
 
-lemma distinct_mset_rempdups_union_mset:
-  assumes "distinct_mset A" and "distinct_mset B"
-  shows "A \<union># B = remdups_mset (A + B)"
-  using assms nat_le_linear unfolding remdups_mset_def
-  by (force simp add: multiset_eq_iff max_def count_mset_set_if distinct_mset_def not_in_iff)
-
-lemma distinct_mset_add_mset[simp]: "distinct_mset (add_mset a L) \<longleftrightarrow> a \<notin># L \<and> distinct_mset L"
-  unfolding distinct_mset_def
-  apply (rule iffI)
-   apply (auto split: if_split_asm; fail)[]
-  by (auto simp: not_in_iff; fail)
-
-lemma distinct_mset_size_eq_card: "distinct_mset C \<Longrightarrow> size C = card (set_mset C)"
-  by (induction C) auto
-
-lemma distinct_mset_add:
-  "distinct_mset (L + L') \<longleftrightarrow> distinct_mset L \<and> distinct_mset L' \<and> L \<inter># L' = {#}"
-  by (induction L arbitrary: L') auto
-
-lemma distinct_mset_set_mset_ident[simp]: "distinct_mset M \<Longrightarrow> mset_set (set_mset M) = M"
-  by (induction M) auto
-
-lemma distinct_finite_set_mset_subseteq_iff[iff]:
-  assumes "distinct_mset M" "finite N"
-  shows "set_mset M \<subseteq> N \<longleftrightarrow> M \<subseteq># mset_set N"
-  by (metis assms distinct_mset_set_mset_ident finite_set_mset msubset_mset_set_iff)
-
-lemma distinct_mem_diff_mset:
-  assumes dist: "distinct_mset M" and mem: "x \<in> set_mset (M - N)"
-  shows "x \<notin> set_mset N"
-proof -
-  have "count M x = 1"
-    using dist mem by (meson distinct_mset_def in_diffD)
-  then show ?thesis
-    using mem by (metis count_greater_eq_one_iff in_diff_count not_less)
-qed
-
-lemma distinct_set_mset_eq:
-  assumes "distinct_mset M" "distinct_mset N" "set_mset M = set_mset N"
-  shows "M = N"
-  using assms distinct_mset_set_mset_ident by fastforce
-
-lemma distinct_mset_union_mset[simp]:
-  \<open>distinct_mset (D \<union># C) \<longleftrightarrow> distinct_mset D \<and> distinct_mset C\<close>
-  unfolding distinct_mset_count_less_1 by force
-
-lemma distinct_mset_inter_mset:
-  "distinct_mset C \<Longrightarrow> distinct_mset (C \<inter># D)"
-  "distinct_mset D \<Longrightarrow> distinct_mset (C \<inter># D)"
-  by (auto simp add: distinct_mset_def min_def count_eq_zero_iff elim!: le_SucE)
-
-lemma distinct_mset_remove1_All: "distinct_mset C \<Longrightarrow> remove1_mset L C = removeAll_mset L C"
-  by (auto simp: multiset_eq_iff distinct_mset_count_less_1)
-
-lemma distinct_mset_size_2: "distinct_mset {#a, b#} \<longleftrightarrow> a \<noteq> b"
+lemma notin_add_mset_remdups_mset:
+  \<open>a \<notin># A \<Longrightarrow> add_mset a (remdups_mset A) = remdups_mset (add_mset a A)\<close>
   by auto
 
-lemma distinct_mset_filter: "distinct_mset M \<Longrightarrow> distinct_mset {# L \<in># M. P L#}"
-  by (simp add: distinct_mset_def)
-
-lemma distinct_mset_mset_distinct[simp]: \<open>distinct_mset (mset xs) = distinct xs\<close>
-  by (induction xs) auto
-
-lemma distinct_image_mset_inj:
-  \<open>inj_on f (set_mset M) \<Longrightarrow> distinct_mset (image_mset f M) \<longleftrightarrow> distinct_mset M\<close>
-  by (induction M) (auto simp: inj_on_def)
-
 
 subsection \<open>Repeat Operation\<close>
 
 lemma repeat_mset_compower: "repeat_mset n A = (((+) A) ^^ n) {#}"
   by (induction n) auto
 
 lemma repeat_mset_prod: "repeat_mset (m * n) A = (((+) (repeat_mset n A)) ^^ m) {#}"
   by (induction m) (auto simp: repeat_mset_distrib)
 
 
 subsection \<open>Cartesian Product\<close>
 
 text \<open>Definition of the cartesian products over multisets. The construction mimics of the cartesian
   product on sets and use the same theorem names (adding only the suffix \<open>_mset\<close> to Sigma
   and Times). See file @{file \<open>~~/src/HOL/Product_Type.thy\<close>}\<close>
 
 definition Sigma_mset :: "'a multiset \<Rightarrow> ('a \<Rightarrow> 'b multiset) \<Rightarrow> ('a \<times> 'b) multiset" where
   "Sigma_mset A B \<equiv> \<Sum>\<^sub># {#{#(a, b). b \<in># B a#}. a \<in># A #}"
 
 abbreviation Times_mset :: "'a multiset \<Rightarrow> 'b multiset \<Rightarrow> ('a \<times> 'b) multiset" (infixr "\<times>#" 80) where
   "Times_mset A B \<equiv> Sigma_mset A (\<lambda>_. B)"
 
 hide_const (open) Times_mset
 
 text \<open>Contrary to the set version @{term \<open>SIGMA x:A. B\<close>}, we use the non-ASCII symbol \<open>\<in>#\<close>.\<close>
 
 syntax
   "_Sigma_mset" :: "[pttrn, 'a multiset, 'b multiset] => ('a * 'b) multiset"
   ("(3SIGMAMSET _\<in>#_./ _)" [0, 0, 10] 10)
 translations
   "SIGMAMSET x\<in>#A. B" == "CONST Sigma_mset A (\<lambda>x. B)"
 
 text \<open>Link between the multiset and the set cartesian product:\<close>
 
 lemma Times_mset_Times: "set_mset (A \<times># B) = set_mset A \<times> set_mset B"
   unfolding Sigma_mset_def by auto
 
 lemma Sigma_msetI [intro!]: "\<lbrakk>a \<in># A; b \<in># B a\<rbrakk> \<Longrightarrow> (a, b) \<in># Sigma_mset A B"
   by (unfold Sigma_mset_def) auto
 
 lemma Sigma_msetE[elim!]: "\<lbrakk>c \<in># Sigma_mset A B; \<And>x y. \<lbrakk>x \<in># A; y \<in># B x; c = (x, y)\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by (unfold Sigma_mset_def) auto
 
 text \<open>Elimination of @{term "(a, b) \<in># A \<times># B"} -- introduces no eigenvariables.\<close>
 
 lemma Sigma_msetD1: "(a, b) \<in># Sigma_mset A B \<Longrightarrow> a \<in># A"
   by blast
 
 lemma Sigma_msetD2: "(a, b) \<in># Sigma_mset A B \<Longrightarrow> b \<in># B a"
   by blast
 
 lemma Sigma_msetE2: "\<lbrakk>(a, b) \<in># Sigma_mset A B; \<lbrakk>a \<in># A; b \<in># B a\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by blast
 
 lemma Sigma_mset_cong:
   "\<lbrakk>A = B; \<And>x. x \<in># B \<Longrightarrow> C x = D x\<rbrakk> \<Longrightarrow> (SIGMAMSET x \<in># A. C x) = (SIGMAMSET x \<in># B. D x)"
   by (metis (mono_tags, lifting) Sigma_mset_def image_mset_cong)
 
 lemma count_sum_mset: "count (\<Sum>\<^sub># M) b = (\<Sum>P \<in># M. count P b)"
   by (induction M) auto
 
 lemma Sigma_mset_plus_distrib1[simp]: "Sigma_mset (A + B) C = Sigma_mset A C + Sigma_mset B C"
   unfolding Sigma_mset_def by auto
 
 lemma Sigma_mset_plus_distrib2[simp]:
   "Sigma_mset A (\<lambda>i. B i + C i) = Sigma_mset A B + Sigma_mset A C"
   unfolding Sigma_mset_def by (induction A) (auto simp: multiset_eq_iff)
 
 lemma Times_mset_single_left: "{#a#} \<times># B = image_mset (Pair a) B"
   unfolding Sigma_mset_def by auto
 
 lemma Times_mset_single_right: "A \<times># {#b#} = image_mset (\<lambda>a. Pair a b) A"
   unfolding Sigma_mset_def by (induction A) auto
 
 lemma Times_mset_single_single[simp]: "{#a#} \<times># {#b#} = {#(a, b)#}"
   unfolding Sigma_mset_def by simp
 
 lemma count_image_mset_Pair:
   "count (image_mset (Pair a) B) (x, b) = (if x = a then count B b else 0)"
   by (induction B) auto
 
 lemma count_Sigma_mset: "count (Sigma_mset A B) (a, b) = count A a * count (B a) b"
   by (induction A) (auto simp: Sigma_mset_def count_image_mset_Pair)
 
 lemma Sigma_mset_empty1[simp]: "Sigma_mset {#} B = {#}"
   unfolding Sigma_mset_def by auto
 
 lemma Sigma_mset_empty2[simp]: "A \<times># {#} = {#}"
   by (auto simp: multiset_eq_iff count_Sigma_mset)
 
 lemma Sigma_mset_mono:
   assumes "A \<subseteq># C" and "\<And>x. x \<in># A \<Longrightarrow> B x \<subseteq># D x"
   shows "Sigma_mset A B \<subseteq># Sigma_mset C D"
 proof -
   have "count A a * count (B a) b \<le> count C a * count (D a) b" for a b
     using assms unfolding subseteq_mset_def by (metis count_inI eq_iff mult_eq_0_iff mult_le_mono)
   then show ?thesis
     by (auto simp: subseteq_mset_def count_Sigma_mset)
 qed
 
 lemma mem_Sigma_mset_iff[iff]: "((a,b) \<in># Sigma_mset A B) = (a \<in># A \<and> b \<in># B a)"
   by blast
 
 lemma mem_Times_mset_iff: "x \<in># A \<times># B \<longleftrightarrow> fst x \<in># A \<and> snd x \<in># B"
   by (induct x) simp
 
 lemma Sigma_mset_empty_iff: "(SIGMAMSET i\<in>#I. X i) = {#} \<longleftrightarrow> (\<forall>i\<in>#I. X i = {#})"
   by (auto simp: Sigma_mset_def)
 
 lemma Times_mset_subset_mset_cancel1: "x \<in># A \<Longrightarrow> (A \<times># B \<subseteq># A \<times># C) = (B \<subseteq># C)"
   by (auto simp: subseteq_mset_def count_Sigma_mset)
 
 lemma Times_mset_subset_mset_cancel2: "x \<in># C \<Longrightarrow> (A \<times># C \<subseteq># B \<times># C) = (A \<subseteq># B)"
   by (auto simp: subseteq_mset_def count_Sigma_mset)
 
 lemma Times_mset_eq_cancel2: "x \<in># C \<Longrightarrow> (A \<times># C = B \<times># C) = (A = B)"
   by (auto simp: multiset_eq_iff count_Sigma_mset dest!: in_countE)
 
 lemma split_paired_Ball_mset_Sigma_mset[simp]:
   "(\<forall>z\<in>#Sigma_mset A B. P z) \<longleftrightarrow> (\<forall>x\<in>#A. \<forall>y\<in>#B x. P (x, y))"
   by blast
 
 lemma split_paired_Bex_mset_Sigma_mset[simp]:
   "(\<exists>z\<in>#Sigma_mset A B. P z) \<longleftrightarrow> (\<exists>x\<in>#A. \<exists>y\<in>#B x. P (x, y))"
   by blast
 
 lemma sum_mset_if_eq_constant:
   "(\<Sum>x\<in>#M. if a = x then (f x) else 0) = (((+) (f a)) ^^ (count M a)) 0"
   by (induction M) (auto simp: ac_simps)
 
 lemma iterate_op_plus: "(((+) k) ^^ m) 0 = k * m"
   by (induction m) auto
 
 lemma untion_image_mset_Pair_distribute:
   "\<Sum>\<^sub>#{#image_mset (Pair x) (C x). x \<in># J - I#} =
    \<Sum>\<^sub># {#image_mset (Pair x) (C x). x \<in># J#} - \<Sum>\<^sub>#{#image_mset (Pair x) (C x). x \<in># I#}"
   by (auto simp: multiset_eq_iff count_sum_mset count_image_mset_Pair sum_mset_if_eq_constant
     iterate_op_plus diff_mult_distrib2)
 
 lemma Sigma_mset_Un_distrib1: "Sigma_mset (I \<union># J) C = Sigma_mset I C \<union># Sigma_mset J C"
   by (auto simp add: Sigma_mset_def union_mset_def untion_image_mset_Pair_distribute)
 
 lemma Sigma_mset_Un_distrib2: "(SIGMAMSET i\<in>#I. A i \<union># B i) = Sigma_mset I A \<union># Sigma_mset I B"
   by (auto simp: multiset_eq_iff count_sum_mset count_image_mset_Pair sum_mset_if_eq_constant
     Sigma_mset_def diff_mult_distrib2 iterate_op_plus max_def not_in_iff)
 
 lemma Sigma_mset_Int_distrib1: "Sigma_mset (I \<inter># J) C = Sigma_mset I C \<inter># Sigma_mset J C"
   by (auto simp: multiset_eq_iff count_sum_mset count_image_mset_Pair sum_mset_if_eq_constant
     Sigma_mset_def iterate_op_plus min_def not_in_iff)
 
 lemma Sigma_mset_Int_distrib2: "(SIGMAMSET i\<in>#I. A i \<inter># B i) = Sigma_mset I A \<inter># Sigma_mset I B"
   by (auto simp: multiset_eq_iff count_sum_mset count_image_mset_Pair sum_mset_if_eq_constant
     Sigma_mset_def iterate_op_plus min_def not_in_iff)
 
 lemma Sigma_mset_Diff_distrib1: "Sigma_mset (I - J) C = Sigma_mset I C - Sigma_mset J C"
   by (auto simp: multiset_eq_iff count_sum_mset count_image_mset_Pair sum_mset_if_eq_constant
     Sigma_mset_def iterate_op_plus min_def not_in_iff diff_mult_distrib2)
 
 lemma Sigma_mset_Diff_distrib2: "(SIGMAMSET i\<in>#I. A i - B i) = Sigma_mset I A - Sigma_mset I B"
   by (auto simp: multiset_eq_iff count_sum_mset count_image_mset_Pair sum_mset_if_eq_constant
     Sigma_mset_def iterate_op_plus min_def not_in_iff diff_mult_distrib)
 
 lemma Sigma_mset_Union: "Sigma_mset (\<Sum>\<^sub>#X) B = (\<Sum>\<^sub># (image_mset (\<lambda>A. Sigma_mset A B) X))"
   by (auto simp: multiset_eq_iff count_sum_mset count_image_mset_Pair sum_mset_if_eq_constant
     Sigma_mset_def iterate_op_plus min_def not_in_iff sum_mset_distrib_left)
 
 lemma Times_mset_Un_distrib1: "(A \<union># B) \<times># C = A \<times># C \<union># B \<times># C"
   by (fact Sigma_mset_Un_distrib1)
 
 lemma Times_mset_Int_distrib1: "(A \<inter># B) \<times># C = A \<times># C \<inter># B \<times># C"
   by (fact Sigma_mset_Int_distrib1)
 
 lemma Times_mset_Diff_distrib1: "(A - B) \<times># C = A \<times># C - B \<times># C"
   by (fact Sigma_mset_Diff_distrib1)
 
 lemma Times_mset_empty[simp]: "A \<times># B = {#} \<longleftrightarrow> A = {#} \<or> B = {#}"
   by (auto simp: Sigma_mset_empty_iff)
 
 lemma Times_insert_left: "A \<times># add_mset x B = A \<times># B + image_mset (\<lambda>a. Pair a x) A"
   unfolding add_mset_add_single[of x B] Sigma_mset_plus_distrib2
   by (simp add: Times_mset_single_right)
 
 lemma Times_insert_right: "add_mset a A \<times># B = A \<times># B + image_mset (Pair a) B"
   unfolding add_mset_add_single[of a A] Sigma_mset_plus_distrib1
   by (simp add: Times_mset_single_left)
 
 lemma fst_image_mset_times_mset [simp]:
   "image_mset fst (A \<times># B) = (if B = {#} then {#} else repeat_mset (size B) A)"
   by (induct B) (auto simp: Times_mset_single_right ac_simps Times_insert_left)
 
 lemma snd_image_mset_times_mset [simp]:
   "image_mset snd (A \<times># B) = (if A = {#} then {#} else repeat_mset (size A) B)"
   by (induct B) (auto simp add: Times_mset_single_right Times_insert_left image_mset_const_eq)
 
 lemma product_swap_mset: "image_mset prod.swap (A \<times># B) = B \<times># A"
   by (induction A) (auto simp add: Times_mset_single_left Times_mset_single_right
       Times_insert_right Times_insert_left)
 
 context
 begin
 
 qualified definition product_mset :: "'a multiset \<Rightarrow> 'b multiset \<Rightarrow> ('a \<times> 'b) multiset" where
   [code_abbrev]: "product_mset A B = A \<times># B"
 
 lemma member_product_mset: "x \<in># product_mset A B \<longleftrightarrow> x \<in># A \<times># B"
   by (simp add: Multiset_More.product_mset_def)
 
 end
 
 lemma count_Sigma_mset_abs_def: "count (Sigma_mset A B) = (\<lambda>(a, b) \<Rightarrow> count A a * count (B a) b)"
   by (auto simp: fun_eq_iff count_Sigma_mset)
 
 lemma Times_mset_image_mset1: "image_mset f A \<times># B = image_mset (\<lambda>(a, b). (f a, b)) (A \<times># B)"
   by (induct B) (auto simp: Times_insert_left)
 
 lemma Times_mset_image_mset2: "A \<times># image_mset f B = image_mset (\<lambda>(a, b). (a, f b)) (A \<times># B)"
   by (induct A) (auto simp: Times_insert_right)
 
 lemma sum_le_singleton: "A \<subseteq> {x} \<Longrightarrow> sum f A = (if x \<in> A then f x else 0)"
   by (auto simp: subset_singleton_iff elim: finite_subset)
 
 lemma Times_mset_assoc: "(A \<times># B) \<times># C = image_mset (\<lambda>(a, b, c). ((a, b), c)) (A \<times># B \<times># C)"
   by (auto simp: multiset_eq_iff count_Sigma_mset count_image_mset vimage_def Times_mset_Times
       Int_commute count_eq_zero_iff intro!: trans[OF _ sym[OF sum_le_singleton[of _ "(_, _, _)"]]]
       cong: sum.cong if_cong)
 
 
 subsection \<open>Transfer Rules\<close>
 
 lemma plus_multiset_transfer[transfer_rule]:
   "(rel_fun (rel_mset R) (rel_fun (rel_mset R) (rel_mset R))) (+) (+)"
   by (unfold rel_fun_def rel_mset_def)
     (force dest: list_all2_appendI intro: exI[of _ "_ @ _"] conjI[rotated])
 
 lemma minus_multiset_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique R"
   shows "(rel_fun (rel_mset R) (rel_fun (rel_mset R) (rel_mset R))) (-) (-)"
 proof (unfold rel_fun_def rel_mset_def, safe)
   fix xs ys xs' ys'
   assume [transfer_rule]: "list_all2 R xs ys" "list_all2 R xs' ys'"
   have "list_all2 R (fold remove1 xs' xs) (fold remove1 ys' ys)"
     by transfer_prover
   moreover have "mset (fold remove1 xs' xs) = mset xs - mset xs'"
     by (induct xs' arbitrary: xs) auto
   moreover have "mset (fold remove1 ys' ys) = mset ys - mset ys'"
     by (induct ys' arbitrary: ys) auto
   ultimately show "\<exists>xs'' ys''.
     mset xs'' = mset xs - mset xs' \<and> mset ys'' = mset ys - mset ys' \<and> list_all2 R xs'' ys''"
     by blast
 qed
 
 declare rel_mset_Zero[transfer_rule]
 
 lemma count_transfer[transfer_rule]:
   assumes "bi_unique R"
   shows "(rel_fun (rel_mset R) (rel_fun R (=))) count count"
 unfolding rel_fun_def rel_mset_def proof safe
   fix x y xs ys
   assume "list_all2 R xs ys" "R x y"
   then show "count (mset xs) x = count (mset ys) y"
   proof (induct xs ys rule: list.rel_induct)
     case (Cons x' xs y' ys)
     then show ?case
       using assms unfolding bi_unique_alt_def2 by (auto simp: rel_fun_def)
   qed simp
 qed
 
 lemma subseteq_multiset_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique R" "right_total R"
   shows "(rel_fun (rel_mset R) (rel_fun (rel_mset R) (=)))
     (\<lambda>M N. filter_mset (Domainp R) M \<subseteq># filter_mset (Domainp R) N) (\<subseteq>#)"
 proof -
   have count_filter_mset_less:
     "(\<forall>a. count (filter_mset (Domainp R) M) a \<le> count (filter_mset (Domainp R) N) a) \<longleftrightarrow>
      (\<forall>a \<in> {x. Domainp R x}. count M a \<le> count N a)" for M and N by auto
   show ?thesis unfolding subseteq_mset_def count_filter_mset_less
     by transfer_prover
 qed
 
 lemma sum_mset_transfer[transfer_rule]:
   "R 0 0 \<Longrightarrow> rel_fun R (rel_fun R R) (+) (+) \<Longrightarrow> (rel_fun (rel_mset R) R) sum_mset sum_mset"
   using sum_list_transfer[of R] unfolding rel_fun_def rel_mset_def by auto
 
 lemma Sigma_mset_transfer[transfer_rule]:
   "(rel_fun (rel_mset R) (rel_fun (rel_fun R (rel_mset S)) (rel_mset (rel_prod R S))))
      Sigma_mset Sigma_mset"
   by (unfold Sigma_mset_def) transfer_prover
 
 
 subsection \<open>Even More about Multisets\<close>
 
 subsubsection \<open>Multisets and Functions\<close>
 
 lemma range_image_mset:
   assumes "set_mset Ds \<subseteq> range f"
   shows "Ds \<in> range (image_mset f)"
 proof -
   have "\<forall>D. D \<in># Ds \<longrightarrow> (\<exists>C. f C = D)"
     using assms by blast
   then obtain f_i where
     f_p: "\<forall>D. D \<in># Ds \<longrightarrow> (f (f_i D) = D)"
     by metis
   define Cs where
     "Cs \<equiv> image_mset f_i Ds"
   from f_p Cs_def have "image_mset f Cs = Ds"
     by auto
   then show ?thesis
     by blast
 qed
 
 
 subsubsection \<open>Multisets and Lists\<close>
 
 lemma length_sorted_list_of_multiset[simp]: "length (sorted_list_of_multiset A) = size A"
   by (metis mset_sorted_list_of_multiset size_mset)
 
 definition list_of_mset :: "'a multiset \<Rightarrow> 'a list" where
   "list_of_mset m = (SOME l. m = mset l)"
 
 lemma list_of_mset_exi: "\<exists>l. m = mset l"
   using ex_mset by metis
 
 lemma mset_list_of_mset[simp]: "mset (list_of_mset m) = m"
   by (metis (mono_tags, lifting) ex_mset list_of_mset_def someI_ex)
 
 lemma length_list_of_mset[simp]: "length (list_of_mset A) = size A"
   unfolding list_of_mset_def by (metis (mono_tags) ex_mset size_mset someI_ex)
 
 lemma range_mset_map:
   assumes "set_mset Ds \<subseteq> range f"
   shows "Ds \<in> range (\<lambda>Cl. mset (map f Cl))"
 proof -
   have "Ds \<in> range (image_mset f)"
     by (simp add: assms range_image_mset)
   then obtain Cs where Cs_p: "image_mset f Cs = Ds"
     by auto
   define Cl where "Cl = list_of_mset Cs"
   then have "mset Cl = Cs"
     by auto
   then have "image_mset f (mset Cl) = Ds"
     using Cs_p by auto
   then have "mset (map f Cl) = Ds"
     by auto
   then show ?thesis
     by auto
 qed
 
 lemma list_of_mset_empty[iff]: "list_of_mset m = [] \<longleftrightarrow> m = {#}"
   by (metis (mono_tags, lifting) ex_mset list_of_mset_def mset_zero_iff_right someI_ex)
 
 lemma in_mset_conv_nth: "(x \<in># mset xs) = (\<exists>i<length xs. xs ! i = x)"
   by (auto simp: in_set_conv_nth)
 
 lemma in_mset_sum_list:
   assumes "L \<in># LL"
   assumes "LL \<in> set Ci"
   shows "L \<in># sum_list Ci"
   using assms by (induction Ci) auto
 
 lemma in_mset_sum_list2:
   assumes "L \<in># sum_list Ci"
   obtains LL where
     "LL \<in> set Ci"
     "L \<in># LL"
   using assms by (induction Ci) auto
 
 (* TODO: Make [simp]. *)
 lemma in_mset_sum_list_iff: "a \<in># sum_list \<A> \<longleftrightarrow> (\<exists>A \<in> set \<A>. a \<in># A)"
   by (metis in_mset_sum_list in_mset_sum_list2)
 
 lemma subseteq_list_Union_mset:
   assumes "length Ci = n"
   assumes "length CAi = n"
   assumes "\<forall>i<n.  Ci ! i \<subseteq># CAi ! i "
   shows "\<Sum>\<^sub># (mset Ci) \<subseteq># \<Sum>\<^sub># (mset CAi)"
   using assms proof (induction n arbitrary: Ci CAi)
   case 0
   then show ?case by auto
 next
   case (Suc n)
   from Suc have "\<forall>i<n. tl Ci ! i \<subseteq># tl CAi ! i"
     by (simp add: nth_tl)
   hence "\<Sum>\<^sub>#(mset (tl Ci)) \<subseteq># \<Sum>\<^sub>#(mset (tl CAi))" using Suc by auto
   moreover
   have "hd Ci \<subseteq># hd CAi" using Suc
     by (metis hd_conv_nth length_greater_0_conv zero_less_Suc)
   ultimately
   show "\<Sum>\<^sub>#(mset Ci) \<subseteq># \<Sum>\<^sub>#(mset CAi)"
     using Suc by (cases Ci; cases CAi) (auto intro: subset_mset.add_mono)
 qed
 
+lemma same_mset_distinct_iff:
+  \<open>mset M = mset M' \<Longrightarrow> distinct M \<longleftrightarrow> distinct M'\<close>
+  by (fact mset_eq_imp_distinct_iff)
+
 
 subsubsection \<open>More on Multisets and Functions\<close>
 
 lemma subseteq_mset_size_eql: "X \<subseteq># Y \<Longrightarrow> size Y = size X \<Longrightarrow> X = Y"
   using mset_subset_size subset_mset_def by fastforce
 
 lemma image_mset_of_subset_list:
   assumes "image_mset \<eta> C' = mset lC"
   shows "\<exists>qC'. map \<eta> qC' = lC \<and> mset qC' = C'"
   using assms apply (induction lC arbitrary: C')
   subgoal by simp
   subgoal by (fastforce dest!: msed_map_invR intro: exI[of _ \<open>_ # _\<close>])
   done
 
 lemma image_mset_of_subset:
   assumes "A \<subseteq># image_mset \<eta> C'"
   shows "\<exists>A'. image_mset \<eta> A' = A \<and> A' \<subseteq># C'"
 proof -
   define C where "C = image_mset \<eta> C'"
 
   define lA where "lA = list_of_mset A"
   define lD where "lD = list_of_mset (C-A)"
   define lC where "lC = lA @ lD"
 
   have "mset lC = C"
     using C_def assms unfolding lD_def lC_def lA_def by auto
   then have "\<exists>qC'. map \<eta> qC' = lC \<and> mset qC' = C'"
     using assms image_mset_of_subset_list unfolding C_def by metis
   then obtain qC' where qC'_p: "map \<eta> qC' = lC \<and> mset qC' = C'"
     by auto
   let ?lA' = "take (length lA) qC'"
   have m: "map \<eta> ?lA' = lA"
     using qC'_p lC_def
     by (metis append_eq_conv_conj take_map)
   let ?A' = "mset ?lA'"
 
   have "image_mset \<eta> ?A' = A"
     using m using lA_def
     by (metis (full_types) ex_mset list_of_mset_def mset_map someI_ex)
   moreover have "?A' \<subseteq># C'"
     using qC'_p unfolding lA_def
     using mset_take_subseteq by blast
   ultimately show ?thesis by blast
 qed
 
 lemma all_the_same: "\<forall>x \<in># X. x = y \<Longrightarrow> card (set_mset X) \<le> Suc 0"
   by (metis card.empty card.insert card_mono finite.intros(1) finite_insert le_SucI singletonI subsetI)
 
 lemma Melem_subseteq_Union_mset[simp]:
   assumes "x \<in># T"
   shows "x \<subseteq># \<Sum>\<^sub>#T"
   using assms sum_mset.remove by force
 
 lemma Melem_subset_eq_sum_list[simp]:
   assumes "x \<in># mset T"
   shows "x \<subseteq># sum_list T"
   using assms by (metis mset_subset_eq_add_left sum_mset.remove sum_mset_sum_list)
 
 lemma less_subset_eq_Union_mset[simp]:
   assumes "i < length CAi"
   shows "CAi ! i \<subseteq># \<Sum>\<^sub>#(mset CAi)"
 proof -
   from assms have "CAi ! i \<in># mset CAi"
     by auto
   then show ?thesis
     by auto
 qed
 
 lemma less_subset_eq_sum_list[simp]:
   assumes "i < length CAi"
   shows "CAi ! i \<subseteq># sum_list CAi"
 proof -
   from assms have "CAi ! i \<in># mset CAi"
     by auto
   then show ?thesis
     by auto
 qed
 
 
 subsubsection \<open>More on Multiset Order\<close>
 
 lemma less_multiset_doubletons:
   assumes
     "y < t \<or> y < s"  
     "x < t \<or> x < s" 
   shows 
     "{#y, x#} < {#t, s#}" 
   unfolding less_multiset\<^sub>D\<^sub>M
 proof (intro exI)
   let ?X = "{#t, s#}"
   let ?Y = "{#y, x#}"
   show "?X \<noteq> {#} \<and> ?X \<subseteq># {#t, s#} \<and> {#y, x#} = {#t, s#} - ?X + ?Y
     \<and> (\<forall>k. k \<in># ?Y \<longrightarrow> (\<exists>a. a \<in># ?X \<and> k < a))"
     using add_eq_conv_diff assms by auto
 qed
 
 end
diff --git a/thys/Ordered_Resolution_Prover/Standard_Redundancy.thy b/thys/Ordered_Resolution_Prover/Standard_Redundancy.thy
--- a/thys/Ordered_Resolution_Prover/Standard_Redundancy.thy
+++ b/thys/Ordered_Resolution_Prover/Standard_Redundancy.thy
@@ -1,339 +1,339 @@
 (*  Title:       The Standard Redundancy Criterion
     Author:      Jasmin Blanchette <j.c.blanchette at vu.nl>, 2014, 2017
     Author:      Dmitriy Traytel <traytel at inf.ethz.ch>, 2014
     Author:      Anders Schlichtkrull <andschl at dtu.dk>, 2017
     Maintainer:  Anders Schlichtkrull <andschl at dtu.dk>
 *)
 
 section \<open>The Standard Redundancy Criterion\<close>
 
 theory Standard_Redundancy
   imports Proving_Process
 begin
 
 text \<open>
 This material is based on Section 4.2.2 (``The Standard Redundancy Criterion'') of Bachmair and
 Ganzinger's chapter.
 \<close>
 
 locale standard_redundancy_criterion =
   inference_system \<Gamma> for \<Gamma> :: "('a :: wellorder) inference set"
 begin
 
 definition redundant_infer :: "'a clause set \<Rightarrow> 'a inference \<Rightarrow> bool" where
   "redundant_infer N \<gamma> \<longleftrightarrow>
    (\<exists>DD. set_mset DD \<subseteq> N \<and> (\<forall>I. I \<Turnstile>m DD + side_prems_of \<gamma> \<longrightarrow> I \<Turnstile> concl_of \<gamma>)
       \<and> (\<forall>D. D \<in># DD \<longrightarrow> D < main_prem_of \<gamma>))"
 
 definition Rf :: "'a clause set \<Rightarrow> 'a clause set" where
   "Rf N = {C. \<exists>DD. set_mset DD \<subseteq> N \<and> (\<forall>I. I \<Turnstile>m DD \<longrightarrow> I \<Turnstile> C) \<and> (\<forall>D. D \<in># DD \<longrightarrow> D < C)}"
 
 definition Ri :: "'a clause set \<Rightarrow> 'a inference set" where
   "Ri N = {\<gamma> \<in> \<Gamma>. redundant_infer N \<gamma>}"
 
 lemma tautology_Rf:
   assumes "Pos A \<in># C"
   assumes "Neg A \<in># C"
   shows "C \<in> Rf N"
 proof -
   have "set_mset {#} \<subseteq> N \<and> (\<forall>I. I \<Turnstile>m {#} \<longrightarrow> I \<Turnstile> C) \<and> (\<forall>D. D \<in># {#} \<longrightarrow> D < C)"
     using assms by auto
   then show "C \<in> Rf N"
     unfolding Rf_def by blast
 qed
 
 lemma tautology_redundant_infer:
   assumes
     pos: "Pos A \<in># concl_of \<iota>" and
     neg: "Neg A \<in># concl_of \<iota>"
   shows "redundant_infer N \<iota>"
   by (metis empty_iff empty_subsetI neg pos pos_neg_in_imp_true redundant_infer_def set_mset_empty)
 
 lemma contradiction_Rf: "{#} \<in> N \<Longrightarrow> Rf N = UNIV - {{#}}"
   unfolding Rf_def by force
 
 text \<open>
 The following results correspond to Lemma 4.5. The lemma \<open>wlog_non_Rf\<close> generalizes the core of
 the argument.
 \<close>
 
 lemma Rf_mono: "N \<subseteq> N' \<Longrightarrow> Rf N \<subseteq> Rf N'"
   unfolding Rf_def by auto
 
 lemma wlog_non_Rf:
   assumes ex: "\<exists>DD. set_mset DD \<subseteq> N \<and> (\<forall>I. I \<Turnstile>m DD + CC \<longrightarrow> I \<Turnstile> E) \<and> (\<forall>D'. D' \<in># DD \<longrightarrow> D' < D)"
   shows "\<exists>DD. set_mset DD \<subseteq> N - Rf N \<and> (\<forall>I. I \<Turnstile>m DD + CC \<longrightarrow> I \<Turnstile> E) \<and> (\<forall>D'. D' \<in># DD \<longrightarrow> D' < D)"
 proof -
   from ex obtain DD0 where
     dd0: "DD0 \<in> {DD. set_mset DD \<subseteq> N \<and> (\<forall>I. I \<Turnstile>m DD + CC \<longrightarrow> I \<Turnstile> E) \<and> (\<forall>D'. D' \<in># DD \<longrightarrow> D' < D)}"
     by blast
   have "\<exists>DD. set_mset DD \<subseteq> N \<and> (\<forall>I. I \<Turnstile>m DD + CC \<longrightarrow> I \<Turnstile> E) \<and> (\<forall>D'. D' \<in># DD \<longrightarrow> D' < D) \<and>
       (\<forall>DD'. set_mset DD' \<subseteq> N \<and> (\<forall>I. I \<Turnstile>m DD' + CC \<longrightarrow> I \<Turnstile> E) \<and> (\<forall>D'. D' \<in># DD' \<longrightarrow> D' < D) \<longrightarrow>
     DD \<le> DD')"
     using wf_eq_minimal[THEN iffD1, rule_format, OF wf_less_multiset dd0]
     unfolding not_le[symmetric] by blast
   then obtain DD where
     dd_subs_n: "set_mset DD \<subseteq> N" and
     ddcc_imp_e: "\<forall>I. I \<Turnstile>m DD + CC \<longrightarrow> I \<Turnstile> E" and
     dd_lt_d: "\<forall>D'. D' \<in># DD \<longrightarrow> D' < D" and
     d_min: "\<forall>DD'. set_mset DD' \<subseteq> N \<and> (\<forall>I. I \<Turnstile>m DD' + CC \<longrightarrow> I \<Turnstile> E) \<and> (\<forall>D'. D' \<in># DD' \<longrightarrow> D' < D) \<longrightarrow>
       DD \<le> DD'"
     by blast
 
   have "\<forall>Da. Da \<in># DD \<longrightarrow> Da \<notin> Rf N"
   proof clarify
     fix Da
     assume
       da_in_dd: "Da \<in># DD" and
       da_rf: "Da \<in> Rf N"
 
     from da_rf obtain DD' where
       dd'_subs_n: "set_mset DD' \<subseteq> N" and
       dd'_imp_da: "\<forall>I. I \<Turnstile>m DD' \<longrightarrow> I \<Turnstile> Da" and
       dd'_lt_da: "\<forall>D'. D' \<in># DD' \<longrightarrow> D' < Da"
       unfolding Rf_def by blast
 
     define DDa where
       "DDa = DD - {#Da#} + DD'"
 
     have "set_mset DDa \<subseteq> N"
       unfolding DDa_def using dd_subs_n dd'_subs_n
       by (meson contra_subsetD in_diffD subsetI union_iff)
     moreover have "\<forall>I. I \<Turnstile>m DDa + CC \<longrightarrow> I \<Turnstile> E"
       using dd'_imp_da ddcc_imp_e da_in_dd unfolding DDa_def true_cls_mset_def
       by (metis in_remove1_mset_neq union_iff)
     moreover have "\<forall>D'. D' \<in># DDa \<longrightarrow> D' < D"
       using dd_lt_d dd'_lt_da da_in_dd unfolding DDa_def
       by (metis insert_DiffM2 order.strict_trans union_iff)
     moreover have "DDa < DD"
       unfolding DDa_def
       by (meson da_in_dd dd'_lt_da mset_lt_single_right_iff single_subset_iff union_le_diff_plus)
     ultimately show False
       using d_min unfolding less_eq_multiset_def by (auto intro!: antisym)
   qed
   then show ?thesis
     using dd_subs_n ddcc_imp_e dd_lt_d by auto
 qed
 
 lemma Rf_imp_ex_non_Rf:
   assumes "C \<in> Rf N"
   shows "\<exists>CC. set_mset CC \<subseteq> N - Rf N \<and> (\<forall>I. I \<Turnstile>m CC \<longrightarrow> I \<Turnstile> C) \<and> (\<forall>C'. C' \<in># CC \<longrightarrow> C' < C)"
   using assms by (auto simp: Rf_def intro: wlog_non_Rf[of _ "{#}", simplified])
 
 lemma Rf_subs_Rf_diff_Rf: "Rf N \<subseteq> Rf (N - Rf N)"
 proof
   fix C
   assume c_rf: "C \<in> Rf N"
   then obtain CC where
     cc_subs: "set_mset CC \<subseteq> N - Rf N" and
     cc_imp_c: "\<forall>I. I \<Turnstile>m CC \<longrightarrow> I \<Turnstile> C" and
     cc_lt_c: "\<forall>C'. C' \<in># CC \<longrightarrow> C' < C"
     using Rf_imp_ex_non_Rf by blast
   have "\<forall>D. D \<in># CC \<longrightarrow> D \<notin> Rf N"
     using cc_subs by (simp add: subset_iff)
   then have cc_nr:
     "\<And>C DD. C \<in># CC \<Longrightarrow> set_mset DD \<subseteq> N \<Longrightarrow> \<forall>I. I \<Turnstile>m DD \<longrightarrow> I \<Turnstile> C \<Longrightarrow> \<exists>D. D \<in># DD \<and> \<not> D < C"
       unfolding Rf_def by auto metis
   have "set_mset CC \<subseteq> N"
     using cc_subs by auto
   then have "set_mset CC \<subseteq>
     N - {C. \<exists>DD. set_mset DD \<subseteq> N \<and> (\<forall>I. I \<Turnstile>m DD \<longrightarrow> I \<Turnstile> C) \<and> (\<forall>D. D \<in># DD \<longrightarrow> D < C)}"
-    using cc_nr by auto
+    using cc_nr by blast
   then show "C \<in> Rf (N - Rf N)"
     using cc_imp_c cc_lt_c unfolding Rf_def by auto
 qed
 
 lemma Rf_eq_Rf_diff_Rf: "Rf N = Rf (N - Rf N)"
   by (metis Diff_subset Rf_mono Rf_subs_Rf_diff_Rf subset_antisym)
 
 text \<open>
 The following results correspond to Lemma 4.6.
 \<close>
 
 lemma Ri_mono: "N \<subseteq> N' \<Longrightarrow> Ri N \<subseteq> Ri N'"
   unfolding Ri_def redundant_infer_def by auto
 
 lemma Ri_subs_Ri_diff_Rf: "Ri N \<subseteq> Ri (N - Rf N)"
 proof
   fix \<gamma>
   assume \<gamma>_ri: "\<gamma> \<in> Ri N"
   then obtain CC D E where \<gamma>: "\<gamma> = Infer CC D E"
     by (cases \<gamma>)
   have cc: "CC = side_prems_of \<gamma>" and d: "D = main_prem_of \<gamma>" and e: "E = concl_of \<gamma>"
     unfolding \<gamma> by simp_all
   obtain DD where
     "set_mset DD \<subseteq> N" and "\<forall>I. I \<Turnstile>m DD + CC \<longrightarrow> I \<Turnstile> E" and "\<forall>C. C \<in># DD \<longrightarrow> C < D"
     using \<gamma>_ri unfolding Ri_def redundant_infer_def cc d e by blast
   then obtain DD' where
     "set_mset DD' \<subseteq> N - Rf N" and "\<forall>I. I \<Turnstile>m DD' + CC \<longrightarrow> I \<Turnstile> E" and "\<forall>D'. D' \<in># DD' \<longrightarrow> D' < D"
     using wlog_non_Rf by atomize_elim blast
   then show "\<gamma> \<in> Ri (N - Rf N)"
     using \<gamma>_ri unfolding Ri_def redundant_infer_def d cc e by blast
 qed
 
 lemma Ri_eq_Ri_diff_Rf: "Ri N = Ri (N - Rf N)"
   by (metis Diff_subset Ri_mono Ri_subs_Ri_diff_Rf subset_antisym)
 
 lemma Ri_subset_\<Gamma>: "Ri N \<subseteq> \<Gamma>"
   unfolding Ri_def by blast
 
 lemma Rf_indep: "N' \<subseteq> Rf N \<Longrightarrow> Rf N \<subseteq> Rf (N - N')"
   by (metis Diff_cancel Diff_eq_empty_iff Diff_mono Rf_eq_Rf_diff_Rf Rf_mono)
 
 lemma Ri_indep: "N' \<subseteq> Rf N \<Longrightarrow> Ri N \<subseteq> Ri (N - N')"
   by (metis Diff_mono Ri_eq_Ri_diff_Rf Ri_mono order_refl)
 
 lemma Rf_model:
   assumes "I \<Turnstile>s N - Rf N"
   shows "I \<Turnstile>s N"
 proof -
   have "I \<Turnstile>s Rf (N - Rf N)"
     unfolding true_clss_def
     by (subst Rf_def, simp add: true_cls_mset_def, metis assms subset_eq true_clss_def)
   then have "I \<Turnstile>s Rf N"
     using Rf_subs_Rf_diff_Rf true_clss_mono by blast
   then show ?thesis
     using assms by (metis Un_Diff_cancel true_clss_union)
 qed
 
 lemma Rf_sat: "satisfiable (N - Rf N) \<Longrightarrow> satisfiable N"
   by (metis Rf_model)
 
 text \<open>
 The following corresponds to Theorem 4.7:
 \<close>
 
 sublocale redundancy_criterion \<Gamma> Rf Ri
   by unfold_locales (rule Ri_subset_\<Gamma>, (elim Rf_mono Ri_mono Rf_indep Ri_indep Rf_sat)+)
 
 end
 
 locale standard_redundancy_criterion_reductive =
   standard_redundancy_criterion + reductive_inference_system
 begin
 
 text \<open>
 The following corresponds to Theorem 4.8:
 \<close>
 
 lemma Ri_effective:
   assumes
     in_\<gamma>: "\<gamma> \<in> \<Gamma>" and
     concl_of_in_n_un_rf_n: "concl_of \<gamma> \<in> N \<union> Rf N"
   shows "\<gamma> \<in> Ri N"
 proof -
   obtain CC D E where
     \<gamma>: "\<gamma> = Infer CC D E"
     by (cases \<gamma>)
   then have cc: "CC = side_prems_of \<gamma>" and d: "D = main_prem_of \<gamma>" and e: "E = concl_of \<gamma>"
     unfolding \<gamma> by simp_all
   note e_in_n_un_rf_n = concl_of_in_n_un_rf_n[folded e]
 
   {
     assume "E \<in> N"
     moreover have "E < D"
       using \<Gamma>_reductive e d in_\<gamma> by auto
     ultimately have
       "set_mset {#E#} \<subseteq> N" and "\<forall>I. I \<Turnstile>m {#E#} + CC \<longrightarrow> I \<Turnstile> E" and "\<forall>D'. D' \<in># {#E#} \<longrightarrow> D' < D"
       by simp_all
     then have "redundant_infer N \<gamma>"
       using redundant_infer_def cc d e by blast
   }
   moreover
   {
     assume "E \<in> Rf N"
     then obtain DD where
       dd_sset: "set_mset DD \<subseteq> N" and
       dd_imp_e: "\<forall>I. I \<Turnstile>m DD \<longrightarrow> I \<Turnstile> E" and
       dd_lt_e: "\<forall>C'. C' \<in># DD \<longrightarrow> C' < E"
       unfolding Rf_def by blast
     from dd_lt_e have "\<forall>Da. Da \<in># DD \<longrightarrow> Da < D"
       using d e in_\<gamma> \<Gamma>_reductive less_trans by blast
     then have "redundant_infer N \<gamma>"
       using redundant_infer_def dd_sset dd_imp_e cc d e by blast
   }
   ultimately show "\<gamma> \<in> Ri N"
     using in_\<gamma> e_in_n_un_rf_n unfolding Ri_def by blast
 qed
 
 sublocale effective_redundancy_criterion \<Gamma> Rf Ri
   unfolding effective_redundancy_criterion_def
   by (intro conjI redundancy_criterion_axioms, unfold_locales, rule Ri_effective)
 
 lemma contradiction_Rf: "{#} \<in> N \<Longrightarrow> Ri N = \<Gamma>"
   unfolding Ri_def redundant_infer_def using \<Gamma>_reductive le_multiset_empty_right
   by (force intro: exI[of _ "{#{#}#}"] le_multiset_empty_left)
 
 end
 
 locale standard_redundancy_criterion_counterex_reducing =
   standard_redundancy_criterion + counterex_reducing_inference_system
 begin
 
 text \<open>
 The following result corresponds to Theorem 4.9.
 \<close>
 
 lemma saturated_upto_complete_if:
   assumes
     satur: "saturated_upto N" and
     unsat: "\<not> satisfiable N"
   shows "{#} \<in> N"
 proof (rule ccontr)
   assume ec_ni_n: "{#} \<notin> N"
 
   define M where
     "M = N - Rf N"
 
   have ec_ni_m: "{#} \<notin> M"
     unfolding M_def using ec_ni_n by fast
 
   have "I_of M \<Turnstile>s M"
   proof (rule ccontr)
     assume "\<not> I_of M \<Turnstile>s M"
     then obtain D where
       d_in_m: "D \<in> M" and
       d_cex: "\<not> I_of M \<Turnstile> D" and
       d_min: "\<And>C. C \<in> M \<Longrightarrow> C < D \<Longrightarrow> I_of M \<Turnstile> C"
       using ex_min_counterex by meson
     then obtain \<gamma> CC E where
       \<gamma>: "\<gamma> = Infer CC D E" and
       cc_subs_m: "set_mset CC \<subseteq> M" and
       cc_true: "I_of M \<Turnstile>m CC" and
       \<gamma>_in: "\<gamma> \<in> \<Gamma>" and
       e_cex: "\<not> I_of M \<Turnstile> E" and
       e_lt_d: "E < D"
       using \<Gamma>_counterex_reducing[OF ec_ni_m] not_less by metis
     have cc: "CC = side_prems_of \<gamma>" and d: "D = main_prem_of \<gamma>" and e: "E = concl_of \<gamma>"
       unfolding \<gamma> by simp_all
     have "\<gamma> \<in> Ri N"
       by (rule subsetD[OF satur[unfolded saturated_upto_def inferences_from_def infer_from_def]])
         (simp add: \<gamma>_in d_in_m cc_subs_m cc[symmetric] d[symmetric] M_def[symmetric])
     then have "\<gamma> \<in> Ri M"
       unfolding M_def using Ri_indep by fast
     then obtain DD where
       dd_subs_m: "set_mset DD \<subseteq> M" and
       dd_cc_imp_d: "\<forall>I. I \<Turnstile>m DD + CC \<longrightarrow> I \<Turnstile> E" and
       dd_lt_d: "\<forall>C. C \<in># DD \<longrightarrow> C < D"
       unfolding Ri_def redundant_infer_def cc d e by blast
     from dd_subs_m dd_lt_d have "I_of M \<Turnstile>m DD"
       using d_min unfolding true_cls_mset_def by (metis contra_subsetD)
     then have "I_of M \<Turnstile> E"
       using dd_cc_imp_d cc_true by auto
     then show False
       using e_cex by auto
   qed
   then have "I_of M \<Turnstile>s N"
     using M_def Rf_model by blast
   then show False
     using unsat by blast
 qed
 
 theorem saturated_upto_complete:
   assumes "saturated_upto N"
   shows "\<not> satisfiable N \<longleftrightarrow> {#} \<in> N"
   using assms saturated_upto_complete_if true_clss_def by auto
 
 end
 
 end
diff --git a/thys/PAC_Checker/Finite_Map_Multiset.thy b/thys/PAC_Checker/Finite_Map_Multiset.thy
--- a/thys/PAC_Checker/Finite_Map_Multiset.thy
+++ b/thys/PAC_Checker/Finite_Map_Multiset.thy
@@ -1,227 +1,229 @@
 (*
   File:         Finite_Map_Multiset.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Maintainer:   Mathias Fleury, JKU
 *)
 theory Finite_Map_Multiset
-imports "HOL-Library.Finite_Map" Duplicate_Free_Multiset
+imports
+  "HOL-Library.Finite_Map"
+  Nested_Multisets_Ordinals.Duplicate_Free_Multiset
 begin
 
 notation image_mset (infixr "`#" 90)
 
 section \<open>Finite maps and multisets\<close>
 
 subsection \<open>Finite sets and multisets\<close>
 
 abbreviation mset_fset :: \<open>'a fset \<Rightarrow> 'a multiset\<close> where
   \<open>mset_fset N \<equiv> mset_set (fset N)\<close>
 
 definition fset_mset :: \<open>'a multiset \<Rightarrow> 'a fset\<close> where
   \<open>fset_mset N \<equiv> Abs_fset (set_mset N)\<close>
 
 lemma fset_mset_mset_fset: \<open>fset_mset (mset_fset N) = N\<close>
   by (auto simp: fset.fset_inverse fset_mset_def)
 
 lemma mset_fset_fset_mset[simp]:
   \<open>mset_fset (fset_mset N) = remdups_mset N\<close>
   by (auto simp: fset.fset_inverse fset_mset_def Abs_fset_inverse remdups_mset_def)
 
 lemma in_mset_fset_fmember[simp]: \<open>x \<in># mset_fset N \<longleftrightarrow> x |\<in>| N\<close>
   by (auto simp: fmember.rep_eq)
 
 lemma in_fset_mset_mset[simp]: \<open>x |\<in>| fset_mset N \<longleftrightarrow> x \<in># N\<close>
   by (auto simp: fmember.rep_eq fset_mset_def Abs_fset_inverse)
 
 
 subsection \<open>Finite map and multisets\<close>
 
 text \<open>Roughly the same as \<^term>\<open>ran\<close> and \<^term>\<open>dom\<close>, but with duplication in the content (unlike their
   finite sets counterpart) while still working on finite domains (unlike a function mapping).
   Remark that \<^term>\<open>dom_m\<close> (the keys) does not contain duplicates, but we keep for symmetry (and for
   easier use of multiset operators as in the definition of \<^term>\<open>ran_m\<close>).
 \<close>
 definition dom_m where
   \<open>dom_m N = mset_fset (fmdom N)\<close>
 
 definition ran_m where
   \<open>ran_m N = the `# fmlookup N `# dom_m N\<close>
 
 lemma dom_m_fmdrop[simp]: \<open>dom_m (fmdrop C N) = remove1_mset C (dom_m N)\<close>
   unfolding dom_m_def
   by (cases \<open>C |\<in>| fmdom N\<close>)
     (auto simp: mset_set.remove fmember.rep_eq)
 
 lemma dom_m_fmdrop_All: \<open>dom_m (fmdrop C N) = removeAll_mset C (dom_m N)\<close>
   unfolding dom_m_def
   by (cases \<open>C |\<in>| fmdom N\<close>)
     (auto simp: mset_set.remove fmember.rep_eq)
 
 lemma dom_m_fmupd[simp]: \<open>dom_m (fmupd k C N) = add_mset k (remove1_mset k (dom_m N))\<close>
   unfolding dom_m_def
   by (cases \<open>k |\<in>| fmdom N\<close>)
     (auto simp: mset_set.remove fmember.rep_eq mset_set.insert_remove)
 
 lemma distinct_mset_dom: \<open>distinct_mset (dom_m N)\<close>
   by (simp add: distinct_mset_mset_set dom_m_def)
 
 lemma in_dom_m_lookup_iff: \<open>C \<in># dom_m N' \<longleftrightarrow> fmlookup N' C \<noteq> None\<close>
   by (auto simp: dom_m_def fmdom.rep_eq fmlookup_dom'_iff)
 
 lemma in_dom_in_ran_m[simp]: \<open>i \<in># dom_m N \<Longrightarrow> the (fmlookup N i) \<in># ran_m N\<close>
   by (auto simp: ran_m_def)
 
 lemma fmupd_same[simp]:
   \<open>x1 \<in># dom_m x1aa \<Longrightarrow> fmupd x1 (the (fmlookup x1aa x1)) x1aa = x1aa\<close>
   by (metis fmap_ext fmupd_lookup in_dom_m_lookup_iff option.collapse)
 
 lemma ran_m_fmempty[simp]: \<open>ran_m fmempty = {#}\<close> and
     dom_m_fmempty[simp]: \<open>dom_m fmempty = {#}\<close>
   by (auto simp: ran_m_def dom_m_def)
 
 lemma fmrestrict_set_fmupd:
   \<open>a \<in> xs \<Longrightarrow> fmrestrict_set xs (fmupd a C N) = fmupd a C (fmrestrict_set xs N)\<close>
   \<open>a \<notin> xs \<Longrightarrow> fmrestrict_set xs (fmupd a C N) = fmrestrict_set xs N\<close>
   by (auto simp: fmfilter_alt_defs)
 
 lemma fset_fmdom_fmrestrict_set:
   \<open>fset (fmdom (fmrestrict_set xs N)) = fset (fmdom N) \<inter> xs\<close>
   by (auto simp: fmfilter_alt_defs)
 
 lemma dom_m_fmrestrict_set: \<open>dom_m (fmrestrict_set (set xs) N) = mset xs \<inter># dom_m N\<close>
   using fset_fmdom_fmrestrict_set[of \<open>set xs\<close> N] distinct_mset_dom[of N]
   distinct_mset_inter_remdups_mset[of \<open>mset_fset (fmdom N)\<close> \<open>mset xs\<close>]
   by (auto simp: dom_m_def fset_mset_mset_fset finite_mset_set_inter multiset_inter_commute
     remdups_mset_def)
 
 lemma dom_m_fmrestrict_set': \<open>dom_m (fmrestrict_set xs N) = mset_set (xs \<inter> set_mset (dom_m N))\<close>
   using fset_fmdom_fmrestrict_set[of \<open>xs\<close> N] distinct_mset_dom[of N]
   by (auto simp: dom_m_def fset_mset_mset_fset finite_mset_set_inter multiset_inter_commute
     remdups_mset_def)
 
 lemma indom_mI: \<open>fmlookup m x = Some y \<Longrightarrow> x \<in># dom_m m\<close>
   by (drule fmdomI)  (auto simp: dom_m_def fmember.rep_eq)
 
 lemma fmupd_fmdrop_id:
   assumes \<open>k |\<in>| fmdom N'\<close>
   shows \<open>fmupd k (the (fmlookup N' k)) (fmdrop k N') = N'\<close>
 proof -
   have [simp]: \<open>map_upd k (the (fmlookup N' k))
        (\<lambda>x. if x \<noteq> k then fmlookup N' x else None) =
      map_upd k (the (fmlookup N' k))
        (fmlookup N')\<close>
     by (auto intro!: ext simp: map_upd_def)
   have [simp]: \<open>map_upd k (the (fmlookup N' k)) (fmlookup N') = fmlookup N'\<close>
     using assms
     by (auto intro!: ext simp: map_upd_def)
   have [simp]: \<open>finite (dom (\<lambda>x. if x = k then None else fmlookup N' x))\<close>
     by (subst dom_if) auto
   show ?thesis
     apply (auto simp: fmupd_def fmupd.abs_eq[symmetric])
     unfolding fmlookup_drop
     apply (simp add: fmlookup_inverse)
     done
 qed
 
 lemma fm_member_split: \<open>k |\<in>| fmdom N' \<Longrightarrow> \<exists>N'' v. N' = fmupd k v N'' \<and> the (fmlookup N' k) = v \<and>
     k |\<notin>| fmdom N''\<close>
   by (rule exI[of _ \<open>fmdrop k N'\<close>])
     (auto simp: fmupd_fmdrop_id)
 
 lemma \<open>fmdrop k (fmupd k va N'') = fmdrop k N''\<close>
   by (simp add: fmap_ext)
 
 lemma fmap_ext_fmdom:
   \<open>(fmdom N = fmdom N') \<Longrightarrow> (\<And> x. x |\<in>| fmdom N \<Longrightarrow> fmlookup N x = fmlookup N' x) \<Longrightarrow>
        N = N'\<close>
   by (rule fmap_ext)
     (case_tac \<open>x |\<in>| fmdom N\<close>, auto simp: fmdom_notD)
 
 lemma fmrestrict_set_insert_in:
   \<open>xa  \<in> fset (fmdom N) \<Longrightarrow>
     fmrestrict_set (insert xa l1) N = fmupd xa (the (fmlookup N xa)) (fmrestrict_set l1 N)\<close>
   apply (rule fmap_ext_fmdom)
    apply (auto simp: fset_fmdom_fmrestrict_set fmember.rep_eq notin_fset; fail)[]
   apply (auto simp: fmlookup_dom_iff; fail)
   done
 
 lemma fmrestrict_set_insert_notin:
   \<open>xa  \<notin> fset (fmdom N) \<Longrightarrow>
     fmrestrict_set (insert xa l1) N = fmrestrict_set l1 N\<close>
   by (rule fmap_ext_fmdom)
      (auto simp: fset_fmdom_fmrestrict_set fmember.rep_eq notin_fset)
 
 lemma fmrestrict_set_insert_in_dom_m[simp]:
   \<open>xa  \<in># dom_m N \<Longrightarrow>
     fmrestrict_set (insert xa l1) N = fmupd xa (the (fmlookup N xa)) (fmrestrict_set l1 N)\<close>
   by (simp add: fmrestrict_set_insert_in dom_m_def)
 
 lemma fmrestrict_set_insert_notin_dom_m[simp]:
   \<open>xa  \<notin># dom_m N \<Longrightarrow>
     fmrestrict_set (insert xa l1) N = fmrestrict_set l1 N\<close>
   by (simp add: fmrestrict_set_insert_notin dom_m_def)
 
 lemma fmlookup_restrict_set_id: \<open>fset (fmdom N) \<subseteq> A \<Longrightarrow> fmrestrict_set A N = N\<close>
   by (metis fmap_ext fmdom'_alt_def fmdom'_notD fmlookup_restrict_set subset_iff)
 
 lemma fmlookup_restrict_set_id': \<open>set_mset (dom_m N) \<subseteq> A \<Longrightarrow> fmrestrict_set A N = N\<close>
   by (rule fmlookup_restrict_set_id)
     (auto simp: dom_m_def)
 
 lemma ran_m_mapsto_upd:
   assumes
     NC: \<open>C \<in># dom_m N\<close>
   shows \<open>ran_m (fmupd C C' N) = add_mset C' (remove1_mset (the (fmlookup N C)) (ran_m N))\<close>
 proof -
   define N' where
     \<open>N' = fmdrop C N\<close>
   have N_N': \<open>dom_m N = add_mset C (dom_m N')\<close>
     using NC unfolding N'_def by auto
   have \<open>C \<notin># dom_m N'\<close>
     using NC distinct_mset_dom[of N] unfolding N_N' by auto
   then show ?thesis
     by (auto simp: N_N' ran_m_def mset_set.insert_remove image_mset_remove1_mset_if
       intro!: image_mset_cong)
 qed
 
 lemma ran_m_mapsto_upd_notin:
   assumes NC: \<open>C \<notin># dom_m N\<close>
   shows \<open>ran_m (fmupd C C' N) = add_mset C' (ran_m N)\<close>
   using NC
   by (auto simp: ran_m_def mset_set.insert_remove image_mset_remove1_mset_if
       intro!: image_mset_cong split: if_splits)
 
 lemma image_mset_If_eq_notin:
    \<open>C \<notin># A \<Longrightarrow> {#f (if x = C then a x else b x). x \<in># A#} = {# f(b x). x \<in># A #}\<close>
   by (induction A) auto
 
 lemma filter_mset_cong2:
   "(\<And>x. x \<in># M \<Longrightarrow> f x = g x) \<Longrightarrow> M = N \<Longrightarrow> filter_mset f M = filter_mset g N"
   by (hypsubst, rule filter_mset_cong, simp)
 
 lemma ran_m_fmdrop:
   \<open>C \<in># dom_m N \<Longrightarrow>  ran_m (fmdrop C N) = remove1_mset (the (fmlookup N C)) (ran_m N)\<close>
   using distinct_mset_dom[of N]
   by (cases \<open>fmlookup N C\<close>)
     (auto simp: ran_m_def image_mset_If_eq_notin[of C _ \<open>\<lambda>x. fst (the x)\<close>]
      dest!: multi_member_split
      intro!: filter_mset_cong2 image_mset_cong2)
 
 lemma ran_m_fmdrop_notin:
   \<open>C \<notin># dom_m N \<Longrightarrow> ran_m (fmdrop C N) = ran_m N\<close>
   using distinct_mset_dom[of N]
   by (auto simp: ran_m_def image_mset_If_eq_notin[of C _ \<open>\<lambda>x. fst (the x)\<close>]
     dest!: multi_member_split
     intro!: filter_mset_cong2 image_mset_cong2)
 
 lemma ran_m_fmdrop_If:
   \<open>ran_m (fmdrop C N) = (if C \<in># dom_m N then remove1_mset (the (fmlookup N C)) (ran_m N) else ran_m N)\<close>
   using distinct_mset_dom[of N]
   by (auto simp: ran_m_def image_mset_If_eq_notin[of C _ \<open>\<lambda>x. fst (the x)\<close>]
     dest!: multi_member_split
     intro!: filter_mset_cong2 image_mset_cong2)
 
 lemma dom_m_empty_iff[iff]:
   \<open>dom_m NU = {#} \<longleftrightarrow> NU = fmempty\<close>
   by (cases NU) (auto simp: dom_m_def mset_set.insert_remove)
 
 end
\ No newline at end of file
diff --git a/thys/PAC_Checker/PAC_Checker.thy b/thys/PAC_Checker/PAC_Checker.thy
--- a/thys/PAC_Checker/PAC_Checker.thy
+++ b/thys/PAC_Checker/PAC_Checker.thy
@@ -1,1382 +1,1383 @@
 (*
   File:         PAC_Checker.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Maintainer:   Mathias Fleury, JKU
 *)
 theory PAC_Checker
   imports PAC_Polynomials_Operations
     PAC_Checker_Specification
     PAC_Map_Rel
     Show.Show
     Show.Show_Instances
+    PAC_Misc
 begin
 
 section \<open>Executable Checker\<close>
 
 text \<open>In this layer we finally refine the checker to executable code.\<close>
 
 subsection \<open>Definitions\<close>
 
 text \<open>Compared to the previous layer, we add an error message when an error is discovered. We do not
   attempt to prove anything on the error message (neither that there really is an error, nor that the
   error message is correct).
 \<close>
 
 paragraph \<open>Extended error message\<close>
 
 datatype 'a code_status =
   is_cfailed: CFAILED (the_error: 'a) |
   CSUCCESS |
   is_cfound: CFOUND
 
 text \<open>In the following function, we merge errors. We will never merge an error message with an
   another error message; hence we do not attempt to concatenate error messages.
 \<close>
 fun merge_cstatus where
   \<open>merge_cstatus (CFAILED a) _ = CFAILED a\<close> |
   \<open>merge_cstatus _ (CFAILED a) = CFAILED a\<close> |
   \<open>merge_cstatus CFOUND _ = CFOUND\<close> |
   \<open>merge_cstatus _ CFOUND = CFOUND\<close> |
   \<open>merge_cstatus _ _ = CSUCCESS\<close>
 
 definition code_status_status_rel :: \<open>('a code_status \<times> status) set\<close> where
 \<open>code_status_status_rel =
   {(CFOUND, FOUND), (CSUCCESS, SUCCESS)} \<union>
   {(CFAILED a, FAILED)| a. True}\<close>
 
 lemma in_code_status_status_rel_iff[simp]:
   \<open>(CFOUND, b) \<in> code_status_status_rel \<longleftrightarrow> b = FOUND\<close>
   \<open>(a, FOUND) \<in> code_status_status_rel \<longleftrightarrow> a = CFOUND\<close>
   \<open>(CSUCCESS, b) \<in> code_status_status_rel \<longleftrightarrow> b = SUCCESS\<close>
   \<open>(a, SUCCESS) \<in> code_status_status_rel \<longleftrightarrow> a = CSUCCESS\<close>
   \<open>(a, FAILED) \<in> code_status_status_rel \<longleftrightarrow> is_cfailed a\<close>
   \<open>(CFAILED C, b) \<in> code_status_status_rel \<longleftrightarrow> b = FAILED\<close>
   by (cases a; cases b; auto simp: code_status_status_rel_def; fail)+
 
 
 paragraph \<open>Refinement relation\<close>
 
 fun pac_step_rel_raw :: \<open>('olbl \<times> 'lbl) set \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> ('c \<times> 'd) set \<Rightarrow> ('a, 'c, 'olbl) pac_step \<Rightarrow> ('b, 'd, 'lbl) pac_step \<Rightarrow> bool\<close> where
 \<open>pac_step_rel_raw R1 R2 R3 (Add p1 p2 i r) (Add p1' p2' i' r') \<longleftrightarrow>
    (p1, p1') \<in> R1 \<and> (p2, p2') \<in> R1 \<and> (i, i') \<in> R1 \<and>
    (r, r') \<in> R2\<close> |
 \<open>pac_step_rel_raw R1 R2 R3 (Mult p1 p2 i r) (Mult p1' p2' i' r') \<longleftrightarrow>
    (p1, p1') \<in> R1 \<and> (p2, p2') \<in> R2 \<and> (i, i') \<in> R1 \<and>
    (r, r') \<in> R2\<close> |
 \<open>pac_step_rel_raw R1 R2 R3 (Del p1) (Del p1') \<longleftrightarrow>
    (p1, p1') \<in> R1\<close> |
 \<open>pac_step_rel_raw R1 R2 R3 (Extension i x p1) (Extension j x' p1') \<longleftrightarrow>
    (i, j) \<in> R1 \<and> (x, x') \<in> R3 \<and> (p1, p1') \<in> R2\<close> |
 \<open>pac_step_rel_raw R1 R2 R3 _ _ \<longleftrightarrow> False\<close>
 
 fun pac_step_rel_assn :: \<open>('olbl \<Rightarrow> 'lbl \<Rightarrow> assn) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> assn) \<Rightarrow> ('c \<Rightarrow> 'd \<Rightarrow> assn) \<Rightarrow> ('a, 'c, 'olbl) pac_step \<Rightarrow> ('b, 'd, 'lbl) pac_step \<Rightarrow> assn\<close> where
 \<open>pac_step_rel_assn R1 R2 R3 (Add p1 p2 i r) (Add p1' p2' i' r') =
    R1 p1 p1' * R1 p2 p2' * R1 i i' *
    R2 r r'\<close> |
 \<open>pac_step_rel_assn R1 R2 R3 (Mult p1 p2 i r) (Mult p1' p2' i' r') =
    R1 p1 p1' * R2 p2 p2' * R1 i i' *
    R2 r r'\<close> |
 \<open>pac_step_rel_assn R1 R2 R3 (Del p1) (Del p1') =
    R1 p1 p1'\<close> |
 \<open>pac_step_rel_assn R1 R2 R3 (Extension i x p1) (Extension i' x' p1') =
    R1 i i' * R3 x x' * R2 p1 p1'\<close> |
 \<open>pac_step_rel_assn R1 R2 _ _ _ = false\<close>
 
 lemma pac_step_rel_assn_alt_def:
   \<open>pac_step_rel_assn R1 R2 R3 x y = (
   case (x, y) of
       (Add p1 p2 i r, Add p1' p2' i' r') \<Rightarrow>
         R1 p1 p1' * R1 p2 p2' * R1 i i' * R2 r r'
     | (Mult p1 p2 i r, Mult p1' p2' i' r') \<Rightarrow>
         R1 p1 p1' * R2 p2 p2' * R1 i i' * R2 r r'
     | (Del p1, Del p1') \<Rightarrow> R1 p1 p1'
     | (Extension i x p1, Extension i' x' p1') \<Rightarrow> R1 i i' * R3 x x' * R2 p1 p1'
     | _ \<Rightarrow> false)\<close>
     by (auto split: pac_step.splits)
 
 
 paragraph \<open>Addition checking\<close>
 
 definition error_msg where
   \<open>error_msg i msg = CFAILED (''s CHECKING failed at line '' @ show i @ '' with error '' @ msg)\<close>
 
 definition error_msg_notin_dom_err where
   \<open>error_msg_notin_dom_err = '' notin domain''\<close>
 
 definition error_msg_notin_dom :: \<open>nat \<Rightarrow> string\<close> where
   \<open>error_msg_notin_dom i = show i @ error_msg_notin_dom_err\<close>
 
 definition error_msg_reused_dom where
   \<open>error_msg_reused_dom i = show i @ '' already in domain''\<close>
 
 
 definition error_msg_not_equal_dom where
   \<open>error_msg_not_equal_dom p q pq r = show p @ '' + '' @ show q @ '' = '' @ show pq @ '' not equal'' @ show r\<close>
 
 
 definition check_not_equal_dom_err :: \<open>llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> string nres\<close> where
   \<open>check_not_equal_dom_err p q pq r = SPEC (\<lambda>_. True)\<close>
 
 
 definition vars_llist :: \<open>llist_polynomial \<Rightarrow> string set\<close> where
 \<open>vars_llist  xs = \<Union>(set ` fst ` set xs)\<close>
 
 
 definition check_addition_l :: \<open>_ \<Rightarrow> _ \<Rightarrow> string set \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> llist_polynomial \<Rightarrow> string code_status nres\<close> where
 \<open>check_addition_l spec A \<V> p q i r = do {
    let b = p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars_llist r \<subseteq> \<V>;
    if \<not>b
    then RETURN (error_msg i ((if p \<notin># dom_m A then error_msg_notin_dom p else []) @ (if q \<notin># dom_m A then error_msg_notin_dom p else []) @
       (if i \<in># dom_m A then error_msg_reused_dom p else [])))
    else do {
      ASSERT (p \<in># dom_m A);
      let p = the (fmlookup A p);
      ASSERT (q \<in># dom_m A);
      let q = the (fmlookup A q);
      pq \<leftarrow> add_poly_l (p, q);
      b \<leftarrow> weak_equality_l pq r;
      b' \<leftarrow> weak_equality_l r spec;
      if b then (if b' then RETURN CFOUND else RETURN CSUCCESS)
      else do {
        c \<leftarrow> check_not_equal_dom_err p q pq r;
        RETURN (error_msg i c)}
    }
 }\<close>
 
 
 paragraph \<open>Multiplication checking\<close>
 
 definition check_mult_l_dom_err :: \<open>bool \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> nat \<Rightarrow> string nres\<close> where
   \<open>check_mult_l_dom_err p_notin p i_already i = SPEC (\<lambda>_. True)\<close>
 
 
 definition check_mult_l_mult_err :: \<open>llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> string nres\<close> where
   \<open>check_mult_l_mult_err p q pq r = SPEC (\<lambda>_. True)\<close>
 
 
 definition check_mult_l :: \<open>_ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow>llist_polynomial \<Rightarrow>  nat \<Rightarrow> llist_polynomial \<Rightarrow> string code_status nres\<close> where
 \<open>check_mult_l spec A \<V> p q i r = do {
     let b = p \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars_llist q \<subseteq> \<V>\<and> vars_llist r \<subseteq> \<V>;
     if \<not>b
     then do {
       c \<leftarrow> check_mult_l_dom_err (p \<notin># dom_m A) p (i \<in># dom_m A) i;
       RETURN (error_msg i c)}
     else do {
        ASSERT (p \<in># dom_m A);
        let p = the (fmlookup A p);
        pq \<leftarrow> mult_poly_full p q;
        b \<leftarrow> weak_equality_l pq r;
        b' \<leftarrow> weak_equality_l r spec;
        if b then (if b' then RETURN CFOUND else RETURN CSUCCESS) else do {
          c \<leftarrow> check_mult_l_mult_err p q pq r;
          RETURN (error_msg i c)
        }
      }
   }\<close>
 
 
 paragraph \<open>Deletion checking\<close>
 
 definition check_del_l :: \<open>_ \<Rightarrow> _ \<Rightarrow> nat \<Rightarrow> string code_status nres\<close> where
 \<open>check_del_l spec A p = RETURN CSUCCESS\<close>
 
 
 paragraph \<open>Extension checking\<close>
 
 definition check_extension_l_dom_err :: \<open>nat \<Rightarrow> string nres\<close> where
   \<open>check_extension_l_dom_err p = SPEC (\<lambda>_. True)\<close>
 
 
 definition check_extension_l_no_new_var_err :: \<open>llist_polynomial \<Rightarrow> string nres\<close> where
   \<open>check_extension_l_no_new_var_err p = SPEC (\<lambda>_. True)\<close>
 
 definition check_extension_l_new_var_multiple_err :: \<open>string \<Rightarrow> llist_polynomial \<Rightarrow> string nres\<close> where
   \<open>check_extension_l_new_var_multiple_err v p = SPEC (\<lambda>_. True)\<close>
 
 definition check_extension_l_side_cond_err
   :: \<open>string \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> llist_polynomial \<Rightarrow> string nres\<close>
 where
   \<open>check_extension_l_side_cond_err v p p' q = SPEC (\<lambda>_. True)\<close>
 
 definition check_extension_l
   :: \<open>_ \<Rightarrow> _ \<Rightarrow> string set \<Rightarrow> nat \<Rightarrow> string \<Rightarrow> llist_polynomial \<Rightarrow> (string code_status) nres\<close>
 where
 \<open>check_extension_l spec A \<V> i v p = do {
   let b = i \<notin># dom_m A \<and> v \<notin> \<V> \<and> ([v], -1) \<in> set p;
   if \<not>b
   then do {
     c \<leftarrow> check_extension_l_dom_err i;
     RETURN (error_msg i c)
   } else do {
       let p' = remove1 ([v], -1) p;
       let b = vars_llist p' \<subseteq> \<V>;
       if \<not>b
       then do {
         c \<leftarrow> check_extension_l_new_var_multiple_err v p';
         RETURN (error_msg i c)
       }
       else do {
          p2 \<leftarrow> mult_poly_full p' p';
          let p' = map (\<lambda>(a,b). (a, -b)) p';
          q \<leftarrow> add_poly_l (p2, p');
          eq \<leftarrow> weak_equality_l q [];
          if eq then do {
            RETURN (CSUCCESS)
          } else do {
           c \<leftarrow> check_extension_l_side_cond_err v p p' q;
           RETURN (error_msg i c)
         }
       }
     }
   }\<close>
 
 
 lemma check_extension_alt_def:
   \<open>check_extension A \<V> i v p \<ge> do {
     b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> i \<notin># dom_m A \<and> v \<notin> \<V>);
     if \<not>b
     then RETURN (False)
     else do {
          p' \<leftarrow> RETURN (p + Var v);
          b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> vars p' \<subseteq> \<V>);
          if \<not>b
          then RETURN (False)
          else do {
            pq \<leftarrow> mult_poly_spec p' p';
            let p' = - p';
            p \<leftarrow> add_poly_spec pq p';
            eq \<leftarrow> weak_equality p 0;
            if eq then RETURN(True)
            else RETURN (False)
        }
      }
    }\<close>
 proof -
   have [intro]: \<open>ab \<notin> \<V> \<Longrightarrow>
        vars ba \<subseteq> \<V> \<Longrightarrow>
        MPoly_Type.coeff (ba + Var ab) (monomial (Suc 0) ab) = 1\<close> for ab ba
     by (subst coeff_add[symmetric], subst not_in_vars_coeff0)
       (auto simp flip: coeff_add monom.abs_eq
         simp: not_in_vars_coeff0 MPoly_Type.coeff_def
           Var.abs_eq Var\<^sub>0_def lookup_single_eq monom.rep_eq)
   have [simp]: \<open>MPoly_Type.coeff p (monomial (Suc 0) ab) = -1\<close>
      if \<open>vars (p + Var ab) \<subseteq> \<V>\<close>
        \<open>ab \<notin> \<V>\<close>
      for ab
    proof -
      define q where \<open>q \<equiv> p + Var ab\<close>
      then have p: \<open>p = q - Var ab\<close>
        by auto
      show ?thesis
        unfolding p
        apply (subst coeff_minus[symmetric], subst not_in_vars_coeff0)
        using that unfolding q_def[symmetric]
        by (auto simp flip: coeff_minus simp: not_in_vars_coeff0
            Var.abs_eq Var\<^sub>0_def simp flip: monom.abs_eq
            simp: not_in_vars_coeff0 MPoly_Type.coeff_def
            Var.abs_eq Var\<^sub>0_def lookup_single_eq monom.rep_eq)
   qed
   have [simp]: \<open>vars (p - Var ab) = vars (Var ab - p)\<close> for ab
     using vars_uminus[of \<open>p - Var ab\<close>]
     by simp
   show ?thesis
     unfolding check_extension_def
     apply (auto 5 5 simp: check_extension_def weak_equality_def
       mult_poly_spec_def field_simps
       add_poly_spec_def power2_eq_square cong: if_cong
       intro!: intro_spec_refine[where R=Id, simplified]
       split: option.splits dest: ideal.span_add)
    done
 qed
 
 (* Copy of WB_More_Refinement *)
 lemma RES_RES_RETURN_RES: \<open>RES A \<bind> (\<lambda>T. RES (f T)) = RES (\<Union>(f ` A))\<close>
   by (auto simp: pw_eq_iff refine_pw_simps)
 
 
 lemma check_add_alt_def:
   \<open>check_add A \<V> p q i r \<ge>
     do {
      b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars r \<subseteq> \<V>);
      if \<not>b
      then RETURN False
      else do {
        ASSERT (p \<in># dom_m A);
        let p = the (fmlookup A p);
        ASSERT (q \<in># dom_m A);
        let q = the (fmlookup A q);
        pq \<leftarrow> add_poly_spec p q;
        eq \<leftarrow> weak_equality pq r;
        RETURN eq
      }
   }\<close> (is \<open>_ \<ge> ?A\<close>)
 proof -
   have check_add_alt_def: \<open>check_add A \<V> p q i r = do {
      b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars r \<subseteq> \<V>);
      if \<not>b then SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars r \<subseteq> \<V> \<and>
             the (fmlookup A p) + the (fmlookup A q) - r \<in>  ideal polynomial_bool)
      else
        SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> q \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars r \<subseteq> \<V> \<and>
             the (fmlookup A p) + the (fmlookup A q) - r \<in>  ideal polynomial_bool)}\<close>
    (is \<open>_ = ?B\<close>)
     by (auto simp: check_add_def RES_RES_RETURN_RES)
    have \<open>?A \<le> \<Down> Id (check_add A \<V> p q i r)\<close>
      apply refine_vcg
      apply ((auto simp: check_add_alt_def weak_equality_def
         add_poly_spec_def RES_RES_RETURN_RES summarize_ASSERT_conv
       cong: if_cong
       intro!: ideal.span_zero;fail)+)
       done
    then show ?thesis
      unfolding check_add_alt_def[symmetric]
      by simp
 qed
 
 lemma check_mult_alt_def:
   \<open>check_mult A \<V> p q i r \<ge>
     do {
      b \<leftarrow> SPEC(\<lambda>b. b \<longrightarrow> p \<in># dom_m A \<and> i \<notin># dom_m A \<and> vars q \<subseteq> \<V>  \<and> vars r \<subseteq> \<V>);
      if \<not>b
      then RETURN False
      else do {
        ASSERT (p \<in># dom_m A);
        let p = the (fmlookup A p);
        pq \<leftarrow> mult_poly_spec p q;
        p \<leftarrow> weak_equality pq r;
        RETURN p
      }
   }\<close>
   unfolding check_mult_def
   apply (rule refine_IdD)
   by refine_vcg
    (auto simp: check_mult_def weak_equality_def
       mult_poly_spec_def RES_RES_RETURN_RES
     intro!:  ideal.span_zero
       exI[of _ \<open>the (fmlookup A p) * q\<close>])
 
 primrec insort_key_rel :: "('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where
 "insort_key_rel f x [] = [x]" |
 "insort_key_rel f x (y#ys) =
   (if f x y then (x#y#ys) else y#(insort_key_rel f x ys))"
 
 lemma set_insort_key_rel[simp]: \<open>set (insort_key_rel R x xs) = insert x (set xs)\<close>
   by (induction xs)
    auto
 
 lemma sorted_wrt_insort_key_rel:
    \<open>total_on R (insert x (set xs)) \<Longrightarrow> transp R \<Longrightarrow> reflp R \<Longrightarrow>
     sorted_wrt R xs \<Longrightarrow> sorted_wrt R (insort_key_rel R x xs)\<close>
   by (induction xs)
    (auto dest: transpD reflpD simp: Restricted_Predicates.total_on_def)
 
 lemma sorted_wrt_insort_key_rel2:
    \<open>total_on R (insert x (set xs)) \<Longrightarrow> transp R \<Longrightarrow> x \<notin> set xs \<Longrightarrow>
     sorted_wrt R xs \<Longrightarrow> sorted_wrt R (insort_key_rel R x xs)\<close>
   by (induction xs)
    (auto dest: transpD simp: Restricted_Predicates.total_on_def in_mono)
 
 
 paragraph \<open>Step checking\<close>
 
 definition PAC_checker_l_step ::  \<open>_ \<Rightarrow> string code_status \<times> string set \<times> _ \<Rightarrow> (llist_polynomial, string, nat) pac_step \<Rightarrow> _\<close> where
   \<open>PAC_checker_l_step = (\<lambda>spec (st', \<V>, A) st. case st of
      Add _ _ _ _ \<Rightarrow>
        do {
          r \<leftarrow> full_normalize_poly (pac_res st);
         eq \<leftarrow> check_addition_l spec A \<V> (pac_src1 st) (pac_src2 st) (new_id st) r;
         let _ = eq;
         if \<not>is_cfailed eq
         then RETURN (merge_cstatus st' eq,
           \<V>, fmupd (new_id st) r A)
         else RETURN (eq, \<V>, A)
    }
    | Del _ \<Rightarrow>
        do {
         eq \<leftarrow> check_del_l spec A (pac_src1 st);
         let _ = eq;
         if \<not>is_cfailed eq
         then RETURN (merge_cstatus st' eq, \<V>, fmdrop (pac_src1 st) A)
         else RETURN (eq, \<V>, A)
    }
    | Mult _ _ _ _ \<Rightarrow>
        do {
          r \<leftarrow> full_normalize_poly (pac_res st);
          q \<leftarrow> full_normalize_poly (pac_mult st);
         eq \<leftarrow> check_mult_l spec A \<V> (pac_src1 st) q (new_id st) r;
         let _ = eq;
         if \<not>is_cfailed eq
         then RETURN (merge_cstatus st' eq,
           \<V>, fmupd (new_id st) r A)
         else RETURN (eq, \<V>, A)
    }
    | Extension _ _ _ \<Rightarrow>
        do {
          r \<leftarrow> full_normalize_poly (([new_var st], -1) # (pac_res st));
         (eq) \<leftarrow> check_extension_l spec A \<V> (new_id st) (new_var st) r;
         if \<not>is_cfailed eq
         then do {
           RETURN (st',
             insert (new_var st) \<V>, fmupd (new_id st) r A)}
         else RETURN (eq, \<V>, A)
    }
  )\<close>
 
 lemma pac_step_rel_raw_def:
   \<open>\<langle>K, V, R\<rangle> pac_step_rel_raw = pac_step_rel_raw K V R\<close>
   by (auto intro!: ext simp: relAPP_def)
 
 definition mononoms_equal_up_to_reorder where
   \<open>mononoms_equal_up_to_reorder xs ys \<longleftrightarrow>
      map (\<lambda>(a, b).  (mset a, b)) xs = map (\<lambda>(a, b). (mset a, b)) ys\<close>
 
 
  definition normalize_poly_l where
   \<open>normalize_poly_l p = SPEC (\<lambda>p'.
      normalize_poly_p\<^sup>*\<^sup>* ((\<lambda>(a, b). (mset a, b)) `# mset p) ((\<lambda>(a, b). (mset a, b)) `# mset p') \<and>
      0 \<notin># snd `# mset p' \<and>
      sorted_wrt (rel2p (term_order_rel \<times>\<^sub>r int_rel)) p' \<and>
      (\<forall> x \<in> mononoms p'. sorted_wrt (rel2p var_order_rel) x))\<close>
 
 
 definition remap_polys_l_dom_err :: \<open>string nres\<close> where
   \<open>remap_polys_l_dom_err = SPEC (\<lambda>_. True)\<close>
 
 
 definition remap_polys_l :: \<open>llist_polynomial \<Rightarrow> string set \<Rightarrow> (nat, llist_polynomial) fmap \<Rightarrow>
    (_ code_status \<times> string set \<times> (nat, llist_polynomial) fmap) nres\<close> where
   \<open>remap_polys_l spec = (\<lambda>\<V> A. do{
    dom \<leftarrow> SPEC(\<lambda>dom. set_mset (dom_m A) \<subseteq> dom \<and> finite dom);
    failed \<leftarrow> SPEC(\<lambda>_::bool. True);
    if failed
    then do {
       c \<leftarrow> remap_polys_l_dom_err;
       RETURN (error_msg (0 :: nat) c, \<V>, fmempty)
    }
    else do {
      (b, \<V>, A) \<leftarrow> FOREACH dom
        (\<lambda>i (b, \<V>,  A').
           if i \<in># dom_m A
           then  do {
             p \<leftarrow> full_normalize_poly (the (fmlookup A i));
             eq \<leftarrow> weak_equality_l p spec;
             \<V> \<leftarrow> RETURN(\<V> \<union> vars_llist (the (fmlookup A i)));
             RETURN(b \<or> eq, \<V>, fmupd i p A')
           } else RETURN (b, \<V>, A'))
        (False, \<V>, fmempty);
      RETURN (if b then CFOUND else CSUCCESS, \<V>, A)
  }})\<close>
 
 definition PAC_checker_l where
   \<open>PAC_checker_l spec A b st = do {
     (S, _) \<leftarrow> WHILE\<^sub>T
        (\<lambda>((b, A), n). \<not>is_cfailed b \<and> n \<noteq> [])
        (\<lambda>((bA), n). do {
           ASSERT(n \<noteq> []);
           S \<leftarrow> PAC_checker_l_step spec bA (hd n);
           RETURN (S, tl n)
         })
       ((b, A), st);
     RETURN S
   }\<close>
 
 
 subsection \<open>Correctness\<close>
 
 text \<open>We now enter the locale to reason about polynomials directly.\<close>
 
 context poly_embed
 begin
 
 abbreviation pac_step_rel where
   \<open>pac_step_rel \<equiv> p2rel (\<langle>Id, fully_unsorted_poly_rel O mset_poly_rel, var_rel\<rangle> pac_step_rel_raw)\<close>
 
 abbreviation fmap_polys_rel where
   \<open>fmap_polys_rel \<equiv> \<langle>nat_rel, sorted_poly_rel O mset_poly_rel\<rangle>fmap_rel\<close>
 
 lemma
   \<open>normalize_poly_p s0 s \<Longrightarrow>
         (s0, p) \<in> mset_poly_rel \<Longrightarrow>
         (s, p) \<in> mset_poly_rel\<close>
   by (auto simp: mset_poly_rel_def normalize_poly_p_poly_of_mset)
 
 lemma vars_poly_of_vars:
   \<open>vars (poly_of_vars a :: int mpoly) \<subseteq> (\<phi> ` set_mset a)\<close>
   by (induction a)
    (auto simp: vars_mult_Var)
 
 lemma vars_polynomial_of_mset:
   \<open>vars (polynomial_of_mset za) \<subseteq> \<Union>(image \<phi> ` (set_mset o fst) ` set_mset za)\<close>
   apply (induction za)
   using vars_poly_of_vars
   by (fastforce elim!: in_vars_addE simp: vars_mult_Const split: if_splits)+
 
 lemma fully_unsorted_poly_rel_vars_subset_vars_llist:
   \<open>(A, B) \<in> fully_unsorted_poly_rel O mset_poly_rel \<Longrightarrow> vars B \<subseteq> \<phi> ` vars_llist A\<close>
   by (auto simp: fully_unsorted_poly_list_rel_def mset_poly_rel_def
       set_rel_def var_rel_def br_def vars_llist_def list_rel_append2 list_rel_append1
       list_rel_split_right_iff list_mset_rel_def image_iff
       unsorted_term_poly_list_rel_def list_rel_split_left_iff
     dest!: set_rev_mp[OF _ vars_polynomial_of_mset] split_list
     dest: multi_member_split
     dest: arg_cong[of \<open>mset _\<close> \<open>add_mset _ _\<close> set_mset])
 
 lemma fully_unsorted_poly_rel_extend_vars:
   \<open>(A, B) \<in> fully_unsorted_poly_rel O mset_poly_rel \<Longrightarrow>
   (x1c, x1a) \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
    RETURN (x1c \<union> vars_llist A)
     \<le> \<Down> (\<langle>var_rel\<rangle>set_rel)
        (SPEC ((\<subseteq>) (x1a \<union> vars (B))))\<close>
   using fully_unsorted_poly_rel_vars_subset_vars_llist[of A B]
   apply (subst RETURN_RES_refine_iff)
   apply clarsimp
   apply (rule exI[of _ \<open>x1a \<union> \<phi> ` vars_llist A\<close>])
   apply (auto simp: set_rel_def var_rel_def br_def
     dest: fully_unsorted_poly_rel_vars_subset_vars_llist)
   done
 
 lemma remap_polys_l_remap_polys:
   assumes
     AB: \<open>(A, B) \<in> \<langle>nat_rel, fully_unsorted_poly_rel O mset_poly_rel\<rangle>fmap_rel\<close> and
     spec: \<open>(spec, spec') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     V: \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel\<close>
   shows \<open>remap_polys_l spec \<V> A \<le>
      \<Down>(code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) (remap_polys spec' \<V>' B)\<close>
   (is \<open>_ \<le> \<Down> ?R _\<close>)
 proof -
   have 1: \<open>inj_on id (dom :: nat set)\<close> for dom
     by auto
   have H: \<open>x \<in># dom_m A \<Longrightarrow>
      (\<And>p. (the (fmlookup A x), p) \<in> fully_unsorted_poly_rel \<Longrightarrow>
        (p, the (fmlookup B x)) \<in> mset_poly_rel \<Longrightarrow> thesis) \<Longrightarrow>
      thesis\<close> for x thesis
      using fmap_rel_nat_the_fmlookup[OF AB, of x x] fmap_rel_nat_rel_dom_m[OF AB] by auto
   have full_normalize_poly: \<open>full_normalize_poly (the (fmlookup A x))
        \<le> \<Down> (sorted_poly_rel O mset_poly_rel)
           (SPEC
             (\<lambda>p. the (fmlookup B x') - p \<in> More_Modules.ideal polynomial_bool \<and>
                  vars p \<subseteq> vars (the (fmlookup B x'))))\<close>
       if x_dom: \<open>x \<in># dom_m A\<close> and \<open>(x, x') \<in> Id\<close> for x x'
       apply (rule H[OF x_dom])
       subgoal for p
       apply (rule full_normalize_poly_normalize_poly_p[THEN order_trans])
       apply assumption
       subgoal
         using that(2) apply -
         unfolding conc_fun_chain[symmetric]
         by (rule ref_two_step', rule RES_refine)
          (auto simp: rtranclp_normalize_poly_p_poly_of_mset
           mset_poly_rel_def ideal.span_zero)
       done
       done
 
   have H': \<open>(p, pa) \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
      weak_equality_l p spec \<le> SPEC (\<lambda>eqa. eqa \<longrightarrow> pa = spec')\<close> for p pa
     using spec by (auto simp: weak_equality_l_def weak_equality_spec_def
         list_mset_rel_def br_def mset_poly_rel_def
       dest: list_rel_term_poly_list_rel_same_rightD sorted_poly_list_relD)
 
   have emp: \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
     ((False, \<V>, fmempty), False, \<V>', fmempty) \<in> bool_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel\<close> for \<V> \<V>'
     by auto
   show ?thesis
     using assms
     unfolding remap_polys_l_def remap_polys_l_dom_err_def
       remap_polys_def prod.case
     apply (refine_rcg full_normalize_poly fmap_rel_fmupd_fmap_rel)
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by (auto simp: error_msg_def)
     apply (rule 1)
     subgoal by auto
     apply (rule emp)
     subgoal
       using V by auto
     subgoal by auto
     subgoal by auto
     subgoal by (rule H')
     apply (rule fully_unsorted_poly_rel_extend_vars)
     subgoal by (auto intro!: fmap_rel_nat_the_fmlookup)
     subgoal by (auto intro!: fmap_rel_fmupd_fmap_rel)
     subgoal by (auto intro!: fmap_rel_fmupd_fmap_rel)
     subgoal by auto
     subgoal by auto
     done
 qed
 
 
 lemma fref_to_Down_curry:
   \<open>(uncurry f, uncurry g) \<in> [P]\<^sub>f A \<rightarrow> \<langle>B\<rangle>nres_rel \<Longrightarrow>
      (\<And>x x' y y'. P (x', y') \<Longrightarrow> ((x, y), (x', y')) \<in> A \<Longrightarrow> f x y \<le> \<Down> B (g x' y'))\<close>
   unfolding fref_def uncurry_def nres_rel_def
   by auto
 
 lemma weak_equality_spec_weak_equality:
   \<open>(p, p') \<in> mset_poly_rel \<Longrightarrow>
     (r, r') \<in> mset_poly_rel \<Longrightarrow>
     weak_equality_spec p r \<le> weak_equality p' r'\<close>
   unfolding weak_equality_spec_def weak_equality_def
   by (auto simp: mset_poly_rel_def)
 
 
 lemma weak_equality_l_weak_equality_l'[refine]:
   \<open>weak_equality_l p q \<le> \<Down> bool_rel (weak_equality p' q')\<close>
   if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
     \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
   for p p' q q'
   using that
   by (auto intro!: weak_equality_l_weak_equality_spec[THEN fref_to_Down_curry, THEN order_trans]
          ref_two_step'
          weak_equality_spec_weak_equality
       simp flip: conc_fun_chain)
 
 lemma error_msg_ne_SUCCES[iff]:
   \<open>error_msg i m \<noteq> CSUCCESS\<close>
   \<open>error_msg i m \<noteq> CFOUND\<close>
   \<open>is_cfailed (error_msg i m)\<close>
   \<open>\<not>is_cfound (error_msg i m)\<close>
   by (auto simp: error_msg_def)
 
 lemma sorted_poly_rel_vars_llist:
   \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
    vars r' \<subseteq> \<phi> ` vars_llist r\<close>
   apply (auto simp: mset_poly_rel_def
       set_rel_def var_rel_def br_def vars_llist_def list_rel_append2 list_rel_append1
       list_rel_split_right_iff list_mset_rel_def image_iff sorted_poly_list_rel_wrt_def
     dest!: set_rev_mp[OF _ vars_polynomial_of_mset]
     dest!: split_list)
     apply (auto dest!: multi_member_split simp: list_rel_append1
       term_poly_list_rel_def eq_commute[of _ \<open>mset _\<close>]
       list_rel_split_right_iff list_rel_append2 list_rel_split_left_iff
       dest: arg_cong[of \<open>mset _\<close> \<open>add_mset _ _\<close> set_mset])
     done
 
 
 lemma check_addition_l_check_add:
   assumes \<open>(A, B) \<in> fmap_polys_rel\<close> and \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close>
     \<open>(p, p') \<in> Id\<close> \<open>(q, q') \<in> Id\<close> \<open>(i, i') \<in> nat_rel\<close>
     \<open>(\<V>', \<V>) \<in> \<langle>var_rel\<rangle>set_rel\<close>
   shows
     \<open>check_addition_l spec A \<V>' p q i r \<le> \<Down> {(st, b). (\<not>is_cfailed st \<longleftrightarrow> b) \<and>
        (is_cfound st \<longrightarrow> spec = r)} (check_add B \<V> p' q' i' r')\<close>
 proof -
   have [refine]:
     \<open>add_poly_l (p, q) \<le> \<Down> (sorted_poly_rel O mset_poly_rel) (add_poly_spec p' q')\<close>
     if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
       \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     for p p' q q'
     using that
     by (auto intro!: add_poly_l_add_poly_p'[THEN order_trans] ref_two_step'
          add_poly_p'_add_poly_spec
       simp flip: conc_fun_chain)
 
   show ?thesis
     using assms
     unfolding check_addition_l_def
       check_not_equal_dom_err_def apply -
     apply (rule order_trans)
     defer
     apply (rule ref_two_step')
     apply (rule check_add_alt_def)
     apply refine_rcg
     subgoal
       by (drule sorted_poly_rel_vars_llist)
        (auto simp: set_rel_def var_rel_def br_def)
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by (auto simp: weak_equality_l_def bind_RES_RETURN_eq)
     done
 qed
 
 lemma check_del_l_check_del:
   \<open>(A, B) \<in> fmap_polys_rel \<Longrightarrow> (x3, x3a) \<in> Id \<Longrightarrow> check_del_l spec A (pac_src1 (Del x3))
     \<le> \<Down> {(st, b). (\<not>is_cfailed st \<longleftrightarrow> b) \<and> (b \<longrightarrow> st = CSUCCESS)} (check_del B (pac_src1 (Del x3a)))\<close>
   unfolding check_del_l_def check_del_def
   by (refine_vcg lhs_step_If RETURN_SPEC_refine)
     (auto simp: fmap_rel_nat_rel_dom_m bind_RES_RETURN_eq)
 
 lemma check_mult_l_check_mult:
   assumes \<open>(A, B) \<in> fmap_polys_rel\<close> and \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     \<open>(p, p') \<in> Id\<close> \<open>(i, i') \<in> nat_rel\<close> \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel\<close>
   shows
     \<open>check_mult_l spec A \<V> p q i r \<le> \<Down>  {(st, b). (\<not>is_cfailed st \<longleftrightarrow> b) \<and>
        (is_cfound st \<longrightarrow> spec = r)} (check_mult B \<V>' p' q' i' r')\<close>
 proof -
   have [refine]:
     \<open>mult_poly_full p q \<le> \<Down> (sorted_poly_rel O mset_poly_rel) (mult_poly_spec p' q')\<close>
     if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
       \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     for p p' q q'
     using that
     by (auto intro!: mult_poly_full_mult_poly_p'[THEN order_trans] ref_two_step'
          mult_poly_p'_mult_poly_spec
       simp flip: conc_fun_chain)
 
   show ?thesis
     using assms
     unfolding check_mult_l_def
       check_mult_l_mult_err_def check_mult_l_dom_err_def apply -
     apply (rule order_trans)
     defer
     apply (rule ref_two_step')
     apply (rule check_mult_alt_def)
     apply refine_rcg
     subgoal
       by (drule sorted_poly_rel_vars_llist)+
         (fastforce simp: set_rel_def var_rel_def br_def)
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by auto
     subgoal
       by (auto simp: weak_equality_l_def bind_RES_RETURN_eq)
     done
 qed
 
 
 lemma normalize_poly_normalize_poly_spec:
   assumes \<open>(r, t) \<in> unsorted_poly_rel O mset_poly_rel\<close>
   shows
     \<open>normalize_poly r \<le> \<Down>(sorted_poly_rel O mset_poly_rel) (normalize_poly_spec t)\<close>
 proof -
   obtain s where
     rs: \<open>(r, s) \<in> unsorted_poly_rel\<close> and
     st: \<open>(s, t) \<in> mset_poly_rel\<close>
     using assms by auto
   show ?thesis
     by (rule normalize_poly_normalize_poly_p[THEN order_trans, OF rs])
      (use st in \<open>auto dest!: rtranclp_normalize_poly_p_poly_of_mset
       intro!: ref_two_step' RES_refine exI[of _ t]
       simp: normalize_poly_spec_def ideal.span_zero mset_poly_rel_def
       simp flip: conc_fun_chain\<close>)
 qed
 
 lemma remove1_list_rel:
   \<open>(xs, ys) \<in> \<langle>R\<rangle> list_rel \<Longrightarrow>
   (a, b) \<in> R \<Longrightarrow>
   IS_RIGHT_UNIQUE R \<Longrightarrow>
   IS_LEFT_UNIQUE R \<Longrightarrow>
   (remove1 a xs, remove1 b ys) \<in> \<langle>R\<rangle>list_rel\<close>
   by (induction xs ys rule: list_rel_induct)
    (auto simp: single_valued_def IS_LEFT_UNIQUE_def)
 
 lemma remove1_list_rel2:
   \<open>(xs, ys) \<in> \<langle>R\<rangle> list_rel \<Longrightarrow>
   (a, b) \<in> R \<Longrightarrow>
   (\<And>c. (a, c) \<in> R \<Longrightarrow> c = b) \<Longrightarrow>
   (\<And>c. (c, b) \<in> R \<Longrightarrow> c = a) \<Longrightarrow>
   (remove1 a xs, remove1 b ys) \<in> \<langle>R\<rangle>list_rel\<close>
   apply (induction xs ys rule: list_rel_induct)
    apply (solves \<open>simp (no_asm)\<close>)
   by (smt list_rel_simp(4) remove1.simps(2))
 
 lemma remove1_sorted_poly_rel_mset_poly_rel:
   assumes
     \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>([a], 1) \<in> set r\<close>
   shows
     \<open>(remove1 ([a], 1) r, r' - Var (\<phi> a))
           \<in> sorted_poly_rel O mset_poly_rel\<close>
 proof -
    have [simp]: \<open>([a], {#a#}) \<in> term_poly_list_rel\<close>
      \<open>\<And>aa. ([a], aa) \<in> term_poly_list_rel \<longleftrightarrow> aa = {#a#}\<close>
      by (auto simp: term_poly_list_rel_def)
   have H:
     \<open>\<And>aa. ([a], aa) \<in> term_poly_list_rel \<Longrightarrow> aa = {#a#}\<close>
      \<open>\<And>aa. (aa, {#a#}) \<in> term_poly_list_rel \<Longrightarrow> aa = [a]\<close>
      by (auto simp: single_valued_def IS_LEFT_UNIQUE_def
        term_poly_list_rel_def)
 
   have [simp]: \<open>Const (1 :: int) = (1 :: int mpoly)\<close>
     by (simp add: Const.abs_eq Const\<^sub>0_one one_mpoly.abs_eq)
   have [simp]: \<open>sorted_wrt term_order (map fst r) \<Longrightarrow>
          sorted_wrt term_order (map fst (remove1 ([a], 1) r))\<close>
     by (induction r) auto
   have [intro]: \<open>distinct (map fst r) \<Longrightarrow> distinct (map fst (remove1 x r))\<close> for x
-    by (induction r) (auto dest: in_set_remove1D)
+    by (induction r) (auto dest: notin_set_remove1)
   have [simp]: \<open>(r, ya) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
          polynomial_of_mset (mset ya) -  Var (\<phi> a) =
          polynomial_of_mset (remove1_mset ({#a#}, 1) (mset ya))\<close> for ya
     using assms
      by (auto simp: list_rel_append1 list_rel_split_right_iff
        dest!: split_list)
 
   show ?thesis
     using assms
     apply (elim relcompEpair)
     apply (rename_tac za, rule_tac b = \<open>remove1_mset ({#a#}, 1) za\<close> in relcompI)
     apply (auto simp: mset_poly_rel_def sorted_poly_list_rel_wrt_def Collect_eq_comp'
       intro!: relcompI[of _ \<open>remove1 ({#a#}, 1) ya\<close>
         for ya :: \<open>(string multiset \<times> int) list\<close>]  remove1_list_rel2 intro: H
       simp: list_mset_rel_def br_def
       dest: in_diffD)
     done
 qed
 
 lemma remove1_sorted_poly_rel_mset_poly_rel_minus:
   assumes
     \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>([a], -1) \<in> set r\<close>
   shows
     \<open>(remove1 ([a], -1) r, r' + Var (\<phi> a))
           \<in> sorted_poly_rel O mset_poly_rel\<close>
 proof -
    have [simp]: \<open>([a], {#a#}) \<in> term_poly_list_rel\<close>
      \<open>\<And>aa. ([a], aa) \<in> term_poly_list_rel \<longleftrightarrow> aa = {#a#}\<close>
      by (auto simp: term_poly_list_rel_def)
   have H:
     \<open>\<And>aa. ([a], aa) \<in> term_poly_list_rel \<Longrightarrow> aa = {#a#}\<close>
      \<open>\<And>aa. (aa, {#a#}) \<in> term_poly_list_rel \<Longrightarrow> aa = [a]\<close>
      by (auto simp: single_valued_def IS_LEFT_UNIQUE_def
        term_poly_list_rel_def)
 
   have [simp]: \<open>Const (1 :: int) = (1 :: int mpoly)\<close>
     by (simp add: Const.abs_eq Const\<^sub>0_one one_mpoly.abs_eq)
   have [simp]: \<open>sorted_wrt term_order (map fst r) \<Longrightarrow>
          sorted_wrt term_order (map fst (remove1 ([a], -1) r))\<close>
     by (induction r) auto
   have [intro]: \<open>distinct (map fst r) \<Longrightarrow> distinct (map fst (remove1 x r))\<close> for x
     apply (induction r) apply auto
     by (meson img_fst in_set_remove1D)
   have [simp]: \<open>(r, ya) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
          polynomial_of_mset (mset ya) +  Var (\<phi> a) =
          polynomial_of_mset (remove1_mset ({#a#}, -1) (mset ya))\<close> for ya
     using assms
      by (auto simp: list_rel_append1 list_rel_split_right_iff
        dest!: split_list)
 
   show ?thesis
     using assms
     apply (elim relcompEpair)
     apply (rename_tac za, rule_tac b = \<open>remove1_mset ({#a#}, -1) za\<close> in relcompI)
     by (auto simp: mset_poly_rel_def sorted_poly_list_rel_wrt_def Collect_eq_comp'
        dest: in_diffD
        intro!: relcompI[of _ \<open>remove1 ({#a#}, -1) ya\<close>
          for ya :: \<open>(string multiset \<times> int) list\<close>]  remove1_list_rel2 intro: H
       simp: list_mset_rel_def br_def)
 qed
 
 
 lemma insert_var_rel_set_rel:
   \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
   (yb, x2) \<in> var_rel \<Longrightarrow>
   (insert yb \<V>, insert x2 \<V>') \<in> \<langle>var_rel\<rangle>set_rel\<close>
   by (auto simp: var_rel_def set_rel_def)
 
 lemma var_rel_set_rel_iff:
   \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
   (yb, x2) \<in> var_rel \<Longrightarrow>
   yb \<in> \<V> \<longleftrightarrow> x2 \<in>  \<V>'\<close>
   using \<phi>_inj inj_eq by (fastforce simp: var_rel_def set_rel_def br_def)
 
 
 lemma check_extension_l_check_extension:
   assumes \<open>(A, B) \<in> fmap_polys_rel\<close> and \<open>(r, r') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>(i, i') \<in> nat_rel\<close> \<open>(\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel\<close> \<open>(x, x') \<in> var_rel\<close>
   shows
     \<open>check_extension_l spec A \<V> i x r \<le>
       \<Down>{((st), (b)).
         (\<not>is_cfailed st \<longleftrightarrow> b) \<and>
        (is_cfound st \<longrightarrow> spec = r)} (check_extension B \<V>' i' x' r')\<close>
 proof -
   have \<open>x' = \<phi> x\<close>
     using assms(5) by (auto simp: var_rel_def br_def)
   have [refine]:
     \<open>mult_poly_full p q \<le> \<Down> (sorted_poly_rel O mset_poly_rel) (mult_poly_spec p' q')\<close>
     if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
       \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     for p p' q q'
     using that
     by (auto intro!: mult_poly_full_mult_poly_p'[THEN order_trans] ref_two_step'
          mult_poly_p'_mult_poly_spec
       simp flip: conc_fun_chain)
   have [refine]:
     \<open>add_poly_l (p, q) \<le> \<Down> (sorted_poly_rel O mset_poly_rel) (add_poly_spec p' q')\<close>
     if \<open>(p, p') \<in> sorted_poly_rel O mset_poly_rel\<close>
       \<open>(q, q') \<in> sorted_poly_rel O mset_poly_rel\<close>
     for p p' q q'
     using that
     by (auto intro!: add_poly_l_add_poly_p'[THEN order_trans] ref_two_step'
          add_poly_p'_add_poly_spec
       simp flip: conc_fun_chain)
 
   have [simp]: \<open>(l, l') \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
        (map (\<lambda>(a, b). (a, - b)) l, map (\<lambda>(a, b). (a, - b)) l')
        \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close> for l l'
      by (induction l l'  rule: list_rel_induct)
         (auto simp: list_mset_rel_def br_def)
 
   have [intro!]:
     \<open>(x2c, za) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel \<Longrightarrow>
      (map (\<lambda>(a, b). (a, - b)) x2c,
         {#case x of (a, b) \<Rightarrow> (a, - b). x \<in># za#})
        \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel O list_mset_rel\<close> for x2c za
      apply (auto)
      subgoal for y
        apply (induction x2c y  rule: list_rel_induct)
        apply (auto simp: list_mset_rel_def br_def)
        apply (rename_tac a ba aa l l', rule_tac b = \<open>(aa, - ba) # map (\<lambda>(a, b). (a, - b)) l'\<close> in relcompI)
        by auto
      done
   have [simp]: \<open>(\<lambda>x. fst (case x of (a, b) \<Rightarrow> (a, - b))) = fst\<close>
     by (auto intro: ext)
 
   have uminus: \<open>(x2c, x2a) \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
        (map (\<lambda>(a, b). (a, - b)) x2c,
         - x2a)
        \<in> sorted_poly_rel O mset_poly_rel\<close> for x2c x2a x1c x1a
      apply (clarsimp simp: sorted_poly_list_rel_wrt_def
       mset_poly_rel_def)
     apply (rule_tac b = \<open>(\<lambda>(a, b). (a, - b)) `# za\<close> in relcompI)
     by (auto simp: sorted_poly_list_rel_wrt_def
       mset_poly_rel_def comp_def polynomial_of_mset_uminus)
    have [simp]: \<open>([], 0) \<in> sorted_poly_rel O mset_poly_rel\<close>
      by (auto simp: sorted_poly_list_rel_wrt_def
       mset_poly_rel_def list_mset_rel_def br_def
       intro!: relcompI[of _ \<open>{#}\<close>])
    show ?thesis
      unfolding check_extension_l_def
        check_extension_l_dom_err_def
        check_extension_l_no_new_var_err_def
        check_extension_l_new_var_multiple_err_def
        check_extension_l_side_cond_err_def
       apply (rule order_trans)
       defer
       apply (rule ref_two_step')
       apply (rule check_extension_alt_def)
       apply (refine_vcg )
       subgoal using assms(1,3,4,5)
         by (auto simp: var_rel_set_rel_iff)
       subgoal using assms(1,3,4,5)
         by (auto simp: var_rel_set_rel_iff)
       subgoal by auto
       subgoal by auto
       apply (subst \<open>x' = \<phi> x\<close>, rule remove1_sorted_poly_rel_mset_poly_rel_minus)
       subgoal using assms by auto
       subgoal using assms by auto
       subgoal using sorted_poly_rel_vars_llist[of \<open>r\<close> \<open>r'\<close>] assms
         by (force simp: set_rel_def var_rel_def br_def
           dest!: sorted_poly_rel_vars_llist)
       subgoal by auto
       subgoal by auto
       subgoal using assms by auto
       subgoal using assms by auto
       apply (rule uminus)
       subgoal using assms by auto
       subgoal using assms by auto
       subgoal using assms by auto
       subgoal using assms by auto
       subgoal using assms by auto
       done
 qed
 
 
 lemma full_normalize_poly_diff_ideal:
   fixes dom
   assumes \<open>(p, p') \<in> fully_unsorted_poly_rel O mset_poly_rel\<close>
   shows
     \<open>full_normalize_poly p
     \<le> \<Down> (sorted_poly_rel O mset_poly_rel)
        (normalize_poly_spec p')\<close>
 proof -
   obtain q where
     pq: \<open>(p, q) \<in> fully_unsorted_poly_rel\<close>  and qp':\<open>(q, p') \<in> mset_poly_rel\<close>
     using assms by auto
    show ?thesis
      unfolding normalize_poly_spec_def
      apply (rule full_normalize_poly_normalize_poly_p[THEN order_trans])
      apply (rule pq)
      unfolding conc_fun_chain[symmetric]
      by (rule ref_two_step', rule RES_refine)
        (use qp' in \<open>auto dest!: rtranclp_normalize_poly_p_poly_of_mset
             simp: mset_poly_rel_def ideal.span_zero\<close>)
 qed
 
 lemma insort_key_rel_decomp:
    \<open>\<exists>ys zs. xs = ys @ zs \<and> insort_key_rel R x xs = ys @ x # zs\<close>
   apply (induction xs)
   subgoal by auto
   subgoal for a xs
     by (force intro: exI[of _ \<open>a # _\<close>])
   done
 
 lemma list_rel_append_same_length:
    \<open>length xs = length xs' \<Longrightarrow> (xs @ ys, xs' @ ys') \<in> \<langle>R\<rangle>list_rel \<longleftrightarrow> (xs, xs') \<in> \<langle>R\<rangle>list_rel \<and> (ys, ys') \<in> \<langle>R\<rangle>list_rel\<close>
   by (auto simp: list_rel_def list_all2_append2 dest: list_all2_lengthD)
 
 lemma term_poly_list_rel_list_relD: \<open>(ys, cs) \<in> \<langle>term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
        cs = map (\<lambda>(a, y). (mset a, y)) ys\<close>
   by (induction ys arbitrary: cs)
    (auto simp: term_poly_list_rel_def list_rel_def list_all2_append list_all2_Cons1 list_all2_Cons2)
 
 lemma term_poly_list_rel_single: \<open>([x32], {#x32#}) \<in> term_poly_list_rel\<close>
   by (auto simp: term_poly_list_rel_def)
 
 lemma unsorted_poly_rel_list_rel_list_rel_uminus:
    \<open>(map (\<lambda>(a, b). (a, - b)) r, yc)
        \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
        (r, map (\<lambda>(a, b). (a, - b)) yc)
        \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel\<close>
   by (induction r arbitrary: yc)
    (auto simp: elim!: list_relE3)
 
 lemma mset_poly_rel_minus: \<open>({#(a, b)#}, v') \<in> mset_poly_rel \<Longrightarrow>
        (mset yc, r') \<in> mset_poly_rel \<Longrightarrow>
        (r, yc)
        \<in> \<langle>unsorted_term_poly_list_rel \<times>\<^sub>r int_rel\<rangle>list_rel \<Longrightarrow>
        (add_mset (a, b) (mset yc),
         v' + r')
        \<in> mset_poly_rel\<close>
   by (induction r arbitrary: r')
     (auto simp: mset_poly_rel_def polynomial_of_mset_uminus)
 
 lemma fully_unsorted_poly_rel_diff:
    \<open>([v], v') \<in> fully_unsorted_poly_rel O mset_poly_rel \<Longrightarrow>
    (r, r') \<in> fully_unsorted_poly_rel O mset_poly_rel \<Longrightarrow>
     (v # r,
      v' + r')
     \<in> fully_unsorted_poly_rel O mset_poly_rel\<close>
   apply auto
   apply (rule_tac b = \<open>y + ya\<close> in relcompI)
   apply (auto simp: fully_unsorted_poly_list_rel_def list_mset_rel_def br_def)
   apply (rule_tac b = \<open>yb @ yc\<close> in relcompI)
   apply (auto elim!: list_relE3 simp: unsorted_poly_rel_list_rel_list_rel_uminus mset_poly_rel_minus)
   done
 
 lemma PAC_checker_l_step_PAC_checker_step:
   assumes
     \<open>(Ast, Bst) \<in> code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel\<close> and
     \<open>(st, st') \<in> pac_step_rel\<close> and
     spec: \<open>(spec, spec') \<in> sorted_poly_rel O mset_poly_rel\<close>
   shows
     \<open>PAC_checker_l_step spec Ast st \<le> \<Down> (code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) (PAC_checker_step spec' Bst st')\<close>
 proof -
   obtain A \<V> cst B \<V>' cst' where
    Ast: \<open>Ast = (cst, \<V>, A)\<close> and
    Bst: \<open>Bst = (cst', \<V>', B)\<close> and
    \<V>[intro]: \<open>(\<V>, \<V>') \<in>  \<langle>var_rel\<rangle>set_rel\<close>  and
    AB: \<open>(A, B) \<in> fmap_polys_rel\<close>
      \<open>(cst, cst') \<in> code_status_status_rel\<close>
     using assms(1)
     by (cases Ast; cases Bst; auto)
   have [refine]: \<open>(r, ra) \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
        (eqa, eqaa)
        \<in> {(st, b). (\<not> is_cfailed st \<longleftrightarrow> b) \<and> (is_cfound st \<longrightarrow> spec = r)} \<Longrightarrow>
        RETURN eqa
        \<le> \<Down> code_status_status_rel
           (SPEC
             (\<lambda>st'. (\<not> is_failed st' \<and>
                    is_found st' \<longrightarrow>
                     ra - spec' \<in> More_Modules.ideal polynomial_bool)))\<close>
      for r ra eqa eqaa
      using spec
      by (cases eqa)
        (auto intro!: RETURN_RES_refine dest!: sorted_poly_list_relD
          simp: mset_poly_rel_def ideal.span_zero)
   have [simp]: \<open>(eqa, st'a) \<in> code_status_status_rel \<Longrightarrow>
        (merge_cstatus cst eqa, merge_status cst' st'a)
        \<in> code_status_status_rel\<close> for eqa st'a
      using AB
      by (cases eqa; cases st'a)
        (auto simp: code_status_status_rel_def)
   have [simp]: \<open>(merge_cstatus cst CSUCCESS, cst') \<in> code_status_status_rel\<close>
     using AB
     by (cases st)
       (auto simp: code_status_status_rel_def)
   have [simp]: \<open>(x32, x32a) \<in> var_rel \<Longrightarrow>
         ([([x32], -1::int)], -Var x32a) \<in> fully_unsorted_poly_rel O mset_poly_rel\<close> for x32 x32a
    by (auto simp: mset_poly_rel_def fully_unsorted_poly_list_rel_def list_mset_rel_def br_def
          unsorted_term_poly_list_rel_def var_rel_def Const_1_eq_1
        intro!: relcompI[of _ \<open>{#({#x32#}, -1 :: int)#}\<close>]
          relcompI[of _ \<open>[({#x32#}, -1)]\<close>])
   have H3: \<open>p - Var a = (-Var a) + p\<close> for p :: \<open>int mpoly\<close> and a
     by auto
   show ?thesis
     using assms(2)
     unfolding PAC_checker_l_step_def PAC_checker_step_def Ast Bst prod.case
     apply (cases st; cases st'; simp only: p2rel_def pac_step.case
       pac_step_rel_raw_def mem_Collect_eq prod.case pac_step_rel_raw.simps)
     subgoal
       apply (refine_rcg normalize_poly_normalize_poly_spec
         check_mult_l_check_mult check_addition_l_check_add
         full_normalize_poly_diff_ideal)
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal by auto
       subgoal by auto
       subgoal by auto
       subgoal by (auto intro: \<V>)
       apply assumption+
       subgoal
         by (auto simp: code_status_status_rel_def)
       subgoal
         by (auto intro!: fmap_rel_fmupd_fmap_rel
           fmap_rel_fmdrop_fmap_rel AB)
       subgoal using AB by auto
       done
     subgoal
       apply (refine_rcg normalize_poly_normalize_poly_spec
         check_mult_l_check_mult check_addition_l_check_add
         full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]])
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal by auto
       subgoal by auto
       subgoal by auto
       apply assumption+
       subgoal
         by (auto simp: code_status_status_rel_def)
       subgoal
         by (auto intro!: fmap_rel_fmupd_fmap_rel
           fmap_rel_fmdrop_fmap_rel AB)
       subgoal using AB by auto
       done
     subgoal
       apply (refine_rcg full_normalize_poly_diff_ideal
         check_extension_l_check_extension)
       subgoal using AB by (auto intro!: fully_unsorted_poly_rel_diff[of _ \<open>-Var _ :: int mpoly\<close>, unfolded H3[symmetric]] simp: comp_def case_prod_beta)
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal by auto
       subgoal by auto
       subgoal
         by (auto simp: code_status_status_rel_def)
       subgoal
         by (auto simp: AB
           intro!: fmap_rel_fmupd_fmap_rel insert_var_rel_set_rel)
       subgoal
         by (auto simp: code_status_status_rel_def AB
           code_status.is_cfailed_def)
       done
     subgoal
       apply (refine_rcg normalize_poly_normalize_poly_spec
         check_del_l_check_del check_addition_l_check_add
         full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]])
       subgoal using AB by auto
       subgoal using AB by auto
       subgoal
         by (auto intro!: fmap_rel_fmupd_fmap_rel
           fmap_rel_fmdrop_fmap_rel code_status_status_rel_def AB)
       subgoal
         by (auto intro!: fmap_rel_fmupd_fmap_rel
           fmap_rel_fmdrop_fmap_rel AB)
       done
     done
 qed
 
 lemma code_status_status_rel_discrim_iff:
   \<open>(x1a, x1c) \<in> code_status_status_rel \<Longrightarrow> is_cfailed x1a \<longleftrightarrow> is_failed x1c\<close>
   \<open>(x1a, x1c) \<in> code_status_status_rel \<Longrightarrow> is_cfound x1a \<longleftrightarrow> is_found x1c\<close>
   by (cases x1a; cases x1c; auto; fail)+
 
 lemma PAC_checker_l_PAC_checker:
   assumes
     \<open>(A, B) \<in> \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel\<close> and
     \<open>(st, st') \<in> \<langle>pac_step_rel\<rangle>list_rel\<close> and
     \<open>(spec, spec') \<in> sorted_poly_rel O mset_poly_rel\<close> and
     \<open>(b, b') \<in> code_status_status_rel\<close>
   shows
     \<open>PAC_checker_l spec A b st \<le> \<Down> (code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) (PAC_checker spec' B b' st')\<close>
 proof -
   have [refine0]: \<open>(((b, A), st), (b', B), st') \<in> ((code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) \<times>\<^sub>r  \<langle>pac_step_rel\<rangle>list_rel)\<close>
     using assms by (auto simp: code_status_status_rel_def)
   show ?thesis
     using assms
     unfolding PAC_checker_l_def PAC_checker_def
     apply (refine_rcg PAC_checker_l_step_PAC_checker_step
       WHILEIT_refine[where R = \<open>((bool_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) \<times>\<^sub>r \<langle>pac_step_rel\<rangle>list_rel)\<close>])
     subgoal by (auto simp: code_status_status_rel_discrim_iff)
     subgoal by auto
     subgoal by (auto simp: neq_Nil_conv)
     subgoal by (auto simp: neq_Nil_conv intro!: param_nth)
     subgoal by (auto simp: neq_Nil_conv)
     subgoal by auto
     done
 qed
 
 end
 
 lemma less_than_char_of_char[code_unfold]:
   \<open>(x, y) \<in> less_than_char \<longleftrightarrow> (of_char x :: nat) < of_char y\<close>
   by (auto simp: less_than_char_def less_char_def)
 
 
 lemmas [code] =
   add_poly_l'.simps[unfolded var_order_rel_def]
 
 export_code add_poly_l' in SML module_name test
 
 definition full_checker_l
   :: \<open>llist_polynomial \<Rightarrow> (nat, llist_polynomial) fmap \<Rightarrow> (_, string, nat) pac_step list \<Rightarrow>
     (string code_status \<times> _) nres\<close>
 where
   \<open>full_checker_l spec A st = do {
     spec' \<leftarrow> full_normalize_poly spec;
     (b, \<V>, A) \<leftarrow> remap_polys_l spec' {} A;
     if is_cfailed b
     then RETURN (b, \<V>, A)
     else do {
       let \<V> = \<V> \<union> vars_llist spec;
       PAC_checker_l spec' (\<V>, A) b st
     }
   }\<close>
 
 
 context poly_embed
 begin
 
 
 term normalize_poly_spec
 thm full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]]
 abbreviation unsorted_fmap_polys_rel where
   \<open>unsorted_fmap_polys_rel \<equiv> \<langle>nat_rel, fully_unsorted_poly_rel O mset_poly_rel\<rangle>fmap_rel\<close>
 
 lemma full_checker_l_full_checker:
  assumes
     \<open>(A, B) \<in> unsorted_fmap_polys_rel\<close> and
     \<open>(st, st') \<in> \<langle>pac_step_rel\<rangle>list_rel\<close> and
     \<open>(spec, spec') \<in> fully_unsorted_poly_rel O mset_poly_rel\<close>
   shows
     \<open>full_checker_l spec A st \<le> \<Down> (code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel) (full_checker spec' B st')\<close>
 proof -
   have [refine]:
     \<open>(spec, spec') \<in> sorted_poly_rel O mset_poly_rel \<Longrightarrow>
     (\<V>, \<V>') \<in> \<langle>var_rel\<rangle>set_rel \<Longrightarrow>
     remap_polys_l spec \<V> A \<le> \<Down>(code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel)
         (remap_polys_change_all spec' \<V>' B)\<close> for spec spec' \<V> \<V>'
     apply (rule remap_polys_l_remap_polys[THEN order_trans, OF assms(1)])
     apply assumption+
     apply (rule ref_two_step[OF order.refl])
     apply(rule remap_polys_spec[THEN order_trans])
     by (rule remap_polys_polynomial_bool_remap_polys_change_all)
 
   show ?thesis
     unfolding full_checker_l_def full_checker_def
     apply (refine_rcg remap_polys_l_remap_polys
        full_normalize_poly_diff_ideal[unfolded normalize_poly_spec_def[symmetric]]
        PAC_checker_l_PAC_checker)
     subgoal
       using assms(3) .
     subgoal by auto
     subgoal by (auto simp: is_cfailed_def is_failed_def)
     subgoal by auto
     apply (rule fully_unsorted_poly_rel_extend_vars)
     subgoal using assms(3) .
     subgoal by auto
     subgoal by auto
     subgoal
       using assms(2) by (auto simp: p2rel_def)
     subgoal by auto
     done
 qed
 
 
 lemma full_checker_l_full_checker':
   \<open>(uncurry2 full_checker_l, uncurry2 full_checker) \<in>
   ((fully_unsorted_poly_rel O mset_poly_rel) \<times>\<^sub>r unsorted_fmap_polys_rel) \<times>\<^sub>r \<langle>pac_step_rel\<rangle>list_rel \<rightarrow>\<^sub>f
     \<langle>(code_status_status_rel \<times>\<^sub>r \<langle>var_rel\<rangle>set_rel \<times>\<^sub>r fmap_polys_rel)\<rangle>nres_rel\<close>
   apply (intro frefI nres_relI)
   using full_checker_l_full_checker by force
 
 end
 
 definition remap_polys_l2 :: \<open>llist_polynomial \<Rightarrow> string set \<Rightarrow> (nat, llist_polynomial) fmap \<Rightarrow> _ nres\<close> where
   \<open>remap_polys_l2 spec = (\<lambda>\<V> A. do{
    n \<leftarrow> upper_bound_on_dom A;
    b \<leftarrow> RETURN (n \<ge> 2^64);
    if b
    then do {
      c \<leftarrow> remap_polys_l_dom_err;
      RETURN (error_msg (0 ::nat) c, \<V>, fmempty)
    }
    else do {
        (b, \<V>, A) \<leftarrow> nfoldli ([0..<n]) (\<lambda>_. True)
        (\<lambda>i (b, \<V>, A').
           if i \<in># dom_m A
           then do {
             ASSERT(fmlookup A i \<noteq> None);
             p \<leftarrow> full_normalize_poly (the (fmlookup A i));
             eq \<leftarrow> weak_equality_l p spec;
             \<V> \<leftarrow> RETURN (\<V> \<union> vars_llist (the (fmlookup A i)));
             RETURN(b \<or> eq, \<V>, fmupd i p A')
           } else RETURN (b, \<V>, A')
         )
        (False, \<V>, fmempty);
      RETURN (if b then CFOUND else CSUCCESS, \<V>, A)
     }
  })\<close>
 
 lemma remap_polys_l2_remap_polys_l:
   \<open>remap_polys_l2 spec \<V> A \<le> \<Down> Id (remap_polys_l spec \<V> A)\<close>
 proof -
   have [refine]: \<open>(A, A') \<in> Id \<Longrightarrow> upper_bound_on_dom A
     \<le> \<Down> {(n, dom). dom = set [0..<n]} (SPEC (\<lambda>dom. set_mset (dom_m A') \<subseteq> dom \<and> finite dom))\<close> for A A'
     unfolding upper_bound_on_dom_def
     apply (rule RES_refine)
     apply (auto simp: upper_bound_on_dom_def)
     done
   have 1: \<open>inj_on id dom\<close> for dom
     by auto
   have 2: \<open>x \<in># dom_m A \<Longrightarrow>
        x' \<in># dom_m A' \<Longrightarrow>
        (x, x') \<in> nat_rel \<Longrightarrow>
        (A, A') \<in> Id \<Longrightarrow>
        full_normalize_poly (the (fmlookup A x))
        \<le> \<Down> Id
           (full_normalize_poly (the (fmlookup A' x')))\<close>
        for A A' x x'
        by (auto)
   have 3: \<open>(n, dom) \<in> {(n, dom). dom = set [0..<n]} \<Longrightarrow>
        ([0..<n], dom) \<in> \<langle>nat_rel\<rangle>list_set_rel\<close> for n dom
   by (auto simp: list_set_rel_def br_def)
   have 4: \<open>(p,q) \<in> Id \<Longrightarrow>
     weak_equality_l p spec \<le> \<Down>Id (weak_equality_l q spec)\<close> for p q spec
     by auto
 
   have 6: \<open>a = b \<Longrightarrow> (a, b) \<in> Id\<close> for a b
     by auto
   show ?thesis
     unfolding remap_polys_l2_def remap_polys_l_def
     apply (refine_rcg LFO_refine[where R= \<open>Id \<times>\<^sub>r \<langle>Id\<rangle>set_rel \<times>\<^sub>r Id\<close>])
     subgoal by auto
     subgoal by auto
     subgoal by auto
     apply (rule 3)
     subgoal by auto
     subgoal by (simp add: in_dom_m_lookup_iff)
     subgoal by (simp add: in_dom_m_lookup_iff)
     apply (rule 2)
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     apply (rule 4; assumption)
     apply (rule 6)
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     done
 qed
 
 end
diff --git a/thys/PAC_Checker/PAC_Misc.thy b/thys/PAC_Checker/PAC_Misc.thy
new file mode 100644
--- /dev/null
+++ b/thys/PAC_Checker/PAC_Misc.thy
@@ -0,0 +1,22 @@
+theory PAC_Misc
+  imports Main
+begin
+
+text "I believe this should be added to the simplifier by default..."
+lemma Collect_eq_comp':
+  "{(x, y). P x y} O {(c, a). c = f a} = {(x, a). P x (f a)}"
+  by auto
+
+lemma in_set_conv_iff:
+  "x \<in> set (take n xs) \<longleftrightarrow> (\<exists>i<n. i < length xs \<and> xs ! i = x)"
+  by (metis in_set_conv_nth length_take min_less_iff_conj nth_take)
+
+lemma in_set_take_conv_nth:
+  "x \<in> set (take n xs) \<longleftrightarrow> (\<exists>i<min n (length xs). xs ! i = x)"
+  by (simp add: in_set_conv_iff)
+
+lemma in_set_remove1D:
+  "a \<in> set (remove1 x xs) \<Longrightarrow> a \<in> set xs"
+  by (meson notin_set_remove1)
+
+end
diff --git a/thys/PAC_Checker/ROOT b/thys/PAC_Checker/ROOT
--- a/thys/PAC_Checker/ROOT
+++ b/thys/PAC_Checker/ROOT
@@ -1,38 +1,37 @@
 chapter AFP
 
 session PAC_Checker (AFP) = "Sepref_IICF" +
   description \<open>PAC proof checker\<close>
   options
     [timeout = 2700]
   sessions
     "HOL-Library"
     "HOL-Algebra"
     "Polynomials"
     Nested_Multisets_Ordinals
   theories
     PAC_More_Poly
-    Duplicate_Free_Multiset
     Finite_Map_Multiset
     WB_Sort
     More_Loops
     PAC_Specification
     PAC_Map_Rel
     PAC_Checker_Specification
     PAC_Checker_Relation
     PAC_Polynomials
     PAC_Polynomials_Term
     PAC_Polynomials_Operations
     PAC_Assoc_Map_Rel
     PAC_Map_Rel
     PAC_Checker
     PAC_Checker_Init
     PAC_Version
     PAC_Checker_Synthesis
   theories [condition=ISABELLE_MLTON]
     PAC_Checker_MLton
   document_files
     "root.tex"
     "root.bib"
   export_files (in "code") [1]
     "PAC_Checker.PAC_Checker_MLton:**"
 
diff --git a/thys/PAC_Checker/WB_Sort.thy b/thys/PAC_Checker/WB_Sort.thy
--- a/thys/PAC_Checker/WB_Sort.thy
+++ b/thys/PAC_Checker/WB_Sort.thy
@@ -1,1688 +1,1688 @@
 (*
   File:         WB_Sort.thy
   Author:       Mathias Fleury, Daniela Kaufmann, JKU
   Author:       Maximilian Wuttke, Saarland University
   Maintainer:   Mathias Fleury, JKU
 
 Correctness proof contributed by Maximilian Wuttke *)
 theory WB_Sort
-  imports Refine_Imperative_HOL.IICF "HOL-Library.Rewrite" Duplicate_Free_Multiset
+  imports
+    Refine_Imperative_HOL.IICF
+    "HOL-Library.Rewrite"
+    Nested_Multisets_Ordinals.Duplicate_Free_Multiset
 begin
 
 text \<open>This a complete copy-paste of the IsaFoL version because sharing is too hard.\<close>
 
-
 text \<open>Every element between \<^term>\<open>lo\<close> and \<^term>\<open>hi\<close> can be chosen as pivot element.\<close>
 definition choose_pivot :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat nres\<close> where
   \<open>choose_pivot _ _ _ lo hi = SPEC(\<lambda>k. k \<ge> lo \<and> k \<le> hi)\<close>
 
 text \<open>The element at index \<open>p\<close> partitions the subarray \<open>lo..hi\<close>. This means that every element \<close>
 definition isPartition_wrt :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'b list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>isPartition_wrt R xs lo hi p \<equiv> (\<forall> i. i \<ge> lo \<and> i < p \<longrightarrow> R (xs!i) (xs!p)) \<and> (\<forall> j. j > p \<and> j \<le> hi \<longrightarrow> R (xs!p) (xs!j))\<close>
 
 lemma isPartition_wrtI:
   \<open>(\<And> i. \<lbrakk>i \<ge> lo; i < p\<rbrakk> \<Longrightarrow> R (xs!i) (xs!p)) \<Longrightarrow> (\<And> j. \<lbrakk>j > p; j \<le> hi\<rbrakk> \<Longrightarrow> R (xs!p) (xs!j)) \<Longrightarrow> isPartition_wrt R xs lo hi p\<close>
   by (simp add: isPartition_wrt_def)
 
 definition isPartition :: \<open>'a :: order list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>isPartition xs lo hi p \<equiv> isPartition_wrt (\<le>) xs lo hi p\<close>
 
 abbreviation isPartition_map :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>isPartition_map R h xs i j k \<equiv> isPartition_wrt (\<lambda>a b. R (h a) (h b)) xs i j k\<close>
 
 lemma isPartition_map_def':
   \<open>lo \<le> p \<Longrightarrow> p \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> isPartition_map R h xs lo hi p = isPartition_wrt R (map h xs) lo hi p\<close>
   by (auto simp add: isPartition_wrt_def conjI)
 
 
 text \<open>Example: 6 is the pivot element (with index 4); \<^term>\<open>7\<close> is equal to the \<^term>\<open>length xs - 1\<close>.\<close>
 lemma \<open>isPartition [0,5,3,4,6,9,8,10::nat] 0 7 4\<close>
   by (auto simp add: isPartition_def isPartition_wrt_def nth_Cons')
 
 
 
 definition sublist :: \<open>'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list\<close> where
 \<open>sublist xs i j \<equiv> take (Suc j - i) (drop i xs)\<close>
 
 (*take from HashMap *)
 lemma take_Suc0:
   "l\<noteq>[] \<Longrightarrow> take (Suc 0) l = [l!0]"
   "0 < length l \<Longrightarrow> take (Suc 0) l = [l!0]"
   "Suc n \<le> length l \<Longrightarrow> take (Suc 0) l = [l!0]"
   by (cases l, auto)+
 
 lemma sublist_single: \<open>i < length xs \<Longrightarrow> sublist xs i i = [xs!i]\<close>
   by (cases xs) (auto simp add: sublist_def take_Suc0)
 
 lemma insert_eq: \<open>insert a b = b \<union> {a}\<close>
   by auto
 
 lemma sublist_nth: \<open>\<lbrakk>lo \<le> hi; hi < length xs; k+lo \<le> hi\<rbrakk> \<Longrightarrow> (sublist xs lo hi)!k = xs!(lo+k)\<close>
   by (simp add: sublist_def)
 
 lemma sublist_length: \<open>\<lbrakk>i \<le> j; j < length xs\<rbrakk> \<Longrightarrow> length (sublist xs i j) = 1 + j - i\<close>
   by (simp add: sublist_def)
 
 lemma sublist_not_empty: \<open>\<lbrakk>i \<le> j; j < length xs; xs \<noteq> []\<rbrakk> \<Longrightarrow> sublist xs i j \<noteq> []\<close>
   apply simp
   apply (rewrite List.length_greater_0_conv[symmetric])
   apply (rewrite sublist_length)
   by auto
 
 
 
 lemma sublist_app: \<open>\<lbrakk>i1 \<le> i2; i2 \<le> i3\<rbrakk> \<Longrightarrow> sublist xs i1 i2 @ sublist xs (Suc i2) i3 = sublist xs i1 i3\<close>
   unfolding sublist_def
   by (smt Suc_eq_plus1_left Suc_le_mono append.assoc le_SucI le_add_diff_inverse le_trans same_append_eq take_add)
 
 definition sorted_sublist_wrt :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'b list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>sorted_sublist_wrt R xs lo hi = sorted_wrt R (sublist xs lo hi)\<close>
 
 definition sorted_sublist :: \<open>'a :: linorder list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>sorted_sublist xs lo hi = sorted_sublist_wrt (\<le>) xs lo hi\<close>
 
 abbreviation sorted_sublist_map :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>sorted_sublist_map R h xs lo hi \<equiv> sorted_sublist_wrt (\<lambda>a b. R (h a) (h b)) xs lo hi\<close>
 
 lemma sorted_sublist_map_def':
   \<open>lo < length xs \<Longrightarrow> sorted_sublist_map R h xs lo hi \<equiv> sorted_sublist_wrt R (map h xs) lo hi\<close>
   apply (simp add: sorted_sublist_wrt_def)
   by (simp add: drop_map sorted_wrt_map sublist_def take_map)
 
 lemma sorted_sublist_wrt_refl: \<open>i < length xs \<Longrightarrow> sorted_sublist_wrt R xs i i\<close>
   by (auto simp add: sorted_sublist_wrt_def sublist_single)
 
 lemma sorted_sublist_refl: \<open>i < length xs \<Longrightarrow> sorted_sublist xs i i\<close>
   by (auto simp add: sorted_sublist_def sorted_sublist_wrt_refl)
 
 lemma sublist_map: \<open>sublist (map f xs) i j = map f (sublist xs i j)\<close>
   apply (auto simp add: sublist_def)
   by (simp add: drop_map take_map)
 
 
 lemma take_set: \<open>j \<le> length xs \<Longrightarrow> x \<in> set (take j xs) \<equiv> (\<exists> k. k < j \<and> xs!k = x)\<close>
-  apply (induction xs)
-   apply simp
-  by (meson in_set_conv_iff less_le_trans)
+  by (rule eq_reflection) (auto simp add: take_set)
 
 lemma drop_set: \<open>j \<le> length xs \<Longrightarrow> x \<in> set (drop j xs) \<equiv> (\<exists>k. j\<le>k\<and>k<length xs \<and> xs!k=x)\<close>
   by (smt Misc.in_set_drop_conv_nth) (* lemma found by sledgehammer *)
 
 lemma sublist_el: \<open>i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> x \<in> set (sublist xs i j) \<equiv> (\<exists> k. k < Suc j-i \<and> xs!(i+k)=x)\<close>
   by (auto simp add: take_set sublist_def)
 
 lemma sublist_el': \<open>i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> x \<in> set (sublist xs i j) \<equiv> (\<exists> k. i\<le>k\<and>k\<le>j \<and> xs!k=x)\<close>
   apply (subst sublist_el, assumption, assumption)
   by (smt Groups.add_ac(2) le_add1 le_add_diff_inverse less_Suc_eq less_diff_conv nat_less_le order_refl)
 
 
 lemma sublist_lt: \<open>hi < lo \<Longrightarrow> sublist xs lo hi = []\<close>
   by (auto simp add: sublist_def)
 
 lemma nat_le_eq_or_lt: \<open>(a :: nat) \<le> b = (a = b \<or> a < b)\<close>
   by linarith
 
 
 lemma sorted_sublist_wrt_le: \<open>hi \<le> lo \<Longrightarrow> hi < length xs \<Longrightarrow> sorted_sublist_wrt R xs lo hi\<close>
   apply (auto simp add: nat_le_eq_or_lt)
   unfolding sorted_sublist_wrt_def
   subgoal apply (rewrite sublist_single) by auto
   subgoal by (auto simp add: sublist_lt)
   done
 
 text \<open>Elements in a sorted sublists are actually sorted\<close>
 lemma sorted_sublist_wrt_nth_le:
   assumes \<open>sorted_sublist_wrt R xs lo hi\<close> and \<open>lo \<le> hi\<close> and \<open>hi < length xs\<close> and
     \<open>lo \<le> i\<close> and \<open>i < j\<close> and \<open>j \<le> hi\<close>
   shows \<open>R (xs!i) (xs!j)\<close>
 proof -
   have A: \<open>lo < length xs\<close> using assms(2) assms(3) by linarith
   obtain i' where I: \<open>i = lo + i'\<close> using assms(4) le_Suc_ex by auto
   obtain j' where J: \<open>j = lo + j'\<close> by (meson assms(4) assms(5) dual_order.trans le_iff_add less_imp_le_nat)
   show ?thesis
     using assms(1) apply (simp add: sorted_sublist_wrt_def I J)
     apply (rewrite sublist_nth[symmetric, where k=i', where lo=lo, where hi=hi])
     using assms apply auto subgoal using I by linarith
     apply (rewrite sublist_nth[symmetric, where k=j', where lo=lo, where hi=hi])
     using assms apply auto subgoal using J by linarith
     apply (rule sorted_wrt_nth_less)
     apply auto
     subgoal using I J nat_add_left_cancel_less by blast
     subgoal apply (simp add: sublist_length) using J by linarith
     done
 qed
 
 text \<open>We can make the assumption \<^term>\<open>i < j\<close> weaker if we have a reflexivie relation.\<close>
 lemma sorted_sublist_wrt_nth_le':
   assumes ref: \<open>\<And> x. R x x\<close>
     and \<open>sorted_sublist_wrt R xs lo hi\<close> and \<open>lo \<le> hi\<close> and \<open>hi < length xs\<close>
     and \<open>lo \<le> i\<close> and \<open>i \<le> j\<close> and \<open>j \<le> hi\<close>
   shows \<open>R (xs!i) (xs!j)\<close>
 proof -
   have \<open>i < j \<or> i = j\<close> using \<open>i \<le> j\<close> by linarith
   then consider (a) \<open>i < j\<close> |
                 (b) \<open>i = j\<close> by blast
   then show ?thesis
   proof cases
     case a
     then show ?thesis
       using assms(2-5,7) sorted_sublist_wrt_nth_le by blast
   next
     case b
     then show ?thesis
       by (simp add: ref)
   qed
 qed
 
 
 
 (*
 lemma sorted_sublist_map_nth_le:
   assumes \<open>sorted_sublist_map R h xs lo hi\<close> and \<open>lo \<le> hi\<close> and \<open>hi < length xs\<close> and
     \<open>lo \<le> i\<close> and \<open>i < j\<close> and \<open>j \<le> hi\<close>
   shows \<open>R (h (xs!i)) (h (xs!j))\<close>
 proof -
   show ?thesis
     using assms by (rule sorted_sublist_wrt_nth_le)
 qed
 *)
 
 
 
 lemma sorted_sublist_le: \<open>hi \<le> lo \<Longrightarrow> hi < length xs \<Longrightarrow> sorted_sublist xs lo hi\<close>
   by (auto simp add: sorted_sublist_def sorted_sublist_wrt_le)
 
 lemma sorted_sublist_map_le: \<open>hi \<le> lo \<Longrightarrow> hi < length xs \<Longrightarrow> sorted_sublist_map R h xs lo hi\<close>
   by (auto simp add: sorted_sublist_wrt_le)
 
 lemma sublist_cons: \<open>lo < hi \<Longrightarrow> hi < length xs \<Longrightarrow> sublist xs lo hi = xs!lo # sublist xs (Suc lo) hi\<close>
   by (metis Cons_eq_appendI append_self_conv2 less_imp_le_nat less_or_eq_imp_le less_trans
       sublist_app sublist_single)
 
 lemma sorted_sublist_wrt_cons':
   \<open>sorted_sublist_wrt R xs (lo+1) hi \<Longrightarrow> lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> (\<forall>j. lo<j\<and>j\<le>hi \<longrightarrow> R (xs!lo) (xs!j)) \<Longrightarrow> sorted_sublist_wrt R xs lo hi\<close>
   apply (auto simp add: nat_le_eq_or_lt sorted_sublist_wrt_def)
   apply (auto 5 4 simp add: sublist_cons sublist_el less_diff_conv add.commute[of _ lo]
       dest: Suc_lessI sublist_single)
   done
 
 lemma sorted_sublist_wrt_cons:
   assumes trans: \<open>(\<And> x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z)\<close> and
     \<open>sorted_sublist_wrt R xs (lo+1) hi\<close> and
     \<open>lo \<le> hi\<close> and \<open>hi < length xs \<close> and \<open>R (xs!lo) (xs!(lo+1))\<close>
   shows \<open>sorted_sublist_wrt R xs lo hi\<close>
 proof -
   show ?thesis
     apply (rule sorted_sublist_wrt_cons') using assms apply auto
     subgoal premises assms' for j
     proof -
       have A: \<open>j=lo+1 \<or> j>lo+1\<close> using assms'(5) by linarith
       show ?thesis
         using A proof
         assume A: \<open>j=lo+1\<close> show ?thesis
           by (simp add: A assms')
       next
         assume A: \<open>j>lo+1\<close> show ?thesis
           apply (rule trans)
           apply (rule assms(5))
           apply (rule sorted_sublist_wrt_nth_le[OF assms(2), where i=\<open>lo+1\<close>, where j=j])
           subgoal using A assms'(6) by linarith
           subgoal using assms'(3) less_imp_diff_less by blast
           subgoal using assms'(5) by auto
           subgoal using A by linarith
           subgoal by (simp add: assms'(6))
           done
       qed
     qed
     done
 qed
 
 lemma sorted_sublist_map_cons:
   \<open>(\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)) \<Longrightarrow>
     sorted_sublist_map R h xs (lo+1) hi \<Longrightarrow> lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> R (h (xs!lo)) (h (xs!(lo+1))) \<Longrightarrow> sorted_sublist_map R h xs lo hi\<close>
   by (blast intro: sorted_sublist_wrt_cons)
 
 
 lemma sublist_snoc: \<open>lo < hi \<Longrightarrow> hi < length xs \<Longrightarrow> sublist xs lo hi = sublist xs lo (hi-1) @ [xs!hi]\<close>
   apply (simp add: sublist_def)
 proof -
   assume a1: "lo < hi"
   assume "hi < length xs"
   then have "take lo xs @ take (Suc hi - lo) (drop lo xs) = (take lo xs @ take (hi - lo) (drop lo xs)) @ [xs ! hi]"
     using a1 by (metis (no_types) Suc_diff_le add_Suc_right hd_drop_conv_nth le_add_diff_inverse less_imp_le_nat take_add take_hd_drop)
   then show "take (Suc hi - lo) (drop lo xs) = take (hi - lo) (drop lo xs) @ [xs ! hi]"
     by simp
 qed
 
 lemma sorted_sublist_wrt_snoc':
   \<open>sorted_sublist_wrt R xs lo (hi-1) \<Longrightarrow> lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> (\<forall>j. lo\<le>j\<and>j<hi \<longrightarrow> R (xs!j) (xs!hi)) \<Longrightarrow> sorted_sublist_wrt R xs lo hi\<close>
   apply (simp add: sorted_sublist_wrt_def)
   apply (auto simp add: nat_le_eq_or_lt)
   subgoal by (simp add: sublist_single)
   by (auto simp add: sublist_snoc sublist_el sorted_wrt_append add.commute[of lo] less_diff_conv
       simp: leI simp flip:nat_le_eq_or_lt)
 
 
 lemma sorted_sublist_wrt_snoc:
   assumes trans: \<open>(\<And> x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z)\<close> and
     \<open>sorted_sublist_wrt R xs lo (hi-1)\<close> and
     \<open>lo \<le> hi\<close> and \<open>hi < length xs\<close> and \<open>(R (xs!(hi-1)) (xs!hi))\<close>
   shows \<open>sorted_sublist_wrt R xs lo hi\<close>
 proof -
   show ?thesis
     apply (rule sorted_sublist_wrt_snoc') using assms apply auto
     subgoal premises assms' for j
     proof -
       have A: \<open>j=hi-1 \<or> j<hi-1\<close> using assms'(6) by linarith
       show ?thesis
         using A proof
         assume A: \<open>j=hi-1\<close> show ?thesis
           by (simp add: A assms')
       next
         assume A: \<open>j<hi-1\<close> show ?thesis
           apply (rule trans)
            apply (rule sorted_sublist_wrt_nth_le[OF assms(2), where i=j, where j=\<open>hi-1\<close>])
                prefer 6
                apply (rule assms(5))
               apply auto
           subgoal using A assms'(5) by linarith
           subgoal using assms'(3) less_imp_diff_less by blast
           subgoal using assms'(5) by auto
           subgoal using A by linarith
           done
       qed
     qed
     done
 qed
 
 lemma sublist_split: \<open>lo \<le> hi \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow> sublist xs lo p @ sublist xs (p+1) hi = sublist xs lo hi\<close>
   by (simp add: sublist_app)
 
 lemma sublist_split_part: \<open>lo \<le> hi \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow> sublist xs lo (p-1) @ xs!p # sublist xs (p+1) hi = sublist xs lo hi\<close>
   by (auto simp add: sublist_split[symmetric] sublist_snoc[where xs=xs,where lo=lo,where hi=p])
 
 
 text \<open>A property for partitions (we always assume that \<^term>\<open>R\<close> is transitive.\<close>
 lemma isPartition_wrt_trans:
 \<open>(\<And> x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z) \<Longrightarrow>
   isPartition_wrt R xs lo hi p \<Longrightarrow>
   (\<forall>i j. lo \<le> i \<and> i < p \<and> p < j \<and> j \<le> hi \<longrightarrow> R (xs!i) (xs!j))\<close>
   by (auto simp add: isPartition_wrt_def)
 
 lemma isPartition_map_trans:
 \<open>(\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)) \<Longrightarrow>
   hi < length xs \<Longrightarrow>
   isPartition_map R h xs lo hi p \<Longrightarrow>
   (\<forall>i j. lo \<le> i \<and> i < p \<and> p < j \<and> j \<le> hi \<longrightarrow> R (h (xs!i)) (h (xs!j)))\<close>
   by (auto simp add: isPartition_wrt_def)
 
 
 lemma merge_sorted_wrt_partitions_between':
   \<open>lo \<le> hi \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     isPartition_wrt R xs lo hi p \<Longrightarrow>
     sorted_sublist_wrt R xs lo (p-1) \<Longrightarrow> sorted_sublist_wrt R xs (p+1) hi \<Longrightarrow>
     (\<forall>i j. lo \<le> i \<and> i < p \<and> p < j \<and> j \<le> hi \<longrightarrow> R (xs!i) (xs!j)) \<Longrightarrow>
     sorted_sublist_wrt R xs lo hi\<close>
   apply (auto simp add: isPartition_def isPartition_wrt_def sorted_sublist_def sorted_sublist_wrt_def sublist_map)
   apply (simp add: sublist_split_part[symmetric])
   apply (auto simp add: List.sorted_wrt_append)
   subgoal by (auto simp add: sublist_el)
   subgoal by (auto simp add: sublist_el)
   subgoal by (auto simp add: sublist_el')
   done
 
 lemma merge_sorted_wrt_partitions_between:
   \<open>(\<And> x y z. \<lbrakk>R x y; R y z\<rbrakk> \<Longrightarrow> R x z) \<Longrightarrow>
     isPartition_wrt R xs lo hi p \<Longrightarrow>
     sorted_sublist_wrt R xs lo (p-1) \<Longrightarrow> sorted_sublist_wrt R xs (p+1) hi \<Longrightarrow>
     lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     sorted_sublist_wrt R xs lo hi\<close>
   by (simp add: merge_sorted_wrt_partitions_between' isPartition_wrt_trans)
 
 
 (*
 lemma merge_sorted_map_partitions_between:
   \<open>(\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)) \<Longrightarrow>
     isPartition_map R h xs lo hi p \<Longrightarrow>
     sorted_sublist_map R h xs lo (p-1) \<Longrightarrow> sorted_sublist_map R h xs (p+1) hi \<Longrightarrow>
     lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow> lo < p \<Longrightarrow> p < hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     sorted_sublist_map R h xs lo hi\<close>
   by (simp add: merge_sorted_wrt_partitions_between' isPartition_map_trans)
 *)
 
 
 
 
 text \<open>The main theorem to merge sorted lists\<close>
 lemma merge_sorted_wrt_partitions:
   \<open>isPartition_wrt R xs lo hi p \<Longrightarrow>
     sorted_sublist_wrt R xs lo (p - Suc 0) \<Longrightarrow> sorted_sublist_wrt R xs (Suc p) hi \<Longrightarrow>
     lo \<le> hi \<Longrightarrow> lo \<le> p \<Longrightarrow> p \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     (\<forall>i j. lo \<le> i \<and> i < p \<and> p < j \<and> j \<le> hi \<longrightarrow> R (xs!i) (xs!j)) \<Longrightarrow>
     sorted_sublist_wrt R xs lo hi\<close>
   subgoal premises assms
   proof -
     have C: \<open>lo=p\<and>p=hi \<or> lo=p\<and>p<hi \<or> lo<p\<and>p=hi \<or> lo<p\<and>p<hi\<close>
       using assms by linarith
     show ?thesis
       using C apply auto
       subgoal \<comment> \<open>lo=p=hi\<close>
         apply (rule sorted_sublist_wrt_refl)
         using assms by auto
       subgoal \<comment> \<open>lo=p<hi\<close>
         using assms by (simp add: isPartition_def isPartition_wrt_def sorted_sublist_wrt_cons')
       subgoal \<comment> \<open>lo<p=hi\<close>
         using assms by (simp add: isPartition_def isPartition_wrt_def sorted_sublist_wrt_snoc')
       subgoal \<comment> \<open>lo<p<hi\<close>
         using assms
         apply (rewrite merge_sorted_wrt_partitions_between'[where p=p])
         by auto
       done
   qed
   done
 
 theorem merge_sorted_map_partitions:
   \<open>(\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)) \<Longrightarrow>
     isPartition_map R h xs lo hi p \<Longrightarrow>
     sorted_sublist_map R h xs lo (p - Suc 0) \<Longrightarrow> sorted_sublist_map R h xs (Suc p) hi \<Longrightarrow>
     lo \<le> hi \<Longrightarrow> lo \<le> p \<Longrightarrow> p \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow>
     sorted_sublist_map R h xs lo hi\<close>
   apply (rule merge_sorted_wrt_partitions) apply auto
   by (simp add: merge_sorted_wrt_partitions isPartition_map_trans)
 
 
 lemma partition_wrt_extend:
   \<open>isPartition_wrt R xs lo' hi' p \<Longrightarrow>
   hi < length xs \<Longrightarrow>
   lo \<le> lo' \<Longrightarrow> lo' \<le> hi \<Longrightarrow> hi' \<le> hi \<Longrightarrow>
   lo' \<le> p \<Longrightarrow> p \<le> hi' \<Longrightarrow>
   (\<And> i. lo\<le>i \<Longrightarrow> i <lo' \<Longrightarrow> R (xs!i) (xs!p)) \<Longrightarrow>
   (\<And> j. hi'<j \<Longrightarrow> j\<le>hi \<Longrightarrow> R (xs!p) (xs!j)) \<Longrightarrow>
   isPartition_wrt R xs lo hi p\<close>
   unfolding isPartition_wrt_def
   apply (intro conjI)
   subgoal
     by (force simp: not_le)
   subgoal
     using leI by blast
   done
 
 lemma partition_map_extend:
   \<open>isPartition_map R h xs lo' hi' p \<Longrightarrow>
   hi < length xs \<Longrightarrow>
   lo \<le> lo' \<Longrightarrow> lo' \<le> hi \<Longrightarrow> hi' \<le> hi \<Longrightarrow>
   lo' \<le> p \<Longrightarrow> p \<le> hi' \<Longrightarrow>
   (\<And> i. lo\<le>i \<Longrightarrow> i <lo' \<Longrightarrow> R (h (xs!i)) (h (xs!p))) \<Longrightarrow>
   (\<And> j. hi'<j \<Longrightarrow> j\<le>hi \<Longrightarrow> R (h (xs!p)) (h (xs!j))) \<Longrightarrow>
   isPartition_map R h xs lo hi p\<close>
   by (auto simp add: partition_wrt_extend)
 
 
 lemma isPartition_empty:
   \<open>(\<And> j. \<lbrakk>lo < j; j \<le> hi\<rbrakk> \<Longrightarrow> R (xs ! lo) (xs ! j)) \<Longrightarrow>
   isPartition_wrt R xs lo hi lo\<close>
   by (auto simp add: isPartition_wrt_def)
 
 
 
 lemma take_ext:
   \<open>(\<forall>i<k. xs'!i=xs!i) \<Longrightarrow>
   k < length xs \<Longrightarrow> k < length xs' \<Longrightarrow>
   take k xs' = take k xs\<close>
   by (simp add: nth_take_lemma)
 
 lemma drop_ext':
   \<open>(\<forall>i. i\<ge>k \<and> i<length xs \<longrightarrow> xs'!i=xs!i) \<Longrightarrow>
    0<k \<Longrightarrow> xs\<noteq>[] \<Longrightarrow> \<comment> \<open>These corner cases will be dealt with in the next lemma\<close>
    length xs'=length xs \<Longrightarrow>
    drop k xs' = drop k xs\<close>
   apply (rewrite in \<open>drop _ \<hole> = _\<close> List.rev_rev_ident[symmetric])
   apply (rewrite in \<open>_ = drop _ \<hole>\<close> List.rev_rev_ident[symmetric])
   apply (rewrite in \<open>\<hole> = _\<close> List.drop_rev)
   apply (rewrite in \<open>_ = \<hole>\<close> List.drop_rev)
   apply simp
   apply (rule take_ext)
   by (auto simp add: rev_nth)
 
 lemma drop_ext:
 \<open>(\<forall>i. i\<ge>k \<and> i<length xs \<longrightarrow> xs'!i=xs!i) \<Longrightarrow>
    length xs'=length xs \<Longrightarrow>
    drop k xs' = drop k xs\<close>
   apply (cases xs)
    apply auto
   apply (cases k)
   subgoal  by (simp add: nth_equalityI)
   subgoal apply (rule drop_ext') by auto
   done
 
 
 lemma sublist_ext':
   \<open>(\<forall>i. lo\<le>i\<and>i\<le>hi \<longrightarrow> xs'!i=xs!i) \<Longrightarrow>
    length xs' = length xs \<Longrightarrow>
    lo \<le> hi \<Longrightarrow> Suc hi < length xs \<Longrightarrow>
    sublist xs' lo hi = sublist xs lo hi\<close>
   apply (simp add: sublist_def)
   apply (rule take_ext)
   by auto
 
 
 lemma lt_Suc: \<open>(a < b) = (Suc a = b \<or> Suc a < b)\<close>
   by auto
 
 lemma sublist_until_end_eq_drop: \<open>Suc hi = length xs \<Longrightarrow> sublist xs lo hi = drop lo xs\<close>
   by (simp add: sublist_def)
 
 lemma sublist_ext:
   \<open>(\<forall>i. lo\<le>i\<and>i\<le>hi \<longrightarrow> xs'!i=xs!i) \<Longrightarrow>
    length xs' = length xs \<Longrightarrow>
    lo \<le> hi \<Longrightarrow> hi < length xs \<Longrightarrow>
    sublist xs' lo hi = sublist xs lo hi\<close>
   apply (auto simp add: lt_Suc[where a=hi])
   subgoal by (auto simp add: sublist_until_end_eq_drop drop_ext)
   subgoal by (auto simp add: sublist_ext')
   done
 
 lemma sorted_wrt_lower_sublist_still_sorted:
   assumes \<open>sorted_sublist_wrt R xs lo (lo' - Suc 0)\<close> and
     \<open>lo \<le> lo'\<close> and \<open>lo' < length xs\<close> and
     \<open>(\<forall> i. lo\<le>i\<and>i<lo' \<longrightarrow> xs'!i=xs!i)\<close> and \<open>length xs' = length xs\<close>
   shows \<open>sorted_sublist_wrt R xs' lo (lo' - Suc 0)\<close>
 proof -
   have l: \<open>lo < lo' - 1 \<or> lo \<ge> lo'-1\<close>
     by linarith
   show ?thesis
     using l apply auto
     subgoal \<comment> \<open>lo < lo' - 1\<close>
       apply (auto simp add: sorted_sublist_wrt_def)
       apply (rewrite sublist_ext[where xs=xs])
       using assms by (auto simp add: sorted_sublist_wrt_def)
     subgoal \<comment> \<open>lo >= lo' - 1\<close>
       using assms by (auto simp add: sorted_sublist_wrt_le)
     done
 qed
 
 lemma sorted_map_lower_sublist_still_sorted:
   assumes \<open>sorted_sublist_map R h xs lo (lo' - Suc 0)\<close> and
     \<open>lo \<le> lo'\<close> and \<open>lo' < length xs\<close> and
     \<open>(\<forall> i. lo\<le>i\<and>i<lo' \<longrightarrow> xs'!i=xs!i)\<close> and \<open>length xs' = length xs\<close>
   shows \<open>sorted_sublist_map R h xs' lo (lo' - Suc 0)\<close>
   using assms by (rule sorted_wrt_lower_sublist_still_sorted)
 
 lemma sorted_wrt_upper_sublist_still_sorted:
   assumes \<open>sorted_sublist_wrt R xs (hi'+1) hi\<close> and
     \<open>lo \<le> lo'\<close> and \<open>hi < length xs\<close> and
     \<open>\<forall> j. hi'<j\<and>j\<le>hi \<longrightarrow> xs'!j=xs!j\<close> and \<open>length xs' = length xs\<close>
   shows \<open>sorted_sublist_wrt R xs' (hi'+1) hi\<close>
 proof -
   have l: \<open>hi' + 1 < hi \<or> hi' + 1 \<ge> hi\<close>
     by linarith
   show ?thesis
     using l apply auto
     subgoal \<comment> \<open>hi' + 1 < h\<close>
       apply (auto simp add: sorted_sublist_wrt_def)
       apply (rewrite sublist_ext[where xs=xs])
       using assms by (auto simp add: sorted_sublist_wrt_def)
     subgoal \<comment> \<open>\<^term>\<open>hi' + 1 \<ge> hi\<close>\<close>
       using assms by (auto simp add: sorted_sublist_wrt_le)
     done
 qed
 
 lemma sorted_map_upper_sublist_still_sorted:
   assumes \<open>sorted_sublist_map R h xs (hi'+1) hi\<close> and
     \<open>lo \<le> lo'\<close> and \<open>hi < length xs\<close> and
     \<open>\<forall> j. hi'<j\<and>j\<le>hi \<longrightarrow> xs'!j=xs!j\<close> and \<open>length xs' = length xs\<close>
   shows \<open>sorted_sublist_map R h xs' (hi'+1) hi\<close>
   using assms by (rule sorted_wrt_upper_sublist_still_sorted)
 
 
 
 
 
 
 
 text \<open>The specification of the partition function\<close>
 definition partition_spec :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>partition_spec R h xs lo hi xs' p \<equiv>
     mset xs' = mset xs \<and> \<comment> \<open>The list is a permutation\<close>
     isPartition_map R h xs' lo hi p \<and> \<comment> \<open>We have a valid partition on the resulting list\<close>
     lo \<le> p \<and> p \<le> hi \<and> \<comment> \<open>The partition index is in bounds\<close>
     (\<forall> i. i<lo \<longrightarrow> xs'!i=xs!i) \<and> (\<forall> i. hi<i\<and>i<length xs' \<longrightarrow> xs'!i=xs!i)\<close> \<comment> \<open>Everything else is unchanged.\<close>
 
 lemma in_set_take_conv_nth:
   \<open>x \<in> set (take n xs) \<longleftrightarrow> (\<exists>m<min n (length xs). xs ! m = x)\<close>
   by (metis in_set_conv_nth length_take min.commute min.strict_boundedE nth_take)
 
 lemma mset_drop_upto: \<open>mset (drop a N) = {#N!i. i \<in># mset_set {a..<length N}#}\<close>
 proof (induction N arbitrary: a)
   case Nil
   then show ?case by simp
 next
   case (Cons c N)
   have upt: \<open>{0..<Suc (length N)} = insert 0 {1..<Suc (length N)}\<close>
     by auto
   then have H: \<open>mset_set {0..<Suc (length N)} = add_mset 0 (mset_set {1..<Suc (length N)})\<close>
     unfolding upt by auto
   have mset_case_Suc: \<open>{#case x of 0 \<Rightarrow> c | Suc x \<Rightarrow> N ! x . x \<in># mset_set {Suc a..<Suc b}#} =
     {#N ! (x-1) . x \<in># mset_set {Suc a..<Suc b}#}\<close> for a b
     by (rule image_mset_cong) (auto split: nat.splits)
   have Suc_Suc: \<open>{Suc a..<Suc b} = Suc ` {a..<b}\<close> for a b
     by auto
   then have mset_set_Suc_Suc: \<open>mset_set {Suc a..<Suc b} = {#Suc n. n \<in># mset_set {a..<b}#}\<close> for a b
     unfolding Suc_Suc by (subst image_mset_mset_set[symmetric]) auto
   have *: \<open>{#N ! (x-Suc 0) . x \<in># mset_set {Suc a..<Suc b}#} = {#N ! x . x \<in># mset_set {a..<b}#}\<close>
     for a b
     by (auto simp add: mset_set_Suc_Suc multiset.map_comp comp_def)
   show ?case
     apply (cases a)
     using Cons[of 0] Cons by (auto simp: nth_Cons drop_Cons H mset_case_Suc *)
 qed
 
 (* Actually, I only need that \<open>set (sublist xs' lo hi) = set (sublist xs lo hi)\<close> *)
 lemma mathias:
   assumes
         Perm: \<open>mset xs' = mset xs\<close>
     and I: \<open>lo\<le>i\<close> \<open>i\<le>hi\<close> \<open>xs'!i=x\<close>
     and Bounds: \<open>hi < length xs\<close>
     and Fix: \<open>\<And> i. i<lo \<Longrightarrow> xs'!i = xs!i\<close> \<open>\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j\<close>
   shows \<open>\<exists>j. lo\<le>j\<and>j\<le>hi \<and> xs!j = x\<close>
 proof -
   define xs1 xs2 xs3 xs1' xs2' xs3' where
      \<open>xs1 = take lo xs\<close> and
      \<open>xs2 = take (Suc hi - lo) (drop lo xs)\<close> and
      \<open>xs3 = drop (Suc hi) xs\<close> and
      \<open>xs1' = take lo xs'\<close> and
      \<open>xs2' = take (Suc hi - lo) (drop lo xs')\<close> and
      \<open>xs3' = drop (Suc hi) xs'\<close>
   have [simp]: \<open>length xs' = length xs\<close>
     using Perm by (auto dest: mset_eq_length)
   have [simp]: \<open>mset xs1 = mset xs1'\<close>
     using Fix(1) unfolding xs1_def xs1'_def
     by (metis Perm le_cases mset_eq_length nth_take_lemma take_all)
   have [simp]: \<open>mset xs3 = mset xs3'\<close>
     using Fix(2) unfolding xs3_def xs3'_def mset_drop_upto
     by (auto intro: image_mset_cong)
   have \<open>xs = xs1 @ xs2 @ xs3\<close> \<open>xs' = xs1' @ xs2' @ xs3'\<close>
     using I unfolding xs1_def xs2_def xs3_def xs1'_def xs2'_def xs3'_def
     by (metis append.assoc append_take_drop_id le_SucI le_add_diff_inverse order_trans take_add)+
   moreover have \<open>xs ! i = xs2 ! (i - lo)\<close> \<open>i \<ge> length xs1\<close>
     using I Bounds unfolding xs2_def xs1_def by (auto simp: nth_take min_def)
   moreover have  \<open>x \<in> set xs2'\<close>
     using I Bounds unfolding xs2'_def
     by (auto simp: in_set_take_conv_nth
        intro!: exI[of _ \<open>i - lo\<close>])
   ultimately have \<open>x \<in> set xs2\<close>
     using Perm I by (auto dest: mset_eq_setD)
   then obtain j where \<open>xs ! (lo + j) = x\<close> \<open>j \<le> hi - lo\<close>
     unfolding in_set_conv_nth xs2_def
     by auto
   then show ?thesis
     using Bounds I
     by (auto intro: exI[of _ \<open>lo+j\<close>])
 qed
 
 
 text \<open>If we fix the left and right rest of two permutated lists, then the sublists are also permutations.\<close>
 text \<open>But we only need that the sets are equal.\<close>
 lemma mset_sublist_incl:
   assumes Perm: \<open>mset xs' = mset xs\<close>
     and Fix: \<open>\<And> i. i<lo \<Longrightarrow> xs'!i = xs!i\<close> \<open>\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j\<close>
     and bounds: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
   shows \<open>set (sublist xs' lo hi) \<subseteq> set (sublist xs lo hi)\<close>
 proof
   fix x
   assume \<open>x \<in> set (sublist xs' lo hi)\<close>
   then have \<open>\<exists>i. lo\<le>i\<and>i\<le>hi \<and> xs'!i=x\<close>
     by (metis assms(1) bounds(1) bounds(2) size_mset sublist_el')
   then obtain i where I: \<open>lo\<le>i\<close> \<open>i\<le>hi\<close> \<open>xs'!i=x\<close> by blast
   have \<open>\<exists>j. lo\<le>j\<and>j\<le>hi \<and> xs!j=x\<close>
     using Perm I bounds(2) Fix by (rule mathias, auto)
   then show \<open>x \<in> set (sublist xs lo hi)\<close>
     by (simp add: bounds(1) bounds(2) sublist_el')
 qed
 
 
 lemma mset_sublist_eq:
   assumes \<open>mset xs' = mset xs\<close>
     and \<open>\<And> i. i<lo \<Longrightarrow> xs'!i = xs!i\<close>
     and \<open>\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j\<close>
     and bounds: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
   shows \<open>set (sublist xs' lo hi) = set (sublist xs lo hi)\<close>
 proof
   show \<open>set (sublist xs' lo hi) \<subseteq> set (sublist xs lo hi)\<close>
     apply (rule mset_sublist_incl)
     using assms by auto
   show \<open>set (sublist xs lo hi) \<subseteq> set (sublist xs' lo hi)\<close>
     by (rule mset_sublist_incl) (metis assms size_mset)+
 qed
 
 
 
 text \<open>Our abstract recursive quicksort procedure. We abstract over a partition procedure.\<close>
 definition quicksort :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<times> nat \<times> 'a list \<Rightarrow> 'a list nres\<close> where
 \<open>quicksort R h = (\<lambda>(lo,hi,xs0). do {
   RECT (\<lambda>f (lo,hi,xs). do {
       ASSERT(lo \<le> hi \<and> hi < length xs \<and> mset xs = mset xs0); \<comment> \<open>Premise for a partition function\<close>
       (xs, p) \<leftarrow> SPEC(uncurry (partition_spec R h xs lo hi)); \<comment> \<open>Abstract partition function\<close>
       ASSERT(mset xs = mset xs0);
       xs \<leftarrow> (if p-1\<le>lo then RETURN xs else f (lo, p-1, xs));
       ASSERT(mset xs = mset xs0);
       if hi\<le>p+1 then RETURN xs else f (p+1, hi, xs)
     }) (lo,hi,xs0)
   })\<close>
 
 text \<open>As premise for quicksor, we only need that the indices are ok.\<close>
 definition quicksort_pre :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow>  nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> bool\<close> where
   \<open>quicksort_pre R h xs0 lo hi xs \<equiv> lo \<le> hi \<and> hi < length xs \<and> mset xs = mset xs0\<close>
 
 definition quicksort_post :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool\<close> where
   \<open>quicksort_post R h lo hi xs xs' \<equiv>
     mset xs' = mset xs \<and>
     sorted_sublist_map R h xs' lo hi \<and>
     (\<forall> i. i<lo \<longrightarrow> xs'!i = xs!i) \<and>
     (\<forall> j. hi<j\<and>j<length xs \<longrightarrow> xs'!j = xs!j)\<close>
 
 text \<open>Convert Pure to HOL\<close>
 lemma quicksort_postI:
   \<open>\<lbrakk>mset xs' = mset xs; sorted_sublist_map R h xs' lo hi; (\<And> i. \<lbrakk>i<lo\<rbrakk> \<Longrightarrow> xs'!i = xs!i); (\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j)\<rbrakk> \<Longrightarrow> quicksort_post R h lo hi xs xs'\<close>
   by (auto simp add: quicksort_post_def)
 
 
 text \<open>The first case for the correctness proof of (abstract) quicksort: We assume that we called the partition function, and we have \<^term>\<open>p-1\<le>lo\<close> and \<^term>\<open>hi\<le>p+1\<close>.\<close>
 lemma quicksort_correct_case1:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
     and pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs: \<open>p-1 \<le> lo\<close> \<open>hi \<le> p+1\<close>
   shows \<open>quicksort_post R h lo hi xs xs'\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
 (*
   have part_perm: \<open>set (sublist xs' lo hi) = set (sublist xs lo hi)\<close>
     using part partition_spec_set_sublist pre(1) pre(2) by blast
 *)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
 
 
   have sorted_lower: \<open>sorted_sublist_map R h xs' lo (p - Suc 0)\<close>
   proof -
     show ?thesis
       apply (rule sorted_sublist_wrt_le)
       subgoal using ifs(1) by auto
       subgoal using ifs(1) mset_eq_length part(1) pre(1) pre(2) by fastforce
       done
   qed
 
   have sorted_upper: \<open>sorted_sublist_map R h xs' (Suc p) hi\<close>
   proof -
     show ?thesis
       apply (rule sorted_sublist_wrt_le)
       subgoal using ifs(2) by auto
       subgoal using ifs(1) mset_eq_length part(1) pre(1) pre(2) by fastforce
       done
   qed
 
   have sorted_middle: \<open>sorted_sublist_map R h xs' lo hi\<close>
   proof -
     show ?thesis
       apply (rule merge_sorted_map_partitions[where p=p])
       subgoal by (rule trans)
       subgoal by (rule part)
       subgoal by (rule sorted_lower)
       subgoal by (rule sorted_upper)
       subgoal using pre(1) by auto
       subgoal by (simp add: part(4))
       subgoal by (simp add: part(5))
       subgoal by (metis part(1) pre(2) size_mset)
       done
   qed
 
   show ?thesis
   proof (intro quicksort_postI)
     show \<open>mset xs' = mset xs\<close>
       by (simp add: part(1))
   next
     show \<open>sorted_sublist_map R h xs' lo hi\<close>
       by (rule sorted_middle)
   next
       show \<open>\<And>i. i < lo \<Longrightarrow> xs' ! i = xs ! i\<close>
       using part(6) by blast
   next
     show \<open>\<And>j. \<lbrakk>hi < j; j < length xs\<rbrakk> \<Longrightarrow> xs' ! j = xs ! j\<close>
       by (metis part(1) part(7) size_mset)
   qed
 qed
 
 
 text \<open>In the second case, we have to show that the precondition still holds for (p+1, hi, x') after the partition.\<close>
 lemma quicksort_correct_case2:
   assumes
         pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs: \<open>\<not> hi \<le> p + 1\<close>
   shows \<open>quicksort_pre R h xs0 (Suc p) hi xs'\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close> \<open>mset xs = mset xs0\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   show ?thesis
     unfolding quicksort_pre_def
   proof (intro conjI)
     show \<open>Suc p \<le> hi\<close>
       using ifs by linarith
     show \<open>hi < length xs'\<close>
       by (metis part(1) pre(2) size_mset)
     show \<open>mset xs' = mset xs0\<close>
       using pre(3) part(1) by (auto dest: mset_eq_setD)
   qed
 qed
 
 
 
 lemma quicksort_post_set:
   assumes \<open>quicksort_post R h lo hi xs xs'\<close>
     and bounds: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
   shows \<open>set (sublist xs' lo hi) = set (sublist xs lo hi)\<close>
 proof -
   have \<open>mset xs' = mset xs\<close> \<open>\<And> i. i<lo \<Longrightarrow> xs'!i = xs!i\<close> \<open>\<And> j. \<lbrakk>hi<j; j<length xs\<rbrakk> \<Longrightarrow> xs'!j = xs!j\<close>
     using assms by (auto simp add: quicksort_post_def)
   then show ?thesis
     using bounds by (rule mset_sublist_eq, auto)
 qed
 
 
 text \<open>In the third case, we have run quicksort recursively on (p+1, hi, xs') after the partition, with hi<=p+1 and p-1<=lo.\<close>
 lemma quicksort_correct_case3:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
     and pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs: \<open>p - Suc 0 \<le> lo\<close> \<open>\<not> hi \<le> Suc p\<close>
     and IH1': \<open>quicksort_post R h (Suc p) hi xs' xs''\<close>
   shows \<open>quicksort_post R h lo hi xs xs''\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close> \<open>mset xs = mset xs0\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   have IH1: \<open>mset xs'' = mset xs'\<close> \<open>sorted_sublist_map R h xs'' (Suc p) hi\<close>
       \<open>\<And> i. i<Suc p \<Longrightarrow> xs'' ! i = xs' ! i\<close> \<open>\<And> j. \<lbrakk>hi < j; j < length xs'\<rbrakk> \<Longrightarrow> xs'' ! j = xs' ! j\<close>
     using IH1' by (auto simp add: quicksort_post_def)
   note IH1_perm = quicksort_post_set[OF IH1']
 
   have still_partition: \<open>isPartition_map R h xs'' lo hi p\<close>
   proof(intro isPartition_wrtI)
     fix i assume \<open>lo \<le> i\<close> \<open>i < p\<close>
     show \<open>R (h (xs'' ! i)) (h (xs'' ! p))\<close>
       text \<open>This holds because this part hasn't changed\<close>
       using IH1(3) \<open>i < p\<close> \<open>lo \<le> i\<close> isPartition_wrt_def part(3) by fastforce
     next
       fix j assume \<open>p < j\<close> \<open>j \<le> hi\<close>
       text \<open>Obtain the position \<^term>\<open>posJ\<close> where \<^term>\<open>xs''!j\<close> was stored in \<^term>\<open>xs'\<close>.\<close>
       have \<open>xs''!j \<in> set (sublist xs'' (Suc p) hi)\<close>
         by (metis IH1(1) Suc_leI \<open>j \<le> hi\<close> \<open>p < j\<close> less_le_trans mset_eq_length part(1) pre(2) sublist_el')
       then have \<open>xs''!j \<in> set (sublist xs' (Suc p) hi)\<close>
         by (metis IH1_perm ifs(2) nat_le_linear part(1) pre(2) size_mset)
       then have \<open>\<exists> posJ. Suc p\<le>posJ\<and>posJ\<le>hi \<and> xs''!j = xs'!posJ\<close>
         by (metis Suc_leI \<open>j \<le> hi\<close> \<open>p < j\<close> less_le_trans part(1) pre(2) size_mset sublist_el')
       then obtain posJ :: nat where PosJ: \<open>Suc p\<le>posJ\<close> \<open>posJ\<le>hi\<close> \<open>xs''!j = xs'!posJ\<close> by blast
 
       then show \<open>R (h (xs'' ! p)) (h (xs'' ! j))\<close>
         by (metis IH1(3) Suc_le_lessD isPartition_wrt_def lessI part(3))
   qed
 
   have sorted_lower: \<open>sorted_sublist_map R h xs'' lo (p - Suc 0)\<close>
   proof -
     show ?thesis
       apply (rule sorted_sublist_wrt_le)
       subgoal by (simp add: ifs(1))
       subgoal using IH1(1) mset_eq_length part(1) part(5) pre(2) by fastforce
       done
   qed
 
   note sorted_upper = IH1(2)
 
   have sorted_middle: \<open>sorted_sublist_map R h xs'' lo hi\<close>
   proof -
     show ?thesis
       apply (rule merge_sorted_map_partitions[where p=p])
       subgoal by (rule trans)
       subgoal by (rule still_partition)
       subgoal by (rule sorted_lower)
       subgoal by (rule sorted_upper)
       subgoal using pre(1) by auto
       subgoal by (simp add: part(4))
       subgoal by (simp add: part(5))
       subgoal by (metis IH1(1) part(1) pre(2) size_mset)
       done
   qed
 
 
   show ?thesis
   proof (intro quicksort_postI)
     show \<open>mset xs'' = mset xs\<close>
       using part(1) IH1(1) by auto \<comment> \<open>I was faster than sledgehammer :-)\<close>
   next
     show \<open>sorted_sublist_map R h xs'' lo hi\<close>
       by (rule sorted_middle)
   next
     show \<open>\<And>i. i < lo \<Longrightarrow> xs'' ! i = xs ! i\<close>
       using IH1(3) le_SucI part(4) part(6) by auto
   next show \<open>\<And>j. hi < j \<Longrightarrow> j < length xs \<Longrightarrow> xs'' ! j = xs ! j\<close>
       by (metis IH1(4) part(1) part(7) size_mset)
   qed
 qed
 
 
 text \<open>In the 4th case, we have to show that the premise holds for \<^term>\<open>(lo,p-1,xs')\<close>, in case \<^term>\<open>\<not>p-1\<le>lo\<close>\<close>
 text \<open>Analogous to case 2.\<close>
 lemma quicksort_correct_case4:
   assumes
         pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs: \<open>\<not> p - Suc 0 \<le> lo \<close>
   shows \<open>quicksort_pre R h xs0 lo (p-Suc 0) xs'\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close> \<open>mset xs0 = mset xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
 
   show ?thesis
     unfolding quicksort_pre_def
   proof (intro conjI)
     show \<open>lo \<le> p - Suc 0\<close>
       using ifs by linarith
     show \<open>p - Suc 0 < length xs'\<close>
       using mset_eq_length part(1) part(5) pre(2) by fastforce
     show \<open>mset xs' = mset xs0\<close>
       using pre(3) part(1) by (auto dest: mset_eq_setD)
   qed
 qed
 
 
 text \<open>In the 5th case, we have run quicksort recursively on (lo, p-1, xs').\<close>
 lemma quicksort_correct_case5:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
     and pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs:  \<open>\<not> p - Suc 0 \<le> lo\<close> \<open>hi \<le> Suc p\<close>
     and IH1': \<open>quicksort_post R h lo (p - Suc 0) xs' xs''\<close>
   shows \<open>quicksort_post R h lo hi xs xs''\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   have IH1: \<open>mset xs'' = mset xs'\<close> \<open>sorted_sublist_map R h xs'' lo (p - Suc 0)\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs''!i = xs'!i\<close> \<open>\<And> j. \<lbrakk>p-Suc 0<j; j<length xs'\<rbrakk> \<Longrightarrow> xs''!j = xs'!j\<close>
     using IH1' by (auto simp add: quicksort_post_def)
   note IH1_perm = quicksort_post_set[OF IH1']
 
 
  have still_partition: \<open>isPartition_map R h xs'' lo hi p\<close>
   proof(intro isPartition_wrtI)
     fix i assume \<open>lo \<le> i\<close> \<open>i < p\<close>
       text \<open>Obtain the position \<^term>\<open>posI\<close> where \<^term>\<open>xs''!i\<close> was stored in \<^term>\<open>xs'\<close>.\<close>
       have \<open>xs''!i \<in> set (sublist xs'' lo (p-Suc 0))\<close>
         by (metis (no_types, lifting) IH1(1) Suc_leI Suc_pred \<open>i < p\<close> \<open>lo \<le> i\<close> le_less_trans less_imp_diff_less mset_eq_length not_le not_less_zero part(1) part(5) pre(2) sublist_el')
       then have \<open>xs''!i \<in> set (sublist xs' lo (p-Suc 0))\<close>
         by (metis IH1_perm ifs(1) le_less_trans less_imp_diff_less mset_eq_length nat_le_linear part(1) part(5) pre(2))
       then have \<open>\<exists> posI. lo\<le>posI\<and>posI\<le>p-Suc 0 \<and> xs''!i = xs'!posI\<close>
       proof - \<comment> \<open>sledgehammer\<close>
         have "p - Suc 0 < length xs"
           by (meson diff_le_self le_less_trans part(5) pre(2))
         then show ?thesis
           by (metis (no_types) \<open>xs'' ! i \<in> set (sublist xs' lo (p - Suc 0))\<close> ifs(1) mset_eq_length nat_le_linear part(1) sublist_el')
       qed
       then obtain posI :: nat where PosI: \<open>lo\<le>posI\<close> \<open>posI\<le>p-Suc 0\<close> \<open>xs''!i = xs'!posI\<close> by blast
       then show \<open>R (h (xs'' ! i)) (h (xs'' ! p))\<close>
         by (metis (no_types, lifting) IH1(4) \<open>i < p\<close> diff_Suc_less isPartition_wrt_def le_less_trans mset_eq_length not_le not_less_eq part(1) part(3) part(5) pre(2) zero_less_Suc)
     next
       fix j assume \<open>p < j\<close> \<open>j \<le> hi\<close>
       then show \<open>R (h (xs'' ! p)) (h (xs'' ! j))\<close>
       text \<open>This holds because this part hasn't changed\<close>
       by (smt IH1(4) add_diff_cancel_left' add_diff_inverse_nat diff_Suc_eq_diff_pred diff_le_self ifs(1) isPartition_wrt_def le_less_Suc_eq less_le_trans mset_eq_length nat_less_le part(1) part(3) part(4) plus_1_eq_Suc pre(2))
   qed
 
 
   note sorted_lower = IH1(2)
 
   have sorted_upper: \<open>sorted_sublist_map R h xs'' (Suc p) hi\<close>
   proof -
     show ?thesis
       apply (rule sorted_sublist_wrt_le)
       subgoal by (simp add: ifs(2))
       subgoal using IH1(1) mset_eq_length part(1) part(5) pre(2) by fastforce
       done
   qed
 
 
   have sorted_middle: \<open>sorted_sublist_map R h xs'' lo hi\<close>
   proof -
     show ?thesis
       apply (rule merge_sorted_map_partitions[where p=p])
       subgoal by (rule trans)
       subgoal by (rule still_partition)
       subgoal by (rule sorted_lower)
       subgoal by (rule sorted_upper)
       subgoal using pre(1) by auto
       subgoal by (simp add: part(4))
       subgoal by (simp add: part(5))
       subgoal by (metis IH1(1) part(1) pre(2) size_mset)
       done
   qed
 
 
   show ?thesis
   proof (intro quicksort_postI)
     show \<open>mset xs'' = mset xs\<close>
       by (simp add: IH1(1) part(1))
   next
     show \<open>sorted_sublist_map R h xs'' lo hi\<close>
       by (rule sorted_middle)
   next
     show \<open>\<And>i. i < lo \<Longrightarrow> xs'' ! i = xs ! i\<close>
       by (simp add: IH1(3) part(6))
   next
     show \<open>\<And>j. hi < j \<Longrightarrow> j < length xs \<Longrightarrow> xs'' ! j = xs ! j\<close>
       by (metis IH1(4) diff_le_self dual_order.strict_trans2 mset_eq_length part(1) part(5) part(7))
   qed
 qed
 
 
 text \<open>In the 6th case, we have run quicksort recursively on (lo, p-1, xs'). We show the precondition on the second call on (p+1, hi, xs'')\<close>
 lemma quicksort_correct_case6:
   assumes
         pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs:  \<open>\<not> p - Suc 0 \<le> lo\<close> \<open>\<not> hi \<le> Suc p\<close>
     and IH1: \<open>quicksort_post R h lo (p - Suc 0) xs' xs''\<close>
   shows \<open>quicksort_pre R h xs0 (Suc p) hi xs''\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close> \<open>mset xs0 = mset xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   have IH1: \<open>mset xs'' = mset xs'\<close> \<open>sorted_sublist_map R h xs'' lo (p - Suc 0)\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs''!i = xs'!i\<close> \<open>\<And> j. \<lbrakk>p-Suc 0<j; j<length xs'\<rbrakk> \<Longrightarrow> xs''!j = xs'!j\<close>
     using IH1 by (auto simp add: quicksort_post_def)
 
   show ?thesis
     unfolding quicksort_pre_def
   proof (intro conjI)
     show \<open>Suc p \<le> hi\<close>
       using ifs(2) by linarith
     show \<open>hi < length xs''\<close>
       using IH1(1) mset_eq_length part(1) pre(2) by fastforce
     show \<open>mset xs'' = mset xs0\<close>
       using pre(3) part(1) IH1(1) by (auto dest: mset_eq_setD)
   qed
 qed
 
 
 text \<open>In the 7th (and last) case, we have run quicksort recursively on (lo, p-1, xs'). We show the postcondition on the second call on (p+1, hi, xs'')\<close>
 lemma quicksort_correct_case7:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
     and pre: \<open>quicksort_pre R h xs0 lo hi xs\<close>
     and part: \<open>partition_spec R h xs lo hi xs' p\<close>
     and ifs:  \<open>\<not> p - Suc 0 \<le> lo\<close> \<open>\<not> hi \<le> Suc p\<close>
     and IH1': \<open>quicksort_post R h lo (p - Suc 0) xs' xs''\<close>
     and IH2': \<open>quicksort_post R h (Suc p) hi xs'' xs'''\<close>
   shows \<open>quicksort_post R h lo hi xs xs'''\<close>
 proof -
   text \<open>First boilerplate code step: 'unfold' the HOL definitions in the assumptions and convert them to Pure\<close>
   have pre: \<open>lo \<le> hi\<close> \<open>hi < length xs\<close>
     using pre by (auto simp add: quicksort_pre_def)
   have part: \<open>mset xs' = mset xs\<close> True
     \<open>isPartition_map R h xs' lo hi p\<close> \<open>lo \<le> p\<close> \<open>p \<le> hi\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs'!i=xs!i\<close> \<open>\<And> i. \<lbrakk>hi<i; i<length xs'\<rbrakk> \<Longrightarrow> xs'!i=xs!i\<close>
     using part by (auto simp add: partition_spec_def)
   have IH1: \<open>mset xs'' = mset xs'\<close> \<open>sorted_sublist_map R h xs'' lo (p - Suc 0)\<close>
     \<open>\<And> i. i<lo \<Longrightarrow> xs''!i = xs'!i\<close> \<open>\<And> j. \<lbrakk>p-Suc 0<j; j<length xs'\<rbrakk> \<Longrightarrow> xs''!j = xs'!j\<close>
     using IH1' by (auto simp add: quicksort_post_def)
   note IH1_perm = quicksort_post_set[OF IH1']
   have IH2: \<open>mset xs''' = mset xs''\<close> \<open>sorted_sublist_map R h xs''' (Suc p) hi\<close>
     \<open>\<And> i. i<Suc p \<Longrightarrow> xs'''!i = xs''!i\<close> \<open>\<And> j. \<lbrakk>hi<j; j<length xs''\<rbrakk> \<Longrightarrow> xs'''!j = xs''!j\<close>
     using IH2' by (auto simp add: quicksort_post_def)
   note IH2_perm = quicksort_post_set[OF IH2']
 
 
   text \<open>We still have a partition after the first call (same as in case 5)\<close>
   have still_partition1: \<open>isPartition_map R h xs'' lo hi p\<close>
   proof(intro isPartition_wrtI)
     fix i assume \<open>lo \<le> i\<close> \<open>i < p\<close>
       text \<open>Obtain the position \<^term>\<open>posI\<close> where \<^term>\<open>xs''!i\<close> was stored in \<^term>\<open>xs'\<close>.\<close>
       have \<open>xs''!i \<in> set (sublist xs'' lo (p-Suc 0))\<close>
         by (metis (no_types, lifting) IH1(1) Suc_leI Suc_pred \<open>i < p\<close> \<open>lo \<le> i\<close> le_less_trans less_imp_diff_less mset_eq_length not_le not_less_zero part(1) part(5) pre(2) sublist_el')
       then have \<open>xs''!i \<in> set (sublist xs' lo (p-Suc 0))\<close>
         by (metis IH1_perm ifs(1) le_less_trans less_imp_diff_less mset_eq_length nat_le_linear part(1) part(5) pre(2))
       then have \<open>\<exists> posI. lo\<le>posI\<and>posI\<le>p-Suc 0 \<and> xs''!i = xs'!posI\<close>
       proof - \<comment> \<open>sledgehammer\<close>
         have "p - Suc 0 < length xs"
           by (meson diff_le_self le_less_trans part(5) pre(2))
         then show ?thesis
           by (metis (no_types) \<open>xs'' ! i \<in> set (sublist xs' lo (p - Suc 0))\<close> ifs(1) mset_eq_length nat_le_linear part(1) sublist_el')
       qed
       then obtain posI :: nat where PosI: \<open>lo\<le>posI\<close> \<open>posI\<le>p-Suc 0\<close> \<open>xs''!i = xs'!posI\<close> by blast
       then show \<open>R (h (xs'' ! i)) (h (xs'' ! p))\<close>
         by (metis (no_types, lifting) IH1(4) \<open>i < p\<close> diff_Suc_less isPartition_wrt_def le_less_trans mset_eq_length not_le not_less_eq part(1) part(3) part(5) pre(2) zero_less_Suc)
     next
       fix j assume \<open>p < j\<close> \<open>j \<le> hi\<close>
       then show \<open>R (h (xs'' ! p)) (h (xs'' ! j))\<close>
       text \<open>This holds because this part hasn't changed\<close>
       by (smt IH1(4) add_diff_cancel_left' add_diff_inverse_nat diff_Suc_eq_diff_pred diff_le_self ifs(1) isPartition_wrt_def le_less_Suc_eq less_le_trans mset_eq_length nat_less_le part(1) part(3) part(4) plus_1_eq_Suc pre(2))
   qed
 
 
   text \<open>We still have a partition after the second call (similar as in case 3)\<close>
   have still_partition2: \<open>isPartition_map R h xs''' lo hi p\<close>
   proof(intro isPartition_wrtI)
     fix i assume \<open>lo \<le> i\<close> \<open>i < p\<close>
     show \<open>R (h (xs''' ! i)) (h (xs''' ! p))\<close>
       text \<open>This holds because this part hasn't changed\<close>
       using IH2(3) \<open>i < p\<close> \<open>lo \<le> i\<close> isPartition_wrt_def still_partition1 by fastforce
     next
       fix j assume \<open>p < j\<close> \<open>j \<le> hi\<close>
       text \<open>Obtain the position \<^term>\<open>posJ\<close> where \<^term>\<open>xs'''!j\<close> was stored in \<^term>\<open>xs'''\<close>.\<close>
       have \<open>xs'''!j \<in> set (sublist xs''' (Suc p) hi)\<close>
         by (metis IH1(1) IH2(1) Suc_leI \<open>j \<le> hi\<close> \<open>p < j\<close> ifs(2) nat_le_linear part(1) pre(2) size_mset sublist_el')
       then have \<open>xs'''!j \<in> set (sublist xs'' (Suc p) hi)\<close>
         by (metis IH1(1) IH2_perm ifs(2) mset_eq_length nat_le_linear part(1) pre(2))
       then have \<open>\<exists> posJ. Suc p\<le>posJ\<and>posJ\<le>hi \<and> xs'''!j = xs''!posJ\<close>
         by (metis IH1(1) ifs(2) mset_eq_length nat_le_linear part(1) pre(2) sublist_el')
       then obtain posJ :: nat where PosJ: \<open>Suc p\<le>posJ\<close> \<open>posJ\<le>hi\<close> \<open>xs'''!j = xs''!posJ\<close> by blast
 
       then show \<open>R (h (xs''' ! p)) (h (xs''' ! j))\<close>
       proof - \<comment> \<open>sledgehammer\<close>
         have "\<forall>n na as p. (p (as ! na::'a) (as ! posJ) \<or> posJ \<le> na) \<or> \<not> isPartition_wrt p as n hi na"
           by (metis (no_types) PosJ(2) isPartition_wrt_def not_less)
         then show ?thesis
           by (metis IH2(3) PosJ(1) PosJ(3) lessI not_less_eq_eq still_partition1)
       qed
   qed
 
 
   text \<open>We have that the lower part is sorted after the first recursive call\<close>
   note sorted_lower1 = IH1(2)
 
   text \<open>We show that it is still sorted after the second call.\<close>
   have sorted_lower2: \<open>sorted_sublist_map R h xs''' lo (p-Suc 0)\<close>
   proof -
     show ?thesis
       using sorted_lower1 apply (rule sorted_wrt_lower_sublist_still_sorted)
       subgoal by (rule part)
       subgoal
         using IH1(1) mset_eq_length part(1) part(5) pre(2) by fastforce
       subgoal
         by (simp add: IH2(3))
       subgoal
         by (metis IH2(1) size_mset)
       done
   qed
 
   text \<open>The second IH gives us the the upper list is sorted after the second recursive call\<close>
   note sorted_upper2 = IH2(2)
 
   text \<open>Finally, we have to show that the entire list is sorted after the second recursive call.\<close>
   have sorted_middle: \<open>sorted_sublist_map R h xs''' lo hi\<close>
   proof -
     show ?thesis
       apply (rule merge_sorted_map_partitions[where p=p])
       subgoal by (rule trans)
       subgoal by (rule still_partition2)
       subgoal by (rule sorted_lower2)
       subgoal by (rule sorted_upper2)
       subgoal using pre(1) by auto
       subgoal by (simp add: part(4))
       subgoal by (simp add: part(5))
       subgoal by (metis IH1(1) IH2(1) part(1) pre(2) size_mset)
       done
   qed
 
   show ?thesis
   proof (intro quicksort_postI)
     show \<open>mset xs''' = mset xs\<close>
       by (simp add: IH1(1) IH2(1) part(1))
   next
     show \<open>sorted_sublist_map R h xs''' lo hi\<close>
       by (rule sorted_middle)
   next
     show \<open>\<And>i. i < lo \<Longrightarrow> xs''' ! i = xs ! i\<close>
       using IH1(3) IH2(3) part(4) part(6) by auto
   next
     show \<open>\<And>j. hi < j \<Longrightarrow> j < length xs \<Longrightarrow> xs''' ! j = xs ! j\<close>
       by (metis IH1(1) IH1(4) IH2(4) diff_le_self ifs(2) le_SucI less_le_trans nat_le_eq_or_lt not_less part(1) part(7) size_mset)
   qed
 
 qed
 
 
 
 text \<open>We can now show the correctness of the abstract quicksort procedure, using the refinement framework and the above case lemmas.\<close>
 lemma quicksort_correct:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
      and Pre: \<open>lo0 \<le> hi0\<close> \<open>hi0 < length xs0\<close>
   shows \<open>quicksort R h (lo0,hi0,xs0) \<le> \<Down> Id (SPEC(\<lambda>xs. quicksort_post R h lo0 hi0 xs0 xs))\<close>
 proof -
   have wf: \<open>wf (measure (\<lambda>(lo, hi, xs). Suc hi - lo))\<close>
     by auto
   define pre where \<open>pre = (\<lambda>(lo,hi,xs). quicksort_pre R h xs0 lo hi xs)\<close>
   define post where \<open>post = (\<lambda>(lo,hi,xs). quicksort_post R h lo hi xs)\<close>
   have pre: \<open>pre (lo0,hi0,xs0)\<close>
     unfolding quicksort_pre_def pre_def by (simp add: Pre)
 
   text \<open>We first generalize the goal a over all states.\<close>
   have \<open>WB_Sort.quicksort R h (lo0,hi0,xs0) \<le> \<Down> Id (SPEC (post (lo0,hi0,xs0)))\<close>
     unfolding quicksort_def prod.case
     apply (rule RECT_rule)
        apply (refine_mono)
       apply (rule wf)
     apply (rule pre)
     subgoal premises IH for f x
       apply (refine_vcg ASSERT_leI)
       unfolding pre_def post_def
 
       subgoal \<comment> \<open>First premise (assertion) for partition\<close>
         using IH(2) by (simp add: quicksort_pre_def pre_def)
       subgoal \<comment> \<open>Second premise (assertion) for partition\<close>
         using IH(2) by (simp add: quicksort_pre_def pre_def)
       subgoal
         using IH(2) by (auto simp add: quicksort_pre_def pre_def dest: mset_eq_setD)
 
 	text \<open>Termination case: \<^term>\<open>(p-1 \<le> lo')\<close> and \<^term>\<open>(hi' \<le> p+1)\<close>; directly show postcondition\<close>
       subgoal unfolding partition_spec_def by (auto dest: mset_eq_setD)
       subgoal \<comment> \<open>Postcondition (after partition)\<close>
         apply -
         using IH(2) unfolding pre_def apply (simp, elim conjE, split prod.splits)
         using trans lin apply (rule quicksort_correct_case1) by auto
 
       text \<open>Case \<^term>\<open>(p-1 \<le> lo')\<close> and \<^term>\<open>(hi' < p+1)\<close> (Only second recursive call)\<close>
       subgoal
         apply (rule IH(1)[THEN order_trans])
 
         text \<open>Show that the invariant holds for the second recursive call\<close>
         subgoal
           using IH(2) unfolding pre_def apply (simp, elim conjE, split prod.splits)
           apply (rule quicksort_correct_case2) by auto
 
         text \<open>Wellfoundness (easy)\<close>
         subgoal by (auto simp add: quicksort_pre_def partition_spec_def)
 
         text \<open>Show that the postcondition holds\<close>
         subgoal
           apply (simp add: Misc.subset_Collect_conv post_def, intro allI impI, elim conjE)
           using trans lin apply (rule quicksort_correct_case3)
           using IH(2) unfolding pre_def by auto
         done
 
       text \<open>Case: At least the first recursive call\<close>
       subgoal
         apply (rule IH(1)[THEN order_trans])
 
         text \<open>Show that the precondition holds for the first recursive call\<close>
         subgoal
           using IH(2) unfolding pre_def post_def apply (simp, elim conjE, split prod.splits) apply auto
           apply (rule quicksort_correct_case4) by auto
 
         text \<open>Wellfoundness for first recursive call (easy)\<close>
         subgoal by (auto simp add: quicksort_pre_def partition_spec_def)
 
         text \<open>Simplify some refinement suff...\<close>
         apply (simp add: Misc.subset_Collect_conv ASSERT_leI, intro allI impI conjI, elim conjE)
         apply (rule ASSERT_leI)
         apply (simp_all add: Misc.subset_Collect_conv ASSERT_leI)
         subgoal unfolding quicksort_post_def pre_def post_def by (auto dest: mset_eq_setD)
         text \<open>Only the first recursive call: show postcondition\<close>
         subgoal
           using trans lin apply (rule quicksort_correct_case5)
           using IH(2) unfolding pre_def post_def by auto
 
         apply (rule ASSERT_leI)
         subgoal unfolding quicksort_post_def pre_def post_def by (auto dest: mset_eq_setD)
 
         text \<open>Both recursive calls.\<close>
         subgoal
           apply (rule IH(1)[THEN order_trans])
 
           text \<open>Show precondition for second recursive call (after the first call)\<close>
           subgoal
             unfolding pre_def post_def
             apply auto
             apply (rule quicksort_correct_case6)
             using IH(2) unfolding pre_def post_def  by auto
 
           text \<open>Wellfoundedness for second recursive call (easy)\<close>
           subgoal by (auto simp add: quicksort_pre_def partition_spec_def)
 
           text \<open>Show that the postcondition holds (after both recursive calls)\<close>
           subgoal
             apply (simp add: Misc.subset_Collect_conv, intro allI impI, elim conjE)
             using trans lin apply (rule quicksort_correct_case7)
             using IH(2) unfolding pre_def post_def by auto
           done
         done
       done
     done
 
   text \<open>Finally, apply the generalized lemma to show the thesis.\<close>
   then show ?thesis unfolding post_def  by auto
 qed
 
 
 
 (* TODO: Show that our (abstract) partition satisifies the specification *)
 
 
 definition partition_main_inv :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> (nat\<times>nat\<times>'a list) \<Rightarrow> bool\<close> where
   \<open>partition_main_inv R h lo hi xs0 p \<equiv>
     case p of (i,j,xs) \<Rightarrow>
     j < length xs \<and> j \<le> hi \<and> i < length xs \<and> lo \<le> i \<and> i \<le> j \<and> mset xs = mset xs0 \<and>
     (\<forall>k. k \<ge> lo \<and> k < i \<longrightarrow> R (h (xs!k)) (h (xs!hi))) \<and> \<comment> \<open>All elements from \<^term>\<open>lo\<close> to \<^term>\<open>i-1\<close> are smaller than the pivot\<close>
     (\<forall>k. k \<ge> i \<and> k < j \<longrightarrow>  R (h (xs!hi)) (h (xs!k))) \<and> \<comment> \<open>All elements from \<^term>\<open>i\<close> to \<^term>\<open>j-1\<close> are greater than the pivot\<close>
     (\<forall>k. k < lo \<longrightarrow> xs!k = xs0!k) \<and> \<comment> \<open>Everything below \<^term>\<open>lo\<close> is unchanged\<close>
     (\<forall>k. k \<ge> j \<and> k < length xs \<longrightarrow> xs!k = xs0!k) \<comment> \<open>All elements from \<^term>\<open>j\<close> are unchanged (including everyting above \<^term>\<open>hi\<close>)\<close>
   \<close>
 
 text \<open>The main part of the partition function. The pivot is assumed to be the last element. This is
 exactly the "Lomuto partition scheme" partition function from Wikipedia.\<close>
 definition partition_main :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> nat) nres\<close> where
   \<open>partition_main R h lo hi xs0 = do {
     ASSERT(hi < length xs0);
     pivot \<leftarrow> RETURN (h (xs0 ! hi));
     (i,j,xs) \<leftarrow> WHILE\<^sub>T\<^bsup>partition_main_inv R h lo hi xs0\<^esup> \<comment> \<open>We loop from \<^term>\<open>j=lo\<close> to \<^term>\<open>j=hi-1\<close>.\<close>
       (\<lambda>(i,j,xs). j < hi)
       (\<lambda>(i,j,xs). do {
         ASSERT(i < length xs \<and> j < length xs);
       	if R (h (xs!j)) pivot
       	then RETURN (i+1, j+1, swap xs i j)
       	else RETURN (i,   j+1, xs)
       })
       (lo, lo, xs0); \<comment> \<open>i and j are both initialized to lo\<close>
     ASSERT(i < length xs \<and> j = hi \<and> lo \<le> i \<and> hi < length xs \<and> mset xs = mset xs0);
     RETURN (swap xs i hi, i)
   }\<close>
 
 (*
 definition partition_spec :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> nat \<Rightarrow> bool\<close> where
   \<open>partition_spec R h xs lo hi xs' p \<equiv>
     mset xs' = mset xs \<and> \<comment> \<open>The list is a permutation\<close>
     isPartition_map R h xs' lo hi p \<and> \<comment> \<open>We have a valid partition on the resulting list\<close>
     lo \<le> p \<and> p \<le> hi \<and> \<comment> \<open>The partition index is in bounds\<close>
     (\<forall> i. i<lo \<longrightarrow> xs'!i=xs!i) \<and> (\<forall> i. hi<i\<and>i<length xs' \<longrightarrow> xs'!i=xs!i)\<close> \<comment> \<open>Everything else is unchanged.\<close>
 *)
 
 lemma partition_main_correct:
   assumes bounds: \<open>hi < length xs\<close> \<open>lo \<le> hi\<close> and
     trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>partition_main R h lo hi xs \<le> SPEC(\<lambda>(xs', p). mset xs = mset xs' \<and>
      lo \<le> p \<and> p \<le> hi \<and> isPartition_map R h xs' lo hi p \<and> (\<forall> i. i<lo \<longrightarrow> xs'!i=xs!i) \<and> (\<forall> i. hi<i\<and>i<length xs' \<longrightarrow> xs'!i=xs!i))\<close>
 proof -
   have K: \<open>b \<le> hi - Suc n \<Longrightarrow> n > 0 \<Longrightarrow> Suc n \<le> hi \<Longrightarrow> Suc b \<le> hi - n\<close> for b hi n
     by auto
   have L: \<open>~ R (h x) (h y) \<Longrightarrow> R (h y) (h x)\<close> for x y \<comment> \<open>Corollary of linearity\<close>
     using assms by blast
   have M: \<open>a < Suc b \<equiv> a = b \<or> a < b\<close> for a b
     by linarith
   have N: \<open>(a::nat) \<le> b \<equiv> a = b \<or> a < b\<close> for a b
     by arith
 
   show ?thesis
     unfolding partition_main_def choose_pivot_def
     apply (refine_vcg WHILEIT_rule[where R = \<open>measure(\<lambda>(i,j,xs). hi-j)\<close>])
     subgoal using assms by blast \<comment> \<open>We feed our assumption to the assertion\<close>
     subgoal by auto \<comment> \<open>WF\<close>
     subgoal \<comment> \<open>Invariant holds before the first iteration\<close>
       unfolding partition_main_inv_def
       using assms apply simp by linarith
     subgoal unfolding partition_main_inv_def by simp
     subgoal unfolding partition_main_inv_def by simp
     subgoal
       unfolding partition_main_inv_def
       apply (auto dest: mset_eq_length)
       done
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal
       unfolding partition_main_inv_def apply (auto dest: mset_eq_length)
       by (metis L M mset_eq_length nat_le_eq_or_lt)
 
     subgoal unfolding partition_main_inv_def by simp \<comment> \<open>assertions, etc\<close>
     subgoal unfolding partition_main_inv_def by simp
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal unfolding partition_main_inv_def by simp
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal unfolding partition_main_inv_def by (auto dest: mset_eq_length)
     subgoal unfolding partition_main_inv_def by simp
     subgoal unfolding partition_main_inv_def by simp
 
     subgoal \<comment> \<open>After the last iteration, we have a partitioning! :-)\<close>
       unfolding partition_main_inv_def by (auto simp add: isPartition_wrt_def)
     subgoal \<comment> \<open>And the lower out-of-bounds parts of the list haven't been changed\<close>
       unfolding partition_main_inv_def by auto
     subgoal \<comment> \<open>And the upper out-of-bounds parts of the list haven't been changed\<close>
       unfolding partition_main_inv_def by auto
     done
 qed
 
 
 definition partition_between :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> nat) nres\<close> where
   \<open>partition_between R h lo hi xs0 = do {
     ASSERT(hi < length xs0 \<and> lo \<le> hi);
     k \<leftarrow> choose_pivot R h xs0 lo hi; \<comment> \<open>choice of pivot\<close>
     ASSERT(k < length xs0);
     xs \<leftarrow> RETURN (swap xs0 k hi); \<comment> \<open>move the pivot to the last position, before we start the actual loop\<close>
     ASSERT(length xs = length xs0);
     partition_main R h lo hi xs
   }\<close>
 
 
 lemma partition_between_correct:
   assumes \<open>hi < length xs\<close> and \<open>lo \<le> hi\<close> and
   \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>partition_between R h lo hi xs \<le> SPEC(uncurry (partition_spec R h xs lo hi))\<close>
 proof -
   have K: \<open>b \<le> hi - Suc n \<Longrightarrow> n > 0 \<Longrightarrow> Suc n \<le> hi \<Longrightarrow> Suc b \<le> hi - n\<close> for b hi n
     by auto
   show ?thesis
     unfolding partition_between_def choose_pivot_def
     apply (refine_vcg partition_main_correct)
     using assms apply (auto dest: mset_eq_length simp add: partition_spec_def)
     by (metis dual_order.strict_trans2 less_imp_not_eq2 mset_eq_length swap_nth)
 qed
 
 
 
 text \<open>We use the median of the first, the middle, and the last element.\<close>
 definition choose_pivot3 where
   \<open>choose_pivot3 R h xs lo (hi::nat) = do {
     ASSERT(lo < length xs);
     ASSERT(hi < length xs);
     let k' = (hi - lo) div 2;
     let k = lo + k';
     ASSERT(k < length xs);
     let start = h (xs ! lo);
     let mid = h (xs ! k);
     let end = h (xs ! hi);
     if (R start mid \<and> R mid end) \<or> (R end mid \<and> R mid start) then RETURN k
     else if (R start end \<and> R end mid) \<or> (R mid end \<and> R end start) then RETURN hi
     else RETURN lo
 }\<close>
 
 \<comment> \<open>We only have to show that this procedure yields a valid index between \<open>lo\<close> and \<open>hi\<close>.\<close>
 lemma choose_pivot3_choose_pivot:
   assumes \<open>lo < length xs\<close> \<open>hi < length xs\<close> \<open>hi \<ge> lo\<close>
   shows \<open>choose_pivot3 R h xs lo hi \<le> \<Down> Id (choose_pivot R h xs lo hi)\<close>
   unfolding choose_pivot3_def choose_pivot_def
   using assms by (auto intro!: ASSERT_leI simp: Let_def)
 
 text \<open>The refined partion function: We use the above pivot function and fold instead of non-deterministic iteration.\<close>
 definition partition_between_ref
   :: \<open>('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> nat) nres\<close>
 where
   \<open>partition_between_ref R h lo hi xs0 = do {
     ASSERT(hi < length xs0 \<and> hi < length xs0 \<and> lo \<le> hi);
     k \<leftarrow> choose_pivot3 R h xs0 lo hi; \<comment> \<open>choice of pivot\<close>
     ASSERT(k < length xs0);
     xs \<leftarrow> RETURN (swap xs0 k hi); \<comment> \<open>move the pivot to the last position, before we start the actual loop\<close>
     ASSERT(length xs = length xs0);
     partition_main R h lo hi xs
   }\<close>
 
 
 lemma partition_main_ref':
   \<open>partition_main R h lo hi xs
     \<le> \<Down> ((\<lambda> a b c d. Id) a b c d) (partition_main R h lo hi xs)\<close>
   by auto
 
 
 (*TODO already exists somewhere*)
 lemma Down_id_eq:
   \<open>\<Down>Id x = x\<close>
   by auto
 
 lemma partition_between_ref_partition_between:
   \<open>partition_between_ref R h lo hi xs \<le> (partition_between R h lo hi xs)\<close>
 proof -
   have swap: \<open>(swap xs k hi, swap xs ka hi) \<in> Id\<close> if \<open>k = ka\<close>
     for k ka
     using that by auto
   have [refine0]: \<open>(h (xsa ! hi), h (xsaa ! hi)) \<in> Id\<close>
     if \<open>(xsa, xsaa) \<in> Id\<close>
     for xsa xsaa
     using that by auto
 
   show ?thesis
     apply (subst (2) Down_id_eq[symmetric])
     unfolding partition_between_ref_def
       partition_between_def
       OP_def
     apply (refine_vcg choose_pivot3_choose_pivot swap partition_main_correct)
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     subgoal by auto
     by (auto intro: Refine_Basic.Id_refine dest: mset_eq_length)
 qed
 
 text \<open>Technical lemma for sepref\<close>
 
 lemma partition_between_ref_partition_between':
   \<open>(uncurry2 (partition_between_ref R h), uncurry2 (partition_between R h)) \<in>
     (nat_rel \<times>\<^sub>r nat_rel) \<times>\<^sub>r \<langle>Id\<rangle>list_rel \<rightarrow>\<^sub>f \<langle>\<langle>Id\<rangle>list_rel \<times>\<^sub>r nat_rel\<rangle>nres_rel\<close>
   by (intro frefI nres_relI)
     (auto intro: partition_between_ref_partition_between)
 
 text \<open>Example instantiation for pivot\<close>
 definition choose_pivot3_impl where
   \<open>choose_pivot3_impl = choose_pivot3 (\<le>) id\<close>
 
 
 lemma partition_between_ref_correct:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
     and bounds: \<open>hi < length xs\<close> \<open>lo \<le> hi\<close>
   shows \<open>partition_between_ref R h lo hi xs \<le> SPEC (uncurry (partition_spec R h xs lo hi))\<close>
 proof -
   show ?thesis
     apply (rule partition_between_ref_partition_between[THEN order_trans])
     using bounds apply (rule partition_between_correct[where h=h])
     subgoal by (rule trans)
     subgoal by (rule lin)
     done
 qed
 
 
 text \<open>Refined quicksort algorithm: We use the refined partition function.\<close>
 definition quicksort_ref :: \<open>_ \<Rightarrow> _ \<Rightarrow> nat \<times> nat \<times> 'a list \<Rightarrow> 'a list nres\<close> where
 \<open>quicksort_ref R h = (\<lambda>(lo,hi,xs0).
   do {
   RECT (\<lambda>f (lo,hi,xs). do {
       ASSERT(lo \<le> hi \<and> hi < length xs0 \<and> mset xs = mset xs0);
       (xs, p) \<leftarrow> partition_between_ref R h lo hi xs; \<comment> \<open>This is the refined partition function. Note that we need the premises (trans,lin,bounds) here.\<close>
       ASSERT(mset xs = mset xs0 \<and> p \<ge> lo \<and> p < length xs0);
       xs \<leftarrow> (if p-1\<le>lo then RETURN xs else f (lo, p-1, xs));
       ASSERT(mset xs = mset xs0);
       if hi\<le>p+1 then RETURN xs else f (p+1, hi, xs)
     }) (lo,hi,xs0)
   })\<close>
 
 
 (*TODO share*)
 lemma fref_to_Down_curry2:
   \<open>(uncurry2 f, uncurry2 g) \<in> [P]\<^sub>f A \<rightarrow> \<langle>B\<rangle>nres_rel \<Longrightarrow>
      (\<And>x x' y y' z z'. P ((x', y'), z') \<Longrightarrow> (((x, y), z), ((x', y'), z')) \<in> A\<Longrightarrow>
          f x y z \<le> \<Down> B (g x' y' z'))\<close>
   unfolding fref_def uncurry_def nres_rel_def
   by auto
 
 lemma fref_to_Down_curry:
   \<open>(f, g) \<in> [P]\<^sub>f A \<rightarrow> \<langle>B\<rangle>nres_rel \<Longrightarrow>
      (\<And>x x' . P x' \<Longrightarrow> (x, x') \<in> A\<Longrightarrow>
          f x  \<le> \<Down> B (g x'))\<close>
   unfolding fref_def uncurry_def nres_rel_def
   by auto
 
 
 
 lemma quicksort_ref_quicksort:
   assumes bounds: \<open>hi < length xs\<close> \<open>lo \<le> hi\<close> and
     trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>quicksort_ref R h x0 \<le> \<Down> Id (quicksort R h x0)\<close>
 proof -
   have wf: \<open>wf (measure (\<lambda>(lo, hi, xs). Suc hi - lo))\<close>
     by auto
   have pre: \<open>x0 = x0' \<Longrightarrow> (x0, x0') \<in> Id \<times>\<^sub>r Id \<times>\<^sub>r \<langle>Id\<rangle>list_rel\<close> for x0 x0' :: \<open>nat \<times> nat \<times> 'b list\<close>
     by auto
   have [refine0]: \<open>(x1e = x1d) \<Longrightarrow> (x1e,x1d) \<in> Id\<close> for x1e x1d :: \<open>'b list\<close>
     by auto
 
   show ?thesis
     unfolding quicksort_def quicksort_ref_def
     apply (refine_vcg pre partition_between_ref_partition_between'[THEN fref_to_Down_curry2])
 
     text \<open>First assertion (premise for partition)\<close>
     subgoal
       by auto
     text \<open>First assertion (premise for partition)\<close>
     subgoal
       by auto
     subgoal
       by (auto dest: mset_eq_length)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
 
     text \<open>Correctness of the concrete partition function\<close>
     subgoal
       apply (simp, rule partition_between_ref_correct)
       subgoal by (rule trans)
       subgoal by (rule lin)
       subgoal by auto \<comment> \<open>first premise\<close>
       subgoal by auto \<comment> \<open>second premise\<close>
       done
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
     subgoal by (auto simp: partition_spec_def isPartition_wrt_def)
     subgoal by (auto simp: partition_spec_def isPartition_wrt_def dest: mset_eq_length)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
     subgoal
       by (auto dest: mset_eq_length mset_eq_setD)
 
     by simp+
 qed
 
 \<comment> \<open>Sort the entire list\<close>
 definition full_quicksort where
   \<open>full_quicksort R h xs \<equiv> if xs = [] then RETURN xs else quicksort R h (0, length xs - 1, xs)\<close>
 
 definition full_quicksort_ref where
   \<open>full_quicksort_ref R h xs \<equiv>
     if List.null xs then RETURN xs
     else quicksort_ref R h (0, length xs - 1, xs)\<close>
 
 definition full_quicksort_impl :: \<open>nat list \<Rightarrow> nat list nres\<close> where
   \<open>full_quicksort_impl xs = full_quicksort_ref (\<le>) id xs\<close>
 
 lemma full_quicksort_ref_full_quicksort:
   assumes trans: \<open>\<And> x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>(full_quicksort_ref R h, full_quicksort R h) \<in>
           \<langle>Id\<rangle>list_rel \<rightarrow>\<^sub>f \<langle> \<langle>Id\<rangle>list_rel\<rangle>nres_rel\<close>
 proof -
   show ?thesis
     unfolding full_quicksort_ref_def full_quicksort_def
     apply (intro frefI nres_relI)
     apply (auto intro!: quicksort_ref_quicksort[unfolded Down_id_eq] simp: List.null_def)
     subgoal by (rule trans)
     subgoal using lin by blast
     done
 qed
 
 
 lemma sublist_entire:
   \<open>sublist xs 0 (length xs - 1) = xs\<close>
   by (simp add: sublist_def)
 
 
 lemma sorted_sublist_wrt_entire:
   assumes \<open>sorted_sublist_wrt R xs 0 (length xs - 1)\<close>
   shows \<open>sorted_wrt R xs\<close>
 proof -
   have \<open>sorted_wrt R (sublist xs 0 (length xs - 1))\<close>
     using assms by (simp add: sorted_sublist_wrt_def )
   then show ?thesis
     by (metis sublist_entire)
 qed
 
 lemma sorted_sublist_map_entire:
   assumes \<open>sorted_sublist_map R h xs 0 (length xs - 1)\<close>
   shows \<open>sorted_wrt (\<lambda> x y. R (h x) (h y)) xs\<close>
 proof -
   show ?thesis
     using assms by (rule sorted_sublist_wrt_entire)
 qed
 
 
 text \<open>Final correctness lemma\<close>
 theorem full_quicksort_correct_sorted:
   assumes
     trans: \<open>\<And>x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and lin: \<open>\<And>x y. x \<noteq> y \<Longrightarrow> R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>full_quicksort R h xs \<le> \<Down> Id (SPEC(\<lambda>xs'. mset xs' = mset xs \<and> sorted_wrt (\<lambda> x y. R (h x) (h y)) xs'))\<close>
 proof -
   show ?thesis
     unfolding full_quicksort_def
     apply (refine_vcg)
     subgoal by simp \<comment> \<open>case xs=[]\<close>
     subgoal by simp \<comment> \<open>case xs=[]\<close>
 
     apply (rule quicksort_correct[THEN order_trans])
     subgoal by (rule trans)
     subgoal by (rule lin)
     subgoal by linarith
     subgoal by simp
 
     apply (simp add: Misc.subset_Collect_conv, intro allI impI conjI)
     subgoal
       by (auto simp add: quicksort_post_def)
     subgoal
       apply (rule sorted_sublist_map_entire)
       by (auto simp add: quicksort_post_def dest: mset_eq_length)
     done
 qed
 
 lemma full_quicksort_correct:
   assumes
     trans: \<open>\<And>x y z. \<lbrakk>R (h x) (h y); R (h y) (h z)\<rbrakk> \<Longrightarrow> R (h x) (h z)\<close> and
     lin: \<open>\<And>x y. R (h x) (h y) \<or> R (h y) (h x)\<close>
   shows \<open>full_quicksort R h xs \<le> \<Down> Id (SPEC(\<lambda>xs'. mset xs' = mset xs))\<close>
   by (rule order_trans[OF full_quicksort_correct_sorted])
     (use assms in auto)
 
 end
diff --git a/thys/Refine_Imperative_HOL/IICF/Intf/IICF_Multiset.thy b/thys/Refine_Imperative_HOL/IICF/Intf/IICF_Multiset.thy
--- a/thys/Refine_Imperative_HOL/IICF/Intf/IICF_Multiset.thy
+++ b/thys/Refine_Imperative_HOL/IICF/Intf/IICF_Multiset.thy
@@ -1,227 +1,225 @@
 section \<open>Multiset Interface\<close>
 theory IICF_Multiset
 imports "../../Sepref"
 begin
 
 subsection \<open>Additions to Multiset Theory\<close>
 lemma rel_mset_Plus_gen: 
   assumes "rel_mset A m m'"
   assumes "rel_mset A n n'"
   shows "rel_mset A (m+n) (m'+n')"
   using assms
   by induction (auto simp: algebra_simps dest: rel_mset_Plus)
   
 lemma rel_mset_single:
   assumes "A x y"
   shows "rel_mset A {#x#} {#y#}"
   unfolding rel_mset_def
   apply (rule exI[where x="[x]"])
   apply (rule exI[where x="[y]"])
   using assms by auto
 
 lemma rel_mset_Minus:
   assumes BIU: "bi_unique A"
   shows "\<lbrakk> rel_mset A m n; A x y \<rbrakk> \<Longrightarrow> rel_mset A (m-{#x#}) (n-{#y#})"
   unfolding rel_mset_def 
 proof clarsimp
   fix ml nl
   assume A: "A x y"
   assume R: "list_all2 A ml nl"
   show "\<exists>ml'. mset ml' = mset ml - {#x#} \<and>
                  (\<exists>nl'. mset nl' = mset nl - {#y#} \<and> list_all2 A ml' nl')"
   proof (cases "x\<in>set ml")
     case False
     have "y \<notin> set nl" using A R 
       apply (auto simp: in_set_conv_decomp list_all2_append2 list_all2_Cons2)
       using False BIU[unfolded bi_unique_alt_def]
       apply (auto dest: left_uniqueD)
       done
     with False R show ?thesis by (auto simp: diff_single_trivial in_multiset_in_set)
   next
     case True  
     then obtain ml1 ml2 where [simp]: "ml=ml1@x#ml2" by (auto simp: in_set_conv_decomp)
     then obtain nl1 nl2 where [simp]: "nl=nl1@y#nl2"
       and LA: "list_all2 A ml1 nl1" "list_all2 A ml2 nl2"
       using A R
       apply (auto simp: in_set_conv_decomp list_all2_append1 list_all2_Cons1)
       using BIU[unfolded bi_unique_alt_def]
       apply (auto dest: right_uniqueD)
       done
     have 
       "mset (ml1@ml2) = mset ml - {#x#}"
       "mset (nl1@nl2) = mset nl - {#y#}"
       using R
       by (auto simp: algebra_simps add_implies_diff union_assoc)
     moreover have "list_all2 A (ml1@ml2) (nl1@nl2)"
       by (rule list_all2_appendI) fact+
     ultimately show ?thesis by blast
   qed  
 qed
 
 lemma rel_mset_Minus_gen: 
   assumes BIU: "bi_unique A"
   assumes "rel_mset A m m'"
   assumes "rel_mset A n n'"
   shows "rel_mset A (m-n) (m'-n')"
   using assms(3,2)
   apply (induction R\<equiv>A _ _ rule: rel_mset_induct)
   apply (auto dest: rel_mset_Minus[OF BIU] simp: algebra_simps)
   done
 
 lemma pcr_count:
   assumes "bi_unique A"
   shows "rel_fun (rel_mset A) (rel_fun A (=)) count count"
   apply (intro rel_funI)
   unfolding rel_mset_def
   apply clarsimp
   subgoal for x y xs ys
     apply (rotate_tac,induction xs ys rule: list_all2_induct)
     using assms
     by (auto simp: bi_unique_alt_def left_uniqueD right_uniqueD)
   done    
 
 subsection \<open>Parametricity Setup\<close>
 definition [to_relAPP]: "mset_rel A \<equiv> p2rel (rel_mset (rel2p A))"
 
 lemma rel2p_mset[rel2p]: "rel2p (\<langle>A\<rangle>mset_rel) = rel_mset (rel2p A)"
   by (simp add: mset_rel_def)
 
 lemma p2re_mset[p2rel]: "p2rel (rel_mset A) = \<langle>p2rel A\<rangle>mset_rel"  
   by (simp add: mset_rel_def)
 
 lemma mset_rel_empty[simp]: 
   "(a,{#})\<in>\<langle>A\<rangle>mset_rel \<longleftrightarrow> a={#}"
   "({#},b)\<in>\<langle>A\<rangle>mset_rel \<longleftrightarrow> b={#}"
   by (auto simp: mset_rel_def p2rel_def rel_mset_def)
 
 
 lemma param_mset_empty[param]: "({#},{#}) \<in> \<langle>A\<rangle>mset_rel"
-  unfolding mset_rel_def
-  apply (simp add: p2rel_def)
-  by (rule rel_mset_Zero)
+  by simp
 
 lemma param_mset_Plus[param]: "((+),(+))\<in>\<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel"  
   apply (rule rel2pD)
   apply (simp add: rel2p)
   apply (intro rel_funI)
   by (rule rel_mset_Plus_gen)
 
 
 (*lemma param_mset_single[param]: 
   "(Multiset.single,Multiset.single) \<in> A \<rightarrow> \<langle>A\<rangle>mset_rel"
   apply (rule rel2pD)
   apply (simp add: rel2p)
   apply (intro rel_funI)
   by (rule rel_mset_single)*)
 
 lemma param_mset_add[param]: "(add_mset, add_mset) \<in> A \<rightarrow> \<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel"
   apply (rule rel2pD)
   apply (simp add: rel2p)
   apply (intro rel_funI)
   by (rule rel_mset_Plus)
 
 lemma param_mset_minus[param]: "\<lbrakk>single_valued A; single_valued (A\<inverse>)\<rbrakk> 
   \<Longrightarrow> ((-), (-)) \<in> \<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel" 
   apply (rule rel2pD)
   apply (simp add: rel2p)
   apply (intro rel_funI)
   apply (rule rel_mset_Minus_gen)
   subgoal apply (unfold IS_LEFT_UNIQUE_def[symmetric])
     by (simp add: prop2p bi_unique_alt_def)
   apply (simp; fail)
   apply (simp; fail)
   done
 
 lemma param_count[param]: "\<lbrakk>single_valued A; single_valued (A\<inverse>)\<rbrakk> \<Longrightarrow> (count,count)\<in>\<langle>A\<rangle>mset_rel \<rightarrow> A \<rightarrow> nat_rel"  
   apply (rule rel2pD)
   apply (simp add: prop2p rel2p)
   apply (rule pcr_count)
   apply (simp add: bi_unique_alt_def)
   done
 
 lemma param_set_mset[param]: 
   shows "(set_mset, set_mset) \<in> \<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>set_rel"
   apply (rule rel2pD; simp add: rel2p)
   by (rule multiset.set_transfer)  
 
 definition [simp]: "mset_is_empty m \<equiv> m = {#}"
 
 lemma mset_is_empty_param[param]: "(mset_is_empty,mset_is_empty) \<in> \<langle>A\<rangle>mset_rel \<rightarrow> bool_rel"
   unfolding mset_rel_def mset_is_empty_def[abs_def]
   by (auto simp: p2rel_def rel_mset_def intro: nres_relI)
   
 
 subsection \<open>Operations\<close>
   sepref_decl_op mset_empty: "{#}" :: "\<langle>A\<rangle>mset_rel" .
 
   sepref_decl_op mset_is_empty: "\<lambda>m. m={#}" :: "\<langle>A\<rangle>mset_rel \<rightarrow> bool_rel"
     unfolding mset_is_empty_def[symmetric]
     apply (rule frefI) 
     by parametricity
 
   (*sepref_decl_op mset_single: "\<lambda>m. {#m#}" :: "A \<rightarrow> \<langle>A\<rangle>mset_rel" .*)
 
   sepref_decl_op mset_insert: "add_mset" :: "A \<rightarrow> \<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel" . 
 
   sepref_decl_op mset_delete: "\<lambda>x m. m - {#x#}" :: "A \<rightarrow> \<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel"
     where "single_valued A" "single_valued (A\<inverse>)" .
 
   sepref_decl_op mset_plus: "(+)::_ multiset \<Rightarrow> _" :: "\<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel" .
   sepref_decl_op mset_minus: "(-)::_ multiset \<Rightarrow> _" :: "\<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel \<rightarrow> \<langle>A\<rangle>mset_rel" 
     where "single_valued A" "single_valued (A\<inverse>)" .
   
 
   sepref_decl_op mset_contains: "(\<in>#)" :: "A \<rightarrow> \<langle>A\<rangle>mset_rel \<rightarrow> bool_rel" 
     where "single_valued A" "single_valued (A\<inverse>)" .
     
   sepref_decl_op mset_count: "\<lambda>x y. count y x" :: "A \<rightarrow> \<langle>A\<rangle>mset_rel \<rightarrow> nat_rel" 
     where "single_valued A" "single_valued (A\<inverse>)" .
 
   sepref_decl_op mset_pick: "\<lambda>m. SPEC (\<lambda>(x,m'). m = {#x#} + m')" :: 
     "[\<lambda>m. m\<noteq>{#}]\<^sub>f \<langle>A\<rangle>mset_rel \<rightarrow> A \<times>\<^sub>r \<langle>A\<rangle>mset_rel"
     unfolding mset_is_empty_def[symmetric]
     apply (intro frefI nres_relI)
     apply (refine_vcg SPEC_refine)
     apply1 (rule ccontr; clarsimp)
     applyS (metis msed_rel_invL rel2p_def rel2p_mset union_ac(2))
     applyS parametricity
     done
     
 
 subsection \<open>Patterns\<close>
 
 lemma [def_pat_rules]:
   "{#} \<equiv> op_mset_empty"
   "add_mset \<equiv> op_mset_insert"
   "(=) $b${#} \<equiv> op_mset_is_empty$b"
   "(=) ${#}$b \<equiv> op_mset_is_empty$b"
   "(+) $a$b \<equiv> op_mset_plus$a$b"
   "(-) $a$b \<equiv> op_mset_minus$a$b"
   by (auto intro!: eq_reflection simp: algebra_simps)
 
 lemma [def_pat_rules]:
   "(+) $b$(add_mset$x${#}) \<equiv> op_mset_insert$x$b"
   "(+) $(add_mset$x${#})$b \<equiv> op_mset_insert$x$b"
   "(-) $b$(add_mset$x${#}) \<equiv> op_mset_delete$x$b"
   "(<) $0$(count$a$x) \<equiv> op_mset_contains$x$a"
   "(\<in>) $x$(set_mset$a) \<equiv> op_mset_contains$x$a"
   by (auto intro!: eq_reflection simp: algebra_simps)
 
 
 locale mset_custom_empty = 
   fixes rel empty and op_custom_empty :: "'a multiset"
   assumes customize_hnr_aux: "(uncurry0 empty,uncurry0 (RETURN (op_mset_empty::'a multiset))) \<in> unit_assn\<^sup>k \<rightarrow>\<^sub>a rel"
   assumes op_custom_empty_def: "op_custom_empty = op_mset_empty"
 begin
   sepref_register op_custom_empty :: "'ax multiset"
 
   lemma fold_custom_empty:
     "{#} = op_custom_empty"
     "op_mset_empty = op_custom_empty"
     "mop_mset_empty = RETURN op_custom_empty"
     unfolding op_custom_empty_def by simp_all
 
   lemmas custom_hnr[sepref_fr_rules] = customize_hnr_aux[folded op_custom_empty_def]
 end
 
 end
diff --git a/thys/Shadow_DOM/Shadow_DOM.thy b/thys/Shadow_DOM/Shadow_DOM.thy
--- a/thys/Shadow_DOM/Shadow_DOM.thy
+++ b/thys/Shadow_DOM/Shadow_DOM.thy
@@ -1,10508 +1,10501 @@
 (***********************************************************************************
  * Copyright (c) 2016-2020 The University of Sheffield, UK
  *               2019-2020 University of Exeter, UK
  *
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
  * modification, are permitted provided that the following conditions are met:
  *
  * * Redistributions of source code must retain the above copyright notice, this
  *   list of conditions and the following disclaimer.
  *
  * * Redistributions in binary form must reproduce the above copyright notice,
  *   this list of conditions and the following disclaimer in the documentation
  *   and/or other materials provided with the distribution.
  *
  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
  * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  *
  * SPDX-License-Identifier: BSD-2-Clause
  ***********************************************************************************)
 
 section\<open>The Shadow DOM\<close>
 theory Shadow_DOM
   imports
     "monads/ShadowRootMonad"
     Core_DOM.Core_DOM
 begin
 
 abbreviation "safe_shadow_root_element_types \<equiv> {''article'', ''aside'', ''blockquote'', ''body'',
   ''div'', ''footer'', ''h1'', ''h2'', ''h3'', ''h4'', ''h5'', ''h6'', ''header'', ''main'',
   ''nav'', ''p'', ''section'', ''span''}"
 
 
 subsection \<open>Function Definitions\<close>
 
 
 subsubsection \<open>get\_child\_nodes\<close>
 
 locale l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   CD: l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
 begin
 definition get_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) shadow_root_ptr \<Rightarrow> unit
     \<Rightarrow> (_, (_) node_ptr list) dom_prog" where
   "get_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr _ = get_M shadow_root_ptr RShadowRoot.child_nodes"
 
 definition a_get_child_nodes_tups :: "(((_) object_ptr \<Rightarrow> bool) \<times> ((_) object_ptr \<Rightarrow> unit
     \<Rightarrow> (_, (_) node_ptr list) dom_prog)) list" where
   "a_get_child_nodes_tups \<equiv> [(is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r, get_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast)]"
 
 definition a_get_child_nodes :: "(_) object_ptr \<Rightarrow> (_, (_) node_ptr list) dom_prog" where
   "a_get_child_nodes ptr = invoke (CD.a_get_child_nodes_tups @ a_get_child_nodes_tups) ptr ()"
 
 definition a_get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" where
   "a_get_child_nodes_locs ptr \<equiv>
     (if is_shadow_root_ptr_kind ptr
     then {preserved (get_M (the (cast ptr)) RShadowRoot.child_nodes)} else {}) \<union>
     CD.a_get_child_nodes_locs ptr"
 
 definition first_child :: "(_) object_ptr \<Rightarrow> (_, (_) node_ptr option) dom_prog"
   where
     "first_child ptr = do {
       children \<leftarrow> a_get_child_nodes ptr;
       return (case children of [] \<Rightarrow> None | child#_ \<Rightarrow> Some child)}"
 end
 
 global_interpretation l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines
   get_child_nodes = l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_child_nodes and
   get_child_nodes_locs = l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_child_nodes_locs
   .
 
 locale l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_type_wf type_wf +
   l_known_ptr known_ptr +
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_get_child_nodes_defs get_child_nodes get_child_nodes_locs +
   CD: l_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> bool"
     and get_child_nodes :: "(_) object_ptr \<Rightarrow> (_, (_) node_ptr list) dom_prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> (_, (_) node_ptr list) dom_prog"
     and get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" +
   assumes known_ptr_impl: "known_ptr = ShadowRootClass.known_ptr"
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
   assumes get_child_nodes_impl: "get_child_nodes = a_get_child_nodes"
   assumes get_child_nodes_locs_impl: "get_child_nodes_locs = a_get_child_nodes_locs"
 begin
 lemmas get_child_nodes_def = get_child_nodes_impl[unfolded a_get_child_nodes_def get_child_nodes_def]
 lemmas get_child_nodes_locs_def = get_child_nodes_locs_impl[unfolded a_get_child_nodes_locs_def
     get_child_nodes_locs_def, folded CD.get_child_nodes_locs_impl]
 
 lemma get_child_nodes_ok:
   assumes "known_ptr ptr"
   assumes "type_wf h"
   assumes "ptr |\<in>| object_ptr_kinds h"
   shows "h \<turnstile> ok (get_child_nodes ptr)"
   using assms[unfolded known_ptr_impl type_wf_impl]
   apply(auto simp add: get_child_nodes_def)[1]
   apply(split CD.get_child_nodes_splits, rule conjI)+
   using ShadowRootClass.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t CD.get_child_nodes_ok CD.known_ptr_impl CD.type_wf_impl
    apply blast
   apply(auto simp add: CD.known_ptr_impl a_get_child_nodes_tups_def get_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
       get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_ok
       dest!: known_ptr_new_shadow_root_ptr intro!: bind_is_OK_I2)[1]
   by (metis is_shadow_root_ptr_kind_none l_get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_lemmas.get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_ok
       l_get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_lemmas_axioms option.case_eq_if shadow_root_ptr_casts_commute3
       shadow_root_ptr_kinds_commutes)
 
 lemma get_child_nodes_ptr_in_heap:
   assumes "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   shows "ptr |\<in>| object_ptr_kinds h"
   using assms
   by(auto simp add: get_child_nodes_def invoke_ptr_in_heap dest: is_OK_returns_result_I)
 
 lemma get_child_nodes_pure [simp]:
   "pure (get_child_nodes ptr) h"
   unfolding get_child_nodes_def a_get_child_nodes_tups_def
 proof(split CD.get_child_nodes_splits, rule conjI; clarify)
   assume "known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M ptr"
   then show "pure (get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M ptr) h"
     by simp
 next
   assume "\<not> known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M ptr"
   then show "pure (invoke [(is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r,
        get_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r)]
      ptr ()) h"
     by(auto simp add: get_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def intro: bind_pure_I split: invoke_splits)
 qed
 
 lemma get_child_nodes_reads: "reads (get_child_nodes_locs ptr) (get_child_nodes ptr) h h'"
   apply (simp add: get_child_nodes_def a_get_child_nodes_tups_def get_child_nodes_locs_def
       CD.get_child_nodes_locs_def)
   apply(split CD.get_child_nodes_splits, rule conjI)+
    apply(auto intro!: reads_subset[OF CD.get_child_nodes_reads[unfolded CD.get_child_nodes_locs_def]]
       split: if_splits)[1]
   apply(split invoke_splits, rule conjI)+
    apply(auto)[1]
   apply(auto simp add: get_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
       intro: reads_subset[OF reads_singleton] reads_subset[OF check_in_heap_reads]
       intro!: reads_bind_pure reads_subset[OF return_reads] split: option.splits)[1]
   done
 end
 
 interpretation i_get_child_nodes?: l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr DocumentClass.type_wf
   DocumentClass.known_ptr get_child_nodes get_child_nodes_locs Core_DOM_Functions.get_child_nodes
   Core_DOM_Functions.get_child_nodes_locs
   by(simp add: l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def instances)
 declare l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_child_nodes_is_l_get_child_nodes [instances]: "l_get_child_nodes type_wf known_ptr
     get_child_nodes get_child_nodes_locs"
   apply(auto simp add: l_get_child_nodes_def instances)[1]
   using get_child_nodes_reads get_child_nodes_ok get_child_nodes_ptr_in_heap get_child_nodes_pure
   by blast+
 
 paragraph \<open>new\_document\<close>
 
 locale l_new_document_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   CD: l_new_document_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes
   get_child_nodes_locs get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> bool"
     and get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_child_nodes_new_document:
   "ptr' \<noteq> cast new_document_ptr \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr
   \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_child_nodes_locs ptr' \<Longrightarrow> r h h'"
   apply(auto simp add: get_child_nodes_locs_def)[1]
   using CD.get_child_nodes_new_document
    apply (metis document_ptr_casts_commute3 empty_iff is_document_ptr_kind_none
       new_document_get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t option.case_eq_if shadow_root_ptr_casts_commute3
       singletonD)
   by (simp add: CD.get_child_nodes_new_document)
 
 lemma new_document_no_child_nodes:
   "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>h h'
      \<Longrightarrow> h' \<turnstile> get_child_nodes (cast new_document_ptr) \<rightarrow>\<^sub>r []"
   apply(auto simp add: get_child_nodes_def)[1]
   apply(split CD.get_child_nodes_splits, rule conjI)+
   using CD.new_document_no_child_nodes apply auto[1]
   by(auto simp add: DocumentClass.a_known_ptr_def CD.known_ptr_impl known_ptr_def
       dest!: new_document_is_document_ptr)
 end
 interpretation i_new_document_get_child_nodes?:
   l_new_document_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr get_child_nodes get_child_nodes_locs
   DocumentClass.type_wf DocumentClass.known_ptr Core_DOM_Functions.get_child_nodes
   Core_DOM_Functions.get_child_nodes_locs
   by(unfold_locales)
 declare l_new_document_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma new_document_get_child_nodes_is_l_new_document_get_child_nodes [instances]:
   "l_new_document_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs"
   using new_document_is_l_new_document get_child_nodes_is_l_get_child_nodes
   apply(simp add: l_new_document_get_child_nodes_def l_new_document_get_child_nodes_axioms_def)
   using get_child_nodes_new_document new_document_no_child_nodes
   by fast
 
 paragraph \<open>new\_shadow\_root\<close>
 
 locale l_new_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes
   get_child_nodes_locs get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> bool"
     and get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_child_nodes_new_shadow_root:
   "ptr' \<noteq> cast new_shadow_root_ptr \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr
      \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_child_nodes_locs ptr' \<Longrightarrow> r h h'"
   apply(auto simp add: get_child_nodes_locs_def)[1]
    apply (metis document_ptr_casts_commute3 insert_absorb insert_not_empty is_document_ptr_kind_none
       new_shadow_root_get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t option.case_eq_if shadow_root_ptr_casts_commute3 singletonD)
   apply(auto simp add: CD.get_child_nodes_locs_def)[1]
   using new_shadow_root_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t apply blast
    apply (smt insertCI new_shadow_root_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t singleton_iff)
   apply (metis document_ptr_casts_commute3 empty_iff new_shadow_root_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t singletonD)
   done
 
 lemma new_shadow_root_no_child_nodes:
   "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h'
      \<Longrightarrow> h' \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []"
   apply(auto simp add: get_child_nodes_def )[1]
   apply(split CD.get_child_nodes_splits, rule conjI)+
    apply(auto simp add: CD.get_child_nodes_def CD.a_get_child_nodes_tups_def)[1]
    apply(split invoke_splits, rule conjI)+
   using NodeClass.a_known_ptr_def known_ptr_not_character_data_ptr known_ptr_not_document_ptr
     known_ptr_not_element_ptr local.CD.known_ptr_impl apply blast
      apply(auto simp add: is_document_ptr_def  split: option.splits document_ptr.splits)[1]
     apply(auto simp add: is_character_data_ptr_def  split: option.splits document_ptr.splits)[1]
    apply(auto simp add: is_element_ptr_def  split: option.splits document_ptr.splits)[1]
   apply(auto simp add: a_get_child_nodes_tups_def)[1]
   apply(split invoke_splits, rule conjI)+
    apply(auto simp add: is_shadow_root_ptr_def split: shadow_root_ptr.splits
       dest!: new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_is_shadow_root_ptr)[1]
   apply(auto intro!: bind_pure_returns_result_I)[1]
    apply(drule(1) new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_ptr_in_heap)
    apply(auto simp add: shadow_root_ptr_kinds_def document_ptr_kinds_def)[1]
    apply (metis check_in_heap_ptr_in_heap is_OK_returns_result_E old.unit.exhaust)
   using  new_shadow_root_children
   by (simp add: new_shadow_root_children get_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def)
 end
 interpretation i_new_shadow_root_get_child_nodes?:
   l_new_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr get_child_nodes get_child_nodes_locs
   DocumentClass.type_wf DocumentClass.known_ptr Core_DOM_Functions.get_child_nodes
   Core_DOM_Functions.get_child_nodes_locs
   by(unfold_locales)
 declare l_new_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def[instances]
 
 locale l_new_shadow_root_get_child_nodes = l_get_child_nodes +
   assumes get_child_nodes_new_shadow_root:
     "ptr' \<noteq> cast new_shadow_root_ptr \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr
      \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_child_nodes_locs ptr' \<Longrightarrow> r h h'"
   assumes new_shadow_root_no_child_nodes:
     "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h'
      \<Longrightarrow> h' \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []"
 
 lemma new_shadow_root_get_child_nodes_is_l_new_shadow_root_get_child_nodes [instances]:
   "l_new_shadow_root_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs"
   apply(simp add: l_new_shadow_root_get_child_nodes_def l_new_shadow_root_get_child_nodes_axioms_def
       instances)
   using get_child_nodes_new_shadow_root new_shadow_root_no_child_nodes
   by fast
 
 paragraph \<open>new\_element\<close>
 
 locale l_new_element_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_new_element_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma get_child_nodes_new_element:
   "ptr' \<noteq> cast new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h'
      \<Longrightarrow> r \<in> get_child_nodes_locs ptr' \<Longrightarrow> r h h'"
   by (auto simp add: get_child_nodes_locs_def CD.get_child_nodes_locs_def new_element_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
       new_element_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t new_element_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t new_element_get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t
       split: prod.splits if_splits option.splits
       elim!: bind_returns_result_E bind_returns_heap_E
       intro: is_element_ptr_kind_obtains)
 
 lemma new_element_no_child_nodes:
   "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h'
    \<Longrightarrow> h' \<turnstile> get_child_nodes (cast new_element_ptr) \<rightarrow>\<^sub>r []"
   apply(auto simp add: get_child_nodes_def a_get_child_nodes_tups_def
       split: prod.splits elim!: bind_returns_result_E bind_returns_heap_E)[1]
   apply(split CD.get_child_nodes_splits, rule conjI)+
   using local.new_element_no_child_nodes apply auto[1]
   apply(auto simp add: invoke_def)[1]
   apply(auto simp add: new_element_ptr_in_heap get_child_nodes\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def check_in_heap_def
       new_element_child_nodes intro!: bind_pure_returns_result_I
       intro: new_element_is_element_ptr elim!: new_element_ptr_in_heap)[1]
 proof -
   assume " h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr"
   assume "h \<turnstile> new_element \<rightarrow>\<^sub>h h'"
   assume "\<not> known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M (cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr)"
   moreover
   have "known_ptr (cast new_element_ptr)"
     using new_element_is_element_ptr \<open>h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr\<close>
     by(auto simp add: known_ptr_impl ShadowRootClass.a_known_ptr_def DocumentClass.a_known_ptr_def
         CharacterDataClass.a_known_ptr_def ElementClass.a_known_ptr_def)
   ultimately show "False"
     by(simp add: known_ptr_impl CD.known_ptr_impl ShadowRootClass.a_known_ptr_def
         is_document_ptr_kind_none)
 qed
 end
 
 interpretation i_new_element_get_child_nodes?:
   l_new_element_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr DocumentClass.type_wf
   DocumentClass.known_ptr get_child_nodes get_child_nodes_locs Core_DOM_Functions.get_child_nodes
   Core_DOM_Functions.get_child_nodes_locs
   by(unfold_locales)
 declare l_new_element_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma new_element_get_child_nodes_is_l_new_element_get_child_nodes [instances]:
   "l_new_element_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs"
   using new_element_is_l_new_element get_child_nodes_is_l_get_child_nodes
   apply(auto simp add: l_new_element_get_child_nodes_def l_new_element_get_child_nodes_axioms_def)[1]
   using get_child_nodes_new_element new_element_no_child_nodes
   by fast+
 
 
 
 
 subsubsection \<open>delete\_shadow\_root\<close>
 
 locale l_delete_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma get_child_nodes_delete_shadow_root:
   "ptr' \<noteq> cast shadow_root_ptr \<Longrightarrow> h \<turnstile> delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M shadow_root_ptr \<rightarrow>\<^sub>h h' \<Longrightarrow>
     r \<in> get_child_nodes_locs ptr' \<Longrightarrow> r h h'"
   by(auto simp add: get_child_nodes_locs_def CD.get_child_nodes_locs_def
       delete_shadow_root_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t delete_shadow_root_get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t
       delete_shadow_root_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t delete_shadow_root_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       split: if_splits option.splits
       intro: is_shadow_root_ptr_kind_obtains)
 end
 
 locale l_delete_shadow_root_get_child_nodes = l_get_child_nodes_defs +
   assumes get_child_nodes_delete_shadow_root:
     "ptr' \<noteq> cast shadow_root_ptr \<Longrightarrow> h \<turnstile> delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M shadow_root_ptr \<rightarrow>\<^sub>h h' \<Longrightarrow>
       r \<in> get_child_nodes_locs ptr' \<Longrightarrow> r h h'"
 
 interpretation l_delete_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr DocumentClass.type_wf
   DocumentClass.known_ptr get_child_nodes get_child_nodes_locs Core_DOM_Functions.get_child_nodes
   Core_DOM_Functions.get_child_nodes_locs
   by(auto simp add: l_delete_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 
 lemma l_delete_shadow_root_get_child_nodes_get_child_nodes_locs [instances]: "l_delete_shadow_root_get_child_nodes get_child_nodes_locs"
   apply(auto simp add: l_delete_shadow_root_get_child_nodes_def)[1]
   using get_child_nodes_delete_shadow_root apply fast
   done
 
 
 
 subsubsection \<open>set\_child\_nodes\<close>
 
 locale l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   CD: l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
 begin
 definition set_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r :: "(_) shadow_root_ptr \<Rightarrow> (_) node_ptr list
     \<Rightarrow> (_, unit) dom_prog" where
   "set_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr = put_M shadow_root_ptr RShadowRoot.child_nodes_update"
 
 definition a_set_child_nodes_tups :: "(((_) object_ptr \<Rightarrow> bool) \<times> ((_) object_ptr \<Rightarrow> (_) node_ptr list
     \<Rightarrow> (_, unit) dom_prog)) list" where
   "a_set_child_nodes_tups \<equiv> [(is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r, set_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast)]"
 
 definition a_set_child_nodes :: "(_) object_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> (_, unit) dom_prog" where
   "a_set_child_nodes ptr children = invoke (CD.a_set_child_nodes_tups @ a_set_child_nodes_tups)
     ptr children"
 
 definition a_set_child_nodes_locs :: "(_) object_ptr \<Rightarrow> (_, unit) dom_prog set"
   where
     "a_set_child_nodes_locs ptr \<equiv>
       (if is_shadow_root_ptr_kind ptr
       then all_args (put_M (the (cast ptr)) RShadowRoot.child_nodes_update)
       else {}) \<union> CD.a_set_child_nodes_locs ptr"
 end
 
 global_interpretation l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs defines
   set_child_nodes = l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_child_nodes and
   set_child_nodes_locs = l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_set_child_nodes_locs
   .
 
 locale l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_type_wf type_wf +
   l_known_ptr known_ptr +
   l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_set_child_nodes_defs set_child_nodes set_child_nodes_locs +
   CD: l_set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   set_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> bool"
     and set_child_nodes :: "(_) object_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> (_, unit) dom_prog"
     and set_child_nodes_locs :: "(_) object_ptr \<Rightarrow> (_, unit) dom_prog set"
     and set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> (_, unit) dom_prog"
     and set_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> (_, unit) dom_prog set" +
   assumes known_ptr_impl: "known_ptr = ShadowRootClass.known_ptr"
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
   assumes set_child_nodes_impl: "set_child_nodes = a_set_child_nodes"
   assumes set_child_nodes_locs_impl: "set_child_nodes_locs = a_set_child_nodes_locs"
 begin
 lemmas set_child_nodes_def = set_child_nodes_impl[unfolded a_set_child_nodes_def set_child_nodes_def]
 lemmas set_child_nodes_locs_def = set_child_nodes_locs_impl[unfolded a_set_child_nodes_locs_def
     set_child_nodes_locs_def, folded CD.set_child_nodes_locs_impl]
 
 lemma set_child_nodes_writes: "writes (set_child_nodes_locs ptr) (set_child_nodes ptr children) h h'"
   apply (simp add: set_child_nodes_def a_set_child_nodes_tups_def set_child_nodes_locs_def)
   apply(split CD.set_child_nodes_splits, rule conjI)+
    apply (simp add: CD.set_child_nodes_writes writes_union_right_I)
   apply(split invoke_splits, rule conjI)+
    apply(auto simp add: a_set_child_nodes_def)[1]
   apply(auto simp add: set_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
       intro!: writes_bind_pure
       intro: writes_union_right_I writes_union_left_I
       split: list.splits)[1]
   by (simp add: is_shadow_root_ptr_kind_none)
 
 lemma set_child_nodes_pointers_preserved:
   assumes "w \<in> set_child_nodes_locs object_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "object_ptr_kinds h = object_ptr_kinds h'"
   using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)]
   by(auto simp add: all_args_def set_child_nodes_locs_def CD.set_child_nodes_locs_def
       split: if_splits)
 
 lemma set_child_nodes_types_preserved:
   assumes "w \<in> set_child_nodes_locs object_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "type_wf h = type_wf h'"
   using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
   by(auto simp add: all_args_def type_wf_impl a_set_child_nodes_tups_def set_child_nodes_locs_def
       CD.set_child_nodes_locs_def
       split: if_splits option.splits)
 end
 
 interpretation
   i_set_child_nodes?: l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr DocumentClass.type_wf
   DocumentClass.known_ptr set_child_nodes set_child_nodes_locs Core_DOM_Functions.set_child_nodes
   Core_DOM_Functions.set_child_nodes_locs
   apply(unfold_locales)
   by (auto simp add: set_child_nodes_def set_child_nodes_locs_def)
 declare l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_child_nodes_is_l_set_child_nodes [instances]: "l_set_child_nodes type_wf set_child_nodes
     set_child_nodes_locs"
-  using instances
-  apply(auto simp add: l_set_child_nodes_def)[1]
-  using  set_child_nodes_writes apply fast
-  using set_child_nodes_pointers_preserved apply(fast, fast)
-  using set_child_nodes_types_preserved apply(fast, fast)
-  done
-
+  using instances Shadow_DOM.i_set_child_nodes.set_child_nodes_pointers_preserved Shadow_DOM.i_set_child_nodes.set_child_nodes_writes i_set_child_nodes.set_child_nodes_types_preserved
+  unfolding l_set_child_nodes_def
+  by blast
 
 
 paragraph \<open>get\_child\_nodes\<close>
 
 locale l_set_child_nodes_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf known_ptr type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs
   get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf known_ptr type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_child_nodes set_child_nodes_locs
   set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + CD: l_set_child_nodes_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> bool"
     and get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and set_child_nodes :: "(_) object_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
 begin
 
 lemma set_child_nodes_get_child_nodes:
   assumes "known_ptr ptr"
   assumes "type_wf h"
   assumes "h \<turnstile> set_child_nodes ptr children \<rightarrow>\<^sub>h h'"
   shows "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
 proof -
   have "h \<turnstile> check_in_heap ptr \<rightarrow>\<^sub>r ()"
     using assms set_child_nodes_def invoke_ptr_in_heap
     by (metis (full_types) check_in_heap_ptr_in_heap is_OK_returns_heap_I is_OK_returns_result_E
         old.unit.exhaust)
   then have ptr_in_h: "ptr |\<in>| object_ptr_kinds h"
     by (simp add: check_in_heap_ptr_in_heap is_OK_returns_result_I)
 
   have "type_wf h'"
     apply(unfold type_wf_impl)
     apply(rule subst[where P=id, OF type_wf_preserved[OF set_child_nodes_writes assms(3),
             unfolded all_args_def], simplified])
     by(auto simp add: all_args_def assms(2)[unfolded type_wf_impl] set_child_nodes_locs_def
         CD.set_child_nodes_locs_def
         split: if_splits)
   have "h' \<turnstile> check_in_heap ptr \<rightarrow>\<^sub>r ()"
     using check_in_heap_reads set_child_nodes_writes assms(3) \<open>h \<turnstile> check_in_heap ptr \<rightarrow>\<^sub>r ()\<close>
     apply(rule reads_writes_separate_forwards)
     apply(auto simp add: all_args_def set_child_nodes_locs_def CD.set_child_nodes_locs_def)[1]
     done
   then have "ptr |\<in>| object_ptr_kinds h'"
     using check_in_heap_ptr_in_heap by blast
   with assms ptr_in_h \<open>type_wf h'\<close> show ?thesis
     apply(auto simp add: type_wf_impl known_ptr_impl  get_child_nodes_def a_get_child_nodes_tups_def
         set_child_nodes_def a_set_child_nodes_tups_def
         del: bind_pure_returns_result_I2
         intro!: bind_pure_returns_result_I2)[1]
     apply(split CD.get_child_nodes_splits, (rule conjI impI)+)+
      apply(split CD.set_child_nodes_splits)+
       apply(auto simp add: CD.set_child_nodes_get_child_nodes type_wf_impl CD.type_wf_impl
         dest: ShadowRootClass.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t)[1]
      apply(auto simp add: CD.set_child_nodes_get_child_nodes type_wf_impl CD.type_wf_impl
         dest: ShadowRootClass.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t)[1]
     apply(split CD.set_child_nodes_splits)+
     by(auto simp add: known_ptr_impl CD.known_ptr_impl set_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         get_child_nodes\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def CD.type_wf_impl ShadowRootClass.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
         dest: known_ptr_new_shadow_root_ptr)[2]
 qed
 
 lemma set_child_nodes_get_child_nodes_different_pointers:
   assumes "ptr \<noteq> ptr'"
   assumes "w \<in> set_child_nodes_locs ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   assumes "r \<in> get_child_nodes_locs ptr'"
   shows "r h h'"
   using assms
   apply(auto simp add: set_child_nodes_locs_def CD.set_child_nodes_locs_def
       get_child_nodes_locs_def CD.get_child_nodes_locs_def)[1]
   by(auto simp add: all_args_def
       elim!: is_document_ptr_kind_obtains is_shadow_root_ptr_kind_obtains
       is_element_ptr_kind_obtains
       split: if_splits option.splits)
 
 end
 
 interpretation
   i_set_child_nodes_get_child_nodes?: l_set_child_nodes_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr
   DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes get_child_nodes_locs
   Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs set_child_nodes
   set_child_nodes_locs Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs
   using instances
   by(auto simp add: l_set_child_nodes_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def )
 declare l_set_child_nodes_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_child_nodes_get_child_nodes_is_l_set_child_nodes_get_child_nodes [instances]:
   "l_set_child_nodes_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs
     set_child_nodes set_child_nodes_locs"
   apply(auto simp add: instances l_set_child_nodes_get_child_nodes_def
       l_set_child_nodes_get_child_nodes_axioms_def)[1]
   using set_child_nodes_get_child_nodes apply fast
   using set_child_nodes_get_child_nodes_different_pointers apply fast
   done
 
 subsubsection \<open>set\_tag\_type\<close>
 
 locale l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   CD: l_set_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_tag_name set_tag_name_locs +
   l_type_wf type_wf
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and set_tag_name :: "(_) element_ptr \<Rightarrow> tag_name \<Rightarrow> (_, unit) dom_prog"
     and set_tag_name_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set" +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
 begin
 lemmas set_tag_name_def = CD.set_tag_name_impl[unfolded CD.a_set_tag_name_def set_tag_name_def]
 lemmas set_tag_name_locs_def = CD.set_tag_name_locs_impl[unfolded CD.a_set_tag_name_locs_def
     set_tag_name_locs_def]
 
 lemma set_tag_name_ok:
   "type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (set_tag_name element_ptr tag)"
   apply(unfold type_wf_impl)
   unfolding set_tag_name_impl[unfolded a_set_tag_name_def] using get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok
   using CD.set_tag_name_ok CD.type_wf_impl ShadowRootClass.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t by blast
 
 lemma set_tag_name_writes:
   "writes (set_tag_name_locs element_ptr) (set_tag_name element_ptr tag) h h'"
   using CD.set_tag_name_writes .
 
 lemma set_tag_name_pointers_preserved:
   assumes "w \<in> set_tag_name_locs element_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "object_ptr_kinds h = object_ptr_kinds h'"
   using assms
   by(simp add: CD.set_tag_name_pointers_preserved)
 
 lemma set_tag_name_typess_preserved:
   assumes "w \<in> set_tag_name_locs element_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "type_wf h = type_wf h'"
   apply(unfold type_wf_impl)
   apply(rule type_wf_preserved[OF writes_singleton2 assms(2)])
   using assms(1) set_tag_name_locs_def
   by(auto simp add: all_args_def set_tag_name_locs_def
       split: if_splits)
 end
 
 interpretation i_set_tag_name?: l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf set_tag_name
   set_tag_name_locs
   by(auto simp add: l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def instances)
 declare l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma set_tag_name_is_l_set_tag_name [instances]:
   "l_set_tag_name type_wf set_tag_name set_tag_name_locs"
   apply(auto simp add: l_set_tag_name_def)[1]
   using set_tag_name_writes apply fast
   using set_tag_name_ok apply fast
   using set_tag_name_pointers_preserved apply (fast, fast)
   using set_tag_name_typess_preserved apply (fast, fast)
   done
 
 paragraph \<open>get\_child\_nodes\<close>
 
 locale l_set_tag_name_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   CD: l_set_tag_name_get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_tag_name set_tag_name_locs
   known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_tag_name_get_child_nodes:
   "\<forall>w \<in> set_tag_name_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))"
   apply(auto simp add: get_child_nodes_locs_def)[1]
     apply(auto simp add: set_tag_name_locs_def all_args_def)[1]
   using CD.set_tag_name_get_child_nodes apply(blast)
   using CD.set_tag_name_get_child_nodes apply(blast)
   done
 end
 
 interpretation
   i_set_tag_name_get_child_nodes?: l_set_tag_name_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   DocumentClass.type_wf set_tag_name set_tag_name_locs known_ptr DocumentClass.known_ptr
   get_child_nodes get_child_nodes_locs Core_DOM_Functions.get_child_nodes
   Core_DOM_Functions.get_child_nodes_locs
   by unfold_locales
 declare l_set_tag_name_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_tag_name_get_child_nodes_is_l_set_tag_name_get_child_nodes [instances]:
   "l_set_tag_name_get_child_nodes type_wf set_tag_name set_tag_name_locs known_ptr get_child_nodes
                                          get_child_nodes_locs"
   using set_tag_name_is_l_set_tag_name get_child_nodes_is_l_get_child_nodes
   apply(simp add: l_set_tag_name_get_child_nodes_def
       l_set_tag_name_get_child_nodes_axioms_def)
   using set_tag_name_get_child_nodes
   by fast
 
 
 
 subsubsection \<open>get\_shadow\_root\<close>
 
 locale l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
 begin
 definition a_get_shadow_root :: "(_) element_ptr \<Rightarrow> (_, (_) shadow_root_ptr option) dom_prog"
   where
     "a_get_shadow_root element_ptr = get_M element_ptr shadow_root_opt"
 
 definition a_get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   where
     "a_get_shadow_root_locs element_ptr \<equiv> {preserved (get_M element_ptr shadow_root_opt)}"
 end
 
 global_interpretation l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
   defines get_shadow_root = a_get_shadow_root
     and get_shadow_root_locs = a_get_shadow_root_locs
   .
 
 locale l_get_shadow_root_defs =
   fixes get_shadow_root :: "(_) element_ptr \<Rightarrow> (_, (_) shadow_root_ptr option) dom_prog"
   fixes get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 
 locale l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
   l_type_wf type_wf
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
   assumes get_shadow_root_impl: "get_shadow_root = a_get_shadow_root"
   assumes get_shadow_root_locs_impl: "get_shadow_root_locs = a_get_shadow_root_locs"
 begin
 lemmas get_shadow_root_def = get_shadow_root_impl[unfolded get_shadow_root_def a_get_shadow_root_def]
 lemmas get_shadow_root_locs_def = get_shadow_root_locs_impl[unfolded get_shadow_root_locs_def
     a_get_shadow_root_locs_def]
 
 lemma get_shadow_root_ok:
   "type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (get_shadow_root element_ptr)"
   unfolding get_shadow_root_def type_wf_impl
   using ShadowRootMonad.get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok by blast
 
 lemma get_shadow_root_pure [simp]: "pure (get_shadow_root element_ptr) h"
   unfolding get_shadow_root_def by simp
 
 lemma get_shadow_root_ptr_in_heap:
   assumes "h \<turnstile> get_shadow_root element_ptr \<rightarrow>\<^sub>r children"
   shows "element_ptr |\<in>| element_ptr_kinds h"
   using assms
   by(auto simp add: get_shadow_root_def get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap dest: is_OK_returns_result_I)
 
 lemma get_shadow_root_reads:
   "reads (get_shadow_root_locs element_ptr) (get_shadow_root element_ptr) h h'"
   by(simp add: get_shadow_root_def get_shadow_root_locs_def reads_bind_pure
       reads_insert_writes_set_right)
 end
 
 interpretation i_get_shadow_root?: l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root
   get_shadow_root_locs
   using instances
   by (auto simp add: l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_get_shadow_root = l_type_wf + l_get_shadow_root_defs +
   assumes get_shadow_root_reads:
     "reads (get_shadow_root_locs element_ptr) (get_shadow_root element_ptr) h h'"
   assumes get_shadow_root_ok:
     "type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (get_shadow_root element_ptr)"
   assumes get_shadow_root_ptr_in_heap:
     "h \<turnstile> ok (get_shadow_root element_ptr) \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h"
   assumes get_shadow_root_pure [simp]:
     "pure (get_shadow_root element_ptr) h"
 
 lemma get_shadow_root_is_l_get_shadow_root [instances]:
   "l_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
   using instances
-  apply(auto simp add: l_get_shadow_root_def)[1]
-  using get_shadow_root_reads apply blast
-  using get_shadow_root_ok apply blast
-  using get_shadow_root_ptr_in_heap apply blast
-  done
+  unfolding l_get_shadow_root_def
+  by (metis (no_types, lifting) ElementClass.l_type_wf\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_axioms get_shadow_root_ok get_shadow_root_pure get_shadow_root_reads l_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas.get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ptr_in_heap l_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_lemmas.intro l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_shadow_root_def)
 
 
 paragraph \<open>set\_disconnected\_nodes\<close>
 
 locale l_set_disconnected_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_disconnected_nodes set_disconnected_nodes_locs +
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and set_disconnected_nodes
     :: "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma set_disconnected_nodes_get_shadow_root:
   "\<forall>w \<in> set_disconnected_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
   by(auto simp add: set_disconnected_nodes_locs_def get_shadow_root_locs_def all_args_def)
 end
 
 locale l_set_disconnected_nodes_get_shadow_root =
   l_set_disconnected_nodes_defs +
   l_get_shadow_root_defs +
   assumes set_disconnected_nodes_get_shadow_root:
     "\<forall>w \<in> set_disconnected_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
 
 interpretation
   i_set_disconnected_nodes_get_shadow_root?: l_set_disconnected_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf DocumentClass.type_wf set_disconnected_nodes set_disconnected_nodes_locs get_shadow_root
   get_shadow_root_locs
   by(auto simp add: l_set_disconnected_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_disconnected_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_disconnected_nodes_get_shadow_root_is_l_set_disconnected_nodes_get_shadow_root [instances]:
   "l_set_disconnected_nodes_get_shadow_root set_disconnected_nodes_locs get_shadow_root_locs"
   apply(auto simp add: l_set_disconnected_nodes_get_shadow_root_def)[1]
   using set_disconnected_nodes_get_shadow_root apply fast
   done
 
 paragraph \<open>set\_tag\_type\<close>
 
 locale l_set_tag_name_get_shadow_root\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_tag_name_get_shadow_root:
   "\<forall>w \<in> set_tag_name_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
   by(auto simp add: set_tag_name_locs_def
       get_shadow_root_locs_def all_args_def
       intro: element_put_get_preserved[where setter=tag_name_update and getter=shadow_root_opt])
 end
 
 locale l_set_tag_name_get_shadow_root = l_set_tag_name + l_get_shadow_root +
   assumes set_tag_name_get_shadow_root:
     "\<forall>w \<in> set_tag_name_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
 
 interpretation
   i_set_tag_name_get_shadow_root?: l_set_tag_name_get_shadow_root\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf
   set_tag_name set_tag_name_locs
   get_shadow_root get_shadow_root_locs
   apply(auto simp add: l_set_tag_name_get_shadow_root\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)[1]
   using l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms
   by unfold_locales
 declare l_set_tag_name_get_shadow_root\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_tag_name_get_shadow_root_is_l_set_tag_name_get_shadow_root [instances]:
   "l_set_tag_name_get_shadow_root type_wf set_tag_name set_tag_name_locs get_shadow_root
                                   get_shadow_root_locs"
   using set_tag_name_is_l_set_tag_name get_shadow_root_is_l_get_shadow_root
   apply(simp add: l_set_tag_name_get_shadow_root_def l_set_tag_name_get_shadow_root_axioms_def)
   using set_tag_name_get_shadow_root
   by fast
 
 
 paragraph \<open>set\_child\_nodes\<close>
 
 locale l_set_child_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_child_nodes
   set_child_nodes_locs set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> bool"
     and set_child_nodes :: "(_) object_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and set_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma set_child_nodes_get_shadow_root: "\<forall>w \<in> set_child_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow>
   (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
   apply(auto simp add: set_child_nodes_locs_def get_shadow_root_locs_def CD.set_child_nodes_locs_def
       all_args_def)[1]
   by(auto intro!: element_put_get_preserved[where getter=shadow_root_opt and
         setter=RElement.child_nodes_update])
 end
 
 locale l_set_child_nodes_get_shadow_root = l_set_child_nodes_defs + l_get_shadow_root_defs +
   assumes set_child_nodes_get_shadow_root:
     "\<forall>w \<in> set_child_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
 
 interpretation
   i_set_child_nodes_get_shadow_root?: l_set_child_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr
   DocumentClass.type_wf DocumentClass.known_ptr set_child_nodes set_child_nodes_locs
   Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs get_shadow_root
   get_shadow_root_locs
   by(auto simp add: l_set_child_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_child_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_child_nodes_get_shadow_root_is_l_set_child_nodes_get_shadow_root [instances]:
   "l_set_child_nodes_get_shadow_root set_child_nodes_locs get_shadow_root_locs"
   apply(auto simp add: l_set_child_nodes_get_shadow_root_def)[1]
   using set_child_nodes_get_shadow_root apply fast
   done
 
 
 paragraph \<open>delete\_shadow\_root\<close>
 
 locale l_delete_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma get_shadow_root_delete_shadow_root:  "h \<turnstile> delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M shadow_root_ptr \<rightarrow>\<^sub>h h'
     \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
   by(auto simp add: get_shadow_root_locs_def delete_shadow_root_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
 end
 
 locale l_delete_shadow_root_get_shadow_root = l_get_shadow_root_defs +
   assumes get_shadow_root_delete_shadow_root:  "h \<turnstile> delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M shadow_root_ptr \<rightarrow>\<^sub>h h'
     \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
 interpretation l_delete_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root
   get_shadow_root_locs
   by(auto simp add: l_delete_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 
 lemma l_delete_shadow_root_get_shadow_root_get_shadow_root_locs [instances]: "l_delete_shadow_root_get_shadow_root get_shadow_root_locs"
   apply(auto simp add: l_delete_shadow_root_get_shadow_root_def)[1]
   using get_shadow_root_delete_shadow_root apply fast
   done
 
 paragraph \<open>new\_character\_data\<close>
 
 locale l_new_character_data_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_shadow_root_new_character_data:
   "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr \<Longrightarrow> h \<turnstile> new_character_data \<rightarrow>\<^sub>h h'
      \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
   by (auto simp add: get_shadow_root_locs_def new_character_data_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t
       new_character_data_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       split: prod.splits if_splits option.splits
       elim!: bind_returns_result_E bind_returns_heap_E
       intro: is_element_ptr_kind_obtains)
 end
 
 locale l_new_character_data_get_shadow_root = l_new_character_data + l_get_shadow_root +
   assumes get_shadow_root_new_character_data:
     "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr
             \<Longrightarrow> h \<turnstile> new_character_data \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
 
 
 interpretation i_new_character_data_get_shadow_root?:
   l_new_character_data_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   by(unfold_locales)
 declare l_new_character_data_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma new_character_data_get_shadow_root_is_l_new_character_data_get_shadow_root [instances]:
   "l_new_character_data_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
   using new_character_data_is_l_new_character_data get_shadow_root_is_l_get_shadow_root
   apply(auto simp add: l_new_character_data_get_shadow_root_def
       l_new_character_data_get_shadow_root_axioms_def instances)[1]
   using get_shadow_root_new_character_data
   by fast
 
 paragraph \<open>new\_document\<close>
 
 locale l_new_document_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_shadow_root_new_document:
   "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>h h'
      \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
   by (auto simp add: get_shadow_root_locs_def new_document_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t new_document_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       split: prod.splits if_splits option.splits
       elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)
 end
 
 locale l_new_document_get_shadow_root = l_new_document + l_get_shadow_root +
   assumes get_shadow_root_new_document:
     "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr
             \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
 
 
 interpretation i_new_document_get_shadow_root?:
   l_new_document_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   by(unfold_locales)
 declare l_new_document_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma new_document_get_shadow_root_is_l_new_document_get_shadow_root [instances]:
   "l_new_document_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
   using new_document_is_l_new_document get_shadow_root_is_l_get_shadow_root
   apply(auto simp add: l_new_document_get_shadow_root_def l_new_document_get_shadow_root_axioms_def
       instances)[1]
   using get_shadow_root_new_document
   by fast
 
 paragraph \<open>new\_element\<close>
 
 locale l_new_element_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_shadow_root_new_element:
   "ptr' \<noteq> new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h'
      \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
   by (auto simp add: get_shadow_root_locs_def new_element_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t new_element_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       new_element_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t split: prod.splits if_splits option.splits
       elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)
 
 lemma new_element_no_shadow_root:
   "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h'
    \<Longrightarrow> h' \<turnstile> get_shadow_root new_element_ptr \<rightarrow>\<^sub>r None"
   by(simp add: get_shadow_root_def new_element_shadow_root_opt)
 end
 
 locale l_new_element_get_shadow_root = l_new_element + l_get_shadow_root +
   assumes get_shadow_root_new_element:
     "ptr' \<noteq> new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr
             \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
   assumes new_element_no_shadow_root:
     "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h'
             \<Longrightarrow> h' \<turnstile> get_shadow_root new_element_ptr \<rightarrow>\<^sub>r None"
 
 
 interpretation i_new_element_get_shadow_root?:
   l_new_element_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   by(unfold_locales)
 declare l_new_element_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma new_element_get_shadow_root_is_l_new_element_get_shadow_root [instances]:
   "l_new_element_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
   using new_element_is_l_new_element get_shadow_root_is_l_get_shadow_root
   apply(auto simp add: l_new_element_get_shadow_root_def l_new_element_get_shadow_root_axioms_def
       instances)[1]
   using get_shadow_root_new_element new_element_no_shadow_root
   by fast+
 
 paragraph \<open>new\_shadow\_root\<close>
 
 locale l_new_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_shadow_root_new_shadow_root:
   "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h'
      \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
   by (auto simp add: get_shadow_root_locs_def new_shadow_root_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t new_shadow_root_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       split: prod.splits if_splits option.splits
       elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)
 end
 
 locale l_new_shadow_root_get_shadow_root = l_get_shadow_root +
   assumes get_shadow_root_new_shadow_root:
     "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr
             \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
 
 interpretation i_new_shadow_root_get_shadow_root?:
   l_new_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   by(unfold_locales)
 declare l_new_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma new_shadow_root_get_shadow_root_is_l_new_shadow_root_get_shadow_root [instances]:
   "l_new_shadow_root_get_shadow_root type_wf get_shadow_root get_shadow_root_locs"
   using get_shadow_root_is_l_get_shadow_root
   apply(auto simp add: l_new_shadow_root_get_shadow_root_def
       l_new_shadow_root_get_shadow_root_axioms_def instances)[1]
   using get_shadow_root_new_shadow_root
   by fast
 
 
 subsubsection \<open>set\_shadow\_root\<close>
 
 locale l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
 begin
 definition a_set_shadow_root :: "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr option \<Rightarrow> (_, unit) dom_prog"
   where
     "a_set_shadow_root element_ptr = put_M element_ptr shadow_root_opt_update"
 
 definition a_set_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_, unit) dom_prog) set"
   where
     "a_set_shadow_root_locs element_ptr \<equiv> all_args (put_M element_ptr shadow_root_opt_update)"
 end
 
 global_interpretation l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
   defines set_shadow_root = a_set_shadow_root
     and set_shadow_root_locs = a_set_shadow_root_locs
   .
 
 locale l_set_shadow_root_defs =
   fixes set_shadow_root :: "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr option \<Rightarrow> (_, unit) dom_prog"
   fixes set_shadow_root_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set"
 
 
 locale l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_type_wf type_wf +
   l_set_shadow_root_defs set_shadow_root set_shadow_root_locs +
   l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and set_shadow_root :: "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr option \<Rightarrow> (_, unit) dom_prog"
     and set_shadow_root_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set" +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
   assumes set_shadow_root_impl: "set_shadow_root = a_set_shadow_root"
   assumes set_shadow_root_locs_impl: "set_shadow_root_locs = a_set_shadow_root_locs"
 begin
 lemmas set_shadow_root_def = set_shadow_root_impl[unfolded set_shadow_root_def
     a_set_shadow_root_def]
 lemmas set_shadow_root_locs_def = set_shadow_root_locs_impl[unfolded set_shadow_root_locs_def
     a_set_shadow_root_locs_def]
 
 lemma set_shadow_root_ok: "type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow>
   h \<turnstile> ok (set_shadow_root element_ptr tag)"
   apply(unfold type_wf_impl)
   unfolding set_shadow_root_def using get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok
   by (simp add: ShadowRootMonad.put_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t_ok)
 
 lemma set_shadow_root_ptr_in_heap:
   "h \<turnstile> ok (set_shadow_root element_ptr shadow_root) \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h"
   by(simp add: set_shadow_root_def ElementMonad.put_M_ptr_in_heap)
 
 lemma set_shadow_root_writes:
   "writes (set_shadow_root_locs element_ptr) (set_shadow_root element_ptr tag) h h'"
   by(auto simp add: set_shadow_root_def set_shadow_root_locs_def intro: writes_bind_pure)
 
 lemma set_shadow_root_pointers_preserved:
   assumes "w \<in> set_shadow_root_locs element_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "object_ptr_kinds h = object_ptr_kinds h'"
   using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)]
   by(auto simp add: all_args_def set_shadow_root_locs_def split: if_splits)
 
 lemma set_shadow_root_types_preserved:
   assumes "w \<in> set_shadow_root_locs element_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "type_wf h = type_wf h'"
   apply(unfold type_wf_impl)
   using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
   by(auto simp add: all_args_def set_shadow_root_locs_def split: if_splits)
 end
 
 interpretation i_set_shadow_root?: l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_shadow_root
   set_shadow_root_locs
   by (auto simp add: l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_set_shadow_root = l_type_wf +l_set_shadow_root_defs +
   assumes set_shadow_root_writes:
     "writes (set_shadow_root_locs element_ptr) (set_shadow_root element_ptr disc_nodes) h h'"
   assumes set_shadow_root_ok:
     "type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow>
       h \<turnstile> ok (set_shadow_root element_ptr shadow_root)"
   assumes set_shadow_root_ptr_in_heap:
     "h \<turnstile> ok (set_shadow_root element_ptr shadow_root) \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h"
   assumes set_shadow_root_pointers_preserved:
     "w \<in> set_shadow_root_locs element_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow>
       object_ptr_kinds h = object_ptr_kinds h'"
   assumes set_shadow_root_types_preserved:
     "w \<in> set_shadow_root_locs element_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'"
 
 lemma set_shadow_root_is_l_set_shadow_root [instances]:
   "l_set_shadow_root type_wf set_shadow_root set_shadow_root_locs"
   apply(auto simp add: l_set_shadow_root_def instances)[1]
   using set_shadow_root_writes apply blast
   using set_shadow_root_ok apply (blast)
   using set_shadow_root_ptr_in_heap apply blast
   using set_shadow_root_pointers_preserved apply(blast, blast)
   using set_shadow_root_types_preserved apply(blast, blast)
   done
 
 paragraph \<open>get\_shadow\_root\<close>
 
 locale l_set_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_shadow_root_get_shadow_root:
   "type_wf h \<Longrightarrow> h \<turnstile> set_shadow_root ptr shadow_root_ptr_opt \<rightarrow>\<^sub>h h' \<Longrightarrow>
   h' \<turnstile> get_shadow_root ptr \<rightarrow>\<^sub>r shadow_root_ptr_opt"
   by(auto simp add: set_shadow_root_def get_shadow_root_def)
 
 lemma set_shadow_root_get_shadow_root_different_pointers: "ptr \<noteq> ptr' \<Longrightarrow>
   \<forall>w \<in> set_shadow_root_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
   by(auto simp add: set_shadow_root_locs_def get_shadow_root_locs_def all_args_def)
 end
 
 interpretation i_set_shadow_root_get_shadow_root?: l_set_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   set_shadow_root set_shadow_root_locs get_shadow_root get_shadow_root_locs
   apply(auto simp add: l_set_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)[1]
   by(unfold_locales)
 declare l_set_shadow_root_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 locale l_set_shadow_root_get_shadow_root =
   l_type_wf +
   l_set_shadow_root_defs +
   l_get_shadow_root_defs +
   assumes set_shadow_root_get_shadow_root:
     "type_wf h \<Longrightarrow> h \<turnstile> set_shadow_root ptr shadow_root_ptr_opt \<rightarrow>\<^sub>h h' \<Longrightarrow>
       h' \<turnstile> get_shadow_root ptr \<rightarrow>\<^sub>r shadow_root_ptr_opt"
   assumes set_shadow_root_get_shadow_root_different_pointers:
     "ptr \<noteq> ptr' \<Longrightarrow> w \<in> set_shadow_root_locs ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow>
       r \<in> get_shadow_root_locs ptr' \<Longrightarrow> r h h'"
 
 lemma set_shadow_root_get_shadow_root_is_l_set_shadow_root_get_shadow_root [instances]:
   "l_set_shadow_root_get_shadow_root type_wf set_shadow_root set_shadow_root_locs get_shadow_root
   get_shadow_root_locs"
   apply(auto simp add: l_set_shadow_root_get_shadow_root_def instances)[1]
   using set_shadow_root_get_shadow_root apply fast
   using set_shadow_root_get_shadow_root_different_pointers apply fast
   done
 
 
 
 subsubsection \<open>set\_mode\<close>
 
 locale l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
 begin
 definition a_set_mode :: "(_) shadow_root_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> (_, unit) dom_prog"
   where
     "a_set_mode shadow_root_ptr = put_M shadow_root_ptr mode_update"
 
 definition a_set_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_, unit) dom_prog) set"
   where
     "a_set_mode_locs shadow_root_ptr \<equiv> all_args (put_M shadow_root_ptr mode_update)"
 end
 
 global_interpretation l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
   defines set_mode = a_set_mode
     and set_mode_locs = a_set_mode_locs
   .
 
 locale l_set_mode_defs =
   fixes set_mode :: "(_) shadow_root_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> (_, unit) dom_prog"
   fixes set_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> (_, unit) dom_prog set"
 
 
 locale l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_type_wf type_wf +
   l_set_mode_defs set_mode set_mode_locs +
   l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and set_mode :: "(_) shadow_root_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> (_, unit) dom_prog"
     and set_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> (_, unit) dom_prog set" +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
   assumes set_mode_impl: "set_mode = a_set_mode"
   assumes set_mode_locs_impl: "set_mode_locs = a_set_mode_locs"
 begin
 lemmas set_mode_def = set_mode_impl[unfolded set_mode_def a_set_mode_def]
 lemmas set_mode_locs_def = set_mode_locs_impl[unfolded set_mode_locs_def a_set_mode_locs_def]
 
 lemma set_mode_ok:
   "type_wf h \<Longrightarrow> shadow_root_ptr |\<in>| shadow_root_ptr_kinds h \<Longrightarrow>
     h \<turnstile> ok (set_mode shadow_root_ptr shadow_root_mode)"
   apply(unfold type_wf_impl)
   unfolding set_mode_def using get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_ok put_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_ok
   by (simp add: ShadowRootMonad.put_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_ok)
 
 lemma set_mode_ptr_in_heap:
   "h \<turnstile> ok (set_mode shadow_root_ptr shadow_root_mode) \<Longrightarrow>
     shadow_root_ptr |\<in>| shadow_root_ptr_kinds h"
   by(simp add: set_mode_def put_M_ptr_in_heap)
 
 lemma set_mode_writes:
   "writes (set_mode_locs shadow_root_ptr) (set_mode shadow_root_ptr shadow_root_mode) h h'"
   by(auto simp add: set_mode_def set_mode_locs_def intro: writes_bind_pure)
 
 lemma set_mode_pointers_preserved:
   assumes "w \<in> set_mode_locs element_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "object_ptr_kinds h = object_ptr_kinds h'"
   using assms(1) object_ptr_kinds_preserved[OF writes_singleton2 assms(2)]
   by(auto simp add: all_args_def set_mode_locs_def split: if_splits)
 
 lemma set_mode_types_preserved:
   assumes "w \<in> set_mode_locs element_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "type_wf h = type_wf h'"
   apply(unfold type_wf_impl)
   using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
   by(auto simp add: all_args_def set_mode_locs_def split: if_splits)
 end
 
 interpretation i_set_mode?: l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_mode set_mode_locs
   by (auto simp add: l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_set_mode = l_type_wf +l_set_mode_defs +
   assumes set_mode_writes:
     "writes (set_mode_locs shadow_root_ptr) (set_mode shadow_root_ptr shadow_root_mode) h h'"
   assumes set_mode_ok:
     "type_wf h \<Longrightarrow> shadow_root_ptr |\<in>| shadow_root_ptr_kinds h \<Longrightarrow>
       h \<turnstile> ok (set_mode shadow_root_ptr shadow_root_mode)"
   assumes set_mode_ptr_in_heap:
     "h \<turnstile> ok (set_mode shadow_root_ptr shadow_root_mode) \<Longrightarrow>
       shadow_root_ptr |\<in>| shadow_root_ptr_kinds h"
   assumes set_mode_pointers_preserved:
     "w \<in> set_mode_locs shadow_root_ptr \<Longrightarrow>
       h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> object_ptr_kinds h = object_ptr_kinds h'"
   assumes set_mode_types_preserved:
     "w \<in> set_mode_locs shadow_root_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> type_wf h = type_wf h'"
 
 lemma set_mode_is_l_set_mode [instances]: "l_set_mode type_wf set_mode set_mode_locs"
   apply(auto simp add: l_set_mode_def instances)[1]
   using set_mode_writes apply blast
   using set_mode_ok apply (blast)
   using set_mode_ptr_in_heap apply blast
   using set_mode_pointers_preserved apply(blast, blast)
   using set_mode_types_preserved apply(blast, blast)
   done
 
 
 paragraph \<open>get\_child\_nodes\<close>
 
 locale l_set_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_shadow_root_get_child_nodes:
   "\<forall>w \<in> set_shadow_root_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))"
   by(auto simp add: get_child_nodes_locs_def set_shadow_root_locs_def CD.get_child_nodes_locs_def
       all_args_def
       intro: element_put_get_preserved[where setter=shadow_root_opt_update])
 end
 
 interpretation i_set_shadow_root_get_child_nodes?: l_set_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   known_ptr DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes get_child_nodes_locs
   Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs set_shadow_root
   set_shadow_root_locs
   by(unfold_locales)
 declare l_set_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 locale l_set_shadow_root_get_child_nodes = l_set_shadow_root + l_get_child_nodes +
   assumes set_shadow_root_get_child_nodes:
     "\<forall>w \<in> set_shadow_root_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))"
 
 lemma set_shadow_root_get_child_nodes_is_l_set_shadow_root_get_child_nodes [instances]:
   "l_set_shadow_root_get_child_nodes type_wf set_shadow_root set_shadow_root_locs known_ptr
     get_child_nodes get_child_nodes_locs"
   apply(auto simp add: l_set_shadow_root_get_child_nodes_def
       l_set_shadow_root_get_child_nodes_axioms_def instances)[1]
   using set_shadow_root_get_child_nodes apply blast
   done
 
 paragraph \<open>get\_shadow\_root\<close>
 
 
 locale l_set_mode_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_mode_get_shadow_root:
   "\<forall>w \<in> set_mode_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
   by(auto simp add: set_mode_locs_def get_shadow_root_locs_def all_args_def)
 end
 
 interpretation
   i_set_mode_get_shadow_root?: l_set_mode_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   set_mode set_mode_locs get_shadow_root
   get_shadow_root_locs
   by unfold_locales
 declare l_set_mode_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 locale l_set_mode_get_shadow_root = l_set_mode + l_get_shadow_root +
   assumes set_mode_get_shadow_root:
     "\<forall>w \<in> set_mode_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
 
 lemma set_mode_get_shadow_root_is_l_set_mode_get_shadow_root [instances]:
   "l_set_mode_get_shadow_root type_wf set_mode set_mode_locs get_shadow_root
                                          get_shadow_root_locs"
   using set_mode_is_l_set_mode get_shadow_root_is_l_get_shadow_root
   apply(simp add: l_set_mode_get_shadow_root_def
       l_set_mode_get_shadow_root_axioms_def)
   using set_mode_get_shadow_root
   by fast
 
 paragraph \<open>get\_child\_nodes\<close>
 
 locale l_set_mode_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_mode_get_child_nodes:
   "\<forall>w \<in> set_mode_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))"
   by(auto simp add: get_child_nodes_locs_def CD.get_child_nodes_locs_def set_mode_locs_def
       all_args_def)[1]
 end
 
 interpretation i_set_mode_get_child_nodes?: l_set_mode_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_mode
   set_mode_locs known_ptr DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes
   get_child_nodes_locs Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs
   by unfold_locales
 declare l_set_mode_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 locale l_set_mode_get_child_nodes = l_set_mode + l_get_child_nodes +
   assumes set_mode_get_child_nodes:
     "\<forall>w \<in> set_mode_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))"
 
 lemma set_mode_get_child_nodes_is_l_set_mode_get_child_nodes [instances]:
   "l_set_mode_get_child_nodes type_wf set_mode set_mode_locs known_ptr get_child_nodes
                                          get_child_nodes_locs"
   using set_mode_is_l_set_mode get_child_nodes_is_l_get_child_nodes
   apply(simp add: l_set_mode_get_child_nodes_def
       l_set_mode_get_child_nodes_axioms_def)
   using set_mode_get_child_nodes
   by fast
 
 
 subsubsection \<open>get\_host\<close>
 
 locale l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_get_shadow_root_defs get_shadow_root get_shadow_root_locs
   for get_shadow_root
     :: "(_::linorder) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 definition a_get_host :: "(_) shadow_root_ptr \<Rightarrow> (_, (_) element_ptr) dom_prog"  where
   "a_get_host shadow_root_ptr = do {
       host_ptrs \<leftarrow> element_ptr_kinds_M \<bind> filter_M (\<lambda>element_ptr. do {
         shadow_root_opt \<leftarrow> get_shadow_root element_ptr;
         return (shadow_root_opt = Some shadow_root_ptr)
       });
       (case host_ptrs of host_ptr#[] \<Rightarrow> return host_ptr | _ \<Rightarrow> error HierarchyRequestError)
     }"
 definition "a_get_host_locs \<equiv> (\<Union>element_ptr. (get_shadow_root_locs element_ptr)) \<union>
   (\<Union>ptr. {preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr RObject.nothing)})"
 
 end
 
 global_interpretation l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_shadow_root get_shadow_root_locs
   defines get_host = "a_get_host"
     and get_host_locs = "a_get_host_locs"
   .
 
 locale l_get_host_defs =
   fixes get_host :: "(_) shadow_root_ptr \<Rightarrow> (_, (_) element_ptr) dom_prog"
   fixes get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 
 locale l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_get_host_defs +
   l_get_shadow_root +
   assumes get_host_impl: "get_host = a_get_host"
   assumes get_host_locs_impl: "get_host_locs = a_get_host_locs"
 begin
 lemmas get_host_def = get_host_impl[unfolded a_get_host_def]
 lemmas get_host_locs_def = get_host_locs_impl[unfolded a_get_host_locs_def]
 
 lemma get_host_pure [simp]: "pure (get_host element_ptr) h"
   by(auto simp add: get_host_def intro!: bind_pure_I filter_M_pure_I split: list.splits)
 
 lemma get_host_reads: "reads get_host_locs (get_host element_ptr) h h'"
   using get_shadow_root_reads[unfolded reads_def]
   by(auto simp add: get_host_def get_host_locs_def
       intro!: reads_bind_pure reads_subset[OF check_in_heap_reads] reads_subset[OF error_reads]
       reads_subset[OF get_shadow_root_reads] reads_subset[OF return_reads]
       reads_subset[OF element_ptr_kinds_M_reads] filter_M_reads filter_M_pure_I
       bind_pure_I
       split: list.splits)
 end
 
 locale l_get_host = l_get_host_defs +
   assumes get_host_pure [simp]: "pure (get_host element_ptr) h"
   assumes get_host_reads: "reads get_host_locs (get_host node_ptr) h h'"
 
 
 interpretation i_get_host?: l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_shadow_root get_shadow_root_locs get_host
   get_host_locs type_wf
   using instances
   by (simp add: l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def get_host_def get_host_locs_def)
 declare l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_host_is_l_get_host [instances]: "l_get_host get_host get_host_locs"
   apply(auto simp add: l_get_host_def)[1]
   using get_host_reads apply fast
   done
 
 
 
 subsubsection \<open>get\_mode\<close>
 
 locale l_get_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
 begin
 definition a_get_mode :: "(_) shadow_root_ptr \<Rightarrow> (_, shadow_root_mode) dom_prog"
   where
     "a_get_mode shadow_root_ptr = get_M shadow_root_ptr mode"
 
 definition a_get_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   where
     "a_get_mode_locs shadow_root_ptr \<equiv> {preserved (get_M shadow_root_ptr mode)}"
 end
 
 global_interpretation l_get_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
   defines get_mode = a_get_mode
     and get_mode_locs = a_get_mode_locs
   .
 
 locale l_get_mode_defs =
   fixes get_mode :: "(_) shadow_root_ptr \<Rightarrow> (_, shadow_root_mode) dom_prog"
   fixes get_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 
 locale l_get_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_get_mode_defs get_mode get_mode_locs +
   l_type_wf type_wf
   for get_mode :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, shadow_root_mode) prog"
     and get_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and type_wf :: "(_) heap \<Rightarrow> bool" +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
   assumes get_mode_impl: "get_mode = a_get_mode"
   assumes get_mode_locs_impl: "get_mode_locs = a_get_mode_locs"
 begin
 lemmas get_mode_def = get_mode_impl[unfolded get_mode_def a_get_mode_def]
 lemmas get_mode_locs_def = get_mode_locs_impl[unfolded get_mode_locs_def a_get_mode_locs_def]
 
 lemma get_mode_ok: "type_wf h \<Longrightarrow> shadow_root_ptr |\<in>| shadow_root_ptr_kinds h \<Longrightarrow>
   h \<turnstile> ok (get_mode shadow_root_ptr)"
   unfolding get_mode_def type_wf_impl
   using ShadowRootMonad.get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_ok by blast
 
 lemma get_mode_pure [simp]: "pure (get_mode element_ptr) h"
   unfolding get_mode_def by simp
 
 lemma get_mode_ptr_in_heap:
   assumes "h \<turnstile> get_mode shadow_root_ptr \<rightarrow>\<^sub>r children"
   shows "shadow_root_ptr |\<in>| shadow_root_ptr_kinds h"
   using assms
   by(auto simp add: get_mode_def get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_ptr_in_heap dest: is_OK_returns_result_I)
 
 lemma get_mode_reads: "reads (get_mode_locs element_ptr) (get_mode element_ptr) h h'"
   by(simp add: get_mode_def get_mode_locs_def reads_bind_pure reads_insert_writes_set_right)
 end
 
 interpretation i_get_mode?: l_get_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_mode get_mode_locs type_wf
   using instances
   by (auto simp add: l_get_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_get_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_get_mode = l_type_wf + l_get_mode_defs +
   assumes get_mode_reads: "reads (get_mode_locs shadow_root_ptr) (get_mode shadow_root_ptr) h h'"
   assumes get_mode_ok:
     "type_wf h \<Longrightarrow> shadow_root_ptr |\<in>| shadow_root_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (get_mode shadow_root_ptr)"
   assumes get_mode_ptr_in_heap:
     "h \<turnstile> ok (get_mode shadow_root_ptr) \<Longrightarrow> shadow_root_ptr |\<in>| shadow_root_ptr_kinds h"
   assumes get_mode_pure [simp]: "pure (get_mode shadow_root_ptr) h"
 
 lemma get_mode_is_l_get_mode [instances]: "l_get_mode type_wf get_mode get_mode_locs"
   apply(auto simp add: l_get_mode_def instances)[1]
   using get_mode_reads apply blast
   using get_mode_ok apply blast
   using get_mode_ptr_in_heap apply blast
   done
 
 subsubsection \<open>get\_shadow\_root\_safe\<close>
 
 locale l_get_shadow_root_safe\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
   l_get_mode_defs get_mode get_mode_locs
   for get_shadow_root :: "(_) element_ptr \<Rightarrow> (_, (_) shadow_root_ptr option) dom_prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_mode :: "(_) shadow_root_ptr \<Rightarrow> (_, shadow_root_mode) dom_prog"
     and get_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 definition a_get_shadow_root_safe :: "(_) element_ptr \<Rightarrow> (_, (_) shadow_root_ptr option) dom_prog"
   where
     "a_get_shadow_root_safe element_ptr = do {
       shadow_root_ptr_opt \<leftarrow> get_shadow_root element_ptr;
       (case shadow_root_ptr_opt of
         Some shadow_root_ptr \<Rightarrow> do {
           mode \<leftarrow> get_mode shadow_root_ptr;
           (if mode = Open then
             return (Some shadow_root_ptr)
           else
             return None
           )
         } | None \<Rightarrow> return None)
     }"
 
 definition a_get_shadow_root_safe_locs
   :: "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" where
   "a_get_shadow_root_safe_locs element_ptr shadow_root_ptr \<equiv>
     (get_shadow_root_locs element_ptr) \<union> (get_mode_locs shadow_root_ptr)"
 end
 
 global_interpretation l_get_shadow_root_safe\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_shadow_root get_shadow_root_locs
   get_mode get_mode_locs
   defines get_shadow_root_safe = a_get_shadow_root_safe
     and get_shadow_root_safe_locs = a_get_shadow_root_safe_locs
   .
 
 locale l_get_shadow_root_safe_defs =
   fixes get_shadow_root_safe :: "(_) element_ptr \<Rightarrow> (_, (_) shadow_root_ptr option) dom_prog"
   fixes get_shadow_root_safe_locs ::
     "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 
 locale l_get_shadow_root_safe\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_shadow_root_safe\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_shadow_root get_shadow_root_locs get_mode get_mode_locs +
   l_get_shadow_root_safe_defs get_shadow_root_safe get_shadow_root_safe_locs +
   l_get_shadow_root  type_wf get_shadow_root get_shadow_root_locs +
   l_get_mode  type_wf get_mode get_mode_locs +
   l_type_wf type_wf
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and get_shadow_root_safe ::
     "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_safe_locs ::
     "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> (_, (_) shadow_root_ptr option) dom_prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_mode :: "(_) shadow_root_ptr \<Rightarrow> (_, shadow_root_mode) dom_prog"
     and get_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
   assumes get_shadow_root_safe_impl: "get_shadow_root_safe = a_get_shadow_root_safe"
   assumes get_shadow_root_safe_locs_impl: "get_shadow_root_safe_locs = a_get_shadow_root_safe_locs"
 begin
 lemmas get_shadow_root_safe_def =
   get_shadow_root_safe_impl[unfolded get_shadow_root_safe_def a_get_shadow_root_safe_def]
 lemmas get_shadow_root_safe_locs_def =
   get_shadow_root_safe_locs_impl[unfolded get_shadow_root_safe_locs_def a_get_shadow_root_safe_locs_def]
 
 lemma get_shadow_root_safe_pure [simp]: "pure (get_shadow_root_safe element_ptr) h"
   apply(auto simp add: get_shadow_root_safe_def)[1]
   by (smt bind_returns_heap_E is_OK_returns_heap_E local.get_mode_pure local.get_shadow_root_pure
       option.case_eq_if pure_def pure_returns_heap_eq return_pure)
 end
 
 interpretation i_get_shadow_root_safe?: l_get_shadow_root_safe\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root_safe
   get_shadow_root_safe_locs get_shadow_root get_shadow_root_locs get_mode get_mode_locs
   using instances
   by (auto simp add: l_get_shadow_root_safe\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_shadow_root_safe\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       get_shadow_root_safe_def get_shadow_root_safe_locs_def)
 declare l_get_shadow_root_safe\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_get_shadow_root_safe = l_get_shadow_root_safe_defs +
   assumes get_shadow_root_safe_pure [simp]: "pure (get_shadow_root_safe element_ptr) h"
 
 lemma get_shadow_root_safe_is_l_get_shadow_root_safe [instances]:
   "l_get_shadow_root_safe get_shadow_root_safe"
   using instances
   apply(auto simp add: l_get_shadow_root_safe_def)[1]
   done
 
 subsubsection \<open>set\_disconnected\_nodes\<close>
 
 locale l_set_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   CD: l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_disconnected_nodes set_disconnected_nodes_locs +
   l_type_wf type_wf
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and set_disconnected_nodes ::
     "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set" +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
 begin
 lemma set_disconnected_nodes_ok:
   "type_wf h \<Longrightarrow> document_ptr |\<in>| document_ptr_kinds h \<Longrightarrow>
     h \<turnstile> ok (set_disconnected_nodes document_ptr node_ptrs)"
   using CD.set_disconnected_nodes_ok CD.type_wf_impl ShadowRootClass.type_wf_defs local.type_wf_impl
   by blast
 
 lemma set_disconnected_nodes_typess_preserved:
   assumes "w \<in> set_disconnected_nodes_locs object_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "type_wf h = type_wf h'"
   using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
   apply(unfold type_wf_impl)
   by(auto simp add: all_args_def CD.set_disconnected_nodes_locs_def split: if_splits)
 end
 
 interpretation i_set_disconnected_nodes?: l_set_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   DocumentClass.type_wf set_disconnected_nodes set_disconnected_nodes_locs
   by(auto simp add: l_set_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def
       l_set_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def instances)
 declare l_set_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma set_disconnected_nodes_is_l_set_disconnected_nodes [instances]:
   "l_set_disconnected_nodes type_wf set_disconnected_nodes set_disconnected_nodes_locs"
   apply(auto simp add: l_set_disconnected_nodes_def)[1]
         apply (simp add: i_set_disconnected_nodes.set_disconnected_nodes_writes)
   using set_disconnected_nodes_ok apply blast
       apply (simp add: i_set_disconnected_nodes.set_disconnected_nodes_ptr_in_heap)
   using i_set_disconnected_nodes.set_disconnected_nodes_pointers_preserved apply (blast, blast)
   using set_disconnected_nodes_typess_preserved apply(blast, blast)
   done
 
 
 paragraph \<open>get\_child\_nodes\<close>
 
 locale l_set_disconnected_nodes_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_disconnected_nodes set_disconnected_nodes_locs +
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes
   get_child_nodes_locs get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and set_disconnected_nodes :: "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit)
     prog"
     and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> bool"
     and get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_child_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 
 lemma set_disconnected_nodes_get_child_nodes:
   "\<forall>w \<in> set_disconnected_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_child_nodes_locs ptr'. r h h'))"
   by(auto simp add: set_disconnected_nodes_locs_def get_child_nodes_locs_def
       CD.get_child_nodes_locs_def all_args_def)
 end
 
 interpretation i_set_disconnected_nodes_get_child_nodes?:
   l_set_disconnected_nodes_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_disconnected_nodes
   set_disconnected_nodes_locs known_ptr DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes
   get_child_nodes_locs Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs
   by(auto simp add: l_set_disconnected_nodes_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_disconnected_nodes_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_disconnected_nodes_get_child_nodes_is_l_set_disconnected_nodes_get_child_nodes [instances]:
   "l_set_disconnected_nodes_get_child_nodes set_disconnected_nodes_locs get_child_nodes_locs"
   apply(auto simp add: l_set_disconnected_nodes_get_child_nodes_def)[1]
   using set_disconnected_nodes_get_child_nodes apply fast
   done
 
 
 paragraph \<open>get\_host\<close>
 
 locale l_set_disconnected_nodes_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_disconnected_nodes_get_host:
   "\<forall>w \<in> set_disconnected_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_host_locs. r h h'))"
   by(auto simp add: CD.set_disconnected_nodes_locs_def get_shadow_root_locs_def get_host_locs_def all_args_def)
 end
 
 interpretation i_set_disconnected_nodes_get_host?: l_set_disconnected_nodes_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   DocumentClass.type_wf set_disconnected_nodes set_disconnected_nodes_locs get_shadow_root
   get_shadow_root_locs get_host get_host_locs
   by(auto simp add: l_set_disconnected_nodes_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_disconnected_nodes_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_set_disconnected_nodes_get_host = l_set_disconnected_nodes_defs + l_get_host_defs +
   assumes set_disconnected_nodes_get_host:
     "\<forall>w \<in> set_disconnected_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_host_locs. r h h'))"
 
 lemma set_disconnected_nodes_get_host_is_l_set_disconnected_nodes_get_host [instances]:
   "l_set_disconnected_nodes_get_host set_disconnected_nodes_locs get_host_locs"
   apply(auto simp add: l_set_disconnected_nodes_get_host_def instances)[1]
   using set_disconnected_nodes_get_host
   by fast
 
 
 
 subsubsection \<open>get\_tag\_name\<close>
 
 locale l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   CD: l_get_tag_name\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_tag_name get_tag_name_locs +
   l_type_wf type_wf
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> (_, tag_name) dom_prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
 begin
 
 lemma get_tag_name_ok:
   "type_wf h \<Longrightarrow> element_ptr |\<in>| element_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (get_tag_name element_ptr)"
   apply(unfold type_wf_impl get_tag_name_impl[unfolded a_get_tag_name_def])
   using CD.get_tag_name_ok CD.type_wf_impl ShadowRootClass.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
   by blast
 end
 
 interpretation i_get_tag_name?: l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf get_tag_name
   get_tag_name_locs
   by(auto simp add: l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def instances)
 declare l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_tag_name_is_l_get_tag_name [instances]: "l_get_tag_name type_wf get_tag_name
   get_tag_name_locs"
   apply(auto simp add: l_get_tag_name_def)[1]
   using get_tag_name_reads apply fast
   using get_tag_name_ok apply fast
   done
 
 
 paragraph \<open>set\_disconnected\_nodes\<close>
 
 locale l_set_disconnected_nodes_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_disconnected_nodes_get_tag_name:
   "\<forall>w \<in> set_disconnected_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_tag_name_locs ptr'. r h h'))"
   by(auto simp add: CD.set_disconnected_nodes_locs_def CD.get_tag_name_locs_def all_args_def)
 end
 
 interpretation i_set_disconnected_nodes_get_tag_name?: l_set_disconnected_nodes_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf DocumentClass.type_wf set_disconnected_nodes set_disconnected_nodes_locs get_tag_name
   get_tag_name_locs
   by(auto simp add: l_set_disconnected_nodes_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_disconnected_nodes_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma set_disconnected_nodes_get_tag_name_is_l_set_disconnected_nodes_get_tag_name [instances]:
   "l_set_disconnected_nodes_get_tag_name type_wf set_disconnected_nodes set_disconnected_nodes_locs
   get_tag_name get_tag_name_locs"
   apply(auto simp add: l_set_disconnected_nodes_get_tag_name_def
       l_set_disconnected_nodes_get_tag_name_axioms_def instances)[1]
   using set_disconnected_nodes_get_tag_name
   by fast
 
 
 paragraph \<open>set\_child\_nodes\<close>
 
 locale l_set_child_nodes_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_child_nodes_get_tag_name:
   "\<forall>w \<in> set_child_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_tag_name_locs ptr'. r h h'))"
   by(auto simp add: CD.set_child_nodes_locs_def set_child_nodes_locs_def CD.get_tag_name_locs_def
       all_args_def
       intro: element_put_get_preserved[where getter=tag_name and
         setter=RElement.child_nodes_update])
 end
 
 interpretation i_set_child_nodes_get_tag_name?: l_set_child_nodes_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   known_ptr DocumentClass.type_wf DocumentClass.known_ptr set_child_nodes set_child_nodes_locs
   Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs get_tag_name
   get_tag_name_locs
   by(auto simp add: l_set_child_nodes_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_child_nodes_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma set_child_nodes_get_tag_name_is_l_set_child_nodes_get_tag_name [instances]:
   "l_set_child_nodes_get_tag_name type_wf set_child_nodes set_child_nodes_locs get_tag_name
   get_tag_name_locs"
   apply(auto simp add: l_set_child_nodes_get_tag_name_def l_set_child_nodes_get_tag_name_axioms_def
       instances)[1]
   using set_child_nodes_get_tag_name
   by fast
 
 
 paragraph \<open>delete\_shadow\_root\<close>
 
 locale l_delete_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma get_tag_name_delete_shadow_root:  "h \<turnstile> delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M shadow_root_ptr \<rightarrow>\<^sub>h h'
     \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
   by(auto simp add: CD.get_tag_name_locs_def delete_shadow_root_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
 end
 
 locale l_delete_shadow_root_get_tag_name = l_get_tag_name_defs +
   assumes get_tag_name_delete_shadow_root:  "h \<turnstile> delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M shadow_root_ptr \<rightarrow>\<^sub>h h'
     \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
 interpretation l_delete_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf get_tag_name
   get_tag_name_locs
   by(auto simp add: l_delete_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 
 lemma l_delete_shadow_root_get_tag_name_get_tag_name_locs [instances]: "l_delete_shadow_root_get_tag_name get_tag_name_locs"
   apply(auto simp add: l_delete_shadow_root_get_tag_name_def)[1]
   using get_tag_name_delete_shadow_root apply fast
   done
 
 
 paragraph \<open>set\_shadow\_root\<close>
 
 locale l_set_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_shadow_root_get_tag_name:
   "\<forall>w \<in> set_shadow_root_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_tag_name_locs ptr'. r h h'))"
   by(auto simp add: set_shadow_root_locs_def CD.get_tag_name_locs_def all_args_def
       element_put_get_preserved[where setter=shadow_root_opt_update])
 end
 
 interpretation i_set_shadow_root_get_tag_name?: l_set_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   set_shadow_root set_shadow_root_locs DocumentClass.type_wf get_tag_name get_tag_name_locs
   apply(auto simp add: l_set_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)[1]
   by(unfold_locales)
 declare l_set_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 locale l_set_shadow_root_get_tag_name = l_set_shadow_root_defs + l_get_tag_name_defs +
   assumes set_shadow_root_get_tag_name:
     "\<forall>w \<in> set_shadow_root_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_tag_name_locs ptr'. r h h'))"
 
 lemma set_shadow_root_get_tag_name_is_l_set_shadow_root_get_tag_name [instances]:
   "l_set_shadow_root_get_tag_name set_shadow_root_locs get_tag_name_locs"
   using set_shadow_root_is_l_set_shadow_root get_tag_name_is_l_get_tag_name
   apply(simp add: l_set_shadow_root_get_tag_name_def )
   using set_shadow_root_get_tag_name
   by fast
 
 paragraph \<open>new\_element\<close>
 
 locale l_new_element_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_tag_name get_tag_name_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> (_, tag_name) dom_prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_tag_name_new_element:
   "ptr' \<noteq> new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h'
      \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
   by (auto simp add: CD.get_tag_name_locs_def new_element_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t new_element_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       new_element_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t split: prod.splits if_splits option.splits
       elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)
 
 lemma new_element_empty_tag_name:
   "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h'
    \<Longrightarrow> h' \<turnstile> get_tag_name new_element_ptr \<rightarrow>\<^sub>r ''''"
   by(simp add: CD.get_tag_name_def new_element_tag_name)
 end
 
 locale l_new_element_get_tag_name = l_new_element + l_get_tag_name +
   assumes get_tag_name_new_element:
     "ptr' \<noteq> new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr
             \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
   assumes new_element_empty_tag_name:
     "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr \<Longrightarrow> h \<turnstile> new_element \<rightarrow>\<^sub>h h'
             \<Longrightarrow> h' \<turnstile> get_tag_name new_element_ptr \<rightarrow>\<^sub>r ''''"
 
 
 interpretation i_new_element_get_tag_name?:
   l_new_element_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf get_tag_name get_tag_name_locs
   by(auto simp add: l_new_element_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_new_element_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma new_element_get_tag_name_is_l_new_element_get_tag_name [instances]:
   "l_new_element_get_tag_name type_wf get_tag_name get_tag_name_locs"
   using new_element_is_l_new_element get_tag_name_is_l_get_tag_name
   apply(auto simp add: l_new_element_get_tag_name_def l_new_element_get_tag_name_axioms_def
       instances)[1]
   using get_tag_name_new_element new_element_empty_tag_name
   by fast+
 
 paragraph \<open>get\_shadow\_root\<close>
 
 locale l_set_mode_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_mode_get_tag_name:
   "\<forall>w \<in> set_mode_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_tag_name_locs ptr'. r h h'))"
   by(auto simp add: set_mode_locs_def CD.get_tag_name_locs_def all_args_def)
 end
 
 interpretation
   i_set_mode_get_tag_name?: l_set_mode_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   set_mode set_mode_locs  DocumentClass.type_wf get_tag_name
   get_tag_name_locs
   by unfold_locales
 declare l_set_mode_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 locale l_set_mode_get_tag_name = l_set_mode + l_get_tag_name +
   assumes set_mode_get_tag_name:
     "\<forall>w \<in> set_mode_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_tag_name_locs ptr'. r h h'))"
 
 lemma set_mode_get_tag_name_is_l_set_mode_get_tag_name [instances]:
   "l_set_mode_get_tag_name type_wf set_mode set_mode_locs get_tag_name
                                          get_tag_name_locs"
   using set_mode_is_l_set_mode get_tag_name_is_l_get_tag_name
   apply(simp add: l_set_mode_get_tag_name_def
       l_set_mode_get_tag_name_axioms_def)
   using set_mode_get_tag_name
   by fast
 
 paragraph \<open>new\_document\<close>
 
 locale l_new_document_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_tag_name get_tag_name_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, tag_name) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_tag_name_new_document:
   "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>h h'
        \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
   by(auto simp add: CD.get_tag_name_locs_def new_document_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
 end
 
 locale l_new_document_get_tag_name = l_get_tag_name_defs +
   assumes get_tag_name_new_document:
     "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr \<Longrightarrow> h \<turnstile> new_document \<rightarrow>\<^sub>h h'
        \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
 
 interpretation i_new_document_get_tag_name?:
   l_new_document_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf get_tag_name
   get_tag_name_locs
   by unfold_locales
 declare l_new_document_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def[instances]
 
 lemma new_document_get_tag_name_is_l_new_document_get_tag_name [instances]:
   "l_new_document_get_tag_name get_tag_name_locs"
   unfolding l_new_document_get_tag_name_def
   unfolding get_tag_name_locs_def
   using new_document_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t by blast
 
 paragraph \<open>new\_shadow\_root\<close>
 
 locale l_new_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma get_tag_name_new_shadow_root:
   "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h'
      \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
   by (auto simp add: CD.get_tag_name_locs_def new_shadow_root_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t new_shadow_root_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       split: prod.splits if_splits option.splits
       elim!: bind_returns_result_E bind_returns_heap_E intro: is_element_ptr_kind_obtains)
 end
 
 locale l_new_shadow_root_get_tag_name = l_get_tag_name +
   assumes get_tag_name_new_shadow_root:
     "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr
             \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
 
 interpretation i_new_shadow_root_get_tag_name?:
   l_new_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf get_tag_name get_tag_name_locs
   by(unfold_locales)
 declare l_new_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma new_shadow_root_get_tag_name_is_l_new_shadow_root_get_tag_name [instances]:
   "l_new_shadow_root_get_tag_name type_wf get_tag_name get_tag_name_locs"
   using get_tag_name_is_l_get_tag_name
   apply(auto simp add: l_new_shadow_root_get_tag_name_def l_new_shadow_root_get_tag_name_axioms_def
       instances)[1]
   using get_tag_name_new_shadow_root
   by fast
 
 paragraph \<open>new\_character\_data\<close>
 
 locale l_new_character_data_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_tag_name get_tag_name_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, tag_name) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_tag_name_new_character_data:
   "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr \<Longrightarrow> h \<turnstile> new_character_data \<rightarrow>\<^sub>h h'
        \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
   by(auto simp add: CD.get_tag_name_locs_def new_character_data_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
 end
 
 locale l_new_character_data_get_tag_name = l_get_tag_name_defs +
   assumes get_tag_name_new_character_data:
     "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr \<Longrightarrow> h \<turnstile> new_character_data \<rightarrow>\<^sub>h h'
        \<Longrightarrow> r \<in> get_tag_name_locs ptr' \<Longrightarrow> r h h'"
 
 interpretation i_new_character_data_get_tag_name?:
   l_new_character_data_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf get_tag_name
   get_tag_name_locs
   by unfold_locales
 declare l_new_character_data_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def[instances]
 
 lemma new_character_data_get_tag_name_is_l_new_character_data_get_tag_name [instances]:
   "l_new_character_data_get_tag_name get_tag_name_locs"
   unfolding l_new_character_data_get_tag_name_def
   unfolding get_tag_name_locs_def
   using new_character_data_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t by blast
 
 paragraph \<open>get\_tag\_type\<close>
 
 locale l_set_tag_name_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M = l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_tag_name_get_tag_name:
   assumes "h \<turnstile> CD.a_set_tag_name element_ptr tag \<rightarrow>\<^sub>h h'"
   shows "h' \<turnstile> CD.a_get_tag_name element_ptr \<rightarrow>\<^sub>r tag"
   using assms
   by(auto simp add: CD.a_get_tag_name_def CD.a_set_tag_name_def)
 
 lemma set_tag_name_get_tag_name_different_pointers:
   assumes "ptr \<noteq> ptr'"
   assumes "w \<in> CD.a_set_tag_name_locs ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   assumes "r \<in> CD.a_get_tag_name_locs ptr'"
   shows "r h h'"
   using assms
   by(auto simp add: all_args_def CD.a_set_tag_name_locs_def CD.a_get_tag_name_locs_def
       split: if_splits option.splits )
 end
 
 interpretation i_set_tag_name_get_tag_name?:
   l_set_tag_name_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf get_tag_name
   get_tag_name_locs set_tag_name set_tag_name_locs
   by unfold_locales
 declare l_set_tag_name_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_tag_name_get_tag_name_is_l_set_tag_name_get_tag_name [instances]:
   "l_set_tag_name_get_tag_name  type_wf get_tag_name get_tag_name_locs
                                                     set_tag_name set_tag_name_locs"
   using set_tag_name_is_l_set_tag_name get_tag_name_is_l_get_tag_name
   apply(simp add: l_set_tag_name_get_tag_name_def
       l_set_tag_name_get_tag_name_axioms_def)
   using set_tag_name_get_tag_name
     set_tag_name_get_tag_name_different_pointers
   by fast+
 
 
 subsubsection \<open>attach\_shadow\_root\<close>
 
 locale l_attach_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_set_shadow_root_defs set_shadow_root set_shadow_root_locs +
   l_set_mode_defs set_mode set_mode_locs +
   l_get_tag_name_defs get_tag_name get_tag_name_locs +
   l_get_shadow_root_defs get_shadow_root get_shadow_root_locs
   for set_shadow_root ::
     "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr option \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and set_mode :: "(_) shadow_root_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> (_, char list) dom_prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 definition a_attach_shadow_root ::
   "(_) element_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> (_, (_) shadow_root_ptr) dom_prog"
   where
     "a_attach_shadow_root element_ptr shadow_root_mode = do {
       tag \<leftarrow> get_tag_name element_ptr;
       (if tag \<notin> safe_shadow_root_element_types then error NotSupportedError else return ());
       prev_shadow_root \<leftarrow> get_shadow_root element_ptr;
       (if prev_shadow_root \<noteq> None then error NotSupportedError else return ());
       new_shadow_root_ptr \<leftarrow> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M;
       set_mode new_shadow_root_ptr shadow_root_mode;
       set_shadow_root element_ptr (Some new_shadow_root_ptr);
       return new_shadow_root_ptr
     }"
 end
 
 locale l_attach_shadow_root_defs =
   fixes attach_shadow_root ::
     "(_) element_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> (_, (_) shadow_root_ptr) dom_prog"
 
 global_interpretation l_attach_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs set_shadow_root set_shadow_root_locs
   set_mode set_mode_locs get_tag_name get_tag_name_locs get_shadow_root get_shadow_root_locs
   defines attach_shadow_root = a_attach_shadow_root
   .
 
 locale l_attach_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_attach_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs set_shadow_root set_shadow_root_locs set_mode set_mode_locs
   get_tag_name get_tag_name_locs get_shadow_root get_shadow_root_locs +
   l_attach_shadow_root_defs attach_shadow_root +
   l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_shadow_root set_shadow_root_locs +
   l_set_mode type_wf set_mode set_mode_locs +
   l_get_tag_name type_wf get_tag_name get_tag_name_locs +
   l_get_shadow_root type_wf get_shadow_root get_shadow_root_locs +
   l_known_ptr known_ptr
   for known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and set_shadow_root ::
     "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr option \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and set_mode :: "(_) shadow_root_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and attach_shadow_root ::
     "(_) element_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr) prog"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> (_, char list) dom_prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" +
   assumes known_ptr_impl: "known_ptr = a_known_ptr"
   assumes attach_shadow_root_impl: "attach_shadow_root = a_attach_shadow_root"
 begin
 lemmas attach_shadow_root_def = a_attach_shadow_root_def[folded attach_shadow_root_impl]
 
 lemma attach_shadow_root_element_ptr_in_heap:
   assumes "h \<turnstile> ok (attach_shadow_root element_ptr shadow_root_mode)"
   shows "element_ptr |\<in>| element_ptr_kinds h"
 proof -
   obtain h' where "h \<turnstile> attach_shadow_root element_ptr shadow_root_mode \<rightarrow>\<^sub>h h'"
     using assms by auto
   then
   obtain h2 h3 new_shadow_root_ptr where
     h2: "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h2" and
     new_shadow_root_ptr: "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr" and
     h3: "h2 \<turnstile> set_mode new_shadow_root_ptr shadow_root_mode \<rightarrow>\<^sub>h h3" and
     "h3 \<turnstile> set_shadow_root element_ptr (Some new_shadow_root_ptr) \<rightarrow>\<^sub>h h'"
     by(auto simp add: attach_shadow_root_def
         elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_tag_name_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_shadow_root_pure, rotated] split: if_splits)
 
   then have "element_ptr |\<in>| element_ptr_kinds h3"
     using set_shadow_root_ptr_in_heap by blast
 
   moreover
   have "object_ptr_kinds h2 = object_ptr_kinds h |\<union>| {|cast new_shadow_root_ptr|}"
     using h2 new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_new_ptr new_shadow_root_ptr by auto
 
   moreover
   have "object_ptr_kinds h2 = object_ptr_kinds h3"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF set_mode_writes h3])
     using set_mode_pointers_preserved
       apply blast
     by (auto simp add: reflp_def transp_def)
   ultimately
   show ?thesis
     by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)
 qed
 
 lemma create_shadow_root_known_ptr:
   assumes "h \<turnstile> attach_shadow_root element_ptr shadow_root_mode \<rightarrow>\<^sub>r new_shadow_root_ptr"
   shows "known_ptr (cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr)"
   using assms
   by(auto simp add: attach_shadow_root_def known_ptr_impl ShadowRootClass.a_known_ptr_def
       new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_def new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_def Let_def
       elim!: bind_returns_result_E)
 end
 
 locale l_attach_shadow_root = l_attach_shadow_root_defs
 
 interpretation
   i_attach_shadow_root?: l_attach_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr set_shadow_root set_shadow_root_locs
   set_mode set_mode_locs attach_shadow_root type_wf get_tag_name get_tag_name_locs get_shadow_root
   get_shadow_root_locs
   by(auto simp add: l_attach_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_attach_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       attach_shadow_root_def instances)
 declare l_attach_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 
 subsubsection \<open>get\_parent\<close>
 
 global_interpretation l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs
   defines get_parent = "l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_parent get_child_nodes"
     and get_parent_locs = "l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_parent_locs get_child_nodes_locs"
   .
 
 interpretation i_get_parent?: l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes
   get_child_nodes_locs known_ptrs get_parent get_parent_locs
   by(simp add: l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def get_parent_def
       get_parent_locs_def instances)
 declare l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_parent_is_l_get_parent [instances]: "l_get_parent type_wf known_ptr known_ptrs get_parent
     get_parent_locs get_child_nodes get_child_nodes_locs"
   apply(simp add: l_get_parent_def l_get_parent_axioms_def instances)
   using get_parent_reads get_parent_ok get_parent_ptr_in_heap get_parent_pure
     get_parent_parent_in_heap get_parent_child_dual get_parent_reads_pointers
   by blast
 
 
 
 paragraph \<open>set\_disconnected\_nodes\<close>
 
 locale l_set_disconnected_nodes_get_parent\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_disconnected_nodes_get_child_nodes
   + l_set_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_disconnected_nodes_get_parent [simp]:
   "\<forall>w \<in> set_disconnected_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_parent_locs. r h h'))"
   by(auto simp add: get_parent_locs_def CD.set_disconnected_nodes_locs_def all_args_def)
 end
 interpretation i_set_disconnected_nodes_get_parent?: l_set_disconnected_nodes_get_parent\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs type_wf
   DocumentClass.type_wf known_ptr known_ptrs get_parent get_parent_locs
   by (simp add: l_set_disconnected_nodes_get_parent\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_disconnected_nodes_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_disconnected_nodes_get_parent_is_l_set_disconnected_nodes_get_parent [instances]:
   "l_set_disconnected_nodes_get_parent set_disconnected_nodes_locs get_parent_locs"
   by(simp add: l_set_disconnected_nodes_get_parent_def)
 
 
 
 subsubsection \<open>get\_root\_node\<close>
 
 global_interpretation l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_parent get_parent_locs
   defines get_root_node = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_root_node get_parent"
     and get_root_node_locs = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_root_node_locs get_parent_locs"
     and get_ancestors = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_ancestors get_parent"
     and get_ancestors_locs = "l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_ancestors_locs get_parent_locs"
   .
 declare a_get_ancestors.simps [code]
 
 interpretation i_get_root_node?: l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr known_ptrs get_parent
   get_parent_locs get_child_nodes get_child_nodes_locs get_ancestors get_ancestors_locs
   get_root_node get_root_node_locs
   by(simp add: l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def get_root_node_def
       get_root_node_locs_def get_ancestors_def get_ancestors_locs_def instances)
 declare l_get_root_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_ancestors_is_l_get_ancestors [instances]: "l_get_ancestors get_ancestors"
   apply(auto simp add: l_get_ancestors_def)[1]
   using get_ancestors_ptr_in_heap apply fast
   using get_ancestors_ptr apply fast
   done
 
 lemma get_root_node_is_l_get_root_node [instances]: "l_get_root_node get_root_node get_parent"
   by (simp add: l_get_root_node_def Shadow_DOM.i_get_root_node.get_root_node_no_parent)
 
 
 
 subsubsection \<open>get\_root\_node\_si\<close>
 
 locale l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_get_parent_defs get_parent get_parent_locs +
   l_get_host_defs get_host get_host_locs
   for get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_::linorder) object_ptr option) prog"
     and get_parent_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 partial_function (dom_prog) a_get_ancestors_si ::
   "(_::linorder) object_ptr \<Rightarrow> (_, (_) object_ptr list) dom_prog"
   where
     "a_get_ancestors_si ptr = do {
       check_in_heap ptr;
       ancestors \<leftarrow> (case cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr of
         Some node_ptr \<Rightarrow> do {
           parent_ptr_opt \<leftarrow> get_parent node_ptr;
           (case parent_ptr_opt of
             Some parent_ptr \<Rightarrow> a_get_ancestors_si parent_ptr
           | None \<Rightarrow> return [])
         }
       | None \<Rightarrow> (case cast ptr of
           Some shadow_root_ptr \<Rightarrow> do {
             host \<leftarrow> get_host shadow_root_ptr;
             a_get_ancestors_si (cast host)
           } |
           None \<Rightarrow> return []));
       return (ptr # ancestors)
     }"
 
 definition "a_get_ancestors_si_locs = get_parent_locs \<union> get_host_locs"
 
 definition a_get_root_node_si :: "(_) object_ptr \<Rightarrow> (_, (_) object_ptr) dom_prog"
   where
     "a_get_root_node_si ptr = do {
       ancestors \<leftarrow> a_get_ancestors_si ptr;
       return (last ancestors)
     }"
 definition "a_get_root_node_si_locs = a_get_ancestors_si_locs"
 end
 
 locale l_get_ancestors_si_defs =
   fixes get_ancestors_si :: "(_::linorder) object_ptr \<Rightarrow> (_, (_) object_ptr list) dom_prog"
   fixes get_ancestors_si_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 
 locale l_get_root_node_si_defs =
   fixes get_root_node_si :: "(_) object_ptr \<Rightarrow> (_, (_) object_ptr) dom_prog"
   fixes get_root_node_si_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 
 locale l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_parent +
   l_get_host +
   l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_get_ancestors_si_defs +
   l_get_root_node_si_defs +
   assumes get_ancestors_si_impl: "get_ancestors_si = a_get_ancestors_si"
   assumes get_ancestors_si_locs_impl: "get_ancestors_si_locs = a_get_ancestors_si_locs"
   assumes get_root_node_si_impl: "get_root_node_si = a_get_root_node_si"
   assumes get_root_node_si_locs_impl: "get_root_node_si_locs = a_get_root_node_si_locs"
 begin
 lemmas get_ancestors_si_def = a_get_ancestors_si.simps[folded get_ancestors_si_impl]
 lemmas get_ancestors_si_locs_def = a_get_ancestors_si_locs_def[folded get_ancestors_si_locs_impl]
 lemmas get_root_node_si_def =
   a_get_root_node_si_def[folded get_root_node_si_impl get_ancestors_si_impl]
 lemmas get_root_node_si_locs_def =
   a_get_root_node_si_locs_def[folded get_root_node_si_locs_impl get_ancestors_si_locs_impl]
 
 lemma get_ancestors_si_pure [simp]:
   "pure (get_ancestors_si ptr) h"
 proof -
   have "\<forall>ptr h h' x. h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r x \<longrightarrow> h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>h h' \<longrightarrow> h = h'"
   proof (induct rule: a_get_ancestors_si.fixp_induct[folded get_ancestors_si_impl])
     case 1
     then show ?case
       by(rule admissible_dom_prog)
   next
     case 2
     then show ?case
       by simp
   next
     case (3 f)
     then show ?case
       using get_parent_pure get_host_pure
       apply(auto simp add: pure_returns_heap_eq pure_def
           split: option.splits
           elim!: bind_returns_heap_E bind_returns_result_E
           dest!: pure_returns_heap_eq[rotated, OF check_in_heap_pure])[1]
         apply (meson option.simps(3) returns_result_eq)
        apply(metis get_parent_pure pure_returns_heap_eq)
       apply(metis get_host_pure pure_returns_heap_eq)
       done
   qed
   then show ?thesis
     by (meson pure_eq_iff)
 qed
 
 
 lemma get_root_node_si_pure [simp]: "pure (get_root_node_si ptr) h"
   by(auto simp add: get_root_node_si_def bind_pure_I)
 
 
 lemma get_ancestors_si_ptr_in_heap:
   assumes "h \<turnstile> ok (get_ancestors_si ptr)"
   shows "ptr |\<in>| object_ptr_kinds h"
   using assms
   by(auto simp add: get_ancestors_si_def check_in_heap_ptr_in_heap elim!: bind_is_OK_E
       dest: is_OK_returns_result_I)
 
 lemma get_ancestors_si_ptr:
   assumes "h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors"
   shows "ptr \<in> set ancestors"
   using assms
   by(simp add: get_ancestors_si_def)
     (auto elim!: bind_returns_result_E2
       split: option.splits
       intro!: bind_pure_I)
 
 
 lemma get_ancestors_si_never_empty:
   assumes "h \<turnstile> get_ancestors_si child \<rightarrow>\<^sub>r ancestors"
   shows "ancestors \<noteq> []"
   using assms
   apply(simp add: get_ancestors_si_def)
   by(auto elim!: bind_returns_result_E2 split: option.splits)
 
 lemma get_root_node_si_no_parent:
   "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None \<Longrightarrow> h \<turnstile> get_root_node_si (cast node_ptr) \<rightarrow>\<^sub>r cast node_ptr"
   apply(auto simp add: check_in_heap_def get_root_node_si_def get_ancestors_si_def
       intro!: bind_pure_returns_result_I )[1]
   using get_parent_ptr_in_heap by blast
 
 
 lemma get_root_node_si_root_not_shadow_root:
   assumes "h \<turnstile> get_root_node_si ptr \<rightarrow>\<^sub>r root"
   shows "\<not> is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r root"
   using assms
 proof(auto simp add: get_root_node_si_def elim!: bind_returns_result_E2)
   fix y
   assume "h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r y"
     and "is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (last y)"
     and "root = last y"
   then
   show False
   proof(induct y arbitrary: ptr)
     case Nil
     then show ?case
       using assms(1) get_ancestors_si_never_empty by blast
   next
     case (Cons a x)
     then show ?case
       apply(auto simp add: get_ancestors_si_def[of ptr]
           elim!: bind_returns_result_E2
           split: option.splits if_splits)[1]
       using get_ancestors_si_never_empty apply blast
       using Cons.prems(2) apply auto[1]
       using \<open>is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r (last y)\<close> \<open>root = last y\<close> by auto
   qed
 qed
 end
 
 global_interpretation l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_parent get_parent_locs get_host get_host_locs
   defines get_root_node_si = a_get_root_node_si
     and get_root_node_si_locs = a_get_root_node_si_locs
     and get_ancestors_si = a_get_ancestors_si
     and get_ancestors_si_locs = a_get_ancestors_si_locs
   .
 declare a_get_ancestors_si.simps [code]
 
 interpretation i_get_root_node_si?: l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr known_ptrs
   get_parent get_parent_locs get_child_nodes get_child_nodes_locs get_host get_host_locs
   get_ancestors_si get_ancestors_si_locs get_root_node_si get_root_node_si_locs
   apply(auto simp add: l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       instances)[1]
   by(auto simp add: get_root_node_si_def get_root_node_si_locs_def get_ancestors_si_def
       get_ancestors_si_locs_def)
 declare l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma get_ancestors_si_is_l_get_ancestors [instances]: "l_get_ancestors get_ancestors_si"
   unfolding l_get_ancestors_def
   using get_ancestors_si_pure get_ancestors_si_ptr get_ancestors_si_ptr_in_heap
   by blast
 
 lemma get_root_node_si_is_l_get_root_node [instances]: "l_get_root_node get_root_node_si get_parent"
   apply(simp add: l_get_root_node_def)
   using get_root_node_si_no_parent
   by fast
 
 
 paragraph \<open>set\_disconnected\_nodes\<close>
 
 
 locale l_set_disconnected_nodes_get_ancestors_si\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_disconnected_nodes_get_parent
   + l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + l_set_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + l_set_disconnected_nodes_get_host
 begin
 lemma set_disconnected_nodes_get_ancestors_si:
   "\<forall>w \<in> set_disconnected_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_ancestors_si_locs. r h h'))"
   by(auto simp add: get_parent_locs_def set_disconnected_nodes_locs_def
       set_disconnected_nodes_get_host get_ancestors_si_locs_def all_args_def)
 end
 
 locale l_set_disconnected_nodes_get_ancestors_si =
   l_set_disconnected_nodes_defs +
   l_get_ancestors_si_defs +
   assumes set_disconnected_nodes_get_ancestors_si:
     "\<forall>w \<in> set_disconnected_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_ancestors_si_locs. r h h'))"
 
 interpretation i_set_disconnected_nodes_get_ancestors_si?:
   l_set_disconnected_nodes_get_ancestors_si\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_disconnected_nodes set_disconnected_nodes_locs
   get_parent get_parent_locs type_wf known_ptr known_ptrs get_child_nodes get_child_nodes_locs
   get_host get_host_locs get_ancestors_si get_ancestors_si_locs get_root_node_si
   get_root_node_si_locs DocumentClass.type_wf
 
   by (auto simp add: l_set_disconnected_nodes_get_ancestors_si\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_set_disconnected_nodes_get_ancestors_si\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 
 lemma set_disconnected_nodes_get_ancestors_si_is_l_set_disconnected_nodes_get_ancestors_si [instances]:
   "l_set_disconnected_nodes_get_ancestors_si set_disconnected_nodes_locs get_ancestors_si_locs"
   using instances
   apply(simp add: l_set_disconnected_nodes_get_ancestors_si_def)
   using set_disconnected_nodes_get_ancestors_si
   by fast
 
 
 
 subsubsection \<open>get\_attribute\<close>
 
 lemma get_attribute_is_l_get_attribute [instances]:
   "l_get_attribute type_wf get_attribute get_attribute_locs"
   apply(auto simp add: l_get_attribute_def)[1]
   using i_get_attribute.get_attribute_reads apply fast
   using type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t i_get_attribute.get_attribute_ok apply blast
   using i_get_attribute.get_attribute_ptr_in_heap apply fast
   done
 
 
 
 subsubsection \<open>to\_tree\_order\<close>
 
 global_interpretation l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs defines
   to_tree_order = "l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_to_tree_order get_child_nodes" .
 declare a_to_tree_order.simps [code]
 
 interpretation i_to_tree_order?: l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M ShadowRootClass.known_ptr
   ShadowRootClass.type_wf Shadow_DOM.get_child_nodes Shadow_DOM.get_child_nodes_locs to_tree_order
   by(auto simp add: l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def to_tree_order_def
       instances)
 declare l_to_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 
 subsubsection \<open>to\_tree\_order\_si\<close>
 
 
 locale l_to_tree_order_si\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_get_child_nodes_defs get_child_nodes get_child_nodes_locs +
   l_get_shadow_root_defs get_shadow_root get_shadow_root_locs
   for get_child_nodes :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 partial_function (dom_prog) a_to_tree_order_si :: "(_) object_ptr \<Rightarrow> (_, (_) object_ptr list) dom_prog"
   where
     "a_to_tree_order_si ptr = (do {
       children \<leftarrow> get_child_nodes ptr;
       shadow_root_part \<leftarrow> (case cast ptr of
         Some element_ptr \<Rightarrow> do {
           shadow_root_opt \<leftarrow> get_shadow_root element_ptr;
           (case shadow_root_opt of
             Some shadow_root_ptr \<Rightarrow> return [cast shadow_root_ptr]
             | None \<Rightarrow> return [])
         } |
         None \<Rightarrow> return []);
       treeorders \<leftarrow> map_M a_to_tree_order_si ((map (cast) children) @ shadow_root_part);
       return (ptr # concat treeorders)
     })"
 end
 
 locale l_to_tree_order_si_defs =
   fixes to_tree_order_si :: "(_) object_ptr \<Rightarrow> (_, (_) object_ptr list) dom_prog"
 
 global_interpretation l_to_tree_order_si\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs
   get_shadow_root get_shadow_root_locs
   defines to_tree_order_si = "a_to_tree_order_si" .
 declare a_to_tree_order_si.simps [code]
 
 
 locale l_to_tree_order_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_to_tree_order_si_defs +
   l_to_tree_order_si\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_get_child_nodes +
   l_get_shadow_root +
   assumes to_tree_order_si_impl: "to_tree_order_si = a_to_tree_order_si"
 begin
 lemmas to_tree_order_si_def = a_to_tree_order_si.simps[folded to_tree_order_si_impl]
 
 lemma to_tree_order_si_pure [simp]: "pure (to_tree_order_si ptr) h"
 proof -
   have "\<forall>ptr h h' x. h \<turnstile> to_tree_order_si ptr \<rightarrow>\<^sub>r x \<longrightarrow> h \<turnstile> to_tree_order_si ptr \<rightarrow>\<^sub>h h' \<longrightarrow> h = h'"
   proof (induct rule: a_to_tree_order_si.fixp_induct[folded to_tree_order_si_impl])
     case 1
     then show ?case
       by (rule admissible_dom_prog)
   next
     case 2
     then show ?case
       by simp
   next
     case (3 f)
     then have "\<And>x h. pure (f x) h"
       by (metis is_OK_returns_heap_E is_OK_returns_result_E pure_def)
     then have "\<And>xs h. pure (map_M f xs) h"
       by(rule map_M_pure_I)
     then show ?case
       by(auto elim!: bind_returns_heap_E2 split: option.splits)
   qed
   then show ?thesis
     unfolding pure_def
     by (metis is_OK_returns_heap_E is_OK_returns_result_E)
 qed
 end
 
 interpretation i_to_tree_order_si?: l_to_tree_order_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M to_tree_order_si get_child_nodes
   get_child_nodes_locs get_shadow_root get_shadow_root_locs type_wf known_ptr
   by(auto simp add: l_to_tree_order_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_to_tree_order_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       to_tree_order_si_def instances)
 declare l_to_tree_order_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>first\_in\_tree\_order\<close>
 
 global_interpretation l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs to_tree_order defines
   first_in_tree_order = "l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_first_in_tree_order to_tree_order" .
 
 interpretation i_first_in_tree_order?: l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M to_tree_order first_in_tree_order
   by(auto simp add: l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def first_in_tree_order_def)
 declare l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma to_tree_order_is_l_to_tree_order [instances]: "l_to_tree_order to_tree_order"
   by(auto simp add: l_to_tree_order_def)
 
 
 
 subsubsection \<open>first\_in\_tree\_order\<close>
 
 global_interpretation l_dummy defines
   first_in_tree_order_si = "l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_first_in_tree_order to_tree_order_si"
   .
 
 
 subsubsection \<open>get\_element\_by\<close>
 
 global_interpretation l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs to_tree_order first_in_tree_order get_attribute
   get_attribute_locs
   defines
     get_element_by_id =
     "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_element_by_id first_in_tree_order get_attribute" and
     get_elements_by_class_name =
     "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_class_name to_tree_order get_attribute" and
     get_elements_by_tag_name =
     "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_tag_name to_tree_order" .
 
 interpretation i_get_element_by?: l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M to_tree_order first_in_tree_order
   get_attribute get_attribute_locs get_element_by_id get_elements_by_class_name
   get_elements_by_tag_name type_wf
   by(auto simp add: l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       get_element_by_id_def get_elements_by_class_name_def get_elements_by_tag_name_def
       instances)
 declare l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 
 lemma get_element_by_is_l_get_element_by [instances]:
   "l_get_element_by get_element_by_id get_elements_by_tag_name to_tree_order"
   apply(auto simp add: l_get_element_by_def)[1]
   using get_element_by_id_result_in_tree_order apply fast
   done
 
 
 subsubsection \<open>get\_element\_by\_si\<close>
 
 global_interpretation l_dummy defines
   get_element_by_id_si =
   "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_element_by_id first_in_tree_order_si get_attribute" and
   get_elements_by_class_name_si =
   "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_class_name to_tree_order_si get_attribute" and
   get_elements_by_tag_name_si =
   "l_get_element_by\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_elements_by_tag_name to_tree_order_si"
   .
 
 
 
 subsubsection \<open>find\_slot\<close>
 
 locale l_find_slot\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_get_parent_defs get_parent get_parent_locs +
   l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
   l_get_mode_defs get_mode get_mode_locs +
   l_get_attribute_defs get_attribute get_attribute_locs +
   l_get_tag_name_defs get_tag_name get_tag_name_locs +
   l_first_in_tree_order_defs first_in_tree_order
   for get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_::linorder) object_ptr option) prog"
     and get_parent_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_mode :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, shadow_root_mode) prog"
     and get_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_attribute :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, char list option) prog"
     and get_attribute_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and first_in_tree_order ::
     "(_) object_ptr \<Rightarrow> ((_) object_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog) \<Rightarrow>
     ((_) heap, exception, (_) element_ptr option) prog"
 begin
 definition a_find_slot :: "bool \<Rightarrow> (_) node_ptr \<Rightarrow> (_, (_) element_ptr option) dom_prog"
   where
     "a_find_slot open_flag slotable = do {
       parent_opt \<leftarrow> get_parent slotable;
       (case parent_opt of
         Some parent \<Rightarrow>
           if is_element_ptr_kind parent
           then do {
             shadow_root_ptr_opt \<leftarrow> get_shadow_root (the (cast parent));
             (case shadow_root_ptr_opt of
               Some shadow_root_ptr \<Rightarrow> do {
                 shadow_root_mode \<leftarrow> get_mode shadow_root_ptr;
                 if open_flag \<and> shadow_root_mode \<noteq> Open
                 then return None
                 else first_in_tree_order (cast shadow_root_ptr) (\<lambda>ptr. if is_element_ptr_kind ptr
                   then do {
                     tag \<leftarrow> get_tag_name (the (cast ptr));
                     name_attr \<leftarrow> get_attribute (the (cast ptr)) ''name'';
                     slotable_name_attr \<leftarrow> (if is_element_ptr_kind slotable
                                            then get_attribute (the (cast slotable)) ''slot''
                                            else return None);
                     (if (tag = ''slot'' \<and> (name_attr = slotable_name_attr \<or>
                         (name_attr = None \<and> slotable_name_attr = Some '''') \<or>
                         (name_attr = Some '''' \<and> slotable_name_attr = None)))
                     then return (Some (the (cast ptr)))
                     else return None)}
                   else return None)}
               | None \<Rightarrow> return None)}
           else return None
     | _ \<Rightarrow> return None)}"
 
 definition a_assigned_slot :: "(_) node_ptr \<Rightarrow> (_, (_) element_ptr option) dom_prog"
   where
     "a_assigned_slot = a_find_slot True"
 end
 
 global_interpretation l_find_slot\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_parent get_parent_locs get_shadow_root
   get_shadow_root_locs get_mode get_mode_locs get_attribute get_attribute_locs get_tag_name
   get_tag_name_locs first_in_tree_order
   defines find_slot = a_find_slot
     and assigned_slot = a_assigned_slot
   .
 
 locale l_find_slot_defs =
   fixes find_slot :: "bool \<Rightarrow> (_) node_ptr \<Rightarrow> (_, (_) element_ptr option) dom_prog"
     and assigned_slot :: "(_) node_ptr \<Rightarrow> (_, (_) element_ptr option) dom_prog"
 
 locale l_find_slot\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_find_slot\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_find_slot_defs +
   l_get_parent +
   l_get_shadow_root +
   l_get_mode +
   l_get_attribute +
   l_get_tag_name +
   l_to_tree_order +
   l_first_in_tree_order\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   assumes find_slot_impl: "find_slot = a_find_slot"
   assumes assigned_slot_impl: "assigned_slot = a_assigned_slot"
 begin
 lemmas find_slot_def = find_slot_impl[unfolded a_find_slot_def]
 lemmas assigned_slot_def = assigned_slot_impl[unfolded a_assigned_slot_def]
 
 lemma find_slot_ptr_in_heap:
   assumes "h \<turnstile> find_slot open_flag slotable \<rightarrow>\<^sub>r slot_opt"
   shows "slotable |\<in>| node_ptr_kinds h"
   using assms
   apply(auto simp add: find_slot_def elim!: bind_returns_result_E2)[1]
   using get_parent_ptr_in_heap by blast
 
 lemma find_slot_slot_in_heap:
   assumes "h \<turnstile> find_slot open_flag slotable \<rightarrow>\<^sub>r Some slot"
   shows "slot |\<in>| element_ptr_kinds h"
   using assms
   apply(auto simp add: find_slot_def first_in_tree_order_def
       elim!: bind_returns_result_E2 map_filter_M_pure_E[where y=slot]
       split: option.splits if_splits list.splits
       intro!: map_filter_M_pure bind_pure_I)[1]
   using get_tag_name_ptr_in_heap by blast+
 
 lemma find_slot_pure [simp]: "pure (find_slot open_flag slotable) h"
   by(auto simp add: find_slot_def first_in_tree_order_def
       intro!: bind_pure_I map_filter_M_pure
       split: option.splits list.splits)
 end
 
 interpretation i_find_slot?: l_find_slot\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs get_shadow_root
   get_shadow_root_locs get_mode get_mode_locs get_attribute get_attribute_locs get_tag_name
   get_tag_name_locs first_in_tree_order find_slot assigned_slot type_wf known_ptr known_ptrs
   get_child_nodes get_child_nodes_locs to_tree_order
   by (auto simp add: find_slot_def assigned_slot_def l_find_slot\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def
       l_find_slot\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def instances)
 declare l_find_slot\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_find_slot = l_find_slot_defs +
   assumes find_slot_ptr_in_heap:
     "h \<turnstile> find_slot open_flag slotable \<rightarrow>\<^sub>r slot_opt \<Longrightarrow> slotable |\<in>| node_ptr_kinds h"
   assumes find_slot_slot_in_heap:
     "h \<turnstile> find_slot open_flag slotable \<rightarrow>\<^sub>r Some slot \<Longrightarrow> slot |\<in>| element_ptr_kinds h"
   assumes find_slot_pure [simp]:
     "pure (find_slot open_flag slotable) h"
 
 lemma find_slot_is_l_find_slot [instances]: "l_find_slot find_slot"
   apply(auto simp add: l_find_slot_def)[1]
   using find_slot_ptr_in_heap apply fast
   using find_slot_slot_in_heap apply fast
   done
 
 
 
 subsubsection \<open>get\_disconnected\_nodes\<close>
 
 locale l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   CD: l_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes
   get_disconnected_nodes_locs +
   l_type_wf type_wf
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> (_, (_) node_ptr list) dom_prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
 begin
 
 lemma get_disconnected_nodes_ok:
   "type_wf h \<Longrightarrow> document_ptr |\<in>| document_ptr_kinds h \<Longrightarrow>
     h \<turnstile> ok (get_disconnected_nodes document_ptr)"
   apply(unfold type_wf_impl get_disconnected_nodes_impl[unfolded a_get_disconnected_nodes_def])
   using CD.get_disconnected_nodes_ok CD.type_wf_impl ShadowRootClass.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t
   by blast
 end
 
 interpretation i_get_disconnected_nodes?: l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   DocumentClass.type_wf get_disconnected_nodes get_disconnected_nodes_locs
   by(auto simp add: l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       instances)
 declare l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_disconnected_nodes_is_l_get_disconnected_nodes [instances]:
   "l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs"
   apply(auto simp add: l_get_disconnected_nodes_def)[1]
   using i_get_disconnected_nodes.get_disconnected_nodes_reads apply fast
   using get_disconnected_nodes_ok apply fast
   using i_get_disconnected_nodes.get_disconnected_nodes_ptr_in_heap apply fast
   done
 
 
 paragraph \<open>set\_child\_nodes\<close>
 
 locale l_set_child_nodes_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_child_nodes_get_disconnected_nodes:
   "\<forall>w \<in> set_child_nodes_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))"
   by(auto simp add: set_child_nodes_locs_def CD.set_child_nodes_locs_def
       CD.get_disconnected_nodes_locs_def all_args_def)
 end
 
 interpretation
   i_set_child_nodes_get_disconnected_nodes?: l_set_child_nodes_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   known_ptr DocumentClass.type_wf DocumentClass.known_ptr set_child_nodes set_child_nodes_locs
   Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs
   apply(auto simp add: l_set_child_nodes_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)[1]
   by(unfold_locales)
 declare l_set_child_nodes_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_child_nodes_get_disconnected_nodes_is_l_set_child_nodes_get_disconnected_nodes [instances]:
   "l_set_child_nodes_get_disconnected_nodes type_wf set_child_nodes set_child_nodes_locs
     get_disconnected_nodes get_disconnected_nodes_locs"
   using set_child_nodes_is_l_set_child_nodes get_disconnected_nodes_is_l_get_disconnected_nodes
   apply(simp add: l_set_child_nodes_get_disconnected_nodes_def
       l_set_child_nodes_get_disconnected_nodes_axioms_def)
   using set_child_nodes_get_disconnected_nodes
   by fast
 
 
 paragraph \<open>set\_disconnected\_nodes\<close>
 
 lemma set_disconnected_nodes_get_disconnected_nodes_l_set_disconnected_nodes_get_disconnected_nodes
   [instances]:
   "l_set_disconnected_nodes_get_disconnected_nodes ShadowRootClass.type_wf get_disconnected_nodes
     get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs"
   apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_def
       l_set_disconnected_nodes_get_disconnected_nodes_axioms_def instances)[1]
   using i_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
    apply fast
   using i_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes_different_pointers
   apply fast
   done
 
 
 paragraph \<open>delete\_shadow\_root\<close>
 
 locale l_delete_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma get_disconnected_nodes_delete_shadow_root:  "h \<turnstile> delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M shadow_root_ptr \<rightarrow>\<^sub>h h'
     \<Longrightarrow> r \<in> get_disconnected_nodes_locs ptr' \<Longrightarrow> r h h'"
   by(auto simp add: CD.get_disconnected_nodes_locs_def delete_shadow_root_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
 end
 
 locale l_delete_shadow_root_get_disconnected_nodes = l_get_disconnected_nodes_defs +
   assumes get_disconnected_nodes_delete_shadow_root:  "h \<turnstile> delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M shadow_root_ptr \<rightarrow>\<^sub>h h'
     \<Longrightarrow> r \<in> get_disconnected_nodes_locs ptr' \<Longrightarrow> r h h'"
 interpretation l_delete_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf
   get_disconnected_nodes get_disconnected_nodes_locs
   by(auto simp add: l_delete_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 
 lemma l_delete_shadow_root_get_disconnected_nodes_get_disconnected_nodes_locs [instances]: "l_delete_shadow_root_get_disconnected_nodes get_disconnected_nodes_locs"
   apply(auto simp add: l_delete_shadow_root_get_disconnected_nodes_def)[1]
   using get_disconnected_nodes_delete_shadow_root apply fast
   done
 
 
 paragraph \<open>set\_shadow\_root\<close>
 
 locale l_set_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_shadow_root_get_disconnected_nodes:
   "\<forall>w \<in> set_shadow_root_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))"
   by(auto simp add: set_shadow_root_locs_def CD.get_disconnected_nodes_locs_def all_args_def)
 end
 
 interpretation i_set_shadow_root_get_disconnected_nodes?:
   l_set_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf set_shadow_root set_shadow_root_locs
   DocumentClass.type_wf get_disconnected_nodes get_disconnected_nodes_locs
   apply(auto simp add: l_set_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)[1]
   by(unfold_locales)
 declare l_set_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 locale l_set_shadow_root_get_disconnected_nodes =
   l_set_shadow_root_defs +
   l_get_disconnected_nodes_defs +
   assumes set_shadow_root_get_disconnected_nodes:
     "\<forall>w \<in> set_shadow_root_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))"
 
 lemma set_shadow_root_get_disconnected_nodes_is_l_set_shadow_root_get_disconnected_nodes [instances]:
   "l_set_shadow_root_get_disconnected_nodes set_shadow_root_locs get_disconnected_nodes_locs"
   using set_shadow_root_is_l_set_shadow_root get_disconnected_nodes_is_l_get_disconnected_nodes
   apply(simp add: l_set_shadow_root_get_disconnected_nodes_def )
   using set_shadow_root_get_disconnected_nodes
   by fast
 
 
 paragraph \<open>set\_mode\<close>
 
 locale l_set_mode_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_mode\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_mode_get_disconnected_nodes:
   "\<forall>w \<in> set_mode_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))"
   by(auto simp add: set_mode_locs_def
       CD.get_disconnected_nodes_locs_impl[unfolded CD.a_get_disconnected_nodes_locs_def]
       all_args_def)
 end
 
 interpretation i_set_mode_get_disconnected_nodes?: l_set_mode_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   set_mode set_mode_locs DocumentClass.type_wf get_disconnected_nodes get_disconnected_nodes_locs
   by unfold_locales
 declare l_set_mode_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 locale l_set_mode_get_disconnected_nodes = l_set_mode + l_get_disconnected_nodes +
   assumes set_mode_get_disconnected_nodes:
     "\<forall>w \<in> set_mode_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))"
 
 lemma set_mode_get_disconnected_nodes_is_l_set_mode_get_disconnected_nodes [instances]:
   "l_set_mode_get_disconnected_nodes type_wf set_mode set_mode_locs get_disconnected_nodes
                                          get_disconnected_nodes_locs"
   using set_mode_is_l_set_mode get_disconnected_nodes_is_l_get_disconnected_nodes
   apply(simp add: l_set_mode_get_disconnected_nodes_def
       l_set_mode_get_disconnected_nodes_axioms_def)
   using set_mode_get_disconnected_nodes
   by fast
 
 paragraph \<open>new\_shadow\_root\<close>
 
 locale l_new_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes
   get_disconnected_nodes_locs
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> (_, (_) node_ptr list) dom_prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 lemma get_disconnected_nodes_new_shadow_root:
   "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h'
     \<Longrightarrow> r \<in> get_disconnected_nodes_locs ptr' \<Longrightarrow> r h h'"
   by(auto simp add: CD.get_disconnected_nodes_locs_def new_shadow_root_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t)
 end
 
 interpretation i_new_shadow_root_get_disconnected_nodes?:
   l_new_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf
   get_disconnected_nodes get_disconnected_nodes_locs
   by unfold_locales
 declare l_new_shadow_root_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 locale l_new_shadow_root_get_disconnected_nodes = l_get_disconnected_nodes_defs +
   assumes get_disconnected_nodes_new_shadow_root:
     "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr \<Longrightarrow> h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h'
     \<Longrightarrow> r \<in> get_disconnected_nodes_locs ptr' \<Longrightarrow> r h h'"
 
 lemma new_shadow_root_get_disconnected_nodes_is_l_new_shadow_root_get_disconnected_nodes [instances]:
   "l_new_shadow_root_get_disconnected_nodes get_disconnected_nodes_locs"
   apply (auto simp add: l_new_shadow_root_get_disconnected_nodes_def)[1]
   using get_disconnected_nodes_new_shadow_root apply fast
   done
 
 
 subsubsection \<open>remove\_shadow\_root\<close>
 
 locale l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_get_child_nodes_defs get_child_nodes get_child_nodes_locs +
   l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
   l_set_shadow_root_defs set_shadow_root set_shadow_root_locs +
   l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs
   for get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and set_shadow_root ::
     "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr option \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 
 definition a_remove_shadow_root :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog" where
   "a_remove_shadow_root element_ptr = do {
     shadow_root_ptr_opt \<leftarrow> get_shadow_root element_ptr;
     (case shadow_root_ptr_opt of
       Some shadow_root_ptr \<Rightarrow> do {
         children \<leftarrow> get_child_nodes (cast shadow_root_ptr);
         (if children = []
         then do {
           set_shadow_root element_ptr None;
           delete_M shadow_root_ptr
         } else do {
           error HierarchyRequestError
         })
       } |
       None \<Rightarrow> error HierarchyRequestError)
     }"
 
 definition a_remove_shadow_root_locs ::
   "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr \<Rightarrow> ((_, unit) dom_prog) set"
   where
     "a_remove_shadow_root_locs element_ptr shadow_root_ptr \<equiv>
       set_shadow_root_locs element_ptr \<union> {delete_M shadow_root_ptr}"
 end
 
 global_interpretation l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs
   get_shadow_root get_shadow_root_locs set_shadow_root set_shadow_root_locs get_disconnected_nodes
   get_disconnected_nodes_locs
   defines remove_shadow_root = "a_remove_shadow_root"
     and remove_shadow_root_locs = a_remove_shadow_root_locs
   .
 
 locale l_remove_shadow_root_defs =
   fixes remove_shadow_root :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog"
   fixes remove_shadow_root_locs ::
     "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr \<Rightarrow> ((_, unit) dom_prog) set"
 
 
 locale l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_remove_shadow_root_defs +
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_child_nodes +
   l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs +
   assumes remove_shadow_root_impl: "remove_shadow_root = a_remove_shadow_root"
   assumes remove_shadow_root_locs_impl: "remove_shadow_root_locs = a_remove_shadow_root_locs"
 begin
 lemmas remove_shadow_root_def =
   remove_shadow_root_impl[unfolded remove_shadow_root_def a_remove_shadow_root_def]
 lemmas remove_shadow_root_locs_def =
   remove_shadow_root_locs_impl[unfolded remove_shadow_root_locs_def a_remove_shadow_root_locs_def]
 
 lemma remove_shadow_root_writes:
   "writes (remove_shadow_root_locs element_ptr (the |h \<turnstile> get_shadow_root element_ptr|\<^sub>r))
     (remove_shadow_root element_ptr) h h'"
   apply(auto simp add: remove_shadow_root_locs_def remove_shadow_root_def all_args_def
       writes_union_right_I writes_union_left_I set_shadow_root_writes
       intro!: writes_bind writes_bind_pure[OF get_shadow_root_pure]
       writes_bind_pure[OF get_child_nodes_pure]
       intro: writes_subset[OF set_shadow_root_writes] writes_subset[OF writes_singleton2]
       split: option.splits)[1]
   using  writes_union_left_I[OF set_shadow_root_writes]
    apply (metis inf_sup_aci(5) insert_is_Un)
   using writes_union_right_I[OF writes_singleton[of delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M]]
   by (smt insert_is_Un writes_singleton2 writes_union_left_I)
 end
 
 interpretation i_remove_shadow_root?: l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes
   get_child_nodes_locs get_shadow_root get_shadow_root_locs set_shadow_root set_shadow_root_locs
   get_disconnected_nodes get_disconnected_nodes_locs remove_shadow_root remove_shadow_root_locs
   type_wf known_ptr
   by(auto simp add: l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       remove_shadow_root_def remove_shadow_root_locs_def instances)
 declare l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 paragraph \<open>get\_child\_nodes\<close>
 
 locale l_remove_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma remove_shadow_root_get_child_nodes_different_pointers:
   assumes "ptr \<noteq> cast shadow_root_ptr"
   assumes "w \<in> remove_shadow_root_locs element_ptr shadow_root_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   assumes "r \<in> get_child_nodes_locs ptr"
   shows "r h h'"
   using assms
   apply(auto simp add: all_args_def get_child_nodes_locs_def CD.get_child_nodes_locs_def
       remove_shadow_root_locs_def set_shadow_root_locs_def
       delete_shadow_root_get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t delete_shadow_root_get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t
       delete_shadow_root_get_M\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t delete_shadow_root_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       delete_shadow_root_get_M\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t[rotated]
       element_put_get_preserved[where setter=shadow_root_opt_update]
       intro: is_shadow_root_ptr_kind_obtains
       elim: is_document_ptr_kind_obtains is_shadow_root_ptr_kind_obtains
       split: if_splits option.splits)[1]
   done
 end
 
 locale l_remove_shadow_root_get_child_nodes = l_get_child_nodes_defs + l_remove_shadow_root_defs +
   assumes remove_shadow_root_get_child_nodes_different_pointers:
     "ptr \<noteq> cast shadow_root_ptr \<Longrightarrow> w \<in> remove_shadow_root_locs element_ptr shadow_root_ptr \<Longrightarrow>
       h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow> r \<in> get_child_nodes_locs ptr \<Longrightarrow> r h h'"
 
 interpretation i_remove_shadow_root_get_child_nodes?: l_remove_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf known_ptr DocumentClass.type_wf DocumentClass.known_ptr get_child_nodes
   get_child_nodes_locs Core_DOM_Functions.get_child_nodes Core_DOM_Functions.get_child_nodes_locs
   get_shadow_root get_shadow_root_locs set_shadow_root set_shadow_root_locs get_disconnected_nodes
   get_disconnected_nodes_locs remove_shadow_root remove_shadow_root_locs
   by(auto simp add: l_remove_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_remove_shadow_root_get_child_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma remove_shadow_root_get_child_nodes_is_l_remove_shadow_root_get_child_nodes [instances]:
   "l_remove_shadow_root_get_child_nodes get_child_nodes_locs remove_shadow_root_locs"
   apply(auto simp add: l_remove_shadow_root_get_child_nodes_def instances )[1]
   using remove_shadow_root_get_child_nodes_different_pointers apply fast
   done
 
 paragraph \<open>get\_tag\_name\<close>
 
 locale l_remove_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma remove_shadow_root_get_tag_name:
   assumes "w \<in> remove_shadow_root_locs element_ptr shadow_root_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   assumes "r \<in> get_tag_name_locs ptr"
   shows "r h h'"
   using assms
   by(auto simp add: all_args_def remove_shadow_root_locs_def set_shadow_root_locs_def
       CD.get_tag_name_locs_def delete_shadow_root_get_M\<^sub>E\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t
       element_put_get_preserved[where setter=shadow_root_opt_update]
       split: if_splits option.splits)
 end
 
 locale l_remove_shadow_root_get_tag_name = l_get_tag_name_defs + l_remove_shadow_root_defs +
   assumes remove_shadow_root_get_tag_name:
     "w \<in> remove_shadow_root_locs element_ptr shadow_root_ptr \<Longrightarrow> h \<turnstile> w \<rightarrow>\<^sub>h h' \<Longrightarrow>
     r \<in> get_tag_name_locs ptr \<Longrightarrow> r h h'"
 
 interpretation i_remove_shadow_root_get_tag_name?: l_remove_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   DocumentClass.type_wf get_tag_name get_tag_name_locs get_child_nodes get_child_nodes_locs
   get_shadow_root get_shadow_root_locs set_shadow_root set_shadow_root_locs get_disconnected_nodes
   get_disconnected_nodes_locs remove_shadow_root remove_shadow_root_locs known_ptr
   by(auto simp add: l_remove_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_remove_shadow_root_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma remove_shadow_root_get_tag_name_is_l_remove_shadow_root_get_tag_name [instances]:
   "l_remove_shadow_root_get_tag_name get_tag_name_locs remove_shadow_root_locs"
   apply(auto simp add: l_remove_shadow_root_get_tag_name_def instances )[1]
   using remove_shadow_root_get_tag_name apply fast
   done
 
 
 subsubsection \<open>get\_owner\_document\<close>
 
 locale l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_get_host_defs get_host get_host_locs +
   CD: l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_root_node get_root_node_locs get_disconnected_nodes
   get_disconnected_nodes_locs
   for get_root_node :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr) prog"
     and get_root_node_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 definition a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ::
   "(_) shadow_root_ptr \<Rightarrow> unit \<Rightarrow> (_, (_) document_ptr) dom_prog"
   where
     "a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr _ = do {
       host \<leftarrow> get_host shadow_root_ptr;
       CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r (cast host) ()
     }"
 
 definition a_get_owner_document_tups :: "(((_) object_ptr \<Rightarrow> bool) \<times> ((_) object_ptr \<Rightarrow> unit
   \<Rightarrow> (_, (_) document_ptr) dom_prog)) list"
   where
     "a_get_owner_document_tups = [(is_shadow_root_ptr, a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast)]"
 
 definition a_get_owner_document :: "(_::linorder) object_ptr \<Rightarrow> (_, (_) document_ptr) dom_prog"
   where
     "a_get_owner_document ptr = invoke (CD.a_get_owner_document_tups @ a_get_owner_document_tups) ptr ()"
 end
 
 global_interpretation l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_root_node_si get_root_node_si_locs
   get_disconnected_nodes get_disconnected_nodes_locs get_host get_host_locs
   defines get_owner_document_tups = a_get_owner_document_tups
     and get_owner_document = a_get_owner_document
     and get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r = a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r
     and get_owner_document_tups\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
       "l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_owner_document_tups
         get_root_node_si get_disconnected_nodes"
     and get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r =
       "l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r
         get_root_node_si get_disconnected_nodes"
   .
 
 locale l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_known_ptr known_ptr +
   l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_root_node_si get_root_node_si_locs get_disconnected_nodes
   get_disconnected_nodes_locs get_host get_host_locs +
   l_get_owner_document_defs get_owner_document +
   l_get_host get_host get_host_locs +
   CD: l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_parent get_parent_locs known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_disconnected_nodes
   get_disconnected_nodes_locs get_root_node_si get_root_node_si_locs get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_root_node_si :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr) prog"
     and get_root_node_si_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_owner_document :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog" +
   assumes known_ptr_impl: "known_ptr = a_known_ptr"
   assumes get_owner_document_impl: "get_owner_document = a_get_owner_document"
 begin
 lemmas known_ptr_def = known_ptr_impl[unfolded a_known_ptr_def]
 lemmas get_owner_document_def = a_get_owner_document_def[folded get_owner_document_impl]
 
 lemma get_owner_document_pure [simp]:
   "pure (get_owner_document ptr) h"
 proof -
   have "\<And>shadow_root_ptr. pure (a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr ()) h"
     apply(auto simp add: a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_pure_I filter_M_pure_I
         split: option.splits)[1]
     by(auto simp add: CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_pure_I filter_M_pure_I
         split: option.splits)
   then show ?thesis
     apply(auto simp add: get_owner_document_def)[1]
     apply(split CD.get_owner_document_splits, rule conjI)+
      apply(simp)
     apply(auto simp add: a_get_owner_document_tups_def)[1]
     apply(split invoke_splits, rule conjI)+
      apply simp
     by(auto intro!: bind_pure_I)
 qed
 
 lemma get_owner_document_ptr_in_heap:
   assumes "h \<turnstile> ok (get_owner_document ptr)"
   shows "ptr |\<in>| object_ptr_kinds h"
   using assms
   by(auto simp add: get_owner_document_def invoke_ptr_in_heap dest: is_OK_returns_heap_I)
 
 end
 
 interpretation i_get_owner_document?: l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr DocumentClass.known_ptr
   get_parent get_parent_locs type_wf get_disconnected_nodes get_disconnected_nodes_locs
   get_root_node_si get_root_node_si_locs CD.a_get_owner_document get_host get_host_locs
   get_owner_document
   by(auto simp add: instances l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_owner_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       get_owner_document_def Core_DOM_Functions.get_owner_document_def)
 declare l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_owner_document_is_l_get_owner_document [instances]:
   "l_get_owner_document get_owner_document"
   apply(auto simp add: l_get_owner_document_def)[1]
   using get_owner_document_ptr_in_heap apply fast
   done
 
 
 
 
 subsubsection \<open>remove\_child\<close>
 
 global_interpretation l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs set_child_nodes
   set_child_nodes_locs get_parent get_parent_locs get_owner_document get_disconnected_nodes
   get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs
   defines remove = "l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_remove get_child_nodes set_child_nodes get_parent
     get_owner_document get_disconnected_nodes set_disconnected_nodes"
     and remove_child = "l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_remove_child get_child_nodes set_child_nodes
     get_owner_document get_disconnected_nodes set_disconnected_nodes"
     and remove_child_locs = "l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_remove_child_locs set_child_nodes_locs
     set_disconnected_nodes_locs"
   .
 
 interpretation i_remove_child?: l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M Shadow_DOM.get_child_nodes
   Shadow_DOM.get_child_nodes_locs Shadow_DOM.set_child_nodes Shadow_DOM.set_child_nodes_locs
   Shadow_DOM.get_parent Shadow_DOM.get_parent_locs Shadow_DOM.get_owner_document
   get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
   set_disconnected_nodes_locs remove_child remove_child_locs remove ShadowRootClass.type_wf
   ShadowRootClass.known_ptr ShadowRootClass.known_ptrs
   by(auto simp add: l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def remove_child_def
       remove_child_locs_def remove_def instances)
 declare l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 
 subsubsection \<open>get\_disconnected\_document\<close>
 
 locale l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_get_disconnected_nodes_defs get_disconnected_nodes get_disconnected_nodes_locs
   for get_disconnected_nodes ::
     "(_::linorder) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 definition a_get_disconnected_document :: "(_) node_ptr \<Rightarrow> (_, (_) document_ptr) dom_prog"
   where
     "a_get_disconnected_document node_ptr = do {
       check_in_heap (cast node_ptr);
       ptrs \<leftarrow> document_ptr_kinds_M;
       candidates \<leftarrow> filter_M (\<lambda>document_ptr. do {
         disconnected_nodes \<leftarrow> get_disconnected_nodes document_ptr;
         return (node_ptr \<in> set disconnected_nodes)
       }) ptrs;
       (case candidates of
         Cons document_ptr [] \<Rightarrow> return document_ptr |
         _ \<Rightarrow> error HierarchyRequestError
       )
     }"
 definition "a_get_disconnected_document_locs =
   (\<Union>document_ptr. get_disconnected_nodes_locs document_ptr) \<union>
   (\<Union>ptr. {preserved (get_M\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t ptr RObject.nothing)})"
 end
 
 locale l_get_disconnected_document_defs =
   fixes get_disconnected_document :: "(_) node_ptr \<Rightarrow> (_, (_::linorder) document_ptr) dom_prog"
   fixes get_disconnected_document_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 
 locale l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs +
   l_get_disconnected_document_defs +
   l_get_disconnected_nodes +
   assumes get_disconnected_document_impl:
     "get_disconnected_document = a_get_disconnected_document"
   assumes get_disconnected_document_locs_impl:
     "get_disconnected_document_locs = a_get_disconnected_document_locs"
 begin
 lemmas get_disconnected_document_def =
   get_disconnected_document_impl[unfolded a_get_disconnected_document_def]
 lemmas get_disconnected_document_locs_def =
   get_disconnected_document_locs_impl[unfolded a_get_disconnected_document_locs_def]
 
 
 lemma get_disconnected_document_pure [simp]: "pure (get_disconnected_document ptr) h"
   using get_disconnected_nodes_pure
   by(auto simp add: get_disconnected_document_def
       intro!: bind_pure_I filter_M_pure_I
       split: list.splits)
 
 lemma get_disconnected_document_ptr_in_heap [simp]:
   "h \<turnstile> ok (get_disconnected_document node_ptr) \<Longrightarrow> node_ptr |\<in>| node_ptr_kinds h"
   using get_disconnected_document_def is_OK_returns_result_I check_in_heap_ptr_in_heap
   by (metis (no_types, lifting) bind_returns_heap_E get_disconnected_document_pure
       node_ptr_kinds_commutes pure_pure)
 
 lemma get_disconnected_document_disconnected_document_in_heap:
   assumes "h \<turnstile> get_disconnected_document child_node \<rightarrow>\<^sub>r disconnected_document"
   shows "disconnected_document |\<in>| document_ptr_kinds h"
   using assms get_disconnected_nodes_pure
   by(auto simp add: get_disconnected_document_def elim!: bind_returns_result_E2
       dest!: filter_M_not_more_elements[where x=disconnected_document]
       intro!: filter_M_pure_I bind_pure_I
       split: if_splits list.splits)
 
 lemma get_disconnected_document_reads:
   "reads get_disconnected_document_locs (get_disconnected_document node_ptr) h h'"
   using get_disconnected_nodes_reads[unfolded reads_def]
   by(auto simp add: get_disconnected_document_def get_disconnected_document_locs_def
       intro!: reads_bind_pure reads_subset[OF check_in_heap_reads]
       reads_subset[OF error_reads]
       reads_subset[OF get_disconnected_nodes_reads] reads_subset[OF return_reads]
       reads_subset[OF document_ptr_kinds_M_reads] filter_M_reads filter_M_pure_I
       bind_pure_I
       split: list.splits)
 
 end
 
 locale l_get_disconnected_document = l_get_disconnected_document_defs +
   assumes get_disconnected_document_reads:
     "reads get_disconnected_document_locs (get_disconnected_document node_ptr) h h'"
   assumes get_disconnected_document_ptr_in_heap:
     "h \<turnstile> ok (get_disconnected_document node_ptr) \<Longrightarrow> node_ptr |\<in>| node_ptr_kinds h"
   assumes get_disconnected_document_pure [simp]:
     "pure (get_disconnected_document node_ptr) h"
   assumes get_disconnected_document_disconnected_document_in_heap:
     "h \<turnstile> get_disconnected_document child_node \<rightarrow>\<^sub>r disconnected_document \<Longrightarrow>
     disconnected_document |\<in>| document_ptr_kinds h"
 
 global_interpretation l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_disconnected_nodes
   get_disconnected_nodes_locs defines
   get_disconnected_document = a_get_disconnected_document and
   get_disconnected_document_locs = a_get_disconnected_document_locs .
 
 interpretation i_get_disconnected_document?: l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_disconnected_nodes get_disconnected_nodes_locs get_disconnected_document
   get_disconnected_document_locs type_wf
   by(auto simp add: l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       get_disconnected_document_def get_disconnected_document_locs_def instances)
 declare l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma get_disconnected_document_is_l_get_disconnected_document [instances]:
   "l_get_disconnected_document get_disconnected_document get_disconnected_document_locs"
   apply(auto simp add: l_get_disconnected_document_def instances)[1]
   using get_disconnected_document_ptr_in_heap get_disconnected_document_pure
     get_disconnected_document_disconnected_document_in_heap get_disconnected_document_reads
   by blast+
 
 paragraph \<open>get\_disconnected\_nodes\<close>
 
 locale l_set_tag_name_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_tag_name_get_disconnected_nodes:
   "\<forall>w \<in> set_tag_name_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_disconnected_nodes_locs ptr'. r h h'))"
   by(auto simp add: CD.set_tag_name_locs_impl[unfolded CD.a_set_tag_name_locs_def]
       CD.get_disconnected_nodes_locs_impl[unfolded CD.a_get_disconnected_nodes_locs_def]
       all_args_def)
 end
 
 interpretation
   i_set_tag_name_get_disconnected_nodes?: l_set_tag_name_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf
   DocumentClass.type_wf set_tag_name set_tag_name_locs get_disconnected_nodes
   get_disconnected_nodes_locs
   by unfold_locales
 declare l_set_tag_name_get_disconnected_nodes\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_tag_name_get_disconnected_nodes_is_l_set_tag_name_get_disconnected_nodes [instances]:
   "l_set_tag_name_get_disconnected_nodes type_wf set_tag_name set_tag_name_locs
     get_disconnected_nodes get_disconnected_nodes_locs"
   using set_tag_name_is_l_set_tag_name get_disconnected_nodes_is_l_get_disconnected_nodes
   apply(simp add: l_set_tag_name_get_disconnected_nodes_def
       l_set_tag_name_get_disconnected_nodes_axioms_def)
   using set_tag_name_get_disconnected_nodes
   by fast
 
 
 subsubsection \<open>adopt\_node\<close>
 
 global_interpretation l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_owner_document get_parent get_parent_locs
   remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs
   set_disconnected_nodes set_disconnected_nodes_locs
   defines adopt_node = a_adopt_node
     and adopt_node_locs = a_adopt_node_locs
   .
 interpretation i_adopt_node?: l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent get_parent_locs
   remove_child remove_child_locs get_disconnected_nodes get_disconnected_nodes_locs
   set_disconnected_nodes set_disconnected_nodes_locs adopt_node adopt_node_locs known_ptr type_wf
   get_child_nodes get_child_nodes_locs known_ptrs set_child_nodes set_child_nodes_locs remove
   by(auto simp add: l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def adopt_node_def
       adopt_node_locs_def instances)
 declare l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma adopt_node_is_l_adopt_node [instances]: "l_adopt_node type_wf known_ptr known_ptrs get_parent
   adopt_node adopt_node_locs get_child_nodes get_owner_document"
   apply(auto simp add: l_adopt_node_def l_adopt_node_axioms_def instances)[1]
   using adopt_node_writes apply fast
   using adopt_node_pointers_preserved apply (fast, fast)
   using adopt_node_types_preserved apply (fast, fast)
   using adopt_node_child_in_heap apply fast
   using adopt_node_children_subset apply fast
   done
 
 
 
 paragraph \<open>get\_shadow\_root\<close>
 
 locale l_adopt_node_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_child_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_disconnected_nodes_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma adopt_node_get_shadow_root:
   "\<forall>w \<in> adopt_node_locs parent owner_document document_ptr.
     (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
   by(auto simp add: adopt_node_locs_def remove_child_locs_def all_args_def
       set_disconnected_nodes_get_shadow_root set_child_nodes_get_shadow_root)
 end
 
 locale l_adopt_node_get_shadow_root = l_adopt_node_defs + l_get_shadow_root_defs +
   assumes adopt_node_get_shadow_root:
     "\<forall>w \<in> adopt_node_locs parent owner_document document_ptr.
     (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
 
 interpretation i_adopt_node_get_shadow_root?: l_adopt_node_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr
   DocumentClass.type_wf DocumentClass.known_ptr set_child_nodes set_child_nodes_locs
   Core_DOM_Functions.set_child_nodes Core_DOM_Functions.set_child_nodes_locs get_shadow_root
   get_shadow_root_locs set_disconnected_nodes set_disconnected_nodes_locs get_owner_document
   get_parent get_parent_locs remove_child remove_child_locs get_disconnected_nodes
   get_disconnected_nodes_locs adopt_node adopt_node_locs get_child_nodes get_child_nodes_locs
   known_ptrs remove
   by(auto simp add: l_adopt_node_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_adopt_node_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma adopt_node_get_shadow_root_is_l_adopt_node_get_shadow_root [instances]:
   "l_adopt_node_get_shadow_root adopt_node_locs get_shadow_root_locs"
   apply(auto simp add: l_adopt_node_get_shadow_root_def)[1]
   using adopt_node_get_shadow_root apply fast
   done
 
 
 
 subsubsection \<open>insert\_before\<close>
 
 global_interpretation l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_parent get_parent_locs get_child_nodes
   get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors_si get_ancestors_si_locs
   adopt_node adopt_node_locs set_disconnected_nodes set_disconnected_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs get_owner_document
   defines
     next_sibling = a_next_sibling and
     insert_node = a_insert_node and
     ensure_pre_insertion_validity = a_ensure_pre_insertion_validity and
     insert_before = a_insert_before and
     insert_before_locs = a_insert_before_locs
   .
 global_interpretation l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs insert_before
   defines append_child = "l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs.a_append_child insert_before"
   .
 
 interpretation i_insert_before?: l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs get_child_nodes
   get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors_si get_ancestors_si_locs
   adopt_node adopt_node_locs set_disconnected_nodes set_disconnected_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs get_owner_document insert_before insert_before_locs append_child type_wf
   known_ptr known_ptrs
   by(auto simp add: l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def insert_before_def
       insert_before_locs_def instances)
 declare l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 interpretation i_append_child?: l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M append_child insert_before insert_before_locs
   by(simp add: l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances append_child_def)
 declare l_append_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 
 subsubsection \<open>get\_assigned\_nodes\<close>
 
 fun map_filter_M2 :: "('x \<Rightarrow> ('heap, 'e, 'y option) prog) \<Rightarrow> 'x list
   \<Rightarrow> ('heap, 'e, 'y list) prog"
   where
     "map_filter_M2 f [] = return []" |
     "map_filter_M2 f (x # xs) = do {
       res \<leftarrow> f x;
       remainder \<leftarrow> map_filter_M2 f xs;
       return ((case res of  Some r \<Rightarrow> [r] | None \<Rightarrow> []) @ remainder)
     }"
 lemma map_filter_M2_pure [simp]:
   assumes "\<And>x. x \<in> set xs \<Longrightarrow> pure (f x) h"
   shows "pure (map_filter_M2 f xs) h"
   using assms
   apply(induct xs arbitrary: h)
   by(auto elim!: bind_returns_result_E2 intro!: bind_pure_I)
 
 lemma map_filter_pure_no_monad:
   assumes "\<And>x. x \<in> set xs \<Longrightarrow> pure (f x) h"
   assumes "h \<turnstile> map_filter_M2 f xs \<rightarrow>\<^sub>r ys"
   shows
     "ys = map the (filter (\<lambda>x. x \<noteq> None) (map (\<lambda>x. |h \<turnstile> f x|\<^sub>r) xs))" and
     "\<And>x. x \<in> set xs \<Longrightarrow> h \<turnstile> ok (f x)"
   using assms
    apply(induct xs arbitrary: h ys)
   by(auto elim!: bind_returns_result_E2)
 
 lemma map_filter_pure_foo:
   assumes "\<And>x. x \<in> set xs \<Longrightarrow> pure (f x) h"
   assumes "h \<turnstile> map_filter_M2 f xs \<rightarrow>\<^sub>r ys"
   assumes "y \<in> set ys"
   obtains x where "h \<turnstile> f x \<rightarrow>\<^sub>r Some y" and "x \<in> set xs"
   using assms
   apply(induct xs arbitrary: ys)
   by(auto elim!: bind_returns_result_E2)
 
 
 lemma map_filter_M2_in_result:
   assumes "h \<turnstile> map_filter_M2 P xs \<rightarrow>\<^sub>r ys"
   assumes "a \<in> set xs"
   assumes "\<And>x. x \<in> set xs \<Longrightarrow> pure (P x) h"
   assumes "h \<turnstile> P a \<rightarrow>\<^sub>r Some b"
   shows "b \<in> set ys"
   using assms
   apply(induct xs arbitrary: h ys)
   by(auto elim!: bind_returns_result_E2 )
 
 
 locale l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   l_get_tag_name_defs get_tag_name get_tag_name_locs +
   l_get_root_node_defs get_root_node get_root_node_locs +
   l_get_host_defs get_host get_host_locs +
   l_get_child_nodes_defs get_child_nodes get_child_nodes_locs +
   l_find_slot_defs find_slot assigned_slot +
   l_remove_defs remove +
   l_insert_before_defs insert_before insert_before_locs +
   l_append_child_defs append_child +
   l_remove_shadow_root_defs remove_shadow_root remove_shadow_root_locs
   for get_child_nodes :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_root_node :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr) prog"
     and get_root_node_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and find_slot :: "bool \<Rightarrow> (_) node_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog"
     and assigned_slot :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog"
     and remove :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and insert_before ::
     "(_) object_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> (_) node_ptr option \<Rightarrow> ((_) heap, exception, unit) prog"
     and insert_before_locs ::  "(_) object_ptr \<Rightarrow> (_) object_ptr option \<Rightarrow> (_) document_ptr \<Rightarrow>
     (_) document_ptr \<Rightarrow> (_, unit) dom_prog set"
     and append_child :: "(_) object_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and remove_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and remove_shadow_root_locs :: "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr \<Rightarrow>
     ((_) heap, exception, unit) prog set"
 begin
 definition a_assigned_nodes :: "(_) element_ptr \<Rightarrow> (_, (_) node_ptr list) dom_prog"
   where
     "a_assigned_nodes slot = do {
       tag \<leftarrow> get_tag_name slot;
       (if tag \<noteq> ''slot''
       then error HierarchyRequestError
       else return ());
       root \<leftarrow> get_root_node (cast slot);
       if is_shadow_root_ptr_kind root
       then do {
         host \<leftarrow> get_host (the (cast root));
         children \<leftarrow> get_child_nodes (cast host);
         filter_M (\<lambda>slotable. do {
           found_slot \<leftarrow> find_slot False slotable;
           return (found_slot = Some slot)}) children}
       else return []}"
 
 partial_function (dom_prog) a_assigned_nodes_flatten ::
   "(_) element_ptr \<Rightarrow> (_, (_) node_ptr list) dom_prog"
   where
     "a_assigned_nodes_flatten slot = do {
       tag \<leftarrow> get_tag_name slot;
       (if tag \<noteq> ''slot''
       then error HierarchyRequestError
       else return ());
       root \<leftarrow> get_root_node (cast slot);
       (if is_shadow_root_ptr_kind root
       then do {
         slotables \<leftarrow> a_assigned_nodes slot;
         slotables_or_child_nodes \<leftarrow> (if slotables = []
         then do {
           get_child_nodes (cast slot)
         } else do {
           return slotables
         });
         list_of_lists \<leftarrow> map_M (\<lambda>node_ptr. do {
           (case cast node_ptr of
             Some element_ptr \<Rightarrow> do {
               tag \<leftarrow> get_tag_name element_ptr;
               (if tag = ''slot''
               then do {
                 root \<leftarrow> get_root_node (cast element_ptr);
                 (if is_shadow_root_ptr_kind root
                 then do {
                   a_assigned_nodes_flatten element_ptr
                 } else do {
                   return [node_ptr]
                 })
               } else do {
                 return [node_ptr]
               })
             }
             | None \<Rightarrow> return [node_ptr])
         }) slotables_or_child_nodes;
         return (concat list_of_lists)
       } else return [])
     }"
 
 definition a_flatten_dom :: "(_, unit) dom_prog" where
   "a_flatten_dom = do {
     tups \<leftarrow> element_ptr_kinds_M \<bind> map_filter_M2 (\<lambda>element_ptr. do {
       tag \<leftarrow> get_tag_name element_ptr;
       assigned_nodes \<leftarrow> a_assigned_nodes element_ptr;
       (if tag = ''slot'' \<and> assigned_nodes \<noteq> []
        then return (Some (element_ptr, assigned_nodes))
        else return None)});
     forall_M (\<lambda>(slot, assigned_nodes). do {
       get_child_nodes (cast slot) \<bind> forall_M remove;
       forall_M (append_child (cast slot)) assigned_nodes
     }) tups;
     shadow_root_ptr_kinds_M \<bind> forall_M (\<lambda>shadow_root_ptr. do {
       host \<leftarrow> get_host shadow_root_ptr;
       get_child_nodes (cast host) \<bind> forall_M remove;
       get_child_nodes (cast shadow_root_ptr) \<bind> forall_M (append_child (cast host));
       remove_shadow_root host
     });
     return ()
   }"
 end
 
 global_interpretation l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs
   get_tag_name get_tag_name_locs get_root_node get_root_node_locs get_host get_host_locs find_slot
   assigned_slot remove insert_before insert_before_locs append_child remove_shadow_root
   remove_shadow_root_locs
   defines assigned_nodes = a_assigned_nodes
     and assigned_nodes_flatten = a_assigned_nodes_flatten
     and flatten_dom = a_flatten_dom
   .
 
 declare a_assigned_nodes_flatten.simps [code]
 
 locale l_assigned_nodes_defs =
   fixes assigned_nodes :: "(_) element_ptr \<Rightarrow> (_, (_) node_ptr list) dom_prog"
   fixes assigned_nodes_flatten :: "(_) element_ptr \<Rightarrow> (_, (_) node_ptr list) dom_prog"
   fixes flatten_dom :: "(_, unit) dom_prog"
 
 locale l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_assigned_nodes_defs
   assigned_nodes assigned_nodes_flatten flatten_dom
   + l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
   get_child_nodes get_child_nodes_locs get_tag_name get_tag_name_locs get_root_node
   get_root_node_locs get_host get_host_locs find_slot assigned_slot remove insert_before
   insert_before_locs append_child remove_shadow_root remove_shadow_root_locs
   + l_get_shadow_root
   type_wf get_shadow_root get_shadow_root_locs
   + l_set_shadow_root
   type_wf set_shadow_root set_shadow_root_locs
   + l_remove
   + l_insert_before
   insert_before insert_before_locs
   + l_find_slot
   find_slot assigned_slot
   + l_get_tag_name
   type_wf get_tag_name get_tag_name_locs
   + l_get_root_node
   get_root_node get_root_node_locs get_parent get_parent_locs
   + l_get_host
   get_host get_host_locs
   + l_get_child_nodes
   type_wf known_ptr get_child_nodes get_child_nodes_locs
   + l_to_tree_order
   to_tree_order
   for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and assigned_nodes :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and assigned_nodes_flatten :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and flatten_dom :: "((_) heap, exception, unit) prog"
     and get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_root_node :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr) prog"
     and get_root_node_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and find_slot :: "bool \<Rightarrow> (_) node_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog"
     and assigned_slot :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr option) prog"
     and remove :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and insert_before ::
     "(_) object_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> (_) node_ptr option \<Rightarrow> ((_) heap, exception, unit) prog"
     and insert_before_locs ::  "(_) object_ptr \<Rightarrow> (_) object_ptr option \<Rightarrow> (_) document_ptr \<Rightarrow>
     (_) document_ptr \<Rightarrow> (_, unit) dom_prog set"
     and append_child :: "(_) object_ptr \<Rightarrow> (_) node_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and remove_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog"
     and remove_shadow_root_locs :: "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr \<Rightarrow>
     ((_) heap, exception, unit) prog set"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and get_shadow_root ::
     "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and set_shadow_root ::
     "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr option \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and get_parent :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr option) prog"
     and get_parent_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and to_tree_order :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) object_ptr list) prog" +
   assumes assigned_nodes_impl: "assigned_nodes = a_assigned_nodes"
   assumes flatten_dom_impl: "flatten_dom = a_flatten_dom"
 begin
 lemmas assigned_nodes_def = assigned_nodes_impl[unfolded a_assigned_nodes_def]
 lemmas flatten_dom_def = flatten_dom_impl[unfolded a_flatten_dom_def, folded assigned_nodes_impl]
 
 lemma assigned_nodes_pure [simp]: "pure (assigned_nodes slot) h"
   by(auto simp add: assigned_nodes_def intro!: bind_pure_I filter_M_pure_I)
 
 lemma assigned_nodes_ptr_in_heap:
   assumes "h \<turnstile> ok (assigned_nodes slot)"
   shows "slot |\<in>| element_ptr_kinds h"
   using assms
   apply(auto simp add: assigned_nodes_def)[1]
   by (meson bind_is_OK_E is_OK_returns_result_I local.get_tag_name_ptr_in_heap)
 
 lemma assigned_nodes_slot_is_slot:
   assumes "h \<turnstile> ok (assigned_nodes slot)"
   shows "h \<turnstile> get_tag_name slot \<rightarrow>\<^sub>r ''slot''"
   using assms
   by(auto simp add: assigned_nodes_def elim!: bind_is_OK_E split: if_splits)
 
 lemma assigned_nodes_different_ptr:
   assumes "h \<turnstile> assigned_nodes slot \<rightarrow>\<^sub>r nodes"
   assumes "h \<turnstile> assigned_nodes slot' \<rightarrow>\<^sub>r nodes'"
   assumes "slot \<noteq> slot'"
   shows "set nodes \<inter> set nodes' = {}"
 proof (rule ccontr)
   assume "set nodes \<inter> set nodes' \<noteq> {} "
   then obtain common_ptr where "common_ptr \<in> set nodes" and "common_ptr \<in> set nodes'"
     by auto
 
   have "h \<turnstile> find_slot False common_ptr \<rightarrow>\<^sub>r Some slot"
     using \<open>common_ptr \<in> set nodes\<close>
     using assms(1)
     by(auto simp add: assigned_nodes_def
         elim!: bind_returns_result_E2
         split: if_splits
         dest!: filter_M_holds_for_result[where x=common_ptr]
         intro!: bind_pure_I)
   moreover
   have "h \<turnstile> find_slot False common_ptr \<rightarrow>\<^sub>r Some slot'"
     using \<open>common_ptr \<in> set nodes'\<close>
     using assms(2)
     by(auto simp add: assigned_nodes_def
         elim!: bind_returns_result_E2
         split: if_splits
         dest!: filter_M_holds_for_result[where x=common_ptr]
         intro!: bind_pure_I)
   ultimately
   show False
     using assms(3)
     by (meson option.inject returns_result_eq)
 qed
 end
 
 interpretation i_assigned_nodes?: l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr assigned_nodes
   assigned_nodes_flatten flatten_dom get_child_nodes get_child_nodes_locs get_tag_name
   get_tag_name_locs get_root_node get_root_node_locs get_host get_host_locs find_slot
   assigned_slot remove insert_before insert_before_locs append_child remove_shadow_root
   remove_shadow_root_locs type_wf get_shadow_root get_shadow_root_locs set_shadow_root
   set_shadow_root_locs get_parent get_parent_locs to_tree_order
   by(auto simp add: instances l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       assigned_nodes_def flatten_dom_def)
 declare l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_assigned_nodes = l_assigned_nodes_defs +
   assumes assigned_nodes_pure [simp]: "pure (assigned_nodes slot) h"
   assumes assigned_nodes_ptr_in_heap:
     "h \<turnstile> ok (assigned_nodes slot) \<Longrightarrow> slot |\<in>| element_ptr_kinds h"
   assumes assigned_nodes_slot_is_slot:
     "h \<turnstile> ok (assigned_nodes slot) \<Longrightarrow> h \<turnstile> get_tag_name slot \<rightarrow>\<^sub>r ''slot''"
   assumes assigned_nodes_different_ptr:
     "h \<turnstile> assigned_nodes slot \<rightarrow>\<^sub>r nodes \<Longrightarrow> h \<turnstile> assigned_nodes slot' \<rightarrow>\<^sub>r nodes' \<Longrightarrow>
   slot \<noteq> slot' \<Longrightarrow> set nodes \<inter> set nodes' = {}"
 
 lemma assigned_nodes_is_l_assigned_nodes [instances]: "l_assigned_nodes assigned_nodes"
   apply(auto simp add: l_assigned_nodes_def)[1]
   using assigned_nodes_ptr_in_heap apply fast
   using assigned_nodes_slot_is_slot apply fast
   using assigned_nodes_different_ptr apply fast
   done
 
 subsubsection \<open>set\_val\<close>
 
 locale l_set_val\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   CD: l_set_val\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M set_val set_val_locs +
   l_type_wf type_wf
   for type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and set_val :: "(_) character_data_ptr \<Rightarrow> char list \<Rightarrow> (_, unit) dom_prog"
     and set_val_locs :: "(_) character_data_ptr \<Rightarrow> (_, unit) dom_prog set"  +
   assumes type_wf_impl: "type_wf = ShadowRootClass.type_wf"
 begin
 
 lemma set_val_ok:
   "type_wf h \<Longrightarrow> character_data_ptr |\<in>| character_data_ptr_kinds h \<Longrightarrow>
   h \<turnstile> ok (set_val character_data_ptr tag)"
   using CD.set_val_ok CD.type_wf_impl ShadowRootClass.type_wf\<^sub>D\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t local.type_wf_impl by blast
 
 lemma set_val_writes:
   "writes (set_val_locs character_data_ptr) (set_val character_data_ptr tag) h h'"
   using CD.set_val_writes .
 
 lemma set_val_pointers_preserved:
   assumes "w \<in> set_val_locs character_data_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "object_ptr_kinds h = object_ptr_kinds h'"
   using assms CD.set_val_pointers_preserved by simp
 
 lemma set_val_typess_preserved:
   assumes "w \<in> set_val_locs character_data_ptr"
   assumes "h \<turnstile> w \<rightarrow>\<^sub>h h'"
   shows "type_wf h = type_wf h'"
   apply(unfold type_wf_impl)
   using assms(1) type_wf_preserved[OF writes_singleton2 assms(2)]
   by(auto simp add: all_args_def CD.set_val_locs_impl[unfolded CD.a_set_val_locs_def]
       split: if_splits)
 end
 
 interpretation
   i_set_val?: l_set_val\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf set_val set_val_locs
   apply(unfold_locales)
   by (auto simp add: set_val_def set_val_locs_def)
 declare l_set_val\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_val_is_l_set_val [instances]: "l_set_val type_wf set_val set_val_locs"
   apply(simp add: l_set_val_def)
   using set_val_ok set_val_writes set_val_pointers_preserved set_val_typess_preserved
   by blast
 
 paragraph \<open>get\_shadow\_root\<close>
 
 locale l_set_val_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_val\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_val_get_shadow_root:
   "\<forall>w \<in> set_val_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
   by(auto simp add: CD.set_val_locs_impl[unfolded CD.a_set_val_locs_def]
       get_shadow_root_locs_def all_args_def)
 end
 
 locale l_set_val_get_shadow_root = l_set_val + l_get_shadow_root +
   assumes set_val_get_shadow_root:
     "\<forall>w \<in> set_val_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_shadow_root_locs ptr'. r h h'))"
 
 interpretation
   i_set_val_get_shadow_root?: l_set_val_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf
   set_val set_val_locs
   get_shadow_root get_shadow_root_locs
   apply(auto simp add: l_set_val_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def  instances)[1]
   using l_set_val\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms
   by unfold_locales
 declare l_set_val_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_val_get_shadow_root_is_l_set_val_get_shadow_root [instances]:
   "l_set_val_get_shadow_root type_wf set_val set_val_locs get_shadow_root
                                   get_shadow_root_locs"
   using set_val_is_l_set_val get_shadow_root_is_l_get_shadow_root
   apply(simp add: l_set_val_get_shadow_root_def l_set_val_get_shadow_root_axioms_def)
   using set_val_get_shadow_root
   by fast
 
 paragraph \<open>get\_tag\_type\<close>
 
 locale l_set_val_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_val\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma set_val_get_tag_name:
   "\<forall>w \<in> set_val_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_tag_name_locs ptr'. r h h'))"
   by(auto simp add: CD.set_val_locs_impl[unfolded CD.a_set_val_locs_def]
       CD.get_tag_name_locs_impl[unfolded CD.a_get_tag_name_locs_def]
       all_args_def)
 end
 
 locale l_set_val_get_tag_name = l_set_val + l_get_tag_name +
   assumes set_val_get_tag_name:
     "\<forall>w \<in> set_val_locs ptr. (h \<turnstile> w \<rightarrow>\<^sub>h h' \<longrightarrow> (\<forall>r \<in> get_tag_name_locs ptr'. r h h'))"
 
 interpretation
   i_set_val_get_tag_name?: l_set_val_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf DocumentClass.type_wf set_val
   set_val_locs get_tag_name get_tag_name_locs
   by unfold_locales
 declare l_set_val_get_tag_name\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_val_get_tag_name_is_l_set_val_get_tag_name [instances]:
   "l_set_val_get_tag_name type_wf set_val set_val_locs get_tag_name get_tag_name_locs"
   using set_val_is_l_set_val get_tag_name_is_l_get_tag_name
   apply(simp add: l_set_val_get_tag_name_def l_set_val_get_tag_name_axioms_def)
   using set_val_get_tag_name
   by fast
 
 subsubsection \<open>create\_character\_data\<close>
 
 
 locale l_create_character_data\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   CD: l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M _ _ _ _ _ _ type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M _ known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_known_ptr known_ptr
   for known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> bool" +
   assumes known_ptr_impl: "known_ptr = a_known_ptr"
 begin
 
 lemma create_character_data_document_in_heap:
   assumes "h \<turnstile> ok (create_character_data document_ptr text)"
   shows "document_ptr |\<in>| document_ptr_kinds h"
   using assms CD.create_character_data_document_in_heap by simp
 
 lemma create_character_data_known_ptr:
   assumes "h \<turnstile> create_character_data document_ptr text \<rightarrow>\<^sub>r new_character_data_ptr"
   shows "known_ptr (cast new_character_data_ptr)"
   using assms CD.create_character_data_known_ptr
   by(simp add: known_ptr_impl CD.known_ptr_impl ShadowRootClass.a_known_ptr_def)
 end
 
 locale l_create_character_data = l_create_character_data_defs
 
 interpretation i_create_character_data?: l_create_character_data\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes
   get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_val set_val_locs
   create_character_data known_ptr DocumentClass.type_wf DocumentClass.known_ptr
   by(auto simp add: l_create_character_data\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_create_character_data\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       instances)
 declare l_create_character_data\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 subsubsection \<open>create\_element\<close>
 
 locale l_create_element\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   CD: l_create_element\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
   set_disconnected_nodes_locs set_tag_name set_tag_name_locs type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M create_element
   known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_known_ptr known_ptr
   for get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and set_disconnected_nodes ::
     "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and set_tag_name :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and create_element ::
     "(_) document_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) object_ptr \<Rightarrow> bool" +
   assumes known_ptr_impl: "known_ptr = a_known_ptr"
 begin
 lemmas create_element_def = CD.create_element_def
 
 lemma create_element_document_in_heap:
   assumes "h \<turnstile> ok (create_element document_ptr tag)"
   shows "document_ptr |\<in>| document_ptr_kinds h"
   using CD.create_element_document_in_heap assms .
 
 lemma create_element_known_ptr:
   assumes "h \<turnstile> create_element document_ptr tag \<rightarrow>\<^sub>r new_element_ptr"
   shows "known_ptr (cast new_element_ptr)"
 proof -
   have "is_element_ptr new_element_ptr"
     using assms
     apply(auto simp add: create_element_def elim!: bind_returns_result_E)[1]
     using new_element_is_element_ptr
     by blast
   then show ?thesis
     by(auto simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
         CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs)
 qed
 end
 
 interpretation i_create_element?: l_create_element\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes
   get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs set_tag_name
   set_tag_name_locs type_wf create_element known_ptr DocumentClass.type_wf DocumentClass.known_ptr
   by(auto simp add: l_create_element\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_create_element\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def instances)
 declare l_create_element\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 
 
 subsection \<open>A wellformed heap (Core DOM)\<close>
 
 subsubsection \<open>wellformed\_heap\<close>
 
 
 locale l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs =
   CD: l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs +
   l_get_shadow_root_defs get_shadow_root get_shadow_root_locs +
   l_get_tag_name_defs get_tag_name get_tag_name_locs
   for get_child_nodes :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 definition a_host_shadow_root_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
   where
     "a_host_shadow_root_rel h = (\<lambda>(x, y). (cast x, cast y)) ` {(host, shadow_root).
       host |\<in>| element_ptr_kinds h \<and> |h \<turnstile> get_shadow_root host|\<^sub>r = Some shadow_root}"
 
 lemma a_host_shadow_root_rel_code [code]: "a_host_shadow_root_rel h = set (concat (map
   (\<lambda>host. (case |h \<turnstile> get_shadow_root host|\<^sub>r of
     Some shadow_root \<Rightarrow> [(cast host, cast shadow_root)] |
     None \<Rightarrow> []))
   (sorted_list_of_fset (element_ptr_kinds h)))
 )"
   by(auto simp add: a_host_shadow_root_rel_def)
 
 definition a_all_ptrs_in_heap :: "(_) heap \<Rightarrow> bool" where
   "a_all_ptrs_in_heap h = ((\<forall>host shadow_root_ptr.
     (h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some shadow_root_ptr) \<longrightarrow>
       shadow_root_ptr |\<in>| shadow_root_ptr_kinds h))"
 
 definition a_distinct_lists :: "(_) heap \<Rightarrow> bool"
   where
     "a_distinct_lists h = distinct (concat (
       map (\<lambda>element_ptr. (case |h \<turnstile> get_shadow_root element_ptr|\<^sub>r of
         Some shadow_root_ptr \<Rightarrow> [shadow_root_ptr] | None \<Rightarrow> []))
         |h \<turnstile> element_ptr_kinds_M|\<^sub>r
     ))"
 
 
 definition a_shadow_root_valid :: "(_) heap \<Rightarrow> bool" where
   "a_shadow_root_valid h = (\<forall>shadow_root_ptr \<in> fset (shadow_root_ptr_kinds h).
      (\<exists>host \<in> fset(element_ptr_kinds h).
        |h \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types \<and>
        |h \<turnstile> get_shadow_root host|\<^sub>r = Some shadow_root_ptr))"
 
 definition a_heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
   where
     "a_heap_is_wellformed h \<longleftrightarrow> CD.a_heap_is_wellformed h \<and>
       acyclic (CD.a_parent_child_rel h \<union> a_host_shadow_root_rel h) \<and>
       a_all_ptrs_in_heap h \<and>
       a_distinct_lists h \<and>
       a_shadow_root_valid h"
 end
 
 global_interpretation l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs get_child_nodes get_child_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs
   get_tag_name get_tag_name_locs
   defines heap_is_wellformed = a_heap_is_wellformed
     and parent_child_rel = CD.a_parent_child_rel
     and host_shadow_root_rel = a_host_shadow_root_rel
     and all_ptrs_in_heap = a_all_ptrs_in_heap
     and distinct_lists = a_distinct_lists
     and shadow_root_valid = a_shadow_root_valid
     and heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = CD.a_heap_is_wellformed
     and parent_child_rel\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = CD.a_parent_child_rel
     and acyclic_heap\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = CD.a_acyclic_heap
     and all_ptrs_in_heap\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = CD.a_all_ptrs_in_heap
     and distinct_lists\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = CD.a_distinct_lists
     and owner_document_valid\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M = CD.a_owner_document_valid
   .
 
 interpretation i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M: l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf
   get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel
   by (auto simp add: l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def parent_child_rel_def instances)
 declare i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_is_l_heap_is_wellformed [instances]:
   "l_heap_is_wellformed type_wf known_ptr heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel get_child_nodes
   get_disconnected_nodes"
   apply(auto simp add: l_heap_is_wellformed_def)[1]
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_is_wellformed_children_in_heap apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_is_wellformed_disc_nodes_in_heap apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_is_wellformed_one_parent apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_is_wellformed_one_disc_parent apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_is_wellformed_children_disc_nodes_different apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_is_wellformed_disconnected_nodes_distinct apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_is_wellformed_children_distinct apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_is_wellformed_children_disc_nodes apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_child apply (blast, blast)
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_finite apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_acyclic apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_node_ptr apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_parent_in_heap apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_child_in_heap apply blast
   done
 
 
 locale l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_defs
   get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
   get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs
   + CD: l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   known_ptr type_wf get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel
   + l_heap_is_wellformed_defs
   heap_is_wellformed parent_child_rel
   + l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_shadow_root get_shadow_root_locs get_host get_host_locs type_wf
   + l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs
   get_disconnected_document get_disconnected_document_locs type_wf
   + l_get_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root get_shadow_root_locs
   for get_child_nodes :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and known_ptr :: "(_) object_ptr \<Rightarrow> bool"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
     and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
     and heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_document :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
     and get_disconnected_document_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set" +
   assumes heap_is_wellformed_impl: "heap_is_wellformed = a_heap_is_wellformed"
 begin
 lemmas heap_is_wellformed_def =
   heap_is_wellformed_impl[unfolded a_heap_is_wellformed_def,
     folded CD.heap_is_wellformed_impl CD.parent_child_rel_impl]
 
 lemma a_distinct_lists_code [code]:
   "a_all_ptrs_in_heap h = ((\<forall>host \<in> fset (element_ptr_kinds h).
     h \<turnstile> ok (get_shadow_root host) \<longrightarrow> (case |h \<turnstile> get_shadow_root host|\<^sub>r of
     Some shadow_root_ptr \<Rightarrow> shadow_root_ptr |\<in>| shadow_root_ptr_kinds h |
     None \<Rightarrow> True)))"
   apply(auto simp add: a_all_ptrs_in_heap_def split: option.splits)[1]
   by (meson is_OK_returns_result_I local.get_shadow_root_ptr_in_heap notin_fset select_result_I2)
 
 lemma get_shadow_root_shadow_root_ptr_in_heap:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some shadow_root_ptr"
   shows "shadow_root_ptr |\<in>| shadow_root_ptr_kinds h"
   using assms
   by(auto simp add: heap_is_wellformed_def a_all_ptrs_in_heap_def)
 
 lemma get_host_ptr_in_heap:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_host shadow_root_ptr \<rightarrow>\<^sub>r host"
   shows "shadow_root_ptr |\<in>| shadow_root_ptr_kinds h"
   using assms get_shadow_root_shadow_root_ptr_in_heap
   by(auto simp add: get_host_def
       elim!: bind_returns_result_E2
       dest!: filter_M_holds_for_result
       intro!: bind_pure_I
       split: list.splits)
 
 lemma shadow_root_same_host:
   assumes "heap_is_wellformed h" and "type_wf h"
   assumes "h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some shadow_root_ptr"
   assumes "h \<turnstile> get_shadow_root host' \<rightarrow>\<^sub>r Some shadow_root_ptr"
   shows "host = host'"
 proof (rule ccontr)
   assume " host \<noteq> host'"
   have "host |\<in>| element_ptr_kinds h"
     using assms(3)
     by (meson is_OK_returns_result_I local.get_shadow_root_ptr_in_heap)
   moreover
   have "host' |\<in>| element_ptr_kinds h"
     using assms(4)
     by (meson is_OK_returns_result_I local.get_shadow_root_ptr_in_heap)
   ultimately show False
     using assms
     apply(auto simp add: heap_is_wellformed_def a_distinct_lists_def)[1]
     apply(drule distinct_concat_map_E(1)[where x=host and y=host'])
        apply(simp)
       apply(simp)
     using \<open>host \<noteq> host'\<close> apply(simp)
     apply(auto)[1]
     done
 qed
 
 lemma shadow_root_host_dual:
   assumes "h \<turnstile> get_host shadow_root_ptr \<rightarrow>\<^sub>r host"
   shows "h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some shadow_root_ptr"
   using assms
   by(auto simp add: get_host_def
       dest: filter_M_holds_for_result
       elim!: bind_returns_result_E2
       intro!: bind_pure_I split: list.splits)
 
 lemma disc_doc_disc_node_dual:
   assumes "h \<turnstile> get_disconnected_document disc_node \<rightarrow>\<^sub>r disc_doc"
   obtains disc_nodes where
     "h \<turnstile> get_disconnected_nodes disc_doc \<rightarrow>\<^sub>r disc_nodes" and
     "disc_node \<in> set disc_nodes"
   using assms get_disconnected_nodes_pure
   by(auto simp add: get_disconnected_document_def bind_pure_I
       dest!: filter_M_holds_for_result
       elim!: bind_returns_result_E2
       intro!: filter_M_pure_I
       split: if_splits list.splits)
 
 lemma get_host_valid_tag_name:
   assumes "heap_is_wellformed h" and "type_wf h"
   assumes "h \<turnstile> get_host shadow_root_ptr \<rightarrow>\<^sub>r host"
   assumes "h \<turnstile> get_tag_name host \<rightarrow>\<^sub>r tag"
   shows "tag \<in> safe_shadow_root_element_types"
 proof -
   obtain host' where
     "host' |\<in>| element_ptr_kinds h" and
     "|h \<turnstile> get_tag_name host'|\<^sub>r \<in> safe_shadow_root_element_types"
     and "h \<turnstile> get_shadow_root host' \<rightarrow>\<^sub>r Some shadow_root_ptr"
     using assms
     apply(auto simp add: heap_is_wellformed_def a_shadow_root_valid_def)[1]
     by (smt assms(1) finite_set_in get_host_ptr_in_heap local.get_shadow_root_ok
         returns_result_select_result)
   then have "host = host'"
     by (meson assms(1) assms(2) assms(3) shadow_root_host_dual shadow_root_same_host)
   then show ?thesis
     by (smt\<open>\<And>thesis. (\<And>host'. \<lbrakk>host' |\<in>| element_ptr_kinds h;
       |h \<turnstile> get_tag_name host'|\<^sub>r \<in> safe_shadow_root_element_types;
       h \<turnstile> get_shadow_root host' \<rightarrow>\<^sub>r Some shadow_root_ptr\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
         \<open>h \<turnstile> get_shadow_root host' \<rightarrow>\<^sub>r Some shadow_root_ptr\<close> assms(1) assms(2) assms(4) select_result_I2
         shadow_root_same_host)
 qed
 
 
 lemma a_host_shadow_root_rel_finite: "finite (a_host_shadow_root_rel h)"
 proof -
   have "a_host_shadow_root_rel h = (\<Union>host \<in> fset (element_ptr_kinds h).
     (case |h \<turnstile> get_shadow_root host|\<^sub>r of
       Some shadow_root \<Rightarrow> {(cast host, cast shadow_root)} | None \<Rightarrow> {}))"
     by(auto simp add: a_host_shadow_root_rel_def split: option.splits)
   moreover have "finite (\<Union>host \<in> fset (element_ptr_kinds h).
     (case |h \<turnstile> get_shadow_root host|\<^sub>r of
       Some shadow_root \<Rightarrow> {(cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r host, cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root)} |
       None \<Rightarrow> {}))"
     by(auto split: option.splits)
   ultimately show ?thesis
     by auto
 qed
 
 lemma heap_is_wellformed_children_in_heap:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> child \<in> set children \<Longrightarrow>
   child |\<in>| node_ptr_kinds h"
   using CD.heap_is_wellformed_children_in_heap local.heap_is_wellformed_def by blast
 lemma heap_is_wellformed_disc_nodes_in_heap:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow>
   node \<in> set disc_nodes \<Longrightarrow> node |\<in>| node_ptr_kinds h"
   using CD.heap_is_wellformed_disc_nodes_in_heap local.heap_is_wellformed_def by blast
 lemma heap_is_wellformed_one_parent:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow>
   h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children' \<Longrightarrow> set children \<inter> set children' \<noteq> {} \<Longrightarrow> ptr = ptr'"
   using CD.heap_is_wellformed_one_parent local.heap_is_wellformed_def by blast
 lemma heap_is_wellformed_one_disc_parent:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow>
   h \<turnstile> get_disconnected_nodes document_ptr' \<rightarrow>\<^sub>r disc_nodes' \<Longrightarrow> set disc_nodes \<inter> set disc_nodes' \<noteq> {}
   \<Longrightarrow> document_ptr = document_ptr'"
   using CD.heap_is_wellformed_one_disc_parent local.heap_is_wellformed_def by blast
 lemma heap_is_wellformed_children_disc_nodes_different:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow>
   h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow> set children \<inter> set disc_nodes = {}"
   using CD.heap_is_wellformed_children_disc_nodes_different local.heap_is_wellformed_def by blast
 lemma heap_is_wellformed_disconnected_nodes_distinct:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes \<Longrightarrow>
   distinct disc_nodes"
   using CD.heap_is_wellformed_disconnected_nodes_distinct local.heap_is_wellformed_def by blast
 lemma heap_is_wellformed_children_distinct:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> distinct children"
   using CD.heap_is_wellformed_children_distinct local.heap_is_wellformed_def by blast
 lemma heap_is_wellformed_children_disc_nodes:
   "heap_is_wellformed h \<Longrightarrow> node_ptr |\<in>| node_ptr_kinds h \<Longrightarrow>
   \<not>(\<exists>parent \<in> fset (object_ptr_kinds h). node_ptr \<in> set |h \<turnstile> get_child_nodes parent|\<^sub>r) \<Longrightarrow>
   (\<exists>document_ptr \<in> fset (document_ptr_kinds h).
     node_ptr \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)"
   using CD.heap_is_wellformed_children_disc_nodes local.heap_is_wellformed_def by blast
 lemma parent_child_rel_finite: "heap_is_wellformed h \<Longrightarrow> finite (parent_child_rel h)"
   using CD.parent_child_rel_finite by blast
 lemma parent_child_rel_acyclic: "heap_is_wellformed h \<Longrightarrow> acyclic (parent_child_rel h)"
   using CD.parent_child_rel_acyclic heap_is_wellformed_def by blast
 lemma parent_child_rel_child_in_heap:
   "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptr parent \<Longrightarrow>
   (parent, child_ptr) \<in> parent_child_rel h \<Longrightarrow> child_ptr |\<in>| object_ptr_kinds h"
   using CD.parent_child_rel_child_in_heap local.heap_is_wellformed_def by blast
 end
 
 interpretation i_heap_is_wellformed?: l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes
   get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root
   get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf heap_is_wellformed
   parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs
   by(auto simp add: l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def parent_child_rel_def heap_is_wellformed_def
       instances)
 declare l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma heap_is_wellformed_is_l_heap_is_wellformed [instances]:
   "l_heap_is_wellformed ShadowRootClass.type_wf ShadowRootClass.known_ptr
     Shadow_DOM.heap_is_wellformed Shadow_DOM.parent_child_rel Shadow_DOM.get_child_nodes
     get_disconnected_nodes"
   apply(auto simp add: l_heap_is_wellformed_def instances)[1]
   using heap_is_wellformed_children_in_heap apply metis
   using heap_is_wellformed_disc_nodes_in_heap apply metis
   using heap_is_wellformed_one_parent apply blast
   using heap_is_wellformed_one_disc_parent apply blast
   using heap_is_wellformed_children_disc_nodes_different apply blast
   using heap_is_wellformed_disconnected_nodes_distinct apply metis
   using heap_is_wellformed_children_distinct apply metis
   using heap_is_wellformed_children_disc_nodes apply metis
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_child apply(blast, blast)
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_finite apply blast
   using parent_child_rel_acyclic apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_node_ptr apply blast
   using i_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_parent_in_heap apply blast
   using parent_child_rel_child_in_heap apply metis
   done
 
 
 subsubsection \<open>get\_parent\<close>
 
 interpretation i_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes
   get_child_nodes_locs known_ptrs get_parent get_parent_locs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   parent_child_rel get_disconnected_nodes
   by(simp add: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare i_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 interpretation i_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes
   get_child_nodes_locs known_ptrs get_parent get_parent_locs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs
   by(auto simp add: l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare i_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.l_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_is_l_get_parent_wf [instances]: "l_get_parent_wf type_wf known_ptr
   known_ptrs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel get_child_nodes get_parent"
   apply(auto simp add: l_get_parent_wf_def l_get_parent_wf_axioms_def instances)[1]
   using i_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.child_parent_dual apply fast
   using i_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_wellformed_induct apply metis
   using i_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.heap_wellformed_induct_rev apply metis
   using i_get_parent_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_parent apply fast
   done
 
 
 subsubsection \<open>get\_disconnected\_nodes\<close>
 
 
 subsubsection \<open>set\_disconnected\_nodes\<close>
 
 
 paragraph \<open>get\_disconnected\_nodes\<close>
 
 interpretation i_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M:
   l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf
   get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
   set_disconnected_nodes_locs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel get_child_nodes
   by (simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare i_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.l_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_is_l_set_disconnected_nodes_get_disconnected_nodes_wf [instances]:
   "l_set_disconnected_nodes_get_disconnected_nodes_wf type_wf known_ptr heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
     parent_child_rel get_child_nodes get_disconnected_nodes get_disconnected_nodes_locs
     set_disconnected_nodes set_disconnected_nodes_locs"
   apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf_def
       l_set_disconnected_nodes_get_disconnected_nodes_wf_axioms_def instances)[1]
   using i_set_disconnected_nodes_get_disconnected_nodes_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.remove_from_disconnected_nodes_removes
   apply fast
   done
 
 
 paragraph \<open>get\_root\_node\<close>
 
 interpretation i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M:l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf known_ptrs
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs
   get_root_node get_root_node_locs
   by(simp add: l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma get_ancestors_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_is_l_get_ancestors_wf [instances]:
   "l_get_ancestors_wf heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel known_ptr known_ptrs type_wf
   get_ancestors get_ancestors_locs get_child_nodes get_parent"
   apply(auto simp add: l_get_ancestors_wf_def l_get_ancestors_wf_axioms_def instances)[1]
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_never_empty apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_ok apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_reads apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_ptrs_in_heap apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_remains_not_in_ancestors apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_also_parent apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_obtains_children apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_parent_child_rel apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_parent_child_rel apply blast
   done
 
 lemma get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_is_l_get_root_node_wf [instances]:
   "l_get_root_node_wf heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_root_node type_wf known_ptr known_ptrs
     get_ancestors get_parent"
   apply(auto simp add: l_get_root_node_wf_def l_get_root_node_wf_axioms_def instances)[1]
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_root_node_ok apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_root_node_ptr_in_heap apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_root_node_root_in_heap apply blast
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_ancestors_same_root_node apply(blast, blast)
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_root_node_same_no_parent apply blast
     (* using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_root_node_not_node_same apply blast *)
   using i_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.get_root_node_parent_same apply (blast, blast)
   done
 
 
 subsubsection \<open>to\_tree\_order\<close>
 
 interpretation i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes
   get_child_nodes_locs to_tree_order known_ptrs get_parent get_parent_locs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs
   apply(simp add: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
   done
 declare i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_is_l_to_tree_order_wf [instances]:
   "l_to_tree_order_wf heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel type_wf known_ptr known_ptrs
   to_tree_order get_parent get_child_nodes"
   apply(auto simp add: l_to_tree_order_wf_def l_to_tree_order_wf_axioms_def instances)[1]
   using i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_ok apply blast
   using i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_ptrs_in_heap apply blast
   using i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_parent_child_rel apply(blast, blast)
   using i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_child2 apply blast
   using i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_node_ptrs apply blast
   using i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_child apply blast
   using i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_ptr_in_result apply blast
   using i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_parent apply blast
   using i_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_subset apply blast
   done
 
 paragraph \<open>get\_root\_node\<close>
 
 interpretation i_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   known_ptr type_wf known_ptrs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel get_child_nodes
   get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_parent get_parent_locs
   get_ancestors get_ancestors_locs get_root_node get_root_node_locs to_tree_order
   by(auto simp add: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare i_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_is_l_to_tree_order_wf_get_root_node_wf [instances]:
   "l_to_tree_order_wf_get_root_node_wf type_wf known_ptr known_ptrs to_tree_order get_root_node
     heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M"
   apply(auto simp add: l_to_tree_order_wf_get_root_node_wf_def
       l_to_tree_order_wf_get_root_node_wf_axioms_def instances)[1]
   using i_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_get_root_node apply blast
   using i_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.to_tree_order_same_root apply blast
   done
 
 subsubsection \<open>remove\_child\<close>
 
 interpretation i_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M: l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs
   set_child_nodes set_child_nodes_locs get_parent
   get_parent_locs get_owner_document get_disconnected_nodes get_disconnected_nodes_locs
   set_disconnected_nodes set_disconnected_nodes_locs remove_child remove_child_locs remove type_wf
   known_ptr known_ptrs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M parent_child_rel
   by unfold_locales
 declare i_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_is_l_remove_child_wf2 [instances]: "l_remove_child_wf2 type_wf known_ptr
   known_ptrs remove_child heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes remove"
   apply(auto simp add: l_remove_child_wf2_def l_remove_child_wf2_axioms_def instances)[1]
   using i_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.remove_child_heap_is_wellformed_preserved apply(fast, fast, fast)
   using i_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.remove_heap_is_wellformed_preserved apply(fast, fast, fast)
   using i_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.remove_child_removes_child apply fast
   using i_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.remove_child_removes_first_child apply fast
   using i_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.remove_removes_child apply fast
   using i_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.remove_for_all_empty_children apply fast
   done
 
 
 subsection \<open>A wellformed heap\<close>
 
 subsubsection \<open>get\_parent\<close>
 
 interpretation i_get_parent_wf?: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes
   get_child_nodes_locs known_ptrs get_parent get_parent_locs heap_is_wellformed parent_child_rel
   get_disconnected_nodes
   using instances
   by(simp add: l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma get_parent_wf_is_l_get_parent_wf [instances]:
   "l_get_parent_wf ShadowRootClass.type_wf ShadowRootClass.known_ptr ShadowRootClass.known_ptrs
   heap_is_wellformed parent_child_rel Shadow_DOM.get_child_nodes Shadow_DOM.get_parent"
   apply(auto simp add: l_get_parent_wf_def l_get_parent_wf_axioms_def instances)[1]
   using child_parent_dual apply blast
   using heap_wellformed_induct apply metis
   using heap_wellformed_induct_rev apply metis
   using parent_child_rel_parent apply metis
   done
 
 
 
 subsubsection \<open>remove\_shadow\_root\<close>
 
 locale l_remove_shadow_root_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_tag_name +
   l_get_disconnected_nodes  +
   l_set_shadow_root_get_tag_name +
   l_get_child_nodes  +
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_remove_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_delete_shadow_root_get_disconnected_nodes +
   l_delete_shadow_root_get_child_nodes +
   l_set_shadow_root_get_disconnected_nodes +
   l_set_shadow_root_get_child_nodes +
   l_delete_shadow_root_get_tag_name +
   l_set_shadow_root_get_shadow_root +
   l_delete_shadow_root_get_shadow_root +
   l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma remove_shadow_root_preserves:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> remove_shadow_root ptr \<rightarrow>\<^sub>h h'"
   shows "known_ptrs h'" and "type_wf h'" "heap_is_wellformed h'"
 proof -
   obtain shadow_root_ptr h2 where
     "h \<turnstile> get_shadow_root ptr \<rightarrow>\<^sub>r Some shadow_root_ptr" and
     "h \<turnstile> get_child_nodes (cast shadow_root_ptr) \<rightarrow>\<^sub>r []" and
     h2: "h \<turnstile> set_shadow_root ptr None \<rightarrow>\<^sub>h h2" and
     h': "h2 \<turnstile> delete_M shadow_root_ptr \<rightarrow>\<^sub>h h'"
     using assms(4)
     by(auto simp add: remove_shadow_root_def
         elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_shadow_root_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated]
         split: option.splits if_splits)
 
   have "type_wf h2"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF set_shadow_root_writes h2]
     using \<open>type_wf h\<close> set_shadow_root_types_preserved
     by(auto simp add: reflp_def transp_def)
   then show "type_wf h'"
     using h' delete_shadow_root_type_wf_preserved local.type_wf_impl
     by blast
 
   have object_ptr_kinds_eq_h: "object_ptr_kinds h = object_ptr_kinds h2"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF set_shadow_root_writes h2])
     using set_shadow_root_pointers_preserved
       apply blast
     by (auto simp add: reflp_def transp_def)
   have node_ptr_kinds_eq_h: "node_ptr_kinds h = node_ptr_kinds h2"
     using object_ptr_kinds_eq_h
     by (simp add: node_ptr_kinds_def)
   have element_ptr_kinds_eq_h: "element_ptr_kinds h = element_ptr_kinds h2"
     using node_ptr_kinds_eq_h
     by (simp add: element_ptr_kinds_def)
   have document_ptr_kinds_eq_h: "document_ptr_kinds h = document_ptr_kinds h2"
     using object_ptr_kinds_eq_h
     by (simp add: document_ptr_kinds_def)
   have shadow_root_ptr_kinds_eq_h: "shadow_root_ptr_kinds h = shadow_root_ptr_kinds h2"
     using object_ptr_kinds_eq_h
     by (simp add: shadow_root_ptr_kinds_def)
 
   have "known_ptrs h2"
     using \<open>known_ptrs h\<close> object_ptr_kinds_eq_h known_ptrs_subset
     by blast
 
   have object_ptr_kinds_eq_h2: "object_ptr_kinds h' |\<subseteq>| object_ptr_kinds h2"
     using h' delete_shadow_root_pointers
     by auto
   have object_ptr_kinds_eq2_h2:
     "object_ptr_kinds h2 = object_ptr_kinds h' |\<union>| {|cast shadow_root_ptr|}"
     using h' delete_shadow_root_pointers
     by auto
   have node_ptr_kinds_eq_h2: "node_ptr_kinds h2 = node_ptr_kinds h'"
     using object_ptr_kinds_eq_h2
     by(auto simp add: node_ptr_kinds_def delete_shadow_root_pointers[OF h'])
   have element_ptr_kinds_eq_h2: "element_ptr_kinds h2 = element_ptr_kinds h'"
     using node_ptr_kinds_eq_h2
     by (simp add: element_ptr_kinds_def)
   have document_ptr_kinds_eq_h2: "document_ptr_kinds h2 = document_ptr_kinds h'"
     using object_ptr_kinds_eq_h2
     by(auto simp add: document_ptr_kinds_def delete_shadow_root_pointers[OF h'])
   have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h' |\<subseteq>| shadow_root_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     by (auto simp add: shadow_root_ptr_kinds_def)
   have shadow_root_ptr_kinds_eq2_h2:
     "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h' |\<union>| {|shadow_root_ptr|}"
     using object_ptr_kinds_eq2_h2
     apply (auto simp add: shadow_root_ptr_kinds_def)[1]
     by (metis \<open>h \<turnstile> get_shadow_root ptr \<rightarrow>\<^sub>r Some shadow_root_ptr\<close> assms(1)
         fset.map_comp local.get_shadow_root_shadow_root_ptr_in_heap object_ptr_kinds_eq_h
         shadow_root_ptr_kinds_def)
 
   show "known_ptrs h'"
     using object_ptr_kinds_eq_h2 \<open>known_ptrs h2\<close> known_ptrs_subset
     by blast
 
 
   have disconnected_nodes_eq_h:
     "\<And>doc_ptr disc_nodes. h \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes =
       h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using get_disconnected_nodes_reads set_shadow_root_writes h2 set_shadow_root_get_disconnected_nodes
     by(rule reads_writes_preserved)
   then have disconnected_nodes_eq2_h:
     "\<And>doc_ptr. |h \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
 
   have disconnected_nodes_eq_h2:
     "\<And>doc_ptr disc_nodes. h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes =
       h' \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using get_disconnected_nodes_reads get_disconnected_nodes_delete_shadow_root[OF h']
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have disconnected_nodes_eq2_h2:
     "\<And>doc_ptr. |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
 
   have tag_name_eq_h:
     "\<And>doc_ptr disc_nodes. h \<turnstile> get_tag_name doc_ptr \<rightarrow>\<^sub>r disc_nodes =
       h2 \<turnstile> get_tag_name doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads set_shadow_root_writes h2 set_shadow_root_get_tag_name
     by(rule reads_writes_preserved)
   then have tag_name_eq2_h: "\<And>doc_ptr. |h \<turnstile> get_tag_name doc_ptr|\<^sub>r = |h2 \<turnstile> get_tag_name doc_ptr|\<^sub>r"
     using select_result_eq by force
 
   have tag_name_eq_h2:
     "\<And>doc_ptr disc_nodes. h2 \<turnstile> get_tag_name doc_ptr \<rightarrow>\<^sub>r disc_nodes =
       h' \<turnstile> get_tag_name doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads get_tag_name_delete_shadow_root[OF h']
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have tag_name_eq2_h2: "\<And>doc_ptr. |h2 \<turnstile> get_tag_name doc_ptr|\<^sub>r = |h' \<turnstile> get_tag_name doc_ptr|\<^sub>r"
     using select_result_eq by force
 
 
   have children_eq_h:
     "\<And>ptr' children. h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using get_child_nodes_reads set_shadow_root_writes h2 set_shadow_root_get_child_nodes
     by(rule reads_writes_preserved)
 
   then have children_eq2_h: "\<And>ptr'. |h \<turnstile> get_child_nodes ptr'|\<^sub>r = |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
 
 
   have children_eq_h2:
     "\<And>ptr' children. ptr' \<noteq> cast shadow_root_ptr \<Longrightarrow> h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children =
       h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using get_child_nodes_reads h' get_child_nodes_delete_shadow_root
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have children_eq2_h2:
     "\<And>ptr'. ptr' \<noteq> cast shadow_root_ptr \<Longrightarrow> |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r =
     |h' \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
 
   have "cast shadow_root_ptr |\<notin>| object_ptr_kinds h'"
     using h' delete\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_ptr_not_in_heap
     by auto
 
   have get_shadow_root_eq_h:
     "\<And>shadow_root_opt ptr'. ptr \<noteq> ptr' \<Longrightarrow> h \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_opt =
     h2 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_opt"
     using get_shadow_root_reads set_shadow_root_writes h2
     apply(rule reads_writes_preserved)
     using set_shadow_root_get_shadow_root_different_pointers
     by fast
 
   have get_shadow_root_eq_h2:
     "\<And>shadow_root_opt ptr'. h2 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_opt =
     h' \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_opt"
     using get_shadow_root_reads get_shadow_root_delete_shadow_root[OF h']
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then
   have get_shadow_root_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_shadow_root ptr'|\<^sub>r =
     |h' \<turnstile> get_shadow_root ptr'|\<^sub>r"
     using select_result_eq by force
 
 
 
   have "acyclic (parent_child_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
   moreover
   have "parent_child_rel h = parent_child_rel h2"
     by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h children_eq2_h)
   moreover
   have "parent_child_rel h' \<subseteq> parent_child_rel h2"
     using object_ptr_kinds_eq_h2
     apply(auto simp add: CD.parent_child_rel_def)[1]
     by (metis \<open>cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr |\<notin>| object_ptr_kinds h'\<close> children_eq2_h2)
   ultimately
   have "CD.a_acyclic_heap h'"
     using acyclic_subset
     by (auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
 
   moreover
   have "CD.a_all_ptrs_in_heap h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_all_ptrs_in_heap h2"
     by(auto simp add: children_eq2_h disconnected_nodes_eq2_h document_ptr_kinds_eq_h
         CD.a_all_ptrs_in_heap_def object_ptr_kinds_eq_h node_ptr_kinds_def
         children_eq_h disconnected_nodes_eq_h)
   then have "CD.a_all_ptrs_in_heap h'"
     apply(auto simp add: CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 children_eq_h2
         disconnected_nodes_eq_h2)[1]
      apply(case_tac "ptr = cast shadow_root_ptr")
     using object_ptr_kinds_eq_h2 children_eq_h2
       apply (meson \<open>cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr |\<notin>| object_ptr_kinds h'\<close>
         is_OK_returns_result_I local.get_child_nodes_ptr_in_heap)
      apply (metis (no_types, lifting) children_eq2_h2 fin_mono finite_set_in object_ptr_kinds_eq_h2
         subsetD)
     by (metis (full_types) assms(1) assms(2) disconnected_nodes_eq2_h disconnected_nodes_eq2_h2
         document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 local.get_disconnected_nodes_ok
         local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq_h node_ptr_kinds_eq_h2
         returns_result_select_result)
 
   moreover
   have "CD.a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_distinct_lists h2"
     by(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h
         children_eq2_h disconnected_nodes_eq2_h)
   then have "CD.a_distinct_lists h'"
     apply(auto simp add: CD.a_distinct_lists_def document_ptr_kinds_eq_h2
         disconnected_nodes_eq2_h2)[1]
      apply(auto simp add:  intro!: distinct_concat_map_I)[1]
       apply(case_tac "x = cast shadow_root_ptr")
     using \<open>cast shadow_root_ptr |\<notin>| object_ptr_kinds h'\<close> apply simp
     using children_eq_h2 concat_map_all_distinct[of "(\<lambda>ptr. |h2 \<turnstile> get_child_nodes ptr|\<^sub>r)"]
       apply (metis (no_types, lifting) children_eq2_h2 finite_fset fmember.rep_eq fset_mp
         object_ptr_kinds_eq_h2 set_sorted_list_of_set)
      apply(case_tac "x = cast shadow_root_ptr")
     using \<open>cast shadow_root_ptr |\<notin>| object_ptr_kinds h'\<close> apply simp
      apply(case_tac "y = cast shadow_root_ptr")
     using \<open>cast shadow_root_ptr |\<notin>| object_ptr_kinds h'\<close> apply simp
     using children_eq_h2 distinct_concat_map_E(1)[of "(\<lambda>ptr. |h2 \<turnstile> get_child_nodes ptr|\<^sub>r)"]
      apply (smt IntI children_eq2_h2 empty_iff finite_fset fmember.rep_eq fset_mp
         object_ptr_kinds_eq_h2 set_sorted_list_of_set)
     apply(case_tac "xa = cast shadow_root_ptr")
     using \<open>cast shadow_root_ptr |\<notin>| object_ptr_kinds h'\<close> apply simp
     by (smt \<open>local.CD.a_distinct_lists h2\<close> \<open>type_wf h'\<close> children_eq2_h2 disconnected_nodes_eq_h2
         fset_mp is_OK_returns_result_E local.CD.distinct_lists_no_parent
         local.get_disconnected_nodes_ok object_ptr_kinds_eq_h2 select_result_I2)
 
   moreover
   have "CD.a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_owner_document_valid h2"
     by(auto simp add: CD.a_owner_document_valid_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h
         node_ptr_kinds_eq_h children_eq2_h disconnected_nodes_eq2_h)
   then have "CD.a_owner_document_valid h'"
     apply(auto simp add: CD.a_owner_document_valid_def  document_ptr_kinds_eq_h2 node_ptr_kinds_eq_h2
         disconnected_nodes_eq2_h2)[1]
   proof -
     fix node_ptr
     assume 0: "\<forall>node_ptr\<in>fset (node_ptr_kinds h').
       (\<exists>document_ptr. document_ptr |\<in>| document_ptr_kinds h' \<and>
       node_ptr \<in> set |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r) \<or>
       (\<exists>parent_ptr. parent_ptr |\<in>| object_ptr_kinds h2 \<and>
       node_ptr \<in> set |h2 \<turnstile> get_child_nodes parent_ptr|\<^sub>r)"
       and 1: "node_ptr |\<in>| node_ptr_kinds h'"
       and 2: "\<forall>parent_ptr. parent_ptr |\<in>| object_ptr_kinds h' \<longrightarrow>
         node_ptr \<notin> set |h' \<turnstile> get_child_nodes parent_ptr|\<^sub>r"
     then have "\<forall>parent_ptr. parent_ptr |\<in>| object_ptr_kinds h2 \<longrightarrow>
       node_ptr \<notin> set |h2 \<turnstile> get_child_nodes parent_ptr|\<^sub>r"
       apply(auto)[1]
       apply(case_tac "parent_ptr = cast shadow_root_ptr")
       using \<open>h \<turnstile> get_child_nodes (cast shadow_root_ptr) \<rightarrow>\<^sub>r []\<close> children_eq_h
        apply auto[1]
       using children_eq2_h2 object_ptr_kinds_eq_h2 h' delete_shadow_root_pointers
       by (metis fempty_iff finsert_iff funionE)
     then show "\<exists>document_ptr. document_ptr |\<in>| document_ptr_kinds h' \<and>
       node_ptr \<in> set |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
       using 0 1
       by auto
   qed
 
   ultimately have "heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M h'"
     by(simp add: CD.heap_is_wellformed_def)
 
   moreover
   have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by(simp add: heap_is_wellformed_def)
   then
   have "acyclic (parent_child_rel h2 \<union> a_host_shadow_root_rel h2)"
   proof -
     have "a_host_shadow_root_rel h2 \<subseteq> a_host_shadow_root_rel h"
       apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h)[1]
       apply(case_tac "aa = ptr")
        apply(simp)
        apply (metis (no_types, lifting) \<open>type_wf h2\<close> assms(2) h2 local.get_shadow_root_ok
           local.type_wf_impl option.distinct(1) returns_result_eq
           returns_result_select_result set_shadow_root_get_shadow_root)
       using get_shadow_root_eq_h
       by (metis (mono_tags, lifting) \<open>type_wf h2\<close> image_eqI is_OK_returns_result_E
           local.get_shadow_root_ok mem_Collect_eq prod.simps(2) select_result_I2)
     then show ?thesis
       using \<open>parent_child_rel h = parent_child_rel h2\<close>
       by (metis (no_types, hide_lams) \<open>acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h)\<close>
           acyclic_subset order_refl sup_mono)
   qed
   then
   have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h')"
   proof -
     have "a_host_shadow_root_rel h' \<subseteq> a_host_shadow_root_rel h2"
       by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2 get_shadow_root_eq2_h2)
     then show ?thesis
       using \<open>parent_child_rel h' \<subseteq> parent_child_rel h2\<close>
         \<open>acyclic (parent_child_rel h2 \<union> a_host_shadow_root_rel h2)\<close>
       using acyclic_subset sup_mono
       by (metis (no_types, hide_lams))
   qed
 
   moreover
   have "a_all_ptrs_in_heap h"
     using \<open>heap_is_wellformed h\<close>
     by(simp add: heap_is_wellformed_def)
   then
   have "a_all_ptrs_in_heap h2"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h)[1]
     apply(case_tac "host = ptr")
      apply(simp)
      apply (metis assms(2) h2 local.type_wf_impl option.distinct(1) returns_result_eq
         set_shadow_root_get_shadow_root)
     using get_shadow_root_eq_h
     by fastforce
   then
   have "a_all_ptrs_in_heap h'"
     apply(auto simp add: a_all_ptrs_in_heap_def get_shadow_root_eq_h2)[1]
     apply(auto simp add: shadow_root_ptr_kinds_eq2_h2)[1]
     by (metis (no_types, lifting) \<open>h \<turnstile> get_shadow_root ptr \<rightarrow>\<^sub>r Some shadow_root_ptr\<close> assms(1)
         assms(2) get_shadow_root_eq_h get_shadow_root_eq_h2 h2 local.shadow_root_same_host
         local.type_wf_impl option.distinct(1) select_result_I2 set_shadow_root_get_shadow_root)
 
   moreover
   have "a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by(simp add: heap_is_wellformed_def)
   then
   have "a_distinct_lists h2"
     apply(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h)[1]
     apply(auto intro!: distinct_concat_map_I split: option.splits)[1]
     apply(case_tac "x = ptr")
      apply(simp)
      apply (metis (no_types, hide_lams) assms(2) h2 is_OK_returns_result_I
         l_set_shadow_root_get_shadow_root.set_shadow_root_get_shadow_root
         l_set_shadow_root_get_shadow_root_axioms local.type_wf_impl option.discI
         returns_result_eq returns_result_select_result)
 
     apply(case_tac "y = ptr")
      apply(simp)
      apply (metis (no_types, hide_lams) assms(2) h2 is_OK_returns_result_I
         l_set_shadow_root_get_shadow_root.set_shadow_root_get_shadow_root
         l_set_shadow_root_get_shadow_root_axioms local.type_wf_impl option.discI
         returns_result_eq returns_result_select_result)
     by (metis \<open>type_wf h2\<close> assms(1) assms(2) get_shadow_root_eq_h local.get_shadow_root_ok
         local.shadow_root_same_host returns_result_select_result)
 
   then
   have "a_distinct_lists h'"
     by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h2 get_shadow_root_eq2_h2)
 
   moreover
   have "a_shadow_root_valid h"
     using \<open>heap_is_wellformed h\<close>
     by(simp add: heap_is_wellformed_def)
   then
   have "a_shadow_root_valid h'"
     apply(auto simp add: a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h element_ptr_kinds_eq_h
         tag_name_eq2_h)[1]
     apply(simp add: shadow_root_ptr_kinds_eq2_h2 element_ptr_kinds_eq_h2 tag_name_eq2_h2)
     using get_shadow_root_eq_h get_shadow_root_eq_h2
     by (smt \<open>cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root_ptr |\<notin>| object_ptr_kinds h'\<close>
         \<open>h \<turnstile> get_shadow_root ptr \<rightarrow>\<^sub>r Some shadow_root_ptr\<close> assms(2) element_ptr_kinds_eq_h
         element_ptr_kinds_eq_h2 finite_set_in local.get_shadow_root_ok option.inject
         returns_result_select_result select_result_I2 shadow_root_ptr_kinds_commutes)
 
   ultimately show "heap_is_wellformed h'"
     by(simp add: heap_is_wellformed_def)
 qed
 end
 
 interpretation i_remove_shadow_root_wf?: l_remove_shadow_root_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf get_tag_name get_tag_name_locs get_disconnected_nodes get_disconnected_nodes_locs
   set_shadow_root set_shadow_root_locs known_ptr get_child_nodes get_child_nodes_locs get_shadow_root
   get_shadow_root_locs heap_is_wellformed parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host
   get_host_locs get_disconnected_document get_disconnected_document_locs remove_shadow_root
   remove_shadow_root_locs known_ptrs get_parent get_parent_locs
   by(auto simp add: l_remove_shadow_root_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_remove_shadow_root_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_root\_node\<close>
 
 interpretation i_get_root_node_wf?: l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf known_ptrs
   heap_is_wellformed parent_child_rel get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs get_parent get_parent_locs get_ancestors get_ancestors_locs
   get_root_node get_root_node_locs
   by(simp add: l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms[instances]
 
 lemma get_ancestors_wf_is_l_get_ancestors_wf [instances]:
   "l_get_ancestors_wf heap_is_wellformed parent_child_rel known_ptr known_ptrs type_wf get_ancestors
   get_ancestors_locs get_child_nodes get_parent"
   apply(auto simp add: l_get_ancestors_wf_def l_get_ancestors_wf_axioms_def instances)[1]
   using get_ancestors_never_empty apply blast
   using get_ancestors_ok apply blast
   using get_ancestors_reads apply blast
   using get_ancestors_ptrs_in_heap apply blast
   using get_ancestors_remains_not_in_ancestors apply blast
   using get_ancestors_also_parent apply blast
   using get_ancestors_obtains_children apply blast
   using get_ancestors_parent_child_rel apply blast
   using get_ancestors_parent_child_rel apply blast
   done
 
 lemma get_root_node_wf_is_l_get_root_node_wf [instances]:
   "l_get_root_node_wf heap_is_wellformed get_root_node type_wf known_ptr known_ptrs get_ancestors
     get_parent"
   using known_ptrs_is_l_known_ptrs
   apply(auto simp add: l_get_root_node_wf_def l_get_root_node_wf_axioms_def)[1]
   using get_root_node_ok apply blast
   using get_root_node_ptr_in_heap apply blast
   using get_root_node_root_in_heap apply blast
   using get_ancestors_same_root_node apply(blast, blast)
   using get_root_node_same_no_parent apply blast
     (* using get_root_node_not_node_same apply blast *)
   using get_root_node_parent_same apply (blast, blast)
   done
 
 subsubsection \<open>get\_parent\_get\_host\<close>
 
 locale l_get_parent_get_host_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_parent_wf +
   l_get_shadow_root +
   l_get_host +
   l_get_child_nodes
 begin
 lemma host_shadow_root_rel_finite: "finite (a_host_shadow_root_rel h)"
 proof -
   have "a_host_shadow_root_rel h = (\<Union>host \<in> fset (element_ptr_kinds h).
     (case |h \<turnstile> get_shadow_root host|\<^sub>r of
     Some shadow_root \<Rightarrow> {(cast host, cast shadow_root)} | None \<Rightarrow> {}))"
     by(auto simp add: a_host_shadow_root_rel_def split: option.splits)
   moreover have "finite (\<Union>host \<in> fset (element_ptr_kinds h).
     (case |h \<turnstile> get_shadow_root host|\<^sub>r of
     Some shadow_root \<Rightarrow> {(cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r host, cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r shadow_root)} |
     None \<Rightarrow> {}))"
     by(auto split: option.splits)
   ultimately show ?thesis
     by auto
 qed
 
 lemma host_shadow_root_rel_shadow_root:
   "h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r shadow_root_option \<Longrightarrow>
    shadow_root_option = Some shadow_root \<longleftrightarrow> ((cast host, cast shadow_root) \<in> a_host_shadow_root_rel h)"
   apply(auto simp add: a_host_shadow_root_rel_def)[1]
   by(metis (mono_tags, lifting) case_prodI is_OK_returns_result_I
       l_get_shadow_root.get_shadow_root_ptr_in_heap local.l_get_shadow_root_axioms
       mem_Collect_eq pair_imageI select_result_I2)
 
 lemma host_shadow_root_rel_host:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> get_host shadow_root \<rightarrow>\<^sub>r host \<Longrightarrow>
   (cast host, cast shadow_root) \<in> a_host_shadow_root_rel h"
   apply(auto simp add: a_host_shadow_root_rel_def)[1]
   using shadow_root_host_dual
   by (metis (no_types, lifting) Collect_cong host_shadow_root_rel_shadow_root
       local.a_host_shadow_root_rel_def split_cong)
 
 lemma heap_wellformed_induct_si [consumes 1, case_names step]:
   assumes "heap_is_wellformed h"
   assumes "\<And>parent. (\<And>children child. h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children \<Longrightarrow>
     child \<in> set children \<Longrightarrow> P (cast child)) \<Longrightarrow> (\<And>shadow_root host. parent = cast host \<Longrightarrow>
       h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some shadow_root \<Longrightarrow>  P (cast shadow_root)) \<Longrightarrow> P parent"
   shows "P ptr"
 proof -
   fix ptr
   have "finite (parent_child_rel h \<union> a_host_shadow_root_rel h)"
     using host_shadow_root_rel_finite
     using local.CD.parent_child_rel_finite local.CD.parent_child_rel_impl
     by auto
   then
   have "wf ((parent_child_rel h \<union> a_host_shadow_root_rel h)\<inverse>)"
     using assms(1)
     apply(simp add: heap_is_wellformed_def)
     by (simp add: finite_acyclic_wf_converse local.CD.parent_child_rel_impl)
   then show "?thesis"
   proof (induct rule: wf_induct_rule)
     case (less parent)
     then show ?case
       apply(auto)[1]
       using assms host_shadow_root_rel_shadow_root local.CD.parent_child_rel_child
       by blast
   qed
 qed
 
 lemma heap_wellformed_induct_rev_si [consumes 1, case_names step]:
   assumes "heap_is_wellformed h"
   assumes "\<And>child. (\<And>parent child_node. child = cast child_node \<Longrightarrow>
     h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent \<Longrightarrow> P parent) \<Longrightarrow>
     (\<And>host shadow_root. child = cast shadow_root \<Longrightarrow> h \<turnstile> get_host shadow_root \<rightarrow>\<^sub>r host \<Longrightarrow>
     P (cast host)) \<Longrightarrow> P child"
   shows "P ptr"
 proof -
   fix ptr
   have "finite (parent_child_rel h \<union> a_host_shadow_root_rel h)"
     using host_shadow_root_rel_finite
     using local.CD.parent_child_rel_finite local.CD.parent_child_rel_impl
     by auto
   then
   have "wf (parent_child_rel h \<union> a_host_shadow_root_rel h)"
     using assms(1)
     apply(simp add: heap_is_wellformed_def)
     by (simp add: finite_acyclic_wf)
   then show "?thesis"
   proof (induct rule: wf_induct_rule)
     case (less parent)
     then show ?case
       apply(auto)[1]
       using parent_child_rel_parent host_shadow_root_rel_host
       using assms(1) assms(2) by auto
   qed
 qed
 end
 
 interpretation i_get_parent_get_host_wf?: l_get_parent_get_host_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
   get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
   heap_is_wellformed parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs
   get_disconnected_document get_disconnected_document_locs known_ptrs get_parent get_parent_locs
   by(auto simp add: l_get_parent_get_host_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_parent_get_host_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 locale l_get_parent_get_host_wf =
   l_heap_is_wellformed_defs +
   l_get_parent_defs +
   l_get_shadow_root_defs +
   l_get_host_defs +
   l_get_child_nodes_defs +
   assumes heap_wellformed_induct_si [consumes 1, case_names step]:
     "heap_is_wellformed h
     \<Longrightarrow> (\<And>parent. (\<And>children child. h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children \<Longrightarrow> child \<in> set children
       \<Longrightarrow> P (cast child))
         \<Longrightarrow> (\<And>shadow_root host. parent = cast host \<Longrightarrow> h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some shadow_root
     \<Longrightarrow>  P (cast shadow_root))
       \<Longrightarrow> P parent)
     \<Longrightarrow> P ptr"
   assumes heap_wellformed_induct_rev_si [consumes 1, case_names step]:
     "heap_is_wellformed h
     \<Longrightarrow> (\<And>child. (\<And>parent child_node. child = cast child_node \<Longrightarrow>
       h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r Some parent \<Longrightarrow> P parent)
       \<Longrightarrow> (\<And>host shadow_root. child = cast shadow_root \<Longrightarrow> h \<turnstile> get_host shadow_root \<rightarrow>\<^sub>r host
     \<Longrightarrow> P (cast host))
       \<Longrightarrow> P child)
     \<Longrightarrow> P ptr"
 
 lemma l_get_parent_get_host_wf_is_get_parent_get_host_wf [instances]:
   "l_get_parent_get_host_wf heap_is_wellformed get_parent get_shadow_root get_host get_child_nodes"
   apply(auto simp add: l_get_parent_get_host_wf_def instances)[1]
   using heap_wellformed_induct_si apply metis
   using heap_wellformed_induct_rev_si apply blast
   done
 
 
 subsubsection \<open>get\_host\<close>
 
 locale l_get_host_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M  get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs
   known_ptr type_wf heap_is_wellformed parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host
   get_host_locs +
   l_type_wf type_wf +
   l_get_host\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_shadow_root get_shadow_root_locs get_host get_host_locs type_wf +
   l_get_shadow_root type_wf get_shadow_root get_shadow_root_locs
   for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and known_ptrs :: "(_) heap \<Rightarrow> bool"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_child_nodes :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
     and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
     and heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
 begin
 
 lemma get_host_ok [simp]:
   assumes "heap_is_wellformed h"
   assumes "type_wf h"
   assumes "known_ptrs h"
   assumes "shadow_root_ptr |\<in>| shadow_root_ptr_kinds h"
   shows "h \<turnstile> ok (get_host shadow_root_ptr)"
 proof -
   obtain host where host: "host |\<in>| element_ptr_kinds h"
     and "|h \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types"
     and shadow_root: "h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some shadow_root_ptr"
     using assms(1) assms(4) get_shadow_root_ok assms(2)
     apply(auto simp add: heap_is_wellformed_def a_shadow_root_valid_def)[1]
     by (smt finite_set_in returns_result_select_result)
 
 
   obtain host_candidates where
     host_candidates: "h \<turnstile> filter_M (\<lambda>element_ptr. Heap_Error_Monad.bind (get_shadow_root element_ptr)
       (\<lambda>shadow_root_opt. return (shadow_root_opt = Some shadow_root_ptr)))
                 (sorted_list_of_set (fset (element_ptr_kinds h)))
           \<rightarrow>\<^sub>r host_candidates"
     apply(drule is_OK_returns_result_E[rotated])
     using get_shadow_root_ok assms(2)
     by(auto intro!: filter_M_is_OK_I bind_pure_I bind_is_OK_I2)
   then have "host_candidates = [host]"
     apply(rule filter_M_ex1)
         apply (simp add: host)
        apply (smt assms(1) assms(2) bind_pure_returns_result_I2 bind_returns_result_E finite_set_in host
         local.get_shadow_root_ok local.get_shadow_root_pure local.shadow_root_same_host
         return_returns_result returns_result_eq shadow_root sorted_list_of_fset.rep_eq
         sorted_list_of_fset_simps(1))
     by (simp_all add: assms(2) bind_pure_I bind_pure_returns_result_I2 host local.get_shadow_root_ok
         returns_result_eq shadow_root)
   then
   show ?thesis
     using host_candidates host assms(1) get_shadow_root_ok
     apply(auto simp add: get_host_def known_ptrs_known_ptr
         intro!: bind_is_OK_pure_I filter_M_pure_I filter_M_is_OK_I bind_pure_I split: list.splits)[1]
     using assms(2) apply blast
      apply (meson list.distinct(1) returns_result_eq)
     by (meson list.distinct(1) list.inject returns_result_eq)
 qed
 end
 
 interpretation i_get_host_wf?: l_get_host_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_document
   get_disconnected_document_locs known_ptr known_ptrs type_wf get_host get_host_locs get_shadow_root
   get_shadow_root_locs get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   by(auto simp add: l_get_host_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_host_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 locale l_get_host_wf = l_heap_is_wellformed_defs + l_known_ptrs + l_type_wf + l_get_host_defs +
   assumes get_host_ok:
     "heap_is_wellformed h \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h \<Longrightarrow>
     shadow_root_ptr |\<in>| shadow_root_ptr_kinds h \<Longrightarrow> h \<turnstile> ok (get_host shadow_root_ptr)"
 
 lemma get_host_wf_is_l_get_host_wf [instances]:
   "l_get_host_wf heap_is_wellformed known_ptr known_ptrs type_wf get_host"
   by(auto simp add: l_get_host_wf_def l_get_host_wf_axioms_def instances)
 
 
 subsubsection \<open>get\_root\_node\_si\<close>
 
 locale l_get_root_node_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_root_node_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_parent_wf +
   l_get_parent_get_host_wf +
   l_get_host_wf
 begin
 lemma get_root_node_si_ptr_in_heap:
   assumes "h \<turnstile> ok (get_root_node_si ptr)"
   shows "ptr |\<in>| object_ptr_kinds h"
   using assms
   unfolding get_root_node_si_def
   using get_ancestors_si_ptr_in_heap
   by auto
 
 
 lemma get_ancestors_si_ok:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
     and "ptr |\<in>| object_ptr_kinds h"
   shows "h \<turnstile> ok (get_ancestors_si ptr)"
 proof (insert assms(1) assms(4), induct rule: heap_wellformed_induct_rev_si)
   case (step child)
   then show ?case
     using assms(2) assms(3)
     apply(auto simp add: get_ancestors_si_def[of child] assms(1) get_parent_parent_in_heap
         intro!: bind_is_OK_pure_I
         split: option.splits)[1]
     using local.get_parent_ok apply blast
     using get_host_ok assms(1) apply blast
     by (meson assms(1) is_OK_returns_result_I local.get_shadow_root_ptr_in_heap
         local.shadow_root_host_dual)
 qed
 
 lemma get_ancestors_si_remains_not_in_ancestors:
   assumes "heap_is_wellformed h"
     and "heap_is_wellformed h'"
     and "h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors"
     and "h' \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors'"
     and "\<And>p children children'. h \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children
         \<Longrightarrow> h' \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children' \<Longrightarrow> set children' \<subseteq> set children"
     and "\<And>p shadow_root_option shadow_root_option'. h \<turnstile> get_shadow_root p \<rightarrow>\<^sub>r shadow_root_option \<Longrightarrow>
         h' \<turnstile> get_shadow_root p \<rightarrow>\<^sub>r shadow_root_option' \<Longrightarrow> (if shadow_root_option = None
         then shadow_root_option' = None else shadow_root_option' = None \<or>
           shadow_root_option' = shadow_root_option)"
     and "node \<notin> set ancestors"
     and object_ptr_kinds_eq3: "object_ptr_kinds h = object_ptr_kinds h'"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
     and type_wf': "type_wf h'"
   shows "node \<notin> set ancestors'"
 proof -
   have object_ptr_kinds_M_eq:
     "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     using object_ptr_kinds_eq3
     by(simp add: object_ptr_kinds_M_defs)
   then have object_ptr_kinds_eq: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by(simp)
 
   show ?thesis
   proof (insert assms(1) assms(3) assms(4) assms(7), induct ptr arbitrary: ancestors ancestors'
       rule: heap_wellformed_induct_rev_si)
     case (step child)
 
     obtain ancestors_remains where ancestors_remains:
       "ancestors = child # ancestors_remains"
       using \<open>h \<turnstile> get_ancestors_si child \<rightarrow>\<^sub>r ancestors\<close> get_ancestors_si_never_empty
       by(auto simp add: get_ancestors_si_def[of child]
           elim!: bind_returns_result_E2
           split: option.splits)
     obtain ancestors_remains' where ancestors_remains':
       "ancestors' = child # ancestors_remains'"
       using \<open>h' \<turnstile> get_ancestors_si child \<rightarrow>\<^sub>r ancestors'\<close> get_ancestors_si_never_empty
       by(auto simp add: get_ancestors_si_def[of child]
           elim!: bind_returns_result_E2
           split: option.splits)
     have "child |\<in>| object_ptr_kinds h"
       using local.get_ancestors_si_ptr_in_heap object_ptr_kinds_eq3 step.prems(2) by fastforce
 
     have "node \<noteq> child"
       using ancestors_remains step.prems(3) by auto
 
     have 1: "\<And>p parent. h' \<turnstile> get_parent p \<rightarrow>\<^sub>r Some parent \<Longrightarrow> h \<turnstile> get_parent p \<rightarrow>\<^sub>r Some parent"
     proof -
       fix p parent
       assume "h' \<turnstile> get_parent p \<rightarrow>\<^sub>r Some parent"
       then obtain children' where
         children': "h' \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children'" and
         p_in_children': "p \<in> set children'"
         using get_parent_child_dual by blast
       obtain children where children: "h \<turnstile> get_child_nodes parent \<rightarrow>\<^sub>r children"
         using get_child_nodes_ok assms(1) get_child_nodes_ptr_in_heap object_ptr_kinds_eq children'
           known_ptrs
         using  type_wf type_wf'
         by (metis \<open>h' \<turnstile> get_parent p \<rightarrow>\<^sub>r Some parent\<close> get_parent_parent_in_heap is_OK_returns_result_E
             local.known_ptrs_known_ptr object_ptr_kinds_eq3)
       have "p \<in> set children"
         using assms(5) children children' p_in_children'
         by blast
       then show "h \<turnstile> get_parent p \<rightarrow>\<^sub>r Some parent"
         using child_parent_dual assms(1) children known_ptrs  type_wf  by blast
     qed
 
     have 2: "\<And>p host. h' \<turnstile> get_host p \<rightarrow>\<^sub>r host \<Longrightarrow> h \<turnstile> get_host p \<rightarrow>\<^sub>r host"
     proof -
       fix p host
       assume "h' \<turnstile> get_host p \<rightarrow>\<^sub>r host"
       then have "h' \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some p"
         using local.shadow_root_host_dual by blast
       then have "h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some p"
         by (metis assms(6) element_ptr_kinds_commutes is_OK_returns_result_I local.get_shadow_root_ok
             local.get_shadow_root_ptr_in_heap node_ptr_kinds_commutes object_ptr_kinds_eq3
             option.distinct(1) returns_result_select_result type_wf)
       then show "h \<turnstile> get_host p \<rightarrow>\<^sub>r host"
         by (metis assms(1) is_OK_returns_result_E known_ptrs local.get_host_ok
             local.get_shadow_root_shadow_root_ptr_in_heap local.shadow_root_host_dual
             local.shadow_root_same_host type_wf)
 
     qed
 
 
     show ?case
     proof (cases "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child")
       case None
       then show ?thesis
         using step(3) step(4) \<open>node \<noteq> child\<close>
         apply(auto simp add: get_ancestors_si_def[of child]
             elim!: bind_returns_result_E2
             split: option.splits)[1]
         by (metis "2" assms(1) l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M.shadow_root_same_host list.set_intros(2)
             local.l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms local.shadow_root_host_dual step.hyps(2)
             step.prems(3) type_wf)
     next
       case (Some node_child)
       then
       show ?thesis
         using step(3) step(4) \<open>node \<noteq> child\<close>
         apply(auto simp add: get_ancestors_si_def[of child]
             elim!: bind_returns_result_E2
             split: option.splits)[1]
          apply (meson "1" option.distinct(1) returns_result_eq)
         by (metis "1" list.set_intros(2) option.inject returns_result_eq step.hyps(1) step.prems(3))
     qed
   qed
 qed
 
 
 lemma get_ancestors_si_ptrs_in_heap:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors"
   assumes "ptr' \<in> set ancestors"
   shows "ptr' |\<in>| object_ptr_kinds h"
 proof (insert assms(4) assms(5), induct ancestors arbitrary: ptr)
   case Nil
   then show ?case
     by(auto)
 next
   case (Cons a ancestors)
   then obtain x where x: "h \<turnstile> get_ancestors_si x \<rightarrow>\<^sub>r a # ancestors"
     by(auto simp add: get_ancestors_si_def[of a] elim!: bind_returns_result_E2 split: option.splits)
   then have "x = a"
     by(auto simp add: get_ancestors_si_def[of x] elim!: bind_returns_result_E2 split: option.splits)
   then show ?case
   proof (cases "ptr' = a")
     case True
     then show ?thesis
       using Cons.hyps Cons.prems(2) get_ancestors_si_ptr_in_heap x
       using \<open>x = a\<close> by blast
   next
     case False
     obtain ptr'' where ptr'': "h \<turnstile> get_ancestors_si ptr'' \<rightarrow>\<^sub>r ancestors"
       using \<open> h \<turnstile> get_ancestors_si x \<rightarrow>\<^sub>r a # ancestors\<close> Cons.prems(2) False
       by(auto simp add: get_ancestors_si_def[of x] elim!: bind_returns_result_E2 split: option.splits)
     then show ?thesis
       using Cons.hyps Cons.prems(2) False by auto
   qed
 qed
 
 lemma get_ancestors_si_reads:
   assumes "heap_is_wellformed h"
   shows "reads get_ancestors_si_locs (get_ancestors_si node_ptr) h h'"
 proof (insert assms(1), induct rule: heap_wellformed_induct_rev_si)
   case (step child)
   then show ?case
     using [[simproc del: Product_Type.unit_eq]] get_parent_reads[unfolded reads_def]
       get_host_reads[unfolded reads_def]
     apply(simp (no_asm) add: get_ancestors_si_def)
     by(auto simp add: get_ancestors_si_locs_def get_parent_reads_pointers
         intro!: reads_bind_pure reads_subset[OF check_in_heap_reads]
         reads_subset[OF return_reads] reads_subset[OF get_parent_reads]
         reads_subset[OF get_child_nodes_reads] reads_subset[OF get_host_reads]
         split: option.splits)
 qed
 
 
 lemma get_ancestors_si_subset:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors"
     and "ancestor \<in> set ancestors"
     and "h \<turnstile> get_ancestors_si ancestor \<rightarrow>\<^sub>r ancestor_ancestors"
     and type_wf: "type_wf h"
     and known_ptrs: "known_ptrs h"
   shows "set ancestor_ancestors \<subseteq> set ancestors"
 proof (insert assms(1) assms(2) assms(3), induct ptr arbitrary: ancestors
     rule: heap_wellformed_induct_rev_si)
   case (step child)
   have "child |\<in>| object_ptr_kinds h"
     using get_ancestors_si_ptr_in_heap step(3) by auto
       (*  then have "h \<turnstile> check_in_heap child \<rightarrow>\<^sub>r ()"
     using returns_result_select_result by force *)
 
 
   obtain tl_ancestors where tl_ancestors: "ancestors = child # tl_ancestors"
     using step(3)
     by(auto simp add: get_ancestors_si_def[of child] intro!: bind_pure_I
         elim!: bind_returns_result_E2 split: option.splits)
   show ?case
   proof (induct "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child")
     case None
     show ?case
     proof (induct "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r child")
       case None
       then show ?case
         using step(3) \<open>None = cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r child\<close>
         apply(auto simp add: get_ancestors_si_def[of child] elim!: bind_returns_result_E2)[1]
         by (metis (no_types, lifting) assms(4) empty_iff empty_set select_result_I2 set_ConsD
             step.prems(1) step.prems(2))
     next
       case (Some shadow_root_child)
       then
       have "shadow_root_child |\<in>| shadow_root_ptr_kinds h"
         using  \<open>child |\<in>| object_ptr_kinds h\<close>
         by (metis (no_types, lifting) shadow_root_ptr_casts_commute shadow_root_ptr_kinds_commutes)
       obtain host where host: "h \<turnstile> get_host shadow_root_child \<rightarrow>\<^sub>r host"
         using get_host_ok assms
         by (meson \<open>shadow_root_child |\<in>| shadow_root_ptr_kinds h\<close> is_OK_returns_result_E)
       then
       have "h \<turnstile> get_ancestors_si (cast host) \<rightarrow>\<^sub>r tl_ancestors"
         using Some step(3) tl_ancestors None
         by(auto simp add: get_ancestors_si_def[of child] intro!: bind_pure_returns_result_I
             elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
       then
       show ?case
         using step(2) Some host step(4) tl_ancestors
         by (metis (no_types, lifting) assms(4) dual_order.trans eq_iff returns_result_eq set_ConsD
             set_subset_Cons shadow_root_ptr_casts_commute step.prems(1))
     qed
   next
     case (Some child_node)
     note s1 = Some
     obtain parent_opt where parent_opt: "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r parent_opt"
       using \<open>child |\<in>| object_ptr_kinds h\<close> assms(1) Some[symmetric]
         get_parent_ok[OF type_wf known_ptrs]
       by (metis (no_types, lifting) is_OK_returns_result_E known_ptrs get_parent_ok
           l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms node_ptr_casts_commute node_ptr_kinds_commutes)
     then show ?case
     proof (induct parent_opt)
       case None
       then have "ancestors = [child]"
         using step(3) s1
         apply(simp add: get_ancestors_si_def)
         by(auto elim!: bind_returns_result_E2 split: option.splits dest: returns_result_eq)
       show ?case
         using step(3) step(4)
         apply(auto simp add: \<open>ancestors = [child]\<close>)[1]
         using assms(4) returns_result_eq by fastforce
     next
       case (Some parent)
       then
       have "h \<turnstile> get_ancestors_si parent \<rightarrow>\<^sub>r tl_ancestors"
         using s1 tl_ancestors step(3)
         by(auto simp add: get_ancestors_si_def[of child]
             elim!: bind_returns_result_E2
             split: option.splits dest: returns_result_eq)
       show ?case
         by (metis (no_types, lifting) Some.prems \<open>h \<turnstile> get_ancestors_si parent \<rightarrow>\<^sub>r tl_ancestors\<close>
             assms(4) eq_iff node_ptr_casts_commute order_trans s1 select_result_I2 set_ConsD
             set_subset_Cons step.hyps(1) step.prems(1) step.prems(2) tl_ancestors)
     qed
   qed
 qed
 
 lemma get_ancestors_si_also_parent:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors_si some_ptr \<rightarrow>\<^sub>r ancestors"
     and "cast child \<in> set ancestors"
     and "h \<turnstile> get_parent child \<rightarrow>\<^sub>r Some parent"
     and type_wf: "type_wf h"
     and known_ptrs: "known_ptrs h"
   shows "parent \<in> set ancestors"
 proof -
   obtain child_ancestors where child_ancestors:
     "h \<turnstile> get_ancestors_si (cast child) \<rightarrow>\<^sub>r child_ancestors"
     by (meson assms(1) assms(4) get_ancestors_si_ok is_OK_returns_result_I known_ptrs
         local.get_parent_ptr_in_heap node_ptr_kinds_commutes returns_result_select_result
         type_wf)
   then have "parent \<in> set child_ancestors"
     apply(simp add: get_ancestors_si_def)
     by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)]
         get_ancestors_si_ptr)
   then show ?thesis
     using assms child_ancestors get_ancestors_si_subset by blast
 qed
 
 lemma get_ancestors_si_also_host:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> get_ancestors_si some_ptr \<rightarrow>\<^sub>r ancestors"
     and "cast shadow_root \<in> set ancestors"
     and "h \<turnstile> get_host shadow_root \<rightarrow>\<^sub>r host"
     and type_wf: "type_wf h"
     and known_ptrs: "known_ptrs h"
   shows "cast host \<in> set ancestors"
 proof -
   obtain child_ancestors where child_ancestors:
     "h \<turnstile> get_ancestors_si (cast shadow_root) \<rightarrow>\<^sub>r child_ancestors"
     by (meson assms(1) assms(2) assms(3) get_ancestors_si_ok get_ancestors_si_ptrs_in_heap
         is_OK_returns_result_E known_ptrs type_wf)
   then have "cast host \<in> set child_ancestors"
     apply(simp add: get_ancestors_si_def)
     by(auto elim!: bind_returns_result_E2 split: option.splits dest!: returns_result_eq[OF assms(4)]
         get_ancestors_si_ptr)
   then show ?thesis
     using assms child_ancestors get_ancestors_si_subset by blast
 qed
 
 lemma get_ancestors_si_parent_child_rel:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> get_ancestors_si child \<rightarrow>\<^sub>r ancestors"
   assumes "((ptr, child) \<in> (parent_child_rel h)\<^sup>*)"
   shows "ptr \<in> set ancestors"
 proof (insert assms(5), induct ptr rule: heap_wellformed_induct_si[OF assms(1)])
   case (1 ptr)
   then show ?case
   proof (cases "ptr = child")
     case True
     then show ?thesis
       using assms(4) local.get_ancestors_si_ptr by blast
   next
     case False
     obtain ptr_child where
       ptr_child: "(ptr, ptr_child) \<in> (parent_child_rel h) \<and> (ptr_child, child) \<in> (parent_child_rel h)\<^sup>*"
       using converse_rtranclE[OF 1(3)] \<open>ptr \<noteq> child\<close>
       by metis
     then obtain ptr_child_node
       where ptr_child_ptr_child_node: "ptr_child = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node"
       using ptr_child node_ptr_casts_commute3 CD.parent_child_rel_node_ptr
       by (metis )
     then obtain children where
       children: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children" and
       ptr_child_node: "ptr_child_node \<in> set children"
     proof -
       assume a1: "\<And>children. \<lbrakk>h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children; ptr_child_node \<in> set children\<rbrakk>
                    \<Longrightarrow> thesis"
 
       have "ptr |\<in>| object_ptr_kinds h"
         using CD.parent_child_rel_parent_in_heap ptr_child by blast
       moreover have "ptr_child_node \<in> set |h \<turnstile> get_child_nodes ptr|\<^sub>r"
         by (metis calculation \<open>known_ptrs h\<close> local.get_child_nodes_ok local.known_ptrs_known_ptr
             CD.parent_child_rel_child ptr_child ptr_child_ptr_child_node
             returns_result_select_result \<open>type_wf h\<close>)
       ultimately show ?thesis
         using a1 get_child_nodes_ok \<open>type_wf h\<close> \<open>known_ptrs h\<close>
         by (meson local.known_ptrs_known_ptr returns_result_select_result)
     qed
     moreover have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node, child) \<in> (parent_child_rel h)\<^sup>*"
       using ptr_child ptr_child_ptr_child_node by auto
     ultimately have "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node \<in> set ancestors"
       using 1 by auto
     moreover have "h \<turnstile> get_parent ptr_child_node \<rightarrow>\<^sub>r Some ptr"
       using assms(1) children ptr_child_node child_parent_dual
       using \<open>known_ptrs h\<close> \<open>type_wf h\<close> by blast
     ultimately show ?thesis
       using get_ancestors_si_also_parent assms \<open>type_wf h\<close> by blast
   qed
 qed
 
 lemma get_ancestors_si_parent_child_host_shadow_root_rel:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> get_ancestors_si child \<rightarrow>\<^sub>r ancestors"
   assumes "((ptr, child) \<in> (parent_child_rel h \<union> a_host_shadow_root_rel h)\<^sup>*)"
   shows "ptr \<in> set ancestors"
 proof (insert assms(5), induct ptr rule: heap_wellformed_induct_si[OF assms(1)])
   case (1 ptr)
   then show ?case
   proof (cases "ptr = child")
     case True
     then show ?thesis
       using assms(4) local.get_ancestors_si_ptr by blast
   next
     case False
 
     obtain ptr_child where
       ptr_child: "(ptr, ptr_child) \<in> (parent_child_rel h \<union> local.a_host_shadow_root_rel h) \<and>
           (ptr_child, child) \<in> (parent_child_rel h \<union> local.a_host_shadow_root_rel h)\<^sup>*"
       using converse_rtranclE[OF 1(3)] \<open>ptr \<noteq> child\<close>
       by metis
     then show ?thesis
     proof(cases "(ptr, ptr_child) \<in> parent_child_rel h")
       case True
 
       then obtain ptr_child_node
         where ptr_child_ptr_child_node: "ptr_child = cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node"
         using ptr_child node_ptr_casts_commute3 CD.parent_child_rel_node_ptr
         by (metis)
       then obtain children where
         children: "h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children" and
         ptr_child_node: "ptr_child_node \<in> set children"
       proof -
         assume a1: "\<And>children. \<lbrakk>h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children; ptr_child_node \<in> set children\<rbrakk>
                    \<Longrightarrow> thesis"
 
         have "ptr |\<in>| object_ptr_kinds h"
           using CD.parent_child_rel_parent_in_heap True by blast
         moreover have "ptr_child_node \<in> set |h \<turnstile> get_child_nodes ptr|\<^sub>r"
           by (metis True assms(2) assms(3) calculation local.CD.parent_child_rel_child
               local.get_child_nodes_ok local.known_ptrs_known_ptr ptr_child_ptr_child_node
               returns_result_select_result)
         ultimately show ?thesis
           using a1 get_child_nodes_ok \<open>type_wf h\<close> \<open>known_ptrs h\<close>
           by (meson local.known_ptrs_known_ptr returns_result_select_result)
       qed
       moreover have "(cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node, child) \<in>
           (parent_child_rel h \<union> local.a_host_shadow_root_rel h)\<^sup>*"
         using ptr_child True ptr_child_ptr_child_node by auto
       ultimately have "cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr_child_node \<in> set ancestors"
         using 1 by auto
       moreover have "h \<turnstile> get_parent ptr_child_node \<rightarrow>\<^sub>r Some ptr"
         using assms(1) children ptr_child_node child_parent_dual
         using \<open>known_ptrs h\<close> \<open>type_wf h\<close> by blast
       ultimately show ?thesis
         using get_ancestors_si_also_parent assms \<open>type_wf h\<close> by blast
     next
       case False
       then
       obtain host where host: "ptr = cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r host"
         using ptr_child
         by(auto simp add: a_host_shadow_root_rel_def)
       then obtain shadow_root where shadow_root: "h \<turnstile> get_shadow_root host \<rightarrow>\<^sub>r Some shadow_root"
         and ptr_child_shadow_root: "ptr_child = cast shadow_root"
         using ptr_child False
         apply(auto simp add: a_host_shadow_root_rel_def)[1]
         by (metis (no_types, lifting) assms(3) local.get_shadow_root_ok select_result_I)
 
       moreover have "(cast shadow_root, child) \<in> (parent_child_rel h \<union> local.a_host_shadow_root_rel h)\<^sup>*"
         using ptr_child ptr_child_shadow_root by blast
       ultimately have "cast shadow_root \<in> set ancestors"
         using "1.hyps"(2) host by blast
       moreover have "h \<turnstile> get_host shadow_root \<rightarrow>\<^sub>r host"
         by (metis assms(1) assms(2) assms(3) is_OK_returns_result_E local.get_host_ok
             local.get_shadow_root_shadow_root_ptr_in_heap local.shadow_root_host_dual
             local.shadow_root_same_host shadow_root)
       ultimately show ?thesis
         using get_ancestors_si_also_host assms(1) assms(2) assms(3) assms(4) host
         by blast
     qed
   qed
 qed
 
 lemma get_root_node_si_ok:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
     and "ptr |\<in>| object_ptr_kinds h"
   shows "h \<turnstile> ok (get_root_node_si ptr)"
   using assms get_ancestors_si_ok
   by(auto simp add: get_root_node_si_def)
 
 lemma get_root_node_si_root_in_heap:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node_si ptr \<rightarrow>\<^sub>r root"
   shows "root |\<in>| object_ptr_kinds h"
   using assms
   apply(auto simp add: get_root_node_si_def elim!: bind_returns_result_E2)[1]
   by (simp add: get_ancestors_si_never_empty get_ancestors_si_ptrs_in_heap)
 
 lemma get_root_node_si_same_no_parent:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_root_node_si ptr \<rightarrow>\<^sub>r cast child"
   shows "h \<turnstile> get_parent child \<rightarrow>\<^sub>r None"
 proof (insert assms(1) assms(4), induct ptr rule: heap_wellformed_induct_rev_si)
   case (step c)
   then show ?case
   proof (cases "cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r c")
     case None
     then show ?thesis
       using step(3)
       by(auto simp add: get_root_node_si_def get_ancestors_si_def[of c]
           elim!: bind_returns_result_E2
           split: if_splits option.splits
           intro!: step(2) bind_pure_returns_result_I)
   next
     case (Some child_node)
     note s = this
     then obtain parent_opt where parent_opt: "h \<turnstile> get_parent child_node \<rightarrow>\<^sub>r parent_opt"
       using step(3)
       apply(auto simp add: get_root_node_si_def get_ancestors_si_def
           intro!: bind_pure_I
           elim!: bind_returns_result_E2)[1]
       by(auto split: option.splits)
     then show ?thesis
     proof(induct parent_opt)
       case None
       then show ?case
         using Some get_root_node_si_no_parent returns_result_eq step.prems by fastforce
     next
       case (Some parent)
       then show ?case
         using step(3) s
         apply(auto simp add: get_root_node_si_def get_ancestors_si_def[of c]
             elim!: bind_returns_result_E2 split: option.splits list.splits if_splits)[1]
         using assms(1) get_ancestors_si_never_empty apply blast
         by(auto simp add: get_root_node_si_def
             dest: returns_result_eq
             intro!: step(1) bind_pure_returns_result_I)
     qed
   qed
 qed
 end
 
 interpretation i_get_root_node_si_wf?: l_get_root_node_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr known_ptrs
   get_parent get_parent_locs get_child_nodes get_child_nodes_locs get_host get_host_locs
   get_ancestors_si get_ancestors_si_locs get_root_node_si get_root_node_si_locs
   get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs
   get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_disconnected_document get_disconnected_document_locs
   by(auto simp add: instances l_get_root_node_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def)
 declare l_get_root_node_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_disconnected\_document\<close>
 
 locale l_get_disconnected_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_disconnected_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_parent_wf +
   l_get_parent
 begin
 
 lemma get_disconnected_document_ok:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None"
   shows "h \<turnstile> ok (get_disconnected_document node_ptr)"
 proof -
   have "node_ptr |\<in>| node_ptr_kinds h"
     by (meson assms(4) is_OK_returns_result_I local.get_parent_ptr_in_heap)
   have "\<not>(\<exists>parent \<in> fset (object_ptr_kinds h). node_ptr \<in> set |h \<turnstile> get_child_nodes parent|\<^sub>r)"
     apply(auto)[1]
     using assms(4) child_parent_dual[OF assms(1)]
       assms(1) assms(2) assms(3) known_ptrs_known_ptr option.simps(3)
       returns_result_eq returns_result_select_result
     by (metis (no_types, lifting) CD.get_child_nodes_ok)
   then
   have "(\<exists>document_ptr \<in> fset (document_ptr_kinds h). node_ptr \<in>
     set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)"
     using heap_is_wellformed_children_disc_nodes
     using \<open>node_ptr |\<in>| node_ptr_kinds h\<close> assms(1) by blast
   then obtain some_owner_document where
     "some_owner_document \<in> set (sorted_list_of_set (fset (document_ptr_kinds h)))" and
     "node_ptr \<in> set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r"
     by auto
 
   have h5: "\<exists>!x. x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h))) \<and>
     h \<turnstile> Heap_Error_Monad.bind (get_disconnected_nodes x)
                   (\<lambda>children. return (node_ptr \<in> set children)) \<rightarrow>\<^sub>r True"
     apply(auto intro!: bind_pure_returns_result_I)[1]
      apply (smt CD.get_disconnected_nodes_ok CD.get_disconnected_nodes_pure
         \<open>\<exists>document_ptr\<in>fset (document_ptr_kinds h). node_ptr \<in>
                 set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r\<close> assms(2)
         bind_pure_returns_result_I2 notin_fset return_returns_result select_result_I2)
 
     apply(auto elim!: bind_returns_result_E2 intro!: bind_pure_returns_result_I)[1]
     using heap_is_wellformed_one_disc_parent assms(1)
     by blast
   let ?filter_M = "filter_M
              (\<lambda>document_ptr.
                  Heap_Error_Monad.bind (get_disconnected_nodes document_ptr)
                   (\<lambda>disconnected_nodes. return (node_ptr \<in> set disconnected_nodes)))
              (sorted_list_of_set (fset (document_ptr_kinds h)))"
   have "h \<turnstile> ok (?filter_M)"
     using CD.get_disconnected_nodes_ok
     by (smt CD.get_disconnected_nodes_pure DocumentMonad.ptr_kinds_M_ptr_kinds
         DocumentMonad.ptr_kinds_ptr_kinds_M assms(2) bind_is_OK_pure_I bind_pure_I
         document_ptr_kinds_M_def filter_M_is_OK_I l_ptr_kinds_M.ptr_kinds_M_ok return_ok
         return_pure returns_result_select_result)
   then
   obtain candidates where candidates: "h \<turnstile> filter_M
              (\<lambda>document_ptr.
                  Heap_Error_Monad.bind (get_disconnected_nodes document_ptr)
                   (\<lambda>disconnected_nodes. return (node_ptr \<in> set disconnected_nodes)))
              (sorted_list_of_set (fset (document_ptr_kinds h)))
        \<rightarrow>\<^sub>r candidates"
     by auto
   have "candidates = [some_owner_document]"
     apply(rule filter_M_ex1[OF candidates \<open>some_owner_document \<in>
                set (sorted_list_of_set (fset (document_ptr_kinds h)))\<close> h5])
     using \<open>node_ptr \<in> set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
       \<open>some_owner_document \<in> set (sorted_list_of_set (fset (document_ptr_kinds h)))\<close>
     by(auto simp add: CD.get_disconnected_nodes_ok assms(2)
         intro!: bind_pure_I
         intro!: bind_pure_returns_result_I)
   then show ?thesis
     using candidates  \<open>node_ptr |\<in>| node_ptr_kinds h\<close>
     apply(auto simp add: get_disconnected_document_def
         intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I
         split: list.splits)[1]
      apply (meson not_Cons_self2 returns_result_eq)
     by (meson list.distinct(1) list.inject returns_result_eq)
 qed
 end
 
 interpretation i_get_disconnected_document_wf?: l_get_disconnected_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
   get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
   heap_is_wellformed parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs
   get_disconnected_document get_disconnected_document_locs known_ptrs get_parent get_parent_locs
   by(auto simp add: l_get_disconnected_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_disconnected_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_owner\_document\<close>
 
 locale l_get_owner_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_disconnected_nodes +
   l_get_child_nodes +
   l_get_owner_document\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_parent_wf +
   l_known_ptrs +
   l_get_root_node_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_parent\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   assumes known_ptr_impl: "known_ptr = ShadowRootClass.known_ptr"
 begin
 lemma get_owner_document_disconnected_nodes:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
   assumes "node_ptr \<in> set disc_nodes"
   assumes known_ptrs: "known_ptrs h"
   assumes type_wf: "type_wf h"
   shows "h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r document_ptr"
 proof -
   have 2: "node_ptr |\<in>| node_ptr_kinds h"
     using assms
     apply(auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.a_all_ptrs_in_heap_def)[1]
     using assms(1) local.heap_is_wellformed_disc_nodes_in_heap by blast
   have 3: "document_ptr |\<in>| document_ptr_kinds h"
     using assms(2) get_disconnected_nodes_ptr_in_heap by blast
   then have 4: "\<not>(\<exists>parent_ptr. parent_ptr |\<in>| object_ptr_kinds h \<and>
     node_ptr \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r)"
     using CD.distinct_lists_no_parent assms
     unfolding heap_is_wellformed_def CD.heap_is_wellformed_def by simp
   moreover have "(\<exists>document_ptr. document_ptr |\<in>| document_ptr_kinds h \<and>
         node_ptr \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r) \<or>
        (\<exists>parent_ptr. parent_ptr |\<in>| object_ptr_kinds h \<and>
         node_ptr \<in> set |h \<turnstile> get_child_nodes parent_ptr|\<^sub>r)"
     using assms(1) 2 "3" assms(2) assms(3) by auto
   ultimately have 0: "\<exists>!document_ptr\<in>set |h \<turnstile> document_ptr_kinds_M|\<^sub>r.
     node_ptr \<in> set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r"
     using concat_map_distinct assms(1)  known_ptrs_implies
     by (smt CD.heap_is_wellformed_one_disc_parent DocumentMonad.ptr_kinds_ptr_kinds_M
         disjoint_iff_not_equal local.get_disconnected_nodes_ok local.heap_is_wellformed_def
         returns_result_select_result type_wf)
 
 
   have "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None"
     using 4 2
     apply(auto simp add: get_parent_def
         intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I )[1]
     apply(auto intro!:  filter_M_empty_I bind_pure_I bind_pure_returns_result_I)[1]
     using get_child_nodes_ok assms(4)  type_wf
     by (metis get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result)
 
 
   then have 4: "h \<turnstile> get_root_node_si (cast node_ptr) \<rightarrow>\<^sub>r cast node_ptr"
     using get_root_node_si_no_parent
     by simp
   obtain document_ptrs where document_ptrs: "h \<turnstile> document_ptr_kinds_M \<rightarrow>\<^sub>r document_ptrs"
     by simp
   then have "h \<turnstile> ok (filter_M (\<lambda>document_ptr. do {
           disconnected_nodes \<leftarrow> get_disconnected_nodes document_ptr;
           return (((cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) \<in> cast ` set disconnected_nodes)
         }) document_ptrs)"
     using assms(1) get_disconnected_nodes_ok type_wf
     by(auto intro!: bind_is_OK_I2 filter_M_is_OK_I bind_pure_I)
   then obtain candidates where
     candidates: "h \<turnstile> filter_M (\<lambda>document_ptr. do {
           disconnected_nodes \<leftarrow> get_disconnected_nodes document_ptr;
           return (((cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) \<in> cast ` set disconnected_nodes)
         }) document_ptrs \<rightarrow>\<^sub>r candidates"
     by auto
 
   have filter: "filter (\<lambda>document_ptr. |h \<turnstile> do {
           disconnected_nodes \<leftarrow> get_disconnected_nodes document_ptr;
           return (cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr \<in> cast ` set disconnected_nodes)
         }|\<^sub>r) document_ptrs = [document_ptr]"
     apply(rule filter_ex1)
     using 0 document_ptrs apply(simp)[1]
        apply (smt "0" "3" assms bind_is_OK_pure_I bind_pure_returns_result_I bind_pure_returns_result_I2
         bind_returns_result_E2 bind_returns_result_E3 document_ptr_kinds_M_def get_disconnected_nodes_ok
         get_disconnected_nodes_pure image_eqI is_OK_returns_result_E l_ptr_kinds_M.ptr_kinds_ptr_kinds_M
         return_ok return_returns_result returns_result_eq select_result_E select_result_I select_result_I2
         select_result_I2)
     using assms(2) assms(3)
       apply (metis (no_types, lifting) bind_pure_returns_result_I2 is_OK_returns_result_I
         local.get_disconnected_nodes_pure node_ptr_inclusion return_returns_result select_result_I2)
     using document_ptrs  3 apply(simp)
     using document_ptrs
     by simp
   have "h \<turnstile> filter_M (\<lambda>document_ptr. do {
           disconnected_nodes \<leftarrow> get_disconnected_nodes document_ptr;
           return (((cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr)) \<in> cast ` set disconnected_nodes)
         }) document_ptrs \<rightarrow>\<^sub>r [document_ptr]"
     apply(rule filter_M_filter2)
     using get_disconnected_nodes_ok document_ptrs 3  assms(1)  type_wf filter
     by(auto intro: bind_pure_I bind_is_OK_I2)
 
   with 4 document_ptrs have "h \<turnstile> CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr () \<rightarrow>\<^sub>r document_ptr"
     by(auto simp add: CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: bind_pure_returns_result_I filter_M_pure_I bind_pure_I split: option.splits)
   moreover have "known_ptr (cast node_ptr)"
     using known_ptrs_known_ptr[OF known_ptrs, where ptr="cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr"] 2
       known_ptrs_implies
     by(simp)
   ultimately show ?thesis
     using 2
     apply(auto simp add: CD.a_get_owner_document_tups_def get_owner_document_def
         a_get_owner_document_tups_def known_ptr_impl)[1]
     apply(split invoke_splits, (rule conjI | rule impI)+)+
         apply(drule(1) known_ptr_not_shadow_root_ptr)
         apply(drule(1) known_ptr_not_document_ptr)
         apply(drule(1)  known_ptr_not_character_data_ptr)
         apply(drule(1)  known_ptr_not_element_ptr)
         apply(simp add: NodeClass.known_ptr_defs)
     by(auto split: option.splits intro!: bind_pure_returns_result_I)
 qed
 
 lemma in_disconnected_nodes_no_parent:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r None"
   assumes "h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r owner_document"
   assumes "h \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes"
   assumes "known_ptrs h"
   assumes "type_wf h"
   shows "node_ptr \<in> set disc_nodes"
 proof -
   have "\<And>parent. parent |\<in>| object_ptr_kinds h \<Longrightarrow> node_ptr \<notin> set |h \<turnstile> get_child_nodes parent|\<^sub>r"
     using assms(2)
     by (meson get_child_nodes_ok assms(1) assms(5) assms(6) local.child_parent_dual
         local.known_ptrs_known_ptr option.distinct(1) returns_result_eq returns_result_select_result)
   then show ?thesis
     by (smt assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) finite_set_in is_OK_returns_result_I
         local.get_disconnected_nodes_ok local.get_owner_document_disconnected_nodes
         local.get_parent_ptr_in_heap local.heap_is_wellformed_children_disc_nodes
         returns_result_select_result select_result_I2)
 qed
 
 
 lemma get_owner_document_owner_document_in_heap_node:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r node_ptr () \<rightarrow>\<^sub>r owner_document"
   shows "owner_document |\<in>| document_ptr_kinds h"
 proof -
   obtain root where
     root: "h \<turnstile> get_root_node_si (cast node_ptr) \<rightarrow>\<^sub>r root"
     using assms(4)
     by(auto simp add: CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         elim!: bind_returns_result_E2
         split: option.splits)
 
   then show ?thesis
   proof (cases "is_document_ptr root")
     case True
     then show ?thesis
       using assms(4) root
       apply(auto simp add: CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!:  bind_returns_result_E2
           intro!: filter_M_pure_I bind_pure_I split: option.splits)[1]
        apply(drule(1) returns_result_eq) apply(auto)[1]
       using assms document_ptr_kinds_commutes get_root_node_si_root_in_heap
       by blast
   next
     case False
     have "known_ptr root"
       using assms local.get_root_node_si_root_in_heap local.known_ptrs_known_ptr root by blast
     have "root |\<in>| object_ptr_kinds h"
       using root
       using assms local.get_root_node_si_root_in_heap
       by blast
 
     have "\<not>is_shadow_root_ptr root"
       using root
       using local.get_root_node_si_root_not_shadow_root by blast
     then have "is_node_ptr_kind root"
       using False \<open>known_ptr root\<close> \<open>root |\<in>| object_ptr_kinds h\<close>
       apply(simp add: known_ptr_impl known_ptr_defs DocumentClass.known_ptr_defs
           CharacterDataClass.known_ptr_defs ElementClass.known_ptr_defs NodeClass.known_ptr_defs)
       using is_node_ptr_kind_none by force
     then
     have "(\<exists>document_ptr \<in> fset (document_ptr_kinds h).
 root \<in> cast ` set |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)"
       using local.child_parent_dual local.get_child_nodes_ok local.get_root_node_si_same_no_parent
         local.heap_is_wellformed_children_disc_nodes local.known_ptrs_known_ptr node_ptr_casts_commute3
         node_ptr_inclusion node_ptr_kinds_commutes notin_fset option.distinct(1) returns_result_eq
         returns_result_select_result root
       by (metis (no_types, lifting) assms \<open>root |\<in>| object_ptr_kinds h\<close>)
     then obtain some_owner_document where
       "some_owner_document |\<in>| document_ptr_kinds h" and
       "root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r"
       by auto
     then
     obtain candidates where
       candidates: "h \<turnstile> filter_M
              (\<lambda>document_ptr.
                  Heap_Error_Monad.bind (get_disconnected_nodes document_ptr)
                   (\<lambda>disconnected_nodes. return (root \<in> cast\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ` set disconnected_nodes)))
              (sorted_list_of_set (fset (document_ptr_kinds h)))
        \<rightarrow>\<^sub>r candidates"
       by (metis (no_types, lifting) assms bind_is_OK_I2 bind_pure_I filter_M_is_OK_I finite_fset
           is_OK_returns_result_E local.get_disconnected_nodes_ok local.get_disconnected_nodes_pure
           notin_fset return_ok return_pure sorted_list_of_set(1))
     then have "some_owner_document \<in> set candidates"
       apply(rule filter_M_in_result_if_ok)
       using \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
         apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
       using \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
        apply(auto intro!: bind_pure_I bind_pure_returns_result_I)[1]
       using \<open>some_owner_document |\<in>| document_ptr_kinds h\<close>
         \<open>root \<in> cast ` set |h \<turnstile> get_disconnected_nodes some_owner_document|\<^sub>r\<close>
       apply(auto simp add: assms local.get_disconnected_nodes_ok
           intro!: bind_pure_I bind_pure_returns_result_I)[1]
       done
     then have "candidates \<noteq> []"
       by auto
     then have "owner_document \<in> set candidates"
       using assms(4) root
       apply(auto simp add: CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def elim!:  bind_returns_result_E2
           intro!: filter_M_pure_I bind_pure_I split: option.splits)[1]
        apply (metis candidates list.set_sel(1) returns_result_eq)
       by (metis \<open>is_node_ptr_kind root\<close> node_ptr_no_document_ptr_cast returns_result_eq)
 
     then show ?thesis
       using candidates
       by (meson bind_pure_I bind_returns_result_E2 filter_M_holds_for_result is_OK_returns_result_I
           local.get_disconnected_nodes_ptr_in_heap local.get_disconnected_nodes_pure return_pure)
   qed
 qed
 
 lemma get_owner_document_owner_document_in_heap:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document"
   shows "owner_document |\<in>| document_ptr_kinds h"
   using assms
   apply(auto simp add: get_owner_document_def a_get_owner_document_tups_def
       CD.a_get_owner_document_tups_def)[1]
   apply(split invoke_split_asm)+
 proof -
   assume "h \<turnstile> invoke [] ptr () \<rightarrow>\<^sub>r owner_document"
   then show "owner_document |\<in>| document_ptr_kinds h"
     by (meson invoke_empty is_OK_returns_result_I)
 next
   assume "h \<turnstile> Heap_Error_Monad.bind (check_in_heap ptr)
           (\<lambda>_. (CD.a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ())
     \<rightarrow>\<^sub>r owner_document"
   then show "owner_document |\<in>| document_ptr_kinds h"
     by(auto simp add: CD.a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         elim!: bind_returns_result_E2
         split: if_splits)
 next
   assume 0: "heap_is_wellformed h"
     and 1: "type_wf h"
     and 2: "known_ptrs h"
     and 3: "\<not> is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
     and 4: "is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
     and 5: "h \<turnstile> Heap_Error_Monad.bind (check_in_heap ptr)
           (\<lambda>_. (CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ()) \<rightarrow>\<^sub>r owner_document"
   then show ?thesis
     by (metis bind_returns_result_E2 check_in_heap_pure comp_apply
         get_owner_document_owner_document_in_heap_node)
 next
   assume 0: "heap_is_wellformed h"
     and 1: "type_wf h"
     and 2: "known_ptrs h"
     and 3: "is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
     and 4: "h \<turnstile> Heap_Error_Monad.bind (check_in_heap ptr)
           (\<lambda>_. (CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ()) \<rightarrow>\<^sub>r owner_document"
   then show ?thesis
     by (metis bind_returns_result_E2 check_in_heap_pure comp_apply
         get_owner_document_owner_document_in_heap_node)
 next
   assume 0: "heap_is_wellformed h"
     and 1: "type_wf h"
     and 2: "known_ptrs h"
     and 3: "\<not> is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
     and 4: "\<not> is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
     and 5: "\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
     and 6: "is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
     and 7: "h \<turnstile> Heap_Error_Monad.bind (check_in_heap ptr)
             (\<lambda>_. (local.a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ())
              \<rightarrow>\<^sub>r owner_document"
   then show "owner_document |\<in>| document_ptr_kinds h"
     apply(auto simp add: CD.a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
         intro!: filter_M_pure_I bind_pure_I
         elim!: bind_returns_result_E2
         split: if_splits option.splits)[1]
     using get_owner_document_owner_document_in_heap_node by blast
 qed
 
 lemma get_owner_document_ok:
   assumes "heap_is_wellformed h"  "known_ptrs h" "type_wf h"
   assumes "ptr |\<in>| object_ptr_kinds h"
   shows "h \<turnstile> ok (get_owner_document ptr)"
 proof -
   have "known_ptr ptr"
     using assms(2) assms(4) local.known_ptrs_known_ptr
     by blast
   then show ?thesis
     apply(simp add: get_owner_document_def a_get_owner_document_tups_def CD.a_get_owner_document_tups_def)
     apply(split invoke_splits, (rule conjI | rule impI)+)+
   proof -
     assume 0: "known_ptr ptr"
       and 1: "\<not> is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
       and 2: "\<not> is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
       and 3: "\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
       and 4: "\<not> is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
     then show "h \<turnstile> ok invoke [] ptr ()"
       using NodeClass.a_known_ptr_def known_ptr_not_character_data_ptr known_ptr_not_document_ptr
         known_ptr_not_shadow_root_ptr known_ptr_not_element_ptr known_ptr_impl
       by blast
   next
     assume 0: "known_ptr ptr"
       and 1: "\<not> is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
       and 2: "\<not> is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
       and 3: "\<not> is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr"
     then show "is_shadow_root_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<longrightarrow> h \<turnstile> ok Heap_Error_Monad.bind (check_in_heap ptr)
     (\<lambda>_. (local.a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ())"
       using assms(1) assms(2) assms(3) assms(4)
       by(auto simp add: local.get_host_ok get_root_node_def
           CD.a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
           a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
           intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I get_root_node_si_ok
           get_disconnected_nodes_ok
           intro!: local.get_shadow_root_ptr_in_heap local.shadow_root_host_dual
           split: option.splits)
   next
     show "is_document_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<longrightarrow> h \<turnstile> ok Heap_Error_Monad.bind (check_in_heap ptr)
     (\<lambda>_. (local.CD.a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ())"
       using assms(4)
       by(auto simp add: CD.a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def split: option.splits)
   next
     show "is_character_data_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<longrightarrow> h \<turnstile> ok Heap_Error_Monad.bind (check_in_heap ptr)
     (\<lambda>_. (local.CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ())"
       using assms(1) assms(2) assms(3) assms(4)
       by(auto simp add: local.get_host_ok get_root_node_def
           CD.a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
           a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
           intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I get_root_node_si_ok
           get_disconnected_nodes_ok
           intro!: local.get_shadow_root_ptr_in_heap local.shadow_root_host_dual split: option.splits)
   next
     show "is_element_ptr\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r ptr \<longrightarrow> h \<turnstile> ok Heap_Error_Monad.bind (check_in_heap ptr)
     (\<lambda>_. (local.CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r \<circ> the \<circ> cast\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r) ptr ())"
       using assms(1) assms(2) assms(3) assms(4)
       by(auto simp add: local.get_host_ok get_root_node_def
           CD.a_get_owner_document\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def CD.a_get_owner_document\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
           a_get_owner_document\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r_def
           intro!: bind_is_OK_pure_I filter_M_pure_I bind_pure_I filter_M_is_OK_I get_root_node_si_ok
           get_disconnected_nodes_ok
           intro!: local.get_shadow_root_ptr_in_heap local.shadow_root_host_dual
           split: option.splits)
   qed
 qed
 end
 interpretation i_get_owner_document_wf?: l_get_owner_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf get_disconnected_nodes get_disconnected_nodes_locs known_ptr
   get_child_nodes get_child_nodes_locs DocumentClass.known_ptr get_parent get_parent_locs
   get_root_node_si get_root_node_si_locs CD.a_get_owner_document get_host get_host_locs
   get_owner_document get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs
   heap_is_wellformed parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_document
   get_disconnected_document_locs known_ptrs get_ancestors_si get_ancestors_si_locs
   by(auto simp add: l_get_owner_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def l_get_owner_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms_def
       instances)
 declare l_get_owner_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 lemma get_owner_document_wf_is_l_get_owner_document_wf [instances]: "l_get_owner_document_wf
   heap_is_wellformed type_wf known_ptr known_ptrs get_disconnected_nodes get_owner_document
   get_parent"
   apply(auto simp add: l_get_owner_document_wf_def l_get_owner_document_wf_axioms_def instances)[1]
   using get_owner_document_disconnected_nodes apply fast
   using in_disconnected_nodes_no_parent apply fast
   using get_owner_document_owner_document_in_heap apply fast
   using get_owner_document_ok apply fast
   done
 
 
 subsubsection \<open>remove\_child\<close>
 
 locale l_remove_child_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_set_disconnected_nodes_get_disconnected_nodes +
   l_get_child_nodes +
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_owner_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_remove_child\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_set_child_nodes_get_shadow_root +
   l_set_disconnected_nodes_get_shadow_root +
   l_set_child_nodes_get_tag_name +
   l_set_disconnected_nodes_get_tag_name +
   CD: l_remove_child_wf2\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma remove_child_preserves_type_wf:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'"
   shows "type_wf h'"
   using CD.remove_child_heap_is_wellformed_preserved(1) assms
   unfolding heap_is_wellformed_def
   by auto
 
 lemma remove_child_preserves_known_ptrs:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'"
   shows "known_ptrs h'"
   using CD.remove_child_heap_is_wellformed_preserved(2) assms
   unfolding heap_is_wellformed_def
   by auto
 
 
 lemma remove_child_heap_is_wellformed_preserved:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> remove_child ptr child \<rightarrow>\<^sub>h h'"
   shows "heap_is_wellformed h'"
 proof -
   have "heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M h'"
     using CD.remove_child_heap_is_wellformed_preserved(3) assms
     unfolding heap_is_wellformed_def
     by auto
 
   have shadow_root_eq: "\<And>ptr' shadow_root_ptr_opt. h \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt =
     h' \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt"
     using get_shadow_root_reads remove_child_writes assms(4)
     apply(rule reads_writes_preserved)
     by(auto simp add: remove_child_locs_def set_child_nodes_get_shadow_root
         set_disconnected_nodes_get_shadow_root)
   then
   have shadow_root_eq2: "\<And>ptr'. |h \<turnstile> get_shadow_root ptr'|\<^sub>r = |h' \<turnstile> get_shadow_root ptr'|\<^sub>r"
     by (meson select_result_eq)
 
   have tag_name_eq: "\<And>ptr' tag. h \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag = h' \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag"
     using get_tag_name_reads remove_child_writes assms(4)
     apply(rule reads_writes_preserved)
     by(auto simp add: remove_child_locs_def set_child_nodes_get_tag_name
         set_disconnected_nodes_get_tag_name)
   then
   have tag_name_eq2: "\<And>ptr'. |h \<turnstile> get_tag_name ptr'|\<^sub>r = |h' \<turnstile> get_tag_name ptr'|\<^sub>r"
     by (meson select_result_eq)
 
   have object_ptr_kinds_eq: "object_ptr_kinds h = object_ptr_kinds h'"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF remove_child_writes assms(4)])
     unfolding remove_child_locs_def
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
 
   have shadow_root_ptr_kinds_eq: "shadow_root_ptr_kinds h = shadow_root_ptr_kinds h'"
     using object_ptr_kinds_eq
     by(auto simp add: shadow_root_ptr_kinds_def)
   have element_ptr_kinds_eq: "element_ptr_kinds h = element_ptr_kinds h'"
     using object_ptr_kinds_eq
     by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)
 
   have "parent_child_rel h' \<subseteq> parent_child_rel h"
     using \<open>heap_is_wellformed h\<close> heap_is_wellformed_def
     using CD.remove_child_parent_child_rel_subset
     using \<open>known_ptrs h\<close> \<open>type_wf h\<close> assms(4)
     by simp
 
   show ?thesis
     using \<open>heap_is_wellformed h\<close>
     using \<open>heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M h'\<close> \<open>parent_child_rel h' \<subseteq> parent_child_rel h\<close>
     apply(auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def
         a_host_shadow_root_rel_def a_all_ptrs_in_heap_def a_distinct_lists_def a_shadow_root_valid_def
         object_ptr_kinds_eq element_ptr_kinds_eq shadow_root_ptr_kinds_eq  shadow_root_eq shadow_root_eq2
         tag_name_eq tag_name_eq2)[1]
     by (meson acyclic_subset order_refl sup_mono)
 qed
 
 lemma remove_preserves_type_wf:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> remove child \<rightarrow>\<^sub>h h'"
   shows "type_wf h'"
   using CD.remove_heap_is_wellformed_preserved(1) assms
   unfolding heap_is_wellformed_def
   by auto
 
 lemma remove_preserves_known_ptrs:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> remove child \<rightarrow>\<^sub>h h'"
   shows "known_ptrs h'"
   using CD.remove_heap_is_wellformed_preserved(2) assms
   unfolding heap_is_wellformed_def
   by auto
 
 
 lemma remove_heap_is_wellformed_preserved:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> remove child \<rightarrow>\<^sub>h h'"
   shows "heap_is_wellformed h'"
   using assms
   by(auto simp add: remove_def elim!: bind_returns_heap_E2
       intro: remove_child_heap_is_wellformed_preserved
       split: option.splits)
 
 lemma remove_child_removes_child:
   "heap_is_wellformed h \<Longrightarrow> h \<turnstile> remove_child ptr' child \<rightarrow>\<^sub>h h'
     \<Longrightarrow> h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children
     \<Longrightarrow> known_ptrs h \<Longrightarrow> type_wf h
     \<Longrightarrow> child \<notin> set children"
   using CD.remove_child_removes_child local.heap_is_wellformed_def by blast
 lemma remove_child_removes_first_child: "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow>
     h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r node_ptr # children \<Longrightarrow> h \<turnstile> remove_child ptr node_ptr \<rightarrow>\<^sub>h h' \<Longrightarrow>
     h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   using CD.remove_child_removes_first_child local.heap_is_wellformed_def by blast
 lemma remove_removes_child: "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow>
     h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r node_ptr # children \<Longrightarrow> h \<turnstile> remove node_ptr \<rightarrow>\<^sub>h h' \<Longrightarrow>
     h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
   using CD.remove_removes_child local.heap_is_wellformed_def by blast
 lemma remove_for_all_empty_children: "heap_is_wellformed h \<Longrightarrow> type_wf h \<Longrightarrow> known_ptrs h \<Longrightarrow>
     h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> h \<turnstile> forall_M remove children \<rightarrow>\<^sub>h h' \<Longrightarrow>
     h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r []"
   using CD.remove_for_all_empty_children local.heap_is_wellformed_def by blast
 end
 
 interpretation i_remove_child_wf2?: l_remove_child_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
   set_disconnected_nodes_locs known_ptr get_child_nodes get_child_nodes_locs get_shadow_root
   get_shadow_root_locs get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs DocumentClass.known_ptr get_parent get_parent_locs get_root_node_si
   get_root_node_si_locs CD.a_get_owner_document get_owner_document known_ptrs get_ancestors_si
   get_ancestors_si_locs set_child_nodes set_child_nodes_locs remove_child remove_child_locs remove
   by(auto simp add: l_remove_child_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_remove_child_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma remove_child_wf2_is_l_remove_child_wf2 [instances]:
   "l_remove_child_wf2 type_wf known_ptr known_ptrs remove_child heap_is_wellformed get_child_nodes remove"
   apply(auto simp add: l_remove_child_wf2_def l_remove_child_wf2_axioms_def instances)[1]
   using remove_child_preserves_type_wf apply fast
   using remove_child_preserves_known_ptrs apply fast
   using remove_child_heap_is_wellformed_preserved apply (fast)
   using remove_preserves_type_wf apply fast
   using remove_preserves_known_ptrs apply fast
   using remove_heap_is_wellformed_preserved apply (fast)
   using remove_child_removes_child apply fast
   using remove_child_removes_first_child apply fast
   using remove_removes_child apply fast
   using remove_for_all_empty_children apply fast
   done
 
 
 
 subsubsection \<open>adopt\_node\<close>
 
 locale l_adopt_node_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes +
   l_get_disconnected_nodes +
   l_set_child_nodes_get_shadow_root +
   l_set_disconnected_nodes_get_shadow_root +
   l_set_child_nodes_get_tag_name +
   l_set_disconnected_nodes_get_tag_name +
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_root_node +
   l_set_disconnected_nodes_get_child_nodes +
   l_get_owner_document_wf +
   l_remove_child_wf2 +
   l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_adopt_node\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_get_parent_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma adopt_node_removes_child:
   assumes wellformed: "heap_is_wellformed h"
     and adopt_node: "h \<turnstile> adopt_node owner_document node_ptr \<rightarrow>\<^sub>h h2"
     and children: "h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "node_ptr \<notin> set children"
 proof -
   obtain old_document parent_opt h' where
     old_document: "h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r old_document" and
     parent_opt: "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r parent_opt" and
     h': "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> remove_child parent node_ptr | None \<Rightarrow> return () ) \<rightarrow>\<^sub>h h'"
     using adopt_node
     by(auto simp add: adopt_node_def elim!: bind_returns_heap_E bind_returns_heap_E2[rotated,
           OF get_owner_document_pure, rotated] bind_returns_heap_E2[rotated, OF get_parent_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] split: if_splits)
 
   then have "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
     using adopt_node
     apply(auto simp add: adopt_node_def  dest!: bind_returns_heap_E3[rotated, OF old_document, rotated]
         bind_returns_heap_E3[rotated, OF parent_opt, rotated] elim!: bind_returns_heap_E4[rotated, OF h', rotated])[1]
     apply(auto split: if_splits elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])[1]
      apply (simp add: set_disconnected_nodes_get_child_nodes children
         reads_writes_preserved[OF get_child_nodes_reads set_disconnected_nodes_writes])
     using children by blast
   show ?thesis
   proof(insert parent_opt h', induct parent_opt)
     case None
     then show ?case
       using child_parent_dual wellformed known_ptrs type_wf
         \<open>h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children\<close> returns_result_eq by fastforce
   next
     case (Some option)
     then show ?case
       using remove_child_removes_child \<open>h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children\<close> known_ptrs type_wf
         wellformed
       by auto
   qed
 qed
 
 lemma adopt_node_preserves_wellformedness:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> adopt_node document_ptr child \<rightarrow>\<^sub>h h'"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "heap_is_wellformed h'" and "known_ptrs h'" and "type_wf h'"
 proof -
   obtain old_document parent_opt h2 where
     old_document: "h \<turnstile> get_owner_document (cast child) \<rightarrow>\<^sub>r old_document" and
     parent_opt: "h \<turnstile> get_parent child \<rightarrow>\<^sub>r parent_opt" and
     h2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> remove_child parent child | None \<Rightarrow> return ()) \<rightarrow>\<^sub>h h2" and
     h': "h2 \<turnstile> (if document_ptr \<noteq> old_document then do {
         old_disc_nodes \<leftarrow> get_disconnected_nodes old_document;
         set_disconnected_nodes old_document (remove1 child old_disc_nodes);
         disc_nodes \<leftarrow> get_disconnected_nodes document_ptr;
         set_disconnected_nodes document_ptr (child # disc_nodes)
       } else do {
         return ()
       }) \<rightarrow>\<^sub>h h'"
     using assms(2)
     by(auto simp add: adopt_node_def elim!: bind_returns_heap_E
         dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure]
         pure_returns_heap_eq[rotated, OF get_parent_pure])
 
   have object_ptr_kinds_h_eq3: "object_ptr_kinds h = object_ptr_kinds h2"
     using h2 apply(simp split: option.splits)
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF remove_child_writes])
     using remove_child_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have object_ptr_kinds_M_eq_h:
     "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h2 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     unfolding object_ptr_kinds_M_defs by simp
   then have object_ptr_kinds_eq_h: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
   then have node_ptr_kinds_eq_h: "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by blast
 
   have wellformed_h2: "heap_is_wellformed h2"
     using h2 remove_child_heap_is_wellformed_preserved known_ptrs type_wf
     by (metis (no_types, lifting) assms(1) option.case_eq_if pure_returns_heap_eq return_pure)
   have "type_wf h2"
     using h2 remove_child_preserves_type_wf assms
     by(auto split: option.splits)
   have "known_ptrs h2"
     using h2 remove_child_preserves_known_ptrs assms
     by(auto split: option.splits)
 
   then have "heap_is_wellformed h' \<and> known_ptrs h' \<and> type_wf h'"
   proof(cases "document_ptr = old_document")
     case True
     then show "heap_is_wellformed h' \<and> known_ptrs h' \<and> type_wf h'"
       using h' wellformed_h2 \<open>known_ptrs h2\<close> \<open>type_wf h2\<close> by auto
   next
     case False
     then obtain h3 old_disc_nodes disc_nodes_document_ptr_h3 where
       docs_neq: "document_ptr \<noteq> old_document" and
       old_disc_nodes: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r old_disc_nodes" and
       h3: "h2 \<turnstile> set_disconnected_nodes old_document (remove1 child old_disc_nodes) \<rightarrow>\<^sub>h h3" and
       disc_nodes_document_ptr_h3: "h3 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_document_ptr_h3" and
       h': "h3 \<turnstile> set_disconnected_nodes document_ptr (child # disc_nodes_document_ptr_h3) \<rightarrow>\<^sub>h h'"
       using h'
       by(auto elim!: bind_returns_heap_E
           bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated] )
 
     have object_ptr_kinds_h2_eq3: "object_ptr_kinds h2 = object_ptr_kinds h3"
       apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
             OF set_disconnected_nodes_writes h3])
       using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
       by (auto simp add: reflp_def transp_def)
     then have object_ptr_kinds_M_eq_h2:
       "\<And>ptrs. h2 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h3 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
       by(simp add: object_ptr_kinds_M_defs)
     then have object_ptr_kinds_eq_h2: "|h2 \<turnstile> object_ptr_kinds_M|\<^sub>r = |h3 \<turnstile> object_ptr_kinds_M|\<^sub>r"
       by(simp)
     then have node_ptr_kinds_eq_h2: "|h2 \<turnstile> node_ptr_kinds_M|\<^sub>r = |h3 \<turnstile> node_ptr_kinds_M|\<^sub>r"
       using node_ptr_kinds_M_eq by blast
     then have node_ptr_kinds_eq3_h2: "node_ptr_kinds h2 = node_ptr_kinds h3"
       by auto
     have document_ptr_kinds_eq2_h2: "|h2 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h3 \<turnstile> document_ptr_kinds_M|\<^sub>r"
       using object_ptr_kinds_eq_h2 document_ptr_kinds_M_eq by auto
     then have document_ptr_kinds_eq3_h2: "document_ptr_kinds h2 = document_ptr_kinds h3"
       using object_ptr_kinds_eq_h2 document_ptr_kinds_M_eq by auto
     have children_eq_h2:
       "\<And>ptr children. h2 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children = h3 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
       using get_child_nodes_reads set_disconnected_nodes_writes h3
       apply(rule reads_writes_preserved)
       by (simp add: set_disconnected_nodes_get_child_nodes)
     then have children_eq2_h2: "\<And>ptr. |h2 \<turnstile> get_child_nodes ptr|\<^sub>r = |h3 \<turnstile> get_child_nodes ptr|\<^sub>r"
       using select_result_eq by force
 
     have object_ptr_kinds_h3_eq3: "object_ptr_kinds h3 = object_ptr_kinds h'"
       apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
             OF set_disconnected_nodes_writes h'])
       using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
       by (auto simp add: reflp_def transp_def)
     then have object_ptr_kinds_M_eq_h3:
       "\<And>ptrs. h3 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
       by(simp add: object_ptr_kinds_M_defs)
     then have object_ptr_kinds_eq_h3: "|h3 \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
       by(simp)
     then have node_ptr_kinds_eq_h3: "|h3 \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
       using node_ptr_kinds_M_eq by blast
     then have node_ptr_kinds_eq3_h3: "node_ptr_kinds h3 = node_ptr_kinds h'"
       by auto
     have document_ptr_kinds_eq2_h3: "|h3 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
       using object_ptr_kinds_eq_h3 document_ptr_kinds_M_eq by auto
     then have document_ptr_kinds_eq3_h3: "document_ptr_kinds h3 = document_ptr_kinds h'"
       using object_ptr_kinds_eq_h3 document_ptr_kinds_M_eq by auto
     have children_eq_h3:
       "\<And>ptr children. h3 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children = h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children"
       using get_child_nodes_reads set_disconnected_nodes_writes h'
       apply(rule reads_writes_preserved)
       by (simp add: set_disconnected_nodes_get_child_nodes)
     then have children_eq2_h3: "\<And>ptr. |h3 \<turnstile> get_child_nodes ptr|\<^sub>r = |h' \<turnstile> get_child_nodes ptr|\<^sub>r"
       using select_result_eq by force
 
     have disconnected_nodes_eq_h2: "\<And>doc_ptr disc_nodes. old_document \<noteq> doc_ptr \<Longrightarrow>
       h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes =
       h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
       using get_disconnected_nodes_reads set_disconnected_nodes_writes h3
       apply(rule reads_writes_preserved)
       by (simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers)
     then have disconnected_nodes_eq2_h2: "\<And>doc_ptr. old_document \<noteq> doc_ptr \<Longrightarrow>
       |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
       using select_result_eq by force
     obtain disc_nodes_old_document_h2 where disc_nodes_old_document_h2:
       "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disc_nodes_old_document_h2"
       using old_disc_nodes by blast
     then have disc_nodes_old_document_h3:
       "h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r remove1 child disc_nodes_old_document_h2"
       using h3 old_disc_nodes returns_result_eq set_disconnected_nodes_get_disconnected_nodes
       by fastforce
     have "distinct disc_nodes_old_document_h2"
       using disc_nodes_old_document_h2 local.heap_is_wellformed_disconnected_nodes_distinct
         wellformed_h2 by blast
 
 
     have "type_wf h2"
     proof (insert h2, induct  parent_opt)
       case None
       then show ?case
         using type_wf by simp
     next
       case (Some option)
       then show ?case
         using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF remove_child_writes]
           type_wf remove_child_types_preserved
         by (simp add: reflp_def transp_def)
     qed
     then have "type_wf h3"
       using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'",
           OF set_disconnected_nodes_writes h3]
       using  set_disconnected_nodes_types_preserved
       by(auto simp add: reflp_def transp_def)
     then have "type_wf h'"
       using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'",
           OF set_disconnected_nodes_writes h']
       using  set_disconnected_nodes_types_preserved
       by(auto simp add: reflp_def transp_def)
 
     have disconnected_nodes_eq_h3: "\<And>doc_ptr disc_nodes. document_ptr \<noteq> doc_ptr \<Longrightarrow>
       h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes =
       h' \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
       using get_disconnected_nodes_reads set_disconnected_nodes_writes h'
       apply(rule reads_writes_preserved)
       by (simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers)
     then have disconnected_nodes_eq2_h3: "\<And>doc_ptr. document_ptr \<noteq> doc_ptr \<Longrightarrow>
       |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
       using select_result_eq by force
     have disc_nodes_document_ptr_h2:
       "h2 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_document_ptr_h3"
       using disconnected_nodes_eq_h2 docs_neq disc_nodes_document_ptr_h3 by auto
     have disc_nodes_document_ptr_h':
       "h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r child # disc_nodes_document_ptr_h3"
       using h' disc_nodes_document_ptr_h3
       using set_disconnected_nodes_get_disconnected_nodes by blast
 
     have document_ptr_in_heap: "document_ptr |\<in>| document_ptr_kinds h2"
       using disc_nodes_document_ptr_h3 document_ptr_kinds_eq2_h2 get_disconnected_nodes_ok assms(1)
       unfolding heap_is_wellformed_def
       using disc_nodes_document_ptr_h2 get_disconnected_nodes_ptr_in_heap by blast
     have old_document_in_heap: "old_document |\<in>| document_ptr_kinds h2"
       using disc_nodes_old_document_h3 document_ptr_kinds_eq2_h2 get_disconnected_nodes_ok assms(1)
       unfolding heap_is_wellformed_def
       using get_disconnected_nodes_ptr_in_heap old_disc_nodes by blast
 
     have "child \<in> set disc_nodes_old_document_h2"
     proof (insert parent_opt h2, induct parent_opt)
       case None
       then have "h = h2"
         by(auto)
       moreover have "CD.a_owner_document_valid h"
         using assms(1)  by(simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
       ultimately show ?case
         using old_document disc_nodes_old_document_h2 None(1) child_parent_dual[OF assms(1)]
           in_disconnected_nodes_no_parent assms(1) known_ptrs type_wf by blast
     next
       case (Some option)
       then show ?case
         apply(simp split: option.splits)
         using assms(1) disc_nodes_old_document_h2 old_document remove_child_in_disconnected_nodes
           known_ptrs by blast
     qed
     have "child \<notin> set (remove1 child disc_nodes_old_document_h2)"
       using disc_nodes_old_document_h3 h3 known_ptrs wellformed_h2
         \<open>distinct disc_nodes_old_document_h2\<close> by auto
     have "child \<notin> set disc_nodes_document_ptr_h3"
     proof -
       have "CD.a_distinct_lists h2"
         using heap_is_wellformed_def CD.heap_is_wellformed_def wellformed_h2 by blast
       then have 0: "distinct (concat (map (\<lambda>document_ptr.
         |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r) |h2 \<turnstile> document_ptr_kinds_M|\<^sub>r))"
         by(simp add: CD.a_distinct_lists_def)
       show ?thesis
         using distinct_concat_map_E(1)[OF 0] \<open>child \<in> set disc_nodes_old_document_h2\<close>
           disc_nodes_old_document_h2 disc_nodes_document_ptr_h2
         by (meson \<open>type_wf h2\<close> docs_neq known_ptrs local.get_owner_document_disconnected_nodes
             local.known_ptrs_preserved object_ptr_kinds_h_eq3 returns_result_eq wellformed_h2)
     qed
 
     have child_in_heap: "child |\<in>| node_ptr_kinds h"
       using get_owner_document_ptr_in_heap[OF is_OK_returns_result_I[OF old_document]]
         node_ptr_kinds_commutes by blast
     have "CD.a_acyclic_heap h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
     have "parent_child_rel h' \<subseteq> parent_child_rel h2"
     proof
       fix x
       assume "x \<in> parent_child_rel h'"
       then show "x \<in> parent_child_rel h2"
         using object_ptr_kinds_h2_eq3  object_ptr_kinds_h3_eq3 children_eq2_h2 children_eq2_h3
           mem_Collect_eq object_ptr_kinds_M_eq_h3 select_result_eq split_cong
         unfolding CD.parent_child_rel_def
         by(simp)
     qed
     then have " CD.a_acyclic_heap h'"
       using \<open> CD.a_acyclic_heap h2\<close>  CD.acyclic_heap_def acyclic_subset by blast
 
     moreover have " CD.a_all_ptrs_in_heap h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
     then have "CD.a_all_ptrs_in_heap h3"
       apply(auto simp add: CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h2 children_eq_h2)[1]
        apply (metis \<open>type_wf h'\<close> children_eq2_h3 children_eq_h2 children_eq_h3 known_ptrs
           l_heap_is_wellformed.heap_is_wellformed_children_in_heap local.get_child_nodes_ok
           local.known_ptrs_known_ptr local.l_heap_is_wellformed_axioms node_ptr_kinds_eq3_h2
           object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 object_ptr_kinds_h_eq3
           returns_result_select_result wellformed_h2)
       by (metis (no_types, hide_lams) disc_nodes_old_document_h2 disc_nodes_old_document_h3
           disconnected_nodes_eq2_h2 document_ptr_kinds_eq3_h2 finite_set_in select_result_I2
           set_remove1_subset subsetD)
     then have "CD.a_all_ptrs_in_heap h'"
       apply(auto simp add: CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq3_h3 children_eq_h3)[1]
        apply (metis (no_types, hide_lams) children_eq2_h3 finite_set_in object_ptr_kinds_h3_eq3
           subsetD)
       by (metis (no_types, hide_lams) \<open>child \<in> set disc_nodes_old_document_h2\<close> disc_nodes_document_ptr_h'
           disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disconnected_nodes_eq2_h3
           document_ptr_kinds_eq3_h3 finite_set_in local.heap_is_wellformed_disc_nodes_in_heap
           node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3 select_result_I2 set_ConsD subsetD wellformed_h2)
 
     moreover have "CD.a_owner_document_valid h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
     then have "CD.a_owner_document_valid h'"
       apply(simp add: CD.a_owner_document_valid_def node_ptr_kinds_eq_h2 node_ptr_kinds_eq3_h3
           object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 document_ptr_kinds_eq2_h2 document_ptr_kinds_eq2_h3
           children_eq2_h2 children_eq2_h3 )
       by (metis (no_types) disc_nodes_document_ptr_h' disc_nodes_document_ptr_h2
           disc_nodes_old_document_h2 disc_nodes_old_document_h3 disconnected_nodes_eq2_h2
           disconnected_nodes_eq2_h3 document_ptr_in_heap document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3
           in_set_remove1 list.set_intros(1) list.set_intros(2) node_ptr_kinds_eq3_h2 node_ptr_kinds_eq3_h3
           object_ptr_kinds_h2_eq3 object_ptr_kinds_h3_eq3 select_result_I2)
 
     have a_distinct_lists_h2: "CD.a_distinct_lists h2"
       using wellformed_h2 by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
     then have "CD.a_distinct_lists h'"
       apply(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_eq_h3 object_ptr_kinds_eq_h2
           children_eq2_h2 children_eq2_h3)[1]
     proof -
       assume 1: "distinct (concat (map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r)
         (sorted_list_of_set (fset (object_ptr_kinds h')))))"
         and 2: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
         (sorted_list_of_set (fset (document_ptr_kinds h2)))))"
         and 3: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r) \<inter>
         (\<Union>x\<in>fset (document_ptr_kinds h2). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       show "distinct (concat (map (\<lambda>document_ptr. |h' \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
         (sorted_list_of_set (fset (document_ptr_kinds h')))))"
       proof(rule distinct_concat_map_I)
         show "distinct (sorted_list_of_set (fset (document_ptr_kinds h')))"
           by(auto simp add: document_ptr_kinds_M_def )
       next
         fix x
         assume a1: "x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))"
         have 4: "distinct |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r"
           using a_distinct_lists_h2 "2" a1 concat_map_all_distinct document_ptr_kinds_eq2_h2
             document_ptr_kinds_eq2_h3 by fastforce
         then show "distinct |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
         proof (cases "old_document \<noteq> x")
           case True
           then show ?thesis
           proof (cases "document_ptr \<noteq> x")
             case True
             then show ?thesis
               using disconnected_nodes_eq2_h2[OF \<open>old_document \<noteq> x\<close>]
                 disconnected_nodes_eq2_h3[OF \<open>document_ptr \<noteq> x\<close>] 4
               by(auto)
           next
             case False
             then show ?thesis
               using  disc_nodes_document_ptr_h3 disc_nodes_document_ptr_h' 4
                 \<open>child \<notin> set disc_nodes_document_ptr_h3\<close>
               by(auto simp add: disconnected_nodes_eq2_h2[OF \<open>old_document \<noteq> x\<close>] )
           qed
         next
           case False
           then show ?thesis
             by (metis (no_types, hide_lams) \<open>distinct disc_nodes_old_document_h2\<close>
                 disc_nodes_old_document_h3 disconnected_nodes_eq2_h3 distinct_remove1 docs_neq select_result_I2)
         qed
       next
         fix x y
         assume a0: "x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))"
           and a1: "y \<in> set (sorted_list_of_set (fset (document_ptr_kinds h')))"
           and a2: "x \<noteq> y"
 
         moreover have 5: "set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter>
           set |h2 \<turnstile> get_disconnected_nodes y|\<^sub>r = {}"
           using 2 calculation
           by (auto simp add: document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3
               dest: distinct_concat_map_E(1))
         ultimately show "set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter>
           set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r = {}"
         proof(cases "old_document = x")
           case True
           have "old_document \<noteq> y"
             using \<open>x \<noteq> y\<close> \<open>old_document = x\<close> by simp
           have "document_ptr \<noteq> x"
             using docs_neq \<open>old_document = x\<close> by auto
           show ?thesis
           proof(cases "document_ptr = y")
             case True
             then show ?thesis
               using 5 True select_result_I2[OF disc_nodes_document_ptr_h']
                 select_result_I2[OF disc_nodes_document_ptr_h2]
                 select_result_I2[OF disc_nodes_old_document_h2]
                 select_result_I2[OF disc_nodes_old_document_h3] \<open>old_document = x\<close>
               by (metis (no_types, lifting) \<open>child \<notin> set (remove1 child disc_nodes_old_document_h2)\<close>
                   \<open>document_ptr \<noteq> x\<close> disconnected_nodes_eq2_h3 disjoint_iff_not_equal notin_set_remove1 set_ConsD)
           next
             case False
             then show ?thesis
               using 5 select_result_I2[OF disc_nodes_document_ptr_h']
                 select_result_I2[OF disc_nodes_document_ptr_h2]
                 select_result_I2[OF disc_nodes_old_document_h2]
                 select_result_I2[OF disc_nodes_old_document_h3]
                 disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 \<open>old_document = x\<close> docs_neq
                 \<open>old_document \<noteq> y\<close>
               by (metis (no_types, lifting) disjoint_iff_not_equal notin_set_remove1)
           qed
         next
           case False
           then show ?thesis
           proof(cases "old_document = y")
             case True
             then show ?thesis
             proof(cases "document_ptr = x")
               case True
               show ?thesis
                 using 5 select_result_I2[OF disc_nodes_document_ptr_h']
                   select_result_I2[OF disc_nodes_document_ptr_h2]
                   select_result_I2[OF disc_nodes_old_document_h2]
                   select_result_I2[OF disc_nodes_old_document_h3]
                   \<open>old_document \<noteq> x\<close> \<open>old_document = y\<close> \<open>document_ptr = x\<close>
                 apply(simp)
                 by (metis (no_types, lifting)
                     \<open>child \<notin> set (remove1 child disc_nodes_old_document_h2)\<close>
                     disconnected_nodes_eq2_h3 disjoint_iff_not_equal notin_set_remove1)
             next
               case False
               then show ?thesis
                 using 5 select_result_I2[OF disc_nodes_document_ptr_h']
                   select_result_I2[OF disc_nodes_document_ptr_h2]
                   select_result_I2[OF disc_nodes_old_document_h2]
                   select_result_I2[OF disc_nodes_old_document_h3] \<open>old_document \<noteq> x\<close>
                   \<open>old_document = y\<close> \<open>document_ptr \<noteq> x\<close>
                 by (metis (no_types, lifting) disconnected_nodes_eq2_h2
                     disconnected_nodes_eq2_h3 disjoint_iff_not_equal docs_neq notin_set_remove1)
             qed
           next
             case False
             have "set |h2 \<turnstile> get_disconnected_nodes y|\<^sub>r \<inter> set disc_nodes_old_document_h2 = {}"
               by (metis DocumentMonad.ptr_kinds_M_ok DocumentMonad.ptr_kinds_M_ptr_kinds False
                   \<open>type_wf h2\<close> a1 disc_nodes_old_document_h2 document_ptr_kinds_M_def document_ptr_kinds_eq2_h2
                   document_ptr_kinds_eq2_h3 l_ptr_kinds_M.ptr_kinds_ptr_kinds_M local.get_disconnected_nodes_ok
                   local.heap_is_wellformed_one_disc_parent returns_result_select_result wellformed_h2)
             then show ?thesis
             proof(cases "document_ptr = x")
               case True
               then have "document_ptr \<noteq> y"
                 using \<open>x \<noteq> y\<close> by auto
               have "set |h2 \<turnstile> get_disconnected_nodes y|\<^sub>r \<inter> set disc_nodes_old_document_h2 = {}"
                 using \<open>set |h2 \<turnstile> get_disconnected_nodes y|\<^sub>r \<inter> set disc_nodes_old_document_h2 = {}\<close>
                 by blast
               then show ?thesis
                 using 5 select_result_I2[OF disc_nodes_document_ptr_h']
                   select_result_I2[OF disc_nodes_document_ptr_h2]
                   select_result_I2[OF disc_nodes_old_document_h2]
                   select_result_I2[OF disc_nodes_old_document_h3] \<open>old_document \<noteq> x\<close>
                   \<open>old_document \<noteq> y\<close> \<open>document_ptr = x\<close> \<open>document_ptr \<noteq> y\<close>
                   \<open>child \<in> set disc_nodes_old_document_h2\<close> disconnected_nodes_eq2_h2
                   disconnected_nodes_eq2_h3 \<open>set |h2 \<turnstile> get_disconnected_nodes y|\<^sub>r \<inter> set disc_nodes_old_document_h2 = {}\<close>
                 by(auto)
             next
               case False
               then show ?thesis
               proof(cases "document_ptr = y")
                 case True
                 have f1: "set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter> set disc_nodes_document_ptr_h3 = {}"
                   using 2 a1 document_ptr_in_heap document_ptr_kinds_eq2_h2
                     document_ptr_kinds_eq2_h3 \<open>document_ptr \<noteq> x\<close>
                     select_result_I2[OF disc_nodes_document_ptr_h3, symmetric]
                     disconnected_nodes_eq2_h2[OF docs_neq[symmetric], symmetric]
                   by (simp add: "5" True)
                 moreover have f1: "set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter>
 set |h2 \<turnstile> get_disconnected_nodes old_document|\<^sub>r = {}"
                   using 2 a1 old_document_in_heap document_ptr_kinds_eq2_h2
                     document_ptr_kinds_eq2_h3 \<open>old_document \<noteq> x\<close>
                   by (metis (no_types, lifting) a0 distinct_concat_map_E(1)
                       document_ptr_kinds_eq3_h2 document_ptr_kinds_eq3_h3 finite_fset fmember.rep_eq
                       set_sorted_list_of_set)
                 ultimately show ?thesis
                   using 5 select_result_I2[OF disc_nodes_document_ptr_h']
                     select_result_I2[OF disc_nodes_old_document_h2] \<open>old_document \<noteq> x\<close>
                     \<open>document_ptr \<noteq> x\<close> \<open>document_ptr = y\<close>
                     \<open>child \<in> set disc_nodes_old_document_h2\<close> disconnected_nodes_eq2_h2
                     disconnected_nodes_eq2_h3
                   by auto
               next
                 case False
                 then show ?thesis
                   using 5
                     select_result_I2[OF disc_nodes_old_document_h2] \<open>old_document \<noteq> x\<close>
                     \<open>document_ptr \<noteq> x\<close> \<open>document_ptr \<noteq> y\<close>
                     \<open>child \<in> set disc_nodes_old_document_h2\<close> disconnected_nodes_eq2_h2
                     disconnected_nodes_eq2_h3
                   by (metis \<open>set |h2 \<turnstile> get_disconnected_nodes y|\<^sub>r \<inter>
                   set disc_nodes_old_document_h2 = {}\<close> empty_iff inf.idem)
               qed
             qed
           qed
         qed
       qed
     next
       fix x xa xb
       assume 0: "distinct (concat (map (\<lambda>ptr. |h' \<turnstile> get_child_nodes ptr|\<^sub>r)
           (sorted_list_of_set (fset (object_ptr_kinds h')))))"
         and 1: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
           (sorted_list_of_set (fset (document_ptr_kinds h2)))))"
         and 2: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r) \<inter>
           (\<Union>x\<in>fset (document_ptr_kinds h2). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         and 3: "xa |\<in>| object_ptr_kinds h'"
         and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         and 5: "xb |\<in>| document_ptr_kinds h'"
         and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
       then show False
         using \<open>child \<in> set disc_nodes_old_document_h2\<close> disc_nodes_document_ptr_h'
           disc_nodes_document_ptr_h2 disc_nodes_old_document_h2 disc_nodes_old_document_h3
           disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 document_ptr_kinds_eq2_h2
           document_ptr_kinds_eq2_h3  old_document_in_heap
         apply(auto)[1]
         apply(cases "xb = old_document")
       proof -
         assume a1: "xb = old_document"
         assume a2: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disc_nodes_old_document_h2"
         assume a3: "h3 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r remove1 child disc_nodes_old_document_h2"
         assume a4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         assume "document_ptr_kinds h2 = document_ptr_kinds h'"
         assume a5: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r) \<inter>
           (\<Union>x\<in>fset (document_ptr_kinds h'). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         have f6: "old_document |\<in>| document_ptr_kinds h'"
           using a1 \<open>xb |\<in>| document_ptr_kinds h'\<close> by blast
         have f7: "|h2 \<turnstile> get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2"
           using a2 by simp
         have "x \<in> set disc_nodes_old_document_h2"
           using f6 a3 a1 by (metis (no_types) \<open>type_wf h'\<close>
               \<open>x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r\<close> disconnected_nodes_eq_h3 docs_neq
               get_disconnected_nodes_ok returns_result_eq returns_result_select_result set_remove1_subset subsetCE)
         then have "set |h' \<turnstile> get_child_nodes xa|\<^sub>r \<inter>  set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r = {}"
           using f7 f6 a5 a4 \<open>xa |\<in>| object_ptr_kinds h'\<close>
           by fastforce
         then show ?thesis
           using \<open>x \<in> set disc_nodes_old_document_h2\<close> a1 a4 f7 by blast
       next
         assume a1: "xb \<noteq> old_document"
         assume a2: "h2 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_document_ptr_h3"
         assume a3: "h2 \<turnstile> get_disconnected_nodes old_document \<rightarrow>\<^sub>r disc_nodes_old_document_h2"
         assume a4: "xa |\<in>| object_ptr_kinds h'"
         assume a5: "h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r child # disc_nodes_document_ptr_h3"
         assume a6: "old_document |\<in>| document_ptr_kinds h'"
         assume a7: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
         assume a8: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
         assume a9: "document_ptr_kinds h2 = document_ptr_kinds h'"
         assume a10: "\<And>doc_ptr. old_document \<noteq> doc_ptr \<Longrightarrow>
           |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
         assume a11: "\<And>doc_ptr. document_ptr \<noteq> doc_ptr \<Longrightarrow> |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r =
           |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
         assume a12: "(\<Union>x\<in>fset (object_ptr_kinds h'). set |h' \<turnstile> get_child_nodes x|\<^sub>r) \<inter>
           (\<Union>x\<in>fset (document_ptr_kinds h'). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
         have f13: "\<And>d. d \<notin> set |h' \<turnstile> document_ptr_kinds_M|\<^sub>r \<or> h2 \<turnstile> ok get_disconnected_nodes d"
           using a9 \<open>type_wf h2\<close> get_disconnected_nodes_ok
           by simp
         then have f14: "|h2 \<turnstile> get_disconnected_nodes old_document|\<^sub>r = disc_nodes_old_document_h2"
           using a6 a3 by simp
         have "x \<notin> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r"
           using a12 a8 a4 \<open>xb |\<in>| document_ptr_kinds h'\<close>
           by (meson UN_I disjoint_iff_not_equal fmember.rep_eq)
         then have "x = child"
           using f13 a11 a10 a7 a5 a2 a1
           by (metis (no_types, lifting) select_result_I2 set_ConsD)
         then have "child \<notin> set disc_nodes_old_document_h2"
           using f14 a12 a8 a6 a4
           by (metis \<open>type_wf h'\<close> adopt_node_removes_child assms(1) assms(2) type_wf
               get_child_nodes_ok known_ptrs local.known_ptrs_known_ptr object_ptr_kinds_h2_eq3
               object_ptr_kinds_h3_eq3 object_ptr_kinds_h_eq3 returns_result_select_result)
         then show ?thesis
           using \<open>child \<in> set disc_nodes_old_document_h2\<close> by fastforce
       qed
     qed
     ultimately have "heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M h'"
       using \<open>CD.a_owner_document_valid h'\<close> CD.heap_is_wellformed_def
       by simp
 
 
 
     have shadow_root_eq_h2:
       "\<And>ptr' shadow_root_ptr_opt. h2 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt =
   h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt"
       using get_shadow_root_reads set_disconnected_nodes_writes h3
       apply(rule reads_writes_preserved)
       by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_shadow_root
           set_disconnected_nodes_get_shadow_root)
     then
     have shadow_root_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_shadow_root ptr'|\<^sub>r = |h3 \<turnstile> get_shadow_root ptr'|\<^sub>r"
       by (meson select_result_eq)
 
     have shadow_root_eq_h3:
       "\<And>ptr' shadow_root_ptr_opt. h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt =
 h' \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt"
       using get_shadow_root_reads set_disconnected_nodes_writes h'
       apply(rule reads_writes_preserved)
       by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_shadow_root
           set_disconnected_nodes_get_shadow_root)
     then
     have shadow_root_eq2_h3: "\<And>ptr'. |h3 \<turnstile> get_shadow_root ptr'|\<^sub>r = |h' \<turnstile> get_shadow_root ptr'|\<^sub>r"
       by (meson select_result_eq)
 
     have tag_name_eq_h2: "\<And>ptr' tag. h2 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag = h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag"
       using get_tag_name_reads set_disconnected_nodes_writes h3
       apply(rule reads_writes_preserved)
       by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_tag_name
           set_disconnected_nodes_get_tag_name)
     then
     have tag_name_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_tag_name ptr'|\<^sub>r = |h3 \<turnstile> get_tag_name ptr'|\<^sub>r"
       by (meson select_result_eq)
 
     have tag_name_eq_h3: "\<And>ptr' tag. h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag = h' \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag"
       using get_tag_name_reads set_disconnected_nodes_writes h'
       apply(rule reads_writes_preserved)
       by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_tag_name
           set_disconnected_nodes_get_tag_name)
     then
     have tag_name_eq2_h3: "\<And>ptr'. |h3 \<turnstile> get_tag_name ptr'|\<^sub>r = |h' \<turnstile> get_tag_name ptr'|\<^sub>r"
       by (meson select_result_eq)
 
     have object_ptr_kinds_eq_h2: "object_ptr_kinds h2 = object_ptr_kinds h3"
       apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
             OF set_disconnected_nodes_writes h3])
       unfolding adopt_node_locs_def remove_child_locs_def
       using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
       by (auto simp add: reflp_def transp_def  split: if_splits)
 
     have object_ptr_kinds_eq_h3: "object_ptr_kinds h3 = object_ptr_kinds h'"
       apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
             OF set_disconnected_nodes_writes h'])
       unfolding adopt_node_locs_def remove_child_locs_def
       using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
       by (auto simp add: reflp_def transp_def  split: if_splits)
 
     have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h3"
       using object_ptr_kinds_eq_h2
       by(auto simp add: shadow_root_ptr_kinds_def)
     have element_ptr_kinds_eq_h2: "element_ptr_kinds h2 = element_ptr_kinds h3"
       using object_ptr_kinds_eq_h2
       by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)
 
     have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h'"
       using object_ptr_kinds_eq_h3
       by(auto simp add: shadow_root_ptr_kinds_def)
     have element_ptr_kinds_eq_h3: "element_ptr_kinds h3 = element_ptr_kinds h'"
       using object_ptr_kinds_eq_h3
       by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)
 
 
     have "known_ptrs h3"
       using known_ptrs local.known_ptrs_preserved object_ptr_kinds_h2_eq3 object_ptr_kinds_h_eq3
       by blast
     then have "known_ptrs h'"
       using local.known_ptrs_preserved object_ptr_kinds_h3_eq3 by blast
 
 
     show "heap_is_wellformed h' \<and> known_ptrs h' \<and> type_wf h'"
       using \<open>heap_is_wellformed h2\<close>
       using \<open>heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M h'\<close> \<open>known_ptrs h'\<close> \<open>type_wf h'\<close>
       using \<open>parent_child_rel h' \<subseteq> parent_child_rel h2\<close>
       apply(auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def
           a_host_shadow_root_rel_def a_all_ptrs_in_heap_def a_distinct_lists_def a_shadow_root_valid_def
           object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 element_ptr_kinds_eq_h2 element_ptr_kinds_eq_h3
           shadow_root_ptr_kinds_eq_h2 shadow_root_ptr_kinds_eq_h3  shadow_root_eq_h2 shadow_root_eq_h3
           shadow_root_eq2_h2 shadow_root_eq2_h3 tag_name_eq_h2 tag_name_eq_h3 tag_name_eq2_h2
           tag_name_eq2_h3 CD.parent_child_rel_def children_eq2_h2 children_eq2_h3 object_ptr_kinds_h2_eq3
           object_ptr_kinds_h3_eq3)[1]
       done
   qed
   then show "heap_is_wellformed h'" and "known_ptrs h'" and "type_wf h'"
     by auto
 qed
 
 
 lemma adopt_node_node_in_disconnected_nodes:
   assumes wellformed: "heap_is_wellformed h"
     and adopt_node: "h \<turnstile> adopt_node owner_document node_ptr \<rightarrow>\<^sub>h h'"
     and "h' \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes"
     and known_ptrs: "known_ptrs h"
     and type_wf: "type_wf h"
   shows "node_ptr \<in> set disc_nodes"
 proof -
   obtain old_document parent_opt h2 where
     old_document: "h \<turnstile> get_owner_document (cast node_ptr) \<rightarrow>\<^sub>r old_document" and
     parent_opt: "h \<turnstile> get_parent node_ptr \<rightarrow>\<^sub>r parent_opt" and
     h2: "h \<turnstile> (case parent_opt of Some parent \<Rightarrow> remove_child parent node_ptr | None \<Rightarrow> return ()) \<rightarrow>\<^sub>h h2" and
     h': "h2 \<turnstile> (if owner_document \<noteq> old_document then do {
         old_disc_nodes \<leftarrow> get_disconnected_nodes old_document;
         set_disconnected_nodes old_document (remove1 node_ptr old_disc_nodes);
         disc_nodes \<leftarrow> get_disconnected_nodes owner_document;
         set_disconnected_nodes owner_document (node_ptr # disc_nodes)
       } else do {
         return ()
       }) \<rightarrow>\<^sub>h h'"
     using assms(2)
     by(auto simp add: adopt_node_def elim!: bind_returns_heap_E
         dest!: pure_returns_heap_eq[rotated, OF get_owner_document_pure]
         pure_returns_heap_eq[rotated, OF get_parent_pure])
 
   show ?thesis
   proof (cases "owner_document = old_document")
     case True
     then show ?thesis
     proof (insert parent_opt h2, induct parent_opt)
       case None
       then have "h = h'"
         using h2 h' by(auto)
       then show ?case
         using in_disconnected_nodes_no_parent assms None old_document by blast
     next
       case (Some parent)
       then show ?case
         using remove_child_in_disconnected_nodes known_ptrs True h' assms(3) old_document
         by auto
     qed
   next
     case False
     then show ?thesis
       using assms(3)  h' list.set_intros(1) select_result_I2
         set_disconnected_nodes_get_disconnected_nodes
       apply(auto elim!: bind_returns_heap_E
           bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated])[1]
     proof -
       fix x  and h'a and xb
       assume a1: "h' \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disc_nodes"
       assume a2: "\<And>h document_ptr disc_nodes h'.
         h \<turnstile> set_disconnected_nodes document_ptr disc_nodes \<rightarrow>\<^sub>h h' \<Longrightarrow>
         h' \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes"
       assume "h'a \<turnstile> set_disconnected_nodes owner_document (node_ptr # xb) \<rightarrow>\<^sub>h h'"
       then have "node_ptr # xb = disc_nodes"
         using a2 a1 by (meson returns_result_eq)
       then show ?thesis
         by (meson list.set_intros(1))
     qed
   qed
 qed
 end
 
 interpretation l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M Shadow_DOM.get_owner_document Shadow_DOM.get_parent
   Shadow_DOM.get_parent_locs Shadow_DOM.remove_child Shadow_DOM.remove_child_locs
   get_disconnected_nodes get_disconnected_nodes_locs
   set_disconnected_nodes set_disconnected_nodes_locs Shadow_DOM.adopt_node Shadow_DOM.adopt_node_locs
   ShadowRootClass.known_ptr ShadowRootClass.type_wf Shadow_DOM.get_child_nodes
   Shadow_DOM.get_child_nodes_locs
   ShadowRootClass.known_ptrs Shadow_DOM.set_child_nodes Shadow_DOM.set_child_nodes_locs
   Shadow_DOM.remove Shadow_DOM.heap_is_wellformed Shadow_DOM.parent_child_rel
   by(auto simp add: l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_adopt_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 interpretation i_adopt_node_wf2?: l_adopt_node_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf known_ptr get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs set_child_nodes set_child_nodes_locs get_shadow_root get_shadow_root_locs
   set_disconnected_nodes set_disconnected_nodes_locs get_tag_name get_tag_name_locs heap_is_wellformed
   parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs get_root_node get_root_node_locs get_parent get_parent_locs known_ptrs
   get_owner_document remove_child remove_child_locs remove adopt_node adopt_node_locs
   by(auto simp add: l_adopt_node_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_adopt_node_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 lemma adopt_node_wf_is_l_adopt_node_wf [instances]:
   "l_adopt_node_wf type_wf known_ptr heap_is_wellformed parent_child_rel get_child_nodes
   get_disconnected_nodes known_ptrs adopt_node"
   apply(auto simp add: l_adopt_node_wf_def l_adopt_node_wf_axioms_def instances)[1]
   using adopt_node_preserves_wellformedness apply blast
   using adopt_node_removes_child apply blast
   using adopt_node_node_in_disconnected_nodes apply blast
   using adopt_node_removes_first_child apply blast
   using adopt_node_document_in_heap apply blast
   using adopt_node_preserves_wellformedness apply blast
   using adopt_node_preserves_wellformedness apply blast
   done
 
 
 subsubsection \<open>insert\_before\<close>
 
 locale l_insert_before_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes +
   l_get_disconnected_nodes +
   l_set_child_nodes_get_shadow_root +
   l_set_disconnected_nodes_get_shadow_root +
   l_set_child_nodes_get_tag_name +
   l_set_disconnected_nodes_get_tag_name +
   l_set_disconnected_nodes_get_disconnected_nodes +
   l_set_child_nodes_get_disconnected_nodes +
   l_set_disconnected_nodes_get_disconnected_nodes_wf +
   l_set_disconnected_nodes_get_ancestors_si +
   l_insert_before\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M _ _ _ _ _ _ get_ancestors_si get_ancestors_si_locs +
   l_get_root_node_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M  +
   l_get_owner_document  +
   l_adopt_node  +
   l_adopt_node_wf  +
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_adopt_node_get_shadow_root
 begin
 lemma insert_before_child_preserves:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> insert_before ptr node child \<rightarrow>\<^sub>h h'"
   shows "type_wf h'" and "known_ptrs h'" and "heap_is_wellformed h'"
 proof -
   obtain ancestors reference_child owner_document h2 h3 disconnected_nodes_h2 where
     ancestors: "h \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors" and
     node_not_in_ancestors: "cast node \<notin> set ancestors" and
     reference_child:
     "h \<turnstile> (if Some node = child then a_next_sibling node else return child) \<rightarrow>\<^sub>r reference_child" and
     owner_document: "h \<turnstile> get_owner_document ptr \<rightarrow>\<^sub>r owner_document" and
     h2: "h \<turnstile> adopt_node owner_document node \<rightarrow>\<^sub>h h2" and
     disconnected_nodes_h2: "h2 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r disconnected_nodes_h2" and
     h3: "h2 \<turnstile> set_disconnected_nodes owner_document (remove1 node disconnected_nodes_h2) \<rightarrow>\<^sub>h h3" and
     h': "h3 \<turnstile> a_insert_node ptr node reference_child \<rightarrow>\<^sub>h h'"
     (* children: "h3 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children" and *)
     (* h': "h3 \<turnstile> set_child_nodes ptr (insert_before_list node reference_child children) \<rightarrow>\<^sub>h h'" *)
     using assms(4)
     by(auto simp add: insert_before_def a_ensure_pre_insertion_validity_def
         elim!: bind_returns_heap_E bind_returns_result_E
         bind_returns_heap_E2[rotated, OF get_parent_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_disconnected_nodes_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_ancestors_pure, rotated]
         bind_returns_heap_E2[rotated, OF next_sibling_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_owner_document_pure, rotated]
         split: if_splits option.splits)
 
   have "type_wf h2"
     using \<open>type_wf h\<close>
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF adopt_node_writes h2]
     using adopt_node_types_preserved
     by(auto simp add: reflp_def transp_def)
   then have "type_wf h3"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF set_disconnected_nodes_writes h3]
     using set_disconnected_nodes_types_preserved
     by(auto simp add: reflp_def transp_def)
   then show "type_wf h'"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF insert_node_writes h']
     using set_child_nodes_types_preserved
     by(auto simp add: reflp_def transp_def)
 
   have "object_ptr_kinds h = object_ptr_kinds h2"
     using adopt_node_writes h2
     apply(rule writes_small_big)
     using adopt_node_pointers_preserved
     by(auto simp add: reflp_def transp_def)
   moreover have "\<dots> = object_ptr_kinds h3"
     using set_disconnected_nodes_writes h3
     apply(rule writes_small_big)
     using set_disconnected_nodes_pointers_preserved
     by(auto simp add: reflp_def transp_def)
   moreover have "\<dots> = object_ptr_kinds h'"
     using insert_node_writes h'
     apply(rule writes_small_big)
     using set_child_nodes_pointers_preserved
     by(auto simp add: reflp_def transp_def)
 
   ultimately
   show "known_ptrs h'"
     using \<open>known_ptrs h\<close> known_ptrs_preserved
     by blast
 
   have "known_ptrs h2"
     using \<open>known_ptrs h\<close> known_ptrs_preserved \<open>object_ptr_kinds h = object_ptr_kinds h2\<close>
     by blast
   then
   have "known_ptrs h3"
     using known_ptrs_preserved \<open>object_ptr_kinds h2 = object_ptr_kinds h3\<close>
     by blast
 
   have "known_ptr ptr"
     by (meson get_owner_document_ptr_in_heap is_OK_returns_result_I \<open>known_ptrs h\<close>
         l_known_ptrs.known_ptrs_known_ptr l_known_ptrs_axioms owner_document)
 
   have object_ptr_kinds_M_eq3_h: "object_ptr_kinds h = object_ptr_kinds h2"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF adopt_node_writes h2])
     using adopt_node_pointers_preserved
       apply blast
     by (auto simp add: reflp_def transp_def)
   then have object_ptr_kinds_M_eq_h:
     "\<And>ptrs. h \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h2 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     by(simp add: object_ptr_kinds_M_defs )
   then have object_ptr_kinds_M_eq2_h: "|h \<turnstile> object_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
   then have node_ptr_kinds_eq2_h: "|h \<turnstile> node_ptr_kinds_M|\<^sub>r = |h2 \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by blast
 
   have wellformed_h2: "heap_is_wellformed h2"
     using adopt_node_preserves_wellformedness[OF \<open>heap_is_wellformed h\<close> h2] \<open>known_ptrs h\<close>
       \<open>type_wf h\<close>
     .
 
   have object_ptr_kinds_M_eq3_h2: "object_ptr_kinds h2 = object_ptr_kinds h3"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF set_disconnected_nodes_writes h3])
     unfolding a_remove_child_locs_def
     using set_disconnected_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have object_ptr_kinds_M_eq_h2:
     "\<And>ptrs. h2 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h3 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     by(simp add: object_ptr_kinds_M_defs)
   then have object_ptr_kinds_M_eq2_h2: "|h2 \<turnstile> object_ptr_kinds_M|\<^sub>r = |h3 \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
   then have node_ptr_kinds_eq2_h2: "|h2 \<turnstile> node_ptr_kinds_M|\<^sub>r = |h3 \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by blast
   have document_ptr_kinds_eq2_h2: "|h2 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h3 \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using object_ptr_kinds_M_eq2_h2 document_ptr_kinds_M_eq by auto
 
   have object_ptr_kinds_M_eq3_h': "object_ptr_kinds h3 = object_ptr_kinds h'"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF insert_node_writes h'])  unfolding a_remove_child_locs_def
     using set_child_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have object_ptr_kinds_M_eq_h3:
     "\<And>ptrs. h3 \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs = h' \<turnstile> object_ptr_kinds_M \<rightarrow>\<^sub>r ptrs"
     by(simp add: object_ptr_kinds_M_defs)
   then have object_ptr_kinds_M_eq2_h3: "|h3 \<turnstile> object_ptr_kinds_M|\<^sub>r = |h' \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
   then have node_ptr_kinds_eq2_h3: "|h3 \<turnstile> node_ptr_kinds_M|\<^sub>r = |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
     using node_ptr_kinds_M_eq by blast
   have document_ptr_kinds_eq2_h3: "|h3 \<turnstile> document_ptr_kinds_M|\<^sub>r = |h' \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using object_ptr_kinds_M_eq2_h3 document_ptr_kinds_M_eq by auto
 
 
   have shadow_root_eq_h2:
     "\<And>ptr' shadow_root. h \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root =
   h2 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root"
     using get_shadow_root_reads adopt_node_writes h2
     apply(rule reads_writes_preserved)
     using local.adopt_node_get_shadow_root by blast
 
   have disconnected_nodes_eq_h2:
     "\<And>doc_ptr disc_nodes. owner_document \<noteq> doc_ptr \<Longrightarrow>
       h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes =
       h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using get_disconnected_nodes_reads set_disconnected_nodes_writes h3
     apply(rule reads_writes_preserved)
     by (auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers)
   then have disconnected_nodes_eq2_h2:
     "\<And>doc_ptr. doc_ptr \<noteq> owner_document \<Longrightarrow>
       |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r =
       |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
   have disconnected_nodes_h3:
     "h3 \<turnstile> get_disconnected_nodes owner_document \<rightarrow>\<^sub>r remove1 node disconnected_nodes_h2"
     using h3 set_disconnected_nodes_get_disconnected_nodes
     by blast
 
   have disconnected_nodes_eq_h3:
     "\<And>doc_ptr disc_nodes. h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes =
       h' \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using get_disconnected_nodes_reads insert_node_writes  h'
     apply(rule reads_writes_preserved)
     using set_child_nodes_get_disconnected_nodes by fast
   then have disconnected_nodes_eq2_h3:
     "\<And>doc_ptr. |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
 
   have children_eq_h2:
     "\<And>ptr' children. h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using get_child_nodes_reads set_disconnected_nodes_writes h3
     apply(rule reads_writes_preserved)
     by (auto simp add: set_disconnected_nodes_get_child_nodes)
   then have children_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r = |h3 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
 
   have children_eq_h3:
     "\<And>ptr' children. ptr \<noteq> ptr' \<Longrightarrow>
        h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using get_child_nodes_reads insert_node_writes h'
     apply(rule reads_writes_preserved)
     by (auto simp add: set_child_nodes_get_child_nodes_different_pointers)
   then have children_eq2_h3:
     "\<And>ptr'. ptr \<noteq> ptr' \<Longrightarrow> |h3 \<turnstile> get_child_nodes ptr'|\<^sub>r = |h' \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   obtain children_h3 where children_h3: "h3 \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children_h3"
     using h' a_insert_node_def by auto
   have children_h': "h' \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r insert_before_list node reference_child children_h3"
     using h' \<open>type_wf h3\<close> \<open>known_ptr ptr\<close>
     by(auto simp add: a_insert_node_def elim!: bind_returns_heap_E2
         dest!: set_child_nodes_get_child_nodes returns_result_eq[OF children_h3])
 
   have ptr_in_heap: "ptr |\<in>| object_ptr_kinds h3"
     using children_h3 get_child_nodes_ptr_in_heap by blast
   have node_in_heap: "node |\<in>| node_ptr_kinds h"
     using h2 adopt_node_child_in_heap by fast
   have child_not_in_any_children:
     "\<And>p children. h2 \<turnstile> get_child_nodes p \<rightarrow>\<^sub>r children \<Longrightarrow> node \<notin> set children"
     using \<open>heap_is_wellformed h\<close> h2 adopt_node_removes_child \<open>type_wf h\<close> \<open>known_ptrs h\<close> by auto
   have "node \<in> set disconnected_nodes_h2"
     using disconnected_nodes_h2 h2 adopt_node_node_in_disconnected_nodes assms(1)
       \<open>type_wf h\<close> \<open>known_ptrs h\<close> by blast
   have node_not_in_disconnected_nodes:
     "\<And>d. d |\<in>| document_ptr_kinds h3 \<Longrightarrow> node \<notin> set |h3 \<turnstile> get_disconnected_nodes d|\<^sub>r"
   proof -
     fix d
     assume "d |\<in>| document_ptr_kinds h3"
     show "node \<notin> set |h3 \<turnstile> get_disconnected_nodes d|\<^sub>r"
     proof (cases "d = owner_document")
       case True
       then show ?thesis
         using disconnected_nodes_h2 wellformed_h2 h3 remove_from_disconnected_nodes_removes
           wellformed_h2 \<open>d |\<in>| document_ptr_kinds h3\<close> disconnected_nodes_h3
         by fastforce
     next
       case False
       then have "set |h2 \<turnstile> get_disconnected_nodes d|\<^sub>r \<inter> set |h2 \<turnstile> get_disconnected_nodes owner_document|\<^sub>r = {}"
         using distinct_concat_map_E(1) wellformed_h2
         by (metis (no_types, lifting) \<open>d |\<in>| document_ptr_kinds h3\<close> \<open>type_wf h2\<close>
             disconnected_nodes_h2 document_ptr_kinds_M_def document_ptr_kinds_eq2_h2
             l_ptr_kinds_M.ptr_kinds_ptr_kinds_M local.get_disconnected_nodes_ok
             local.heap_is_wellformed_one_disc_parent returns_result_select_result select_result_I2)
       then show ?thesis
         using disconnected_nodes_eq2_h2[OF False] \<open>node \<in> set disconnected_nodes_h2\<close>
           disconnected_nodes_h2 by fastforce
     qed
   qed
 
   have "cast node \<noteq> ptr"
     using ancestors node_not_in_ancestors get_ancestors_ptr
     by fast
 
   obtain ancestors_h2 where ancestors_h2: "h2 \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors_h2"
     using get_ancestors_si_ok
     by (metis \<open>known_ptrs h2\<close> \<open>type_wf h2\<close> is_OK_returns_result_E
         object_ptr_kinds_M_eq3_h2 ptr_in_heap wellformed_h2)
   have ancestors_h3: "h3 \<turnstile> get_ancestors_si ptr \<rightarrow>\<^sub>r ancestors_h2"
     using get_ancestors_si_reads set_disconnected_nodes_writes h3
     apply(rule reads_writes_separate_forwards)
     using  \<open>heap_is_wellformed h2\<close> apply simp
     using ancestors_h2 apply simp
     apply(auto simp add: get_ancestors_si_locs_def get_parent_locs_def)[1]
      apply (simp add: local.get_ancestors_si_locs_def local.get_parent_reads_pointers
         local.set_disconnected_nodes_get_ancestors_si)
     using local.get_ancestors_si_locs_def local.set_disconnected_nodes_get_ancestors_si by blast
   have node_not_in_ancestors_h2: "cast node \<notin> set ancestors_h2"
     using \<open>heap_is_wellformed h\<close> \<open>heap_is_wellformed h2\<close> ancestors ancestors_h2
     apply(rule get_ancestors_si_remains_not_in_ancestors)
     using assms(2) assms(3) h2 local.adopt_node_children_subset apply blast
     using shadow_root_eq_h2 node_not_in_ancestors object_ptr_kinds_M_eq2_h assms(2) assms(3)
       \<open>type_wf h2\<close>
     by(auto dest: returns_result_eq)
 
   moreover
   have "parent_child_rel h2 = parent_child_rel h3"
     by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2)
   have "parent_child_rel h' = insert (ptr, cast node) ((parent_child_rel h3))"
     using children_h3 children_h' ptr_in_heap
     apply(auto simp add: CD.parent_child_rel_def object_ptr_kinds_M_eq3_h' children_eq2_h3
         insert_before_list_node_in_set)[1]
      apply (metis (no_types, lifting) children_eq2_h3 insert_before_list_in_set select_result_I2)
     by (metis (no_types, lifting) children_eq2_h3 imageI insert_before_list_in_set select_result_I2)
   have "CD.a_acyclic_heap h'"
   proof -
     have "acyclic (parent_child_rel h2)"
       using wellformed_h2
       by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
     then have "acyclic (parent_child_rel h3)"
       by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2)
     moreover have "cast node \<notin> {x. (x, ptr) \<in> (parent_child_rel h2)\<^sup>*}"
       using get_ancestors_si_parent_child_rel
       using \<open>known_ptrs h2\<close> \<open>type_wf h2\<close> ancestors_h2 node_not_in_ancestors_h2 wellformed_h2
       by blast
     then have "cast node \<notin> {x. (x, ptr) \<in> (parent_child_rel h3)\<^sup>*}"
       by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_M_eq3_h2 children_eq2_h2)
     ultimately show ?thesis
       using \<open>parent_child_rel h' = insert (ptr, cast node) ((parent_child_rel h3))\<close>
       by(auto simp add: CD.acyclic_heap_def)
   qed
 
 
   moreover have "CD.a_all_ptrs_in_heap h2"
     using wellformed_h2  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   have "CD.a_all_ptrs_in_heap h'"
   proof -
     have "CD.a_all_ptrs_in_heap h3"
       using \<open>CD.a_all_ptrs_in_heap h2\<close>
       apply(auto simp add: CD.a_all_ptrs_in_heap_def object_ptr_kinds_M_eq2_h2
           node_ptr_kinds_eq2_h2 children_eq_h2)[1]
       using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3
       using node_ptr_kinds_eq2_h2 apply auto[1]
        apply (metis (no_types, lifting) children_eq2_h2 in_mono notin_fset object_ptr_kinds_M_eq3_h2)
       by (metis (no_types, hide_lams) NodeMonad.ptr_kinds_ptr_kinds_M disconnected_nodes_eq2_h2
           disconnected_nodes_h2 disconnected_nodes_h3 document_ptr_kinds_commutes finite_set_in
           node_ptr_kinds_eq2_h2 object_ptr_kinds_M_eq3_h2 select_result_I2 set_remove1_subset subsetD)
     have "set children_h3  \<subseteq> set |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
       using children_h3 \<open>CD.a_all_ptrs_in_heap h3\<close>
       apply(auto simp add: CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq2_h3)[1]
       using CD.parent_child_rel_child_nodes2 \<open>known_ptr ptr\<close>
         \<open>parent_child_rel h2 = parent_child_rel h3\<close> \<open>type_wf h2\<close>
         local.parent_child_rel_child_in_heap node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h'
         object_ptr_kinds_M_eq3_h2 wellformed_h2 by blast
     then have "set (insert_before_list node reference_child children_h3) \<subseteq> set |h' \<turnstile> node_ptr_kinds_M|\<^sub>r"
       using node_in_heap
       apply(auto simp add: node_ptr_kinds_eq2_h node_ptr_kinds_eq2_h2 node_ptr_kinds_eq2_h3)[1]
       by (metis (no_types, hide_lams) contra_subsetD finite_set_in insert_before_list_in_set
           node_ptr_kinds_commutes object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' object_ptr_kinds_M_eq3_h2)
     then show ?thesis
       using \<open>CD.a_all_ptrs_in_heap h3\<close>
       apply(auto simp add: object_ptr_kinds_M_eq3_h' CD.a_all_ptrs_in_heap_def node_ptr_kinds_def
           node_ptr_kinds_eq2_h3 disconnected_nodes_eq_h3)[1]
       using children_eq_h3 children_h'
        apply (metis (no_types, lifting) children_eq2_h3 finite_set_in select_result_I2 subsetD)
       by (metis (no_types, lifting) DocumentMonad.ptr_kinds_ptr_kinds_M disconnected_nodes_eq2_h3
           document_ptr_kinds_eq2_h3 finite_set_in subsetD)
   qed
 
 
   moreover have "CD.a_distinct_lists h2"
     using wellformed_h2  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def )
   then have "CD.a_distinct_lists h3"
   proof(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_M_eq2_h2 document_ptr_kinds_eq2_h2
       children_eq2_h2 intro!: distinct_concat_map_I)
     fix x
     assume 1: "x |\<in>| document_ptr_kinds h3"
       and 2: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
 (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
     show "distinct |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r"
       using distinct_concat_map_E(2)[OF 2] select_result_I2[OF disconnected_nodes_h3]
         disconnected_nodes_eq2_h2 select_result_I2[OF disconnected_nodes_h2] 1
       by (metis (full_types) distinct_remove1 finite_fset fmember.rep_eq set_sorted_list_of_set)
   next
     fix x y xa
     assume 1: "distinct (concat (map (\<lambda>document_ptr. |h2 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
 (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
       and 2: "x |\<in>| document_ptr_kinds h3"
       and 3: "y |\<in>| document_ptr_kinds h3"
       and 4: "x \<noteq> y"
       and 5: "xa \<in> set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r"
       and 6: "xa \<in> set |h3 \<turnstile> get_disconnected_nodes y|\<^sub>r"
     show False
     proof (cases "x = owner_document")
       case True
       then have "y \<noteq> owner_document"
         using 4 by simp
       show ?thesis
         using distinct_concat_map_E(1)[OF 1]
         using 2 3 4 5 6 select_result_I2[OF disconnected_nodes_h3]
           select_result_I2[OF disconnected_nodes_h2]
         apply(auto simp add: True disconnected_nodes_eq2_h2[OF \<open>y \<noteq> owner_document\<close>])[1]
         by (metis (no_types, hide_lams) disconnected_nodes_eq2_h2 disjoint_iff_not_equal
             notin_set_remove1)
     next
       case False
       then show ?thesis
       proof (cases "y = owner_document")
         case True
         then show ?thesis
           using distinct_concat_map_E(1)[OF 1]
           using 2 3 4 5 6 select_result_I2[OF disconnected_nodes_h3]
             select_result_I2[OF disconnected_nodes_h2]
           apply(auto simp add: True disconnected_nodes_eq2_h2[OF \<open>x \<noteq> owner_document\<close>])[1]
           by (metis (no_types, hide_lams) disconnected_nodes_eq2_h2 disjoint_iff_not_equal
               notin_set_remove1)
       next
         case False
         then show ?thesis
           using distinct_concat_map_E(1)[OF 1, simplified, OF 2 3 4] 5 6
           using disconnected_nodes_eq2_h2 disconnected_nodes_h2 disconnected_nodes_h3
             disjoint_iff_not_equal finite_fset fmember.rep_eq notin_set_remove1 select_result_I2
             set_sorted_list_of_set
           by (metis (no_types, lifting))
       qed
     qed
   next
     fix x xa xb
     assume 1: "(\<Union>x\<in>fset (object_ptr_kinds h3). set |h3 \<turnstile> get_child_nodes x|\<^sub>r) \<inter>
 (\<Union>x\<in>fset (document_ptr_kinds h3). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 2: "xa |\<in>| object_ptr_kinds h3"
       and 3: "x \<in> set |h3 \<turnstile> get_child_nodes xa|\<^sub>r"
       and 4: "xb |\<in>| document_ptr_kinds h3"
       and 5: "x \<in> set |h3 \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     have 6: "set |h3 \<turnstile> get_child_nodes xa|\<^sub>r \<inter> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r = {}"
       using 1 2 4
       by (metis \<open>type_wf h2\<close> children_eq2_h2 document_ptr_kinds_commutes \<open>known_ptrs h\<close>
           local.get_child_nodes_ok local.get_disconnected_nodes_ok
           local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr
           object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h2 returns_result_select_result wellformed_h2)
     show False
     proof (cases "xb = owner_document")
       case True
       then show ?thesis
         using select_result_I2[OF disconnected_nodes_h3,folded select_result_I2[OF disconnected_nodes_h2]]
         by (metis (no_types, lifting) "3" "5" "6" disjoint_iff_not_equal notin_set_remove1)
     next
       case False
       show ?thesis
         using 2 3 4 5 6 unfolding disconnected_nodes_eq2_h2[OF False] by auto
     qed
   qed
   then have "CD.a_distinct_lists h'"
   proof(auto simp add: CD.a_distinct_lists_def document_ptr_kinds_eq2_h3 object_ptr_kinds_M_eq2_h3
       disconnected_nodes_eq2_h3 intro!: distinct_concat_map_I)
     fix x
     assume 1: "distinct (concat (map (\<lambda>ptr. |h3 \<turnstile> get_child_nodes ptr|\<^sub>r)
 (sorted_list_of_set (fset (object_ptr_kinds h')))))" and
       2: "x |\<in>| object_ptr_kinds h'"
     have 3: "\<And>p. p |\<in>| object_ptr_kinds h' \<Longrightarrow> distinct |h3 \<turnstile> get_child_nodes p|\<^sub>r"
       using 1  by (auto elim: distinct_concat_map_E)
     show "distinct |h' \<turnstile> get_child_nodes x|\<^sub>r"
     proof(cases "ptr = x")
       case True
       show ?thesis
         using 3[OF 2] children_h3 children_h'
         by(auto simp add: True  insert_before_list_distinct
             dest: child_not_in_any_children[unfolded children_eq_h2])
     next
       case False
       show ?thesis
         using children_eq2_h3[OF False] 3[OF 2] by auto
     qed
   next
     fix x y xa
     assume 1:"distinct (concat (map (\<lambda>ptr. |h3 \<turnstile> get_child_nodes ptr|\<^sub>r)
 (sorted_list_of_set (fset (object_ptr_kinds h')))))"
       and 2: "x |\<in>| object_ptr_kinds h'"
       and 3: "y |\<in>| object_ptr_kinds h'"
       and 4: "x \<noteq> y"
       and 5: "xa \<in> set |h' \<turnstile> get_child_nodes x|\<^sub>r"
       and 6: "xa \<in> set |h' \<turnstile> get_child_nodes y|\<^sub>r"
     have 7:"set |h3 \<turnstile> get_child_nodes x|\<^sub>r \<inter> set |h3 \<turnstile> get_child_nodes y|\<^sub>r = {}"
       using distinct_concat_map_E(1)[OF 1] 2 3 4 by auto
     show False
     proof (cases "ptr = x")
       case True
       then have "ptr \<noteq> y"
         using 4 by simp
       then show ?thesis
         using  children_h3 children_h' child_not_in_any_children[unfolded children_eq_h2] 5 6
         apply(auto simp add:  True children_eq2_h3[OF \<open>ptr \<noteq> y\<close>])[1]
         by (metis (no_types, hide_lams) "3" "7" \<open>type_wf h3\<close> children_eq2_h3 disjoint_iff_not_equal
             get_child_nodes_ok insert_before_list_in_set \<open>known_ptrs h\<close> local.known_ptrs_known_ptr
             object_ptr_kinds_M_eq3_h object_ptr_kinds_M_eq3_h' object_ptr_kinds_M_eq3_h2
             returns_result_select_result select_result_I2)
     next
       case False
       then show ?thesis
       proof (cases "ptr = y")
         case True
         then show ?thesis
           using  children_h3 children_h' child_not_in_any_children[unfolded children_eq_h2] 5 6
           apply(auto simp add:  True children_eq2_h3[OF \<open>ptr \<noteq> x\<close>])[1]
           by (metis (no_types, hide_lams) "2" "4" "7" IntI \<open>known_ptrs h3\<close> \<open>type_wf h'\<close>
               children_eq_h3 empty_iff insert_before_list_in_set local.get_child_nodes_ok
               local.known_ptrs_known_ptr object_ptr_kinds_M_eq3_h' returns_result_select_result select_result_I2)
       next
         case False
         then show ?thesis
           using children_eq2_h3[OF \<open>ptr \<noteq> x\<close>] children_eq2_h3[OF \<open>ptr \<noteq> y\<close>] 5 6 7 by auto
       qed
     qed
   next
     fix x xa xb
     assume 1: " (\<Union>x\<in>fset (object_ptr_kinds h'). set |h3 \<turnstile> get_child_nodes x|\<^sub>r) \<inter>
 (\<Union>x\<in>fset (document_ptr_kinds h'). set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r) = {} "
       and 2: "xa |\<in>| object_ptr_kinds h'"
       and 3: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
       and 4: "xb |\<in>| document_ptr_kinds h'"
       and 5: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     have 6: "set |h3 \<turnstile> get_child_nodes xa|\<^sub>r \<inter> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r = {}"
       using 1 2 3 4 5
     proof -
       have "\<forall>h d. \<not> type_wf h \<or> d |\<notin>| document_ptr_kinds h \<or> h \<turnstile> ok get_disconnected_nodes d"
         using local.get_disconnected_nodes_ok by satx
       then have "h' \<turnstile> ok get_disconnected_nodes xb"
         using "4" \<open>type_wf h'\<close> by fastforce
       then have f1: "h3 \<turnstile> get_disconnected_nodes xb \<rightarrow>\<^sub>r |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
         by (simp add: disconnected_nodes_eq_h3)
       have "xa |\<in>| object_ptr_kinds h3"
         using "2" object_ptr_kinds_M_eq3_h' by blast
       then show ?thesis
         using f1 \<open>local.CD.a_distinct_lists h3\<close> CD.distinct_lists_no_parent by fastforce
     qed
     show False
     proof (cases "ptr = xa")
       case True
       show ?thesis
         using 6 node_not_in_disconnected_nodes  3 4 5  select_result_I2[OF children_h']
           select_result_I2[OF children_h3] True disconnected_nodes_eq2_h3
         by (metis (no_types, lifting) "2" DocumentMonad.ptr_kinds_ptr_kinds_M
             \<open>CD.a_distinct_lists h3\<close> \<open>type_wf h'\<close> disconnected_nodes_eq_h3 CD.distinct_lists_no_parent
             document_ptr_kinds_eq2_h3 get_disconnected_nodes_ok insert_before_list_in_set
             object_ptr_kinds_M_eq3_h' returns_result_select_result)
 
     next
       case False
       then show ?thesis
         using 1 2 3 4 5 children_eq2_h3[OF False] by fastforce
     qed
   qed
 
   moreover have "CD.a_owner_document_valid h2"
     using wellformed_h2  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_owner_document_valid h'"
     apply(auto simp add: CD.a_owner_document_valid_def object_ptr_kinds_M_eq2_h2
         object_ptr_kinds_M_eq2_h3 node_ptr_kinds_eq2_h2 node_ptr_kinds_eq2_h3 document_ptr_kinds_eq2_h2
         document_ptr_kinds_eq2_h3 children_eq2_h2 )[1] thm children_eq2_h3
     apply(auto simp add: document_ptr_kinds_eq2_h2[simplified]  document_ptr_kinds_eq2_h3[simplified]
         object_ptr_kinds_M_eq2_h2[simplified] object_ptr_kinds_M_eq2_h3[simplified]
         node_ptr_kinds_eq2_h2[simplified] node_ptr_kinds_eq2_h3[simplified])[1]
     apply(auto simp add: disconnected_nodes_eq2_h3[symmetric])[1]
     by (metis (no_types, lifting) Core_DOM_Functions.i_insert_before.insert_before_list_in_set
         children_eq2_h3 children_h' children_h3 disconnected_nodes_eq2_h2 disconnected_nodes_h2
         disconnected_nodes_h3 finite_set_in in_set_remove1 is_OK_returns_result_I object_ptr_kinds_M_eq3_h'
         ptr_in_heap returns_result_eq returns_result_select_result)
   ultimately have "heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M h'"
     by (simp add: CD.heap_is_wellformed_def)
 
   have shadow_root_eq_h2:
     "\<And>ptr' shadow_root_ptr_opt. h2 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt =
 h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt"
     using get_shadow_root_reads set_disconnected_nodes_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_shadow_root
         set_disconnected_nodes_get_shadow_root)
   then
   have shadow_root_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_shadow_root ptr'|\<^sub>r = |h3 \<turnstile> get_shadow_root ptr'|\<^sub>r"
     by (meson select_result_eq)
 
   have shadow_root_eq_h3:
     "\<And>ptr' shadow_root_ptr_opt. h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt =
 h' \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r shadow_root_ptr_opt"
     using get_shadow_root_reads insert_node_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_shadow_root
         set_disconnected_nodes_get_shadow_root)
   then
   have shadow_root_eq2_h3: "\<And>ptr'. |h3 \<turnstile> get_shadow_root ptr'|\<^sub>r = |h' \<turnstile> get_shadow_root ptr'|\<^sub>r"
     by (meson select_result_eq)
 
   have tag_name_eq_h2: "\<And>ptr' tag. h2 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag = h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag"
     using get_tag_name_reads set_disconnected_nodes_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_tag_name
         set_disconnected_nodes_get_tag_name)
   then
   have tag_name_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_tag_name ptr'|\<^sub>r = |h3 \<turnstile> get_tag_name ptr'|\<^sub>r"
     by (meson select_result_eq)
 
   have tag_name_eq_h3: "\<And>ptr' tag. h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag = h' \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r tag"
     using get_tag_name_reads insert_node_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: adopt_node_locs_def remove_child_locs_def set_child_nodes_get_tag_name
         set_disconnected_nodes_get_tag_name)
   then
   have tag_name_eq2_h3: "\<And>ptr'. |h3 \<turnstile> get_tag_name ptr'|\<^sub>r = |h' \<turnstile> get_tag_name ptr'|\<^sub>r"
     by (meson select_result_eq)
 
   have object_ptr_kinds_eq_h2: "object_ptr_kinds h2 = object_ptr_kinds h3"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF set_disconnected_nodes_writes h3])
     unfolding adopt_node_locs_def remove_child_locs_def
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def  split: if_splits)
 
   have object_ptr_kinds_eq_h3: "object_ptr_kinds h3 = object_ptr_kinds h'"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h = object_ptr_kinds h'",
           OF insert_node_writes h'])
     using set_disconnected_nodes_pointers_preserved set_child_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def  split: if_splits)
 
   have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h3"
     using object_ptr_kinds_eq_h2
     by(auto simp add: shadow_root_ptr_kinds_def)
   have element_ptr_kinds_eq_h2: "element_ptr_kinds h2 = element_ptr_kinds h3"
     using object_ptr_kinds_eq_h2
     by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)
 
   have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h'"
     using object_ptr_kinds_eq_h3
     by(auto simp add: shadow_root_ptr_kinds_def)
   have element_ptr_kinds_eq_h3: "element_ptr_kinds h3 = element_ptr_kinds h'"
     using object_ptr_kinds_eq_h3
     by(auto simp add: element_ptr_kinds_def node_ptr_kinds_def)
 
 
   have "a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3"
     by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2 shadow_root_eq2_h2)
   have "a_host_shadow_root_rel h3 = a_host_shadow_root_rel h'"
     by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h3 shadow_root_eq2_h3)
 
   have "cast node \<notin> {x. (x, ptr) \<in> (parent_child_rel h3 \<union> a_host_shadow_root_rel h3)\<^sup>*}"
     using get_ancestors_si_parent_child_host_shadow_root_rel
     using \<open>known_ptrs h2\<close> \<open>local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3\<close>
       \<open>parent_child_rel h2 = parent_child_rel h3\<close> \<open>type_wf h2\<close> ancestors_h2 node_not_in_ancestors_h2
       wellformed_h2
     by auto
 
   have "acyclic (parent_child_rel h3 \<union> a_host_shadow_root_rel h3)"
     using \<open>heap_is_wellformed h2\<close>
     by(auto simp add: heap_is_wellformed_def \<open>parent_child_rel h2 = parent_child_rel h3\<close>
         \<open>a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3\<close>)
   then
   have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h')"
     apply(auto simp add: \<open>a_host_shadow_root_rel h3 = a_host_shadow_root_rel h'\<close>
         \<open>parent_child_rel h' = insert (ptr, cast node) ((parent_child_rel h3))\<close>)[1]
     using \<open>cast node \<notin> {x. (x, ptr) \<in> (parent_child_rel h3 \<union> a_host_shadow_root_rel h3)\<^sup>*}\<close>
     by (simp add: \<open>local.a_host_shadow_root_rel h3 = local.a_host_shadow_root_rel h'\<close>)
   then
   show "heap_is_wellformed h'"
     using \<open>heap_is_wellformed h2\<close>
     using \<open>heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M h'\<close>
     apply(auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def
         a_all_ptrs_in_heap_def a_distinct_lists_def a_shadow_root_valid_def)[1]
     by(auto simp add: object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 element_ptr_kinds_eq_h2
         element_ptr_kinds_eq_h3 shadow_root_ptr_kinds_eq_h2 shadow_root_ptr_kinds_eq_h3  shadow_root_eq_h2
         shadow_root_eq_h3 shadow_root_eq2_h2 shadow_root_eq2_h3 tag_name_eq_h2 tag_name_eq_h3
         tag_name_eq2_h2 tag_name_eq2_h3)
 
 qed
 end
 
 interpretation i_insert_before_wf?: l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_parent get_parent_locs
   get_child_nodes get_child_nodes_locs set_child_nodes set_child_nodes_locs get_ancestors_si
   get_ancestors_si_locs adopt_node adopt_node_locs set_disconnected_nodes set_disconnected_nodes_locs
   get_disconnected_nodes get_disconnected_nodes_locs get_owner_document insert_before
   insert_before_locs append_child type_wf known_ptr known_ptrs heap_is_wellformed parent_child_rel
   by(simp add: l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_insert_before_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma insert_before_wf_is_l_insert_before_wf [instances]:
   "l_insert_before_wf Shadow_DOM.heap_is_wellformed ShadowRootClass.type_wf
 ShadowRootClass.known_ptr ShadowRootClass.known_ptrs
      Shadow_DOM.insert_before Shadow_DOM.get_child_nodes"
   apply(auto simp add: l_insert_before_wf_def l_insert_before_wf_axioms_def instances)[1]
   using insert_before_removes_child apply fast
   done
 
 lemma l_set_disconnected_nodes_get_disconnected_nodes_wf [instances]: "l_set_disconnected_nodes_get_disconnected_nodes_wf ShadowRootClass.type_wf
 ShadowRootClass.known_ptr Shadow_DOM.heap_is_wellformed Shadow_DOM.parent_child_rel Shadow_DOM.get_child_nodes
      get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs"
   apply(auto simp add: l_set_disconnected_nodes_get_disconnected_nodes_wf_def
       l_set_disconnected_nodes_get_disconnected_nodes_wf_axioms_def instances)[1]
   by (metis Diff_iff Shadow_DOM.i_heap_is_wellformed.heap_is_wellformed_disconnected_nodes_distinct
       Shadow_DOM.i_remove_child.set_disconnected_nodes_get_disconnected_nodes insert_iff
       returns_result_eq set_remove1_eq)
 
 interpretation l_get_root_node_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf known_ptr known_ptrs get_parent get_parent_locs get_child_nodes get_child_nodes_locs
   get_host get_host_locs get_ancestors_si get_ancestors_si_locs get_root_node_si get_root_node_si_locs
   get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs
   get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_disconnected_document get_disconnected_document_locs
   by(auto simp add: l_get_root_node_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_get_root_node_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 interpretation i_insert_before_wf2?: l_insert_before_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf known_ptr get_child_nodes
   get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs set_child_nodes set_child_nodes_locs get_shadow_root get_shadow_root_locs set_disconnected_nodes set_disconnected_nodes_locs get_tag_name get_tag_name_locs heap_is_wellformed parent_child_rel get_ancestors_si get_ancestors_si_locs get_parent get_parent_locs adopt_node adopt_node_locs get_owner_document insert_before insert_before_locs append_child known_ptrs get_host get_host_locs get_root_node_si get_root_node_si_locs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_document get_disconnected_document_locs
   by(auto simp add: l_insert_before_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_insert_before_wf2\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 lemma insert_before_wf2_is_l_insert_before_wf2 [instances]:
   "l_insert_before_wf2 ShadowRootClass.type_wf ShadowRootClass.known_ptr ShadowRootClass.known_ptrs
 Shadow_DOM.insert_before
      Shadow_DOM.heap_is_wellformed"
   apply(auto simp add: l_insert_before_wf2_def l_insert_before_wf2_axioms_def instances)[1]
   using insert_before_child_preserves apply(fast, fast, fast)
   done
 
 
 subsubsection \<open>append\_child\<close>
 
 interpretation i_append_child_wf?: l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_owner_document get_parent
   get_parent_locs remove_child remove_child_locs
   get_disconnected_nodes get_disconnected_nodes_locs
   set_disconnected_nodes set_disconnected_nodes_locs
   adopt_node adopt_node_locs known_ptr type_wf get_child_nodes
   get_child_nodes_locs known_ptrs set_child_nodes
   set_child_nodes_locs remove get_ancestors_si get_ancestors_si_locs
   insert_before insert_before_locs append_child heap_is_wellformed
   parent_child_rel
   by(auto simp add: l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_append_child_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma append_child_wf_is_l_append_child_wf [instances]:
   "l_append_child_wf type_wf known_ptr known_ptrs append_child heap_is_wellformed"
   apply(auto simp add: l_append_child_wf_def l_append_child_wf_axioms_def instances)[1]
   using append_child_heap_is_wellformed_preserved by fast+
 
 
 subsubsection \<open>to\_tree\_order\<close>
 
 interpretation i_to_tree_order_wf?: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf get_child_nodes
   get_child_nodes_locs to_tree_order known_ptrs get_parent get_parent_locs heap_is_wellformed
   parent_child_rel get_disconnected_nodes get_disconnected_nodes_locs
   apply(auto simp add: l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)[1]
   done
 declare l_to_tree_order_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma to_tree_order_wf_is_l_to_tree_order_wf [instances]:
   "l_to_tree_order_wf heap_is_wellformed parent_child_rel type_wf known_ptr known_ptrs
 to_tree_order get_parent get_child_nodes"
   apply(auto simp add: l_to_tree_order_wf_def l_to_tree_order_wf_axioms_def instances)[1]
   using to_tree_order_ok apply fast
   using to_tree_order_ptrs_in_heap apply fast
   using to_tree_order_parent_child_rel apply(fast, fast)
   using to_tree_order_child2 apply blast
   using to_tree_order_node_ptrs apply fast
   using to_tree_order_child apply fast
   using to_tree_order_ptr_in_result apply fast
   using to_tree_order_parent apply fast
   using to_tree_order_subset apply fast
   done
 
 
 paragraph \<open>get\_root\_node\<close>
 
 interpretation i_to_tree_order_wf_get_root_node_wf?: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   known_ptr type_wf known_ptrs heap_is_wellformed parent_child_rel
   get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
   get_parent get_parent_locs get_ancestors get_ancestors_locs get_root_node get_root_node_locs
   to_tree_order
   by(auto simp add: l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_to_tree_order_wf_get_root_node_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 lemma to_tree_order_wf_get_root_node_wf_is_l_to_tree_order_wf_get_root_node_wf [instances]:
   "l_to_tree_order_wf_get_root_node_wf ShadowRootClass.type_wf ShadowRootClass.known_ptr
 ShadowRootClass.known_ptrs to_tree_order Shadow_DOM.get_root_node
      Shadow_DOM.heap_is_wellformed"
   apply(auto simp add: l_to_tree_order_wf_get_root_node_wf_def
       l_to_tree_order_wf_get_root_node_wf_axioms_def instances)[1]
   using to_tree_order_get_root_node apply fast
   using to_tree_order_same_root apply fast
   done
 
 
 subsubsection \<open>to\_tree\_order\_si\<close>
 
 locale l_to_tree_order_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_child_nodes +
   l_get_parent_get_host_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_to_tree_order_si\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 lemma to_tree_order_si_ok:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
     and "ptr |\<in>| object_ptr_kinds h"
   shows "h \<turnstile> ok (to_tree_order_si ptr)"
 proof(insert assms(1) assms(4), induct rule: heap_wellformed_induct_si)
   case (step parent)
   have "known_ptr parent"
     using assms(2) local.known_ptrs_known_ptr step.prems
     by blast
   then show ?case
     using step
     using assms(1) assms(2) assms(3)
     using local.heap_is_wellformed_children_in_heap local.get_shadow_root_shadow_root_ptr_in_heap
     by(auto simp add: to_tree_order_si_def[of parent] intro: get_child_nodes_ok get_shadow_root_ok
         intro!: bind_is_OK_pure_I map_M_pure_I bind_pure_I map_M_ok_I split: option.splits)
 qed
 end
 
 interpretation i_to_tree_order_si_wf?: l_to_tree_order_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   type_wf known_ptr get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs get_tag_name
   get_tag_name_locs heap_is_wellformed parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_host get_host_locs get_disconnected_document get_disconnected_document_locs
   known_ptrs get_parent get_parent_locs to_tree_order_si
   by(auto simp add: l_to_tree_order_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_to_tree_order_si_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>get\_assigned\_nodes\<close>
 
 lemma forall_M_small_big: "h \<turnstile> forall_M f xs \<rightarrow>\<^sub>h h' \<Longrightarrow> P h \<Longrightarrow>
 (\<And>h h' x. x \<in> set xs \<Longrightarrow> h \<turnstile> f x \<rightarrow>\<^sub>h h' \<Longrightarrow> P h \<Longrightarrow> P h') \<Longrightarrow> P h'"
   by(induct xs arbitrary: h) (auto elim!: bind_returns_heap_E)
 
 locale l_assigned_nodes_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_assigned_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_heap_is_wellformed +
   l_remove_child_wf2 +
   l_append_child_wf +
   l_remove_shadow_root_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
 begin
 
 lemma assigned_nodes_distinct:
   assumes "heap_is_wellformed h"
   assumes "h \<turnstile> assigned_nodes slot \<rightarrow>\<^sub>r nodes"
   shows "distinct nodes"
 proof -
   have "\<And>ptr children. h \<turnstile> get_child_nodes ptr \<rightarrow>\<^sub>r children \<Longrightarrow> distinct children"
     using assms(1) local.heap_is_wellformed_children_distinct by blast
   then show ?thesis
     using assms
     apply(auto simp add: assigned_nodes_def elim!: bind_returns_result_E2 split: if_splits)[1]
     by (simp add: filter_M_distinct)
 qed
 
 
 lemma flatten_dom_preserves:
   assumes "heap_is_wellformed h" and "known_ptrs h" and "type_wf h"
   assumes "h \<turnstile> flatten_dom \<rightarrow>\<^sub>h h'"
   shows "heap_is_wellformed h'" and "known_ptrs h'" and "type_wf h'"
 proof -
   obtain tups h2 element_ptrs shadow_root_ptrs where
     "h \<turnstile> element_ptr_kinds_M \<rightarrow>\<^sub>r element_ptrs" and
     tups: "h \<turnstile> map_filter_M2 (\<lambda>element_ptr. do {
       tag \<leftarrow> get_tag_name element_ptr;
       assigned_nodes \<leftarrow> assigned_nodes element_ptr;
       (if tag = ''slot'' \<and> assigned_nodes \<noteq> [] then
 return (Some (element_ptr, assigned_nodes)) else return None)}) element_ptrs \<rightarrow>\<^sub>r tups"
     (is "h \<turnstile> map_filter_M2 ?f element_ptrs \<rightarrow>\<^sub>r tups") and
     h2: "h \<turnstile> forall_M (\<lambda>(slot, assigned_nodes). do {
       get_child_nodes (cast slot) \<bind> forall_M remove;
       forall_M (append_child (cast slot)) assigned_nodes
     }) tups \<rightarrow>\<^sub>h h2" and
     "h2 \<turnstile> shadow_root_ptr_kinds_M \<rightarrow>\<^sub>r shadow_root_ptrs" and
     h': "h2 \<turnstile> forall_M (\<lambda>shadow_root_ptr. do {
       host \<leftarrow> get_host shadow_root_ptr;
       get_child_nodes (cast host) \<bind> forall_M remove;
       get_child_nodes (cast shadow_root_ptr) \<bind> forall_M (append_child (cast host));
       remove_shadow_root host
     }) shadow_root_ptrs \<rightarrow>\<^sub>h h'"
     using \<open>h \<turnstile> flatten_dom \<rightarrow>\<^sub>h h'\<close>
     apply(auto simp add: flatten_dom_def elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF ElementMonad.ptr_kinds_M_pure, rotated]
         bind_returns_heap_E2[rotated, OF ShadowRootMonad.ptr_kinds_M_pure, rotated])[1]
     apply(drule pure_returns_heap_eq)
     by(auto intro!: map_filter_M2_pure bind_pure_I)
   have "heap_is_wellformed h2 \<and> known_ptrs h2 \<and> type_wf h2"
     using h2 \<open>heap_is_wellformed h\<close> \<open>known_ptrs h\<close> \<open>type_wf h\<close>
     by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated,
           OF get_child_nodes_pure, rotated]
         elim!: forall_M_small_big[where P = "\<lambda>h. heap_is_wellformed h \<and> known_ptrs h \<and> type_wf h",
           simplified]
         intro: remove_preserves_known_ptrs remove_heap_is_wellformed_preserved
         remove_preserves_type_wf
         append_child_preserves_known_ptrs append_child_heap_is_wellformed_preserved
         append_child_preserves_type_wf)
   then
   show "heap_is_wellformed h'" and "known_ptrs h'" and "type_wf h'"
     using h'
     by(auto elim!: bind_returns_heap_E bind_returns_heap_E2[rotated, OF get_host_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_child_nodes_pure, rotated]
         dest!: forall_M_small_big[where P = "\<lambda>h. heap_is_wellformed h \<and> known_ptrs h \<and> type_wf h",
           simplified]
         intro: remove_preserves_known_ptrs remove_heap_is_wellformed_preserved
         remove_preserves_type_wf
         append_child_preserves_known_ptrs append_child_heap_is_wellformed_preserved
         append_child_preserves_type_wf
         remove_shadow_root_preserves
         )
 qed
 end
 
 interpretation i_assigned_nodes_wf?: l_assigned_nodes_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   known_ptr assigned_nodes assigned_nodes_flatten flatten_dom get_child_nodes get_child_nodes_locs
   get_tag_name get_tag_name_locs get_root_node get_root_node_locs get_host get_host_locs find_slot
   assigned_slot remove insert_before insert_before_locs append_child remove_shadow_root
   remove_shadow_root_locs type_wf get_shadow_root get_shadow_root_locs set_shadow_root
   set_shadow_root_locs get_parent get_parent_locs to_tree_order heap_is_wellformed parent_child_rel
   get_disconnected_nodes get_disconnected_nodes_locs known_ptrs remove_child remove_child_locs
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_document get_disconnected_document_locs
   by(auto simp add: l_assigned_nodes_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_assigned_nodes_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 subsubsection \<open>get\_shadow\_root\_safe\<close>
 
 locale l_get_shadow_root_safe_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M  get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs
   known_ptr type_wf heap_is_wellformed parent_child_rel heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host
   get_host_locs +
   l_type_wf type_wf +
   l_get_shadow_root_safe\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf get_shadow_root_safe get_shadow_root_safe_locs
   get_shadow_root get_shadow_root_locs get_mode get_mode_locs
   for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and known_ptrs :: "(_) heap \<Rightarrow> bool"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root ::
     "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root_safe ::
     "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_safe_locs ::
     "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_child_nodes :: "(_::linorder) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
     and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
     and heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_mode :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, shadow_root_mode) prog"
     and get_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
 begin
 
 
 end
 
 
 subsubsection \<open>create\_element\<close>
 
 locale l_create_element_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs +
   l_set_tag_name type_wf set_tag_name set_tag_name_locs +
   l_create_element_defs create_element +
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M  get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs
   get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
   heap_is_wellformed parent_child_rel
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs +
   l_new_element_get_disconnected_nodes get_disconnected_nodes get_disconnected_nodes_locs +
   l_set_tag_name_get_disconnected_nodes type_wf set_tag_name set_tag_name_locs
   get_disconnected_nodes get_disconnected_nodes_locs +
   l_create_element\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
   set_disconnected_nodes_locs set_tag_name set_tag_name_locs type_wf create_element known_ptr
   type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M +
   l_new_element_get_child_nodes type_wf known_ptr get_child_nodes get_child_nodes_locs +
   l_set_tag_name_get_child_nodes type_wf set_tag_name set_tag_name_locs known_ptr
   get_child_nodes get_child_nodes_locs +
   l_set_tag_name_get_tag_name type_wf get_tag_name get_tag_name_locs set_tag_name set_tag_name_locs +
   l_new_element_get_tag_name type_wf get_tag_name get_tag_name_locs +
   l_set_disconnected_nodes_get_child_nodes set_disconnected_nodes set_disconnected_nodes_locs
   get_child_nodes get_child_nodes_locs +
   l_set_disconnected_nodes_get_shadow_root set_disconnected_nodes set_disconnected_nodes_locs
   get_shadow_root get_shadow_root_locs +
   l_set_disconnected_nodes_get_tag_name type_wf set_disconnected_nodes set_disconnected_nodes_locs
   get_tag_name get_tag_name_locs +
   l_set_disconnected_nodes type_wf set_disconnected_nodes set_disconnected_nodes_locs +
   l_set_disconnected_nodes_get_disconnected_nodes  type_wf get_disconnected_nodes
   get_disconnected_nodes_locs set_disconnected_nodes set_disconnected_nodes_locs +
   l_new_element_get_shadow_root type_wf get_shadow_root get_shadow_root_locs +
   l_set_tag_name_get_shadow_root type_wf set_tag_name set_tag_name_locs get_shadow_root
   get_shadow_root_locs +
   l_new_element type_wf +
   l_known_ptrs known_ptr known_ptrs
   for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and known_ptrs :: "(_) heap \<Rightarrow> bool"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
     and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
     and set_tag_name :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and set_disconnected_nodes ::
     "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and create_element ::
     "(_) document_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_document :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
     and get_disconnected_document_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
 begin
 lemma create_element_preserves_wellformedness:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> create_element document_ptr tag \<rightarrow>\<^sub>h h'"
     and "type_wf h"
     and "known_ptrs h"
   shows "heap_is_wellformed h'" and "type_wf h'" and "known_ptrs h'"
 proof -
   obtain new_element_ptr h2 h3 disc_nodes_h3 where
     new_element_ptr: "h \<turnstile> new_element \<rightarrow>\<^sub>r new_element_ptr" and
     h2: "h \<turnstile> new_element \<rightarrow>\<^sub>h h2" and
     h3: "h2 \<turnstile> set_tag_name new_element_ptr tag \<rightarrow>\<^sub>h h3" and
     disc_nodes_h3: "h3 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h3" and
     h': "h3 \<turnstile> set_disconnected_nodes document_ptr (cast new_element_ptr # disc_nodes_h3) \<rightarrow>\<^sub>h h'"
     using assms(2)
     by(auto simp add: create_element_def
         elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF CD.get_disconnected_nodes_pure, rotated] )
   then have "h \<turnstile> create_element document_ptr tag \<rightarrow>\<^sub>r new_element_ptr"
     apply(auto simp add: create_element_def intro!: bind_returns_result_I)[1]
       apply (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)
      apply (metis is_OK_returns_heap_E is_OK_returns_result_I CD.get_disconnected_nodes_pure
         pure_returns_heap_eq)
     by (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)
 
   have "new_element_ptr \<notin> set |h \<turnstile> element_ptr_kinds_M|\<^sub>r"
     using new_element_ptr ElementMonad.ptr_kinds_ptr_kinds_M h2
     using new_element_ptr_not_in_heap by blast
   then have "cast new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r"
     by simp
   then have "cast new_element_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
 
   have object_ptr_kinds_eq_h: "object_ptr_kinds h2 = object_ptr_kinds h |\<union>| {|cast new_element_ptr|}"
     using new_element_new_ptr h2 new_element_ptr by blast
   then have node_ptr_kinds_eq_h: "node_ptr_kinds h2 = node_ptr_kinds h |\<union>| {|cast new_element_ptr|}"
     apply(simp add: node_ptr_kinds_def)
     by force
   then have element_ptr_kinds_eq_h: "element_ptr_kinds h2 = element_ptr_kinds h |\<union>| {|new_element_ptr|}"
     apply(simp add: element_ptr_kinds_def)
     by force
   have character_data_ptr_kinds_eq_h: "character_data_ptr_kinds h2 = character_data_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: node_ptr_kinds_def character_data_ptr_kinds_def)
   have document_ptr_kinds_eq_h: "document_ptr_kinds h2 = document_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: document_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF set_tag_name_writes h3])
     using set_tag_name_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
     by (auto simp add: document_ptr_kinds_def)
   have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     by(auto simp add: node_ptr_kinds_def)
   then have element_ptr_kinds_eq_h2: "element_ptr_kinds h3 = element_ptr_kinds h2"
     by(simp add: element_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF set_disconnected_nodes_writes h'])
     using set_disconnected_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3"
     by (auto simp add: document_ptr_kinds_def)
   have node_ptr_kinds_eq_h3: "node_ptr_kinds h' = node_ptr_kinds h3"
     using object_ptr_kinds_eq_h3
     by(auto simp add: node_ptr_kinds_def)
   then have element_ptr_kinds_eq_h3: "element_ptr_kinds h' = element_ptr_kinds h3"
     by(simp add: element_ptr_kinds_def)
 
   have "known_ptr (cast new_element_ptr)"
     using \<open>h \<turnstile> create_element document_ptr tag \<rightarrow>\<^sub>r new_element_ptr\<close> local.create_element_known_ptr
     by blast
   then
   have "known_ptrs h2"
     using known_ptrs_new_ptr object_ptr_kinds_eq_h \<open>known_ptrs h\<close> h2
     by blast
   then
   have "known_ptrs h3"
     using known_ptrs_preserved object_ptr_kinds_eq_h2 by blast
   then
   show "known_ptrs h'"
     using known_ptrs_preserved object_ptr_kinds_eq_h3 by blast
 
 
   have "document_ptr |\<in>| document_ptr_kinds h"
     using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
       CD.get_disconnected_nodes_ptr_in_heap \<open>type_wf h\<close> document_ptr_kinds_def
     by (metis is_OK_returns_result_I)
 
   have children_eq_h: "\<And>(ptr'::(_) object_ptr) children. ptr' \<noteq> cast new_element_ptr
               \<Longrightarrow> h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads h2 get_child_nodes_new_element[rotated, OF new_element_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have children_eq2_h: "\<And>ptr'. ptr' \<noteq> cast new_element_ptr
                                     \<Longrightarrow> |h \<turnstile> get_child_nodes ptr'|\<^sub>r = |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   have "h2 \<turnstile> get_child_nodes (cast new_element_ptr) \<rightarrow>\<^sub>r []"
     using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr]
       new_element_is_element_ptr[OF new_element_ptr] new_element_no_child_nodes
     by blast
   have tag_name_eq_h:
     "\<And>ptr' disc_nodes. ptr' \<noteq>  new_element_ptr
               \<Longrightarrow> h \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h2 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads h2 get_tag_name_new_element[rotated, OF new_element_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by(blast)+
   then have tag_name_eq2_h: "\<And>ptr'. ptr' \<noteq> new_element_ptr
                                     \<Longrightarrow> |h \<turnstile> get_tag_name ptr'|\<^sub>r = |h2 \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
   have "h2 \<turnstile> get_tag_name new_element_ptr \<rightarrow>\<^sub>r ''''"
     using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr]
       new_element_is_element_ptr[OF new_element_ptr] new_element_empty_tag_name
     by blast
 
 
   have disconnected_nodes_eq_h:
     "\<And>doc_ptr disc_nodes. h \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes
                                              = h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using CD.get_disconnected_nodes_reads h2 get_disconnected_nodes_new_element[OF new_element_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have disconnected_nodes_eq2_h:
     "\<And>doc_ptr. |h \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
 
   have children_eq_h2:
     "\<And>ptr' children. h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads set_tag_name_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_tag_name_get_child_nodes)
   then have children_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r = |h3 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   have disconnected_nodes_eq_h2:
     "\<And>doc_ptr disc_nodes. h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes
                                                = h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using CD.get_disconnected_nodes_reads set_tag_name_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_tag_name_get_disconnected_nodes)
   then have disconnected_nodes_eq2_h2:
     "\<And>doc_ptr. |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
   have tag_name_eq_h2:
     "\<And>ptr' disc_nodes. ptr' \<noteq>  new_element_ptr
               \<Longrightarrow> h2 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     apply(rule reads_writes_preserved[OF get_tag_name_reads set_tag_name_writes h3])
     by (metis local.set_tag_name_get_tag_name_different_pointers)
   then have tag_name_eq2_h2: "\<And>ptr'. ptr' \<noteq> new_element_ptr
                                     \<Longrightarrow> |h2 \<turnstile> get_tag_name ptr'|\<^sub>r = |h3 \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
   have "h2 \<turnstile> get_tag_name new_element_ptr \<rightarrow>\<^sub>r ''''"
     using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr]
       new_element_is_element_ptr[OF new_element_ptr] new_element_empty_tag_name
     by blast
 
   have "type_wf h2"
     using \<open>type_wf h\<close> new_element_types_preserved h2 by blast
   then have "type_wf h3"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF set_tag_name_writes h3]
     using  set_tag_name_types_preserved
     by(auto simp add: reflp_def transp_def)
   then show "type_wf h'"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF set_disconnected_nodes_writes h']
     using  set_disconnected_nodes_types_preserved
     by(auto simp add: reflp_def transp_def)
 
   have children_eq_h3:
     "\<And>ptr' children. h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads set_disconnected_nodes_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: set_disconnected_nodes_get_child_nodes)
   then have children_eq2_h3: "\<And>ptr'. |h3 \<turnstile> get_child_nodes ptr'|\<^sub>r = |h' \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   have disconnected_nodes_eq_h3:
     "\<And>doc_ptr disc_nodes. document_ptr \<noteq> doc_ptr
        \<Longrightarrow> h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes
                                                = h' \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using CD.get_disconnected_nodes_reads set_disconnected_nodes_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers)
   then have disconnected_nodes_eq2_h3:
     "\<And>doc_ptr. document_ptr \<noteq> doc_ptr
                 \<Longrightarrow> |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
   have tag_name_eq_h2:
     "\<And>ptr' disc_nodes. ptr' \<noteq>  new_element_ptr
               \<Longrightarrow> h2 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     apply(rule reads_writes_preserved[OF get_tag_name_reads set_tag_name_writes h3])
     by (metis local.set_tag_name_get_tag_name_different_pointers)
   then have tag_name_eq2_h2: "\<And>ptr'. ptr' \<noteq> new_element_ptr
                                     \<Longrightarrow> |h2 \<turnstile> get_tag_name ptr'|\<^sub>r = |h3 \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
 
   have disc_nodes_document_ptr_h2: "h2 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h3"
     using disconnected_nodes_eq_h2 disc_nodes_h3 by auto
   then have disc_nodes_document_ptr_h: "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h3"
     using disconnected_nodes_eq_h by auto
   then have "cast new_element_ptr \<notin> set disc_nodes_h3"
     using \<open>heap_is_wellformed h\<close>
     using \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
       a_all_ptrs_in_heap_def heap_is_wellformed_def
     using NodeMonad.ptr_kinds_ptr_kinds_M local.heap_is_wellformed_disc_nodes_in_heap by blast
 
   have tag_name_eq_h3:
     "\<And>ptr' disc_nodes. h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h' \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     apply(rule reads_writes_preserved[OF get_tag_name_reads set_disconnected_nodes_writes h'])
     using set_disconnected_nodes_get_tag_name
     by blast
   then have tag_name_eq2_h3: "\<And>ptr'. |h3 \<turnstile> get_tag_name ptr'|\<^sub>r = |h' \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
 
 
   have "acyclic (parent_child_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h2"
   proof(auto simp add: CD.parent_child_rel_def)[1]
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h"
       and 1: "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
     then show "a |\<in>| object_ptr_kinds h2"
       by (simp add: object_ptr_kinds_eq_h)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h"
       and 1: "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
     then show "x \<in> set |h2 \<turnstile> get_child_nodes a|\<^sub>r"
       by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
           \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close> children_eq2_h)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h2"
       and 1: "x \<in> set |h2 \<turnstile> get_child_nodes a|\<^sub>r"
     then show "a |\<in>| object_ptr_kinds h"
       using object_ptr_kinds_eq_h \<open>h2 \<turnstile> get_child_nodes (cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr) \<rightarrow>\<^sub>r []\<close>
       by(auto)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h2"
       and 1: "x \<in> set |h2 \<turnstile> get_child_nodes a|\<^sub>r"
     then show "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
       by (metis (no_types, lifting)
           \<open>h2 \<turnstile> get_child_nodes (cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr) \<rightarrow>\<^sub>r []\<close>
           children_eq2_h empty_iff empty_set image_eqI select_result_I2)
   qed
   also have "\<dots> = parent_child_rel h3"
     by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
   also have "\<dots> = parent_child_rel h'"
     by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
   finally have "CD.a_acyclic_heap h'"
     by (simp add: CD.acyclic_heap_def)
 
   have "CD.a_all_ptrs_in_heap h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_all_ptrs_in_heap h2"
     apply(auto simp add: CD.a_all_ptrs_in_heap_def)[1]
      apply (metis \<open>known_ptrs h2\<close> \<open>parent_child_rel h = parent_child_rel h2\<close> \<open>type_wf h2\<close> assms(1)
         assms(3) funion_iff CD.get_child_nodes_ok local.known_ptrs_known_ptr
         local.parent_child_rel_child_in_heap CD.parent_child_rel_child_nodes2 node_ptr_kinds_commutes
         node_ptr_kinds_eq_h returns_result_select_result)
     by (metis (no_types, lifting) CD.get_child_nodes_ok CD.get_child_nodes_ptr_in_heap
         \<open>h2 \<turnstile> get_child_nodes (cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr) \<rightarrow>\<^sub>r []\<close> assms(3) assms(4)
         children_eq_h disconnected_nodes_eq2_h document_ptr_kinds_eq_h finite_set_in is_OK_returns_result_I
         local.known_ptrs_known_ptr node_ptr_kinds_commutes returns_result_select_result subsetD)
   then have "CD.a_all_ptrs_in_heap h3"
     by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
   then have "CD.a_all_ptrs_in_heap h'"
     by (smt children_eq2_h3 disc_nodes_h3 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3
         element_ptr_kinds_commutes h' h2 local.CD.a_all_ptrs_in_heap_def
         local.set_disconnected_nodes_get_disconnected_nodes new_element_ptr new_element_ptr_in_heap
         node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h3 notin_fset object_ptr_kinds_eq_h3 select_result_I2
         set_ConsD subset_code(1))
 
   have "\<And>p. p |\<in>| object_ptr_kinds h \<Longrightarrow> cast new_element_ptr \<notin> set |h \<turnstile> get_child_nodes p|\<^sub>r"
     using \<open>heap_is_wellformed h\<close> \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
       heap_is_wellformed_children_in_heap
     by (meson NodeMonad.ptr_kinds_ptr_kinds_M CD.a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp
         fset_of_list_elem CD.get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result)
   then have "\<And>p. p |\<in>| object_ptr_kinds h2 \<Longrightarrow> cast new_element_ptr \<notin> set |h2 \<turnstile> get_child_nodes p|\<^sub>r"
     using children_eq2_h
     apply(auto simp add: object_ptr_kinds_eq_h)[1]
     using \<open>h2 \<turnstile> get_child_nodes (cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr) \<rightarrow>\<^sub>r []\<close> apply auto[1]
     by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
         \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close>)
   then have "\<And>p. p |\<in>| object_ptr_kinds h3 \<Longrightarrow> cast new_element_ptr \<notin> set |h3 \<turnstile> get_child_nodes p|\<^sub>r"
     using object_ptr_kinds_eq_h2 children_eq2_h2 by auto
   then have new_element_ptr_not_in_any_children:
     "\<And>p. p |\<in>| object_ptr_kinds h' \<Longrightarrow> cast new_element_ptr \<notin> set |h' \<turnstile> get_child_nodes p|\<^sub>r"
     using object_ptr_kinds_eq_h3 children_eq2_h3 by auto
 
   have "CD.a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: CD.heap_is_wellformed_def heap_is_wellformed_def)
   then have "CD.a_distinct_lists h2"
     using \<open>h2 \<turnstile> get_child_nodes (cast new_element_ptr) \<rightarrow>\<^sub>r []\<close>
     apply(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h
         disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1]
        apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert)
       apply(case_tac "x=cast new_element_ptr")
        apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
       apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
      apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
      apply (metis IntI assms(1) assms(3) assms(4) empty_iff  CD.get_child_nodes_ok
         local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr returns_result_select_result)
     apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
     by (metis \<open> CD.a_distinct_lists h\<close> \<open>type_wf h2\<close> disconnected_nodes_eq_h document_ptr_kinds_eq_h
         CD.distinct_lists_no_parent  get_disconnected_nodes_ok returns_result_select_result)
 
   then have " CD.a_distinct_lists h3"
     by(auto simp add:  CD.a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         children_eq2_h2 object_ptr_kinds_eq_h2)
   then have " CD.a_distinct_lists h'"
   proof(auto simp add:  CD.a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3
       object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3
       intro!: distinct_concat_map_I)[1]
     fix x
     assume "distinct (concat (map (\<lambda>document_ptr. |h3 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                               (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
       and "x |\<in>| document_ptr_kinds h3"
     then show "distinct |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
       using document_ptr_kinds_eq_h3 disconnected_nodes_eq_h3 h'
         set_disconnected_nodes_get_disconnected_nodes
       by (metis (no_types, lifting) \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set disc_nodes_h3\<close>
           \<open> CD.a_distinct_lists h3\<close> \<open>type_wf h'\<close> disc_nodes_h3 distinct.simps(2)
           CD.distinct_lists_disconnected_nodes  get_disconnected_nodes_ok returns_result_eq
           returns_result_select_result)
   next
     fix x y xa
     assume "distinct (concat (map (\<lambda>document_ptr. |h3 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                             (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
       and "x |\<in>| document_ptr_kinds h3"
       and "y |\<in>| document_ptr_kinds h3"
       and "x \<noteq> y"
       and "xa \<in> set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
       and "xa \<in> set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r"
     moreover have "set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter> set |h3 \<turnstile> get_disconnected_nodes y|\<^sub>r = {}"
       using calculation by(auto dest: distinct_concat_map_E(1))
     ultimately show "False"
       apply(-)
       apply(cases "x = document_ptr")
        apply(smt NodeMonad.ptr_kinds_ptr_kinds_M
           \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close> \<open>CD.a_all_ptrs_in_heap h\<close>
           disc_nodes_h3 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
           disjoint_iff_not_equal document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h'
           set_disconnected_nodes_get_disconnected_nodes
           CD.a_all_ptrs_in_heap_def
           select_result_I2 set_ConsD subsetD)
       by (smt NodeMonad.ptr_kinds_ptr_kinds_M
           \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close> \<open>CD.a_all_ptrs_in_heap h\<close>
           disc_nodes_document_ptr_h2 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2
           disconnected_nodes_eq2_h3
           disjoint_iff_not_equal document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h'
           l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
           CD.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
           select_result_I2 set_ConsD subsetD)
   next
     fix x xa xb
     assume 2: "(\<Union>x\<in>fset (object_ptr_kinds h3). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                    \<inter> (\<Union>x\<in>fset (document_ptr_kinds h3). set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 3: "xa |\<in>| object_ptr_kinds h3"
       and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
       and 5: "xb |\<in>| document_ptr_kinds h3"
       and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     show "False"
       using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3
       apply -
       apply(cases "xb = document_ptr")
        apply (metis (no_types, hide_lams) "3" "4" "6"
           \<open>\<And>p. p |\<in>| object_ptr_kinds h3
                       \<Longrightarrow> cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h3 \<turnstile> get_child_nodes p|\<^sub>r\<close>
           \<open> CD.a_distinct_lists h3\<close> children_eq2_h3 disc_nodes_h3 CD.distinct_lists_no_parent h'
           select_result_I2 set_ConsD  set_disconnected_nodes_get_disconnected_nodes)
       by (metis "3" "4" "5" "6" \<open> CD.a_distinct_lists h3\<close> \<open>type_wf h3\<close> children_eq2_h3
           CD.distinct_lists_no_parent  get_disconnected_nodes_ok returns_result_select_result)
   qed
 
   have "CD.a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_owner_document_valid h'"
     using disc_nodes_h3 \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
     apply(auto simp add: CD.a_owner_document_valid_def)[1]
     apply(auto simp add:  object_ptr_kinds_eq_h object_ptr_kinds_eq_h3 )[1]
     apply(auto simp add: object_ptr_kinds_eq_h2)[1]
     apply(auto simp add:  document_ptr_kinds_eq_h document_ptr_kinds_eq_h3 )[1]
     apply(auto simp add: document_ptr_kinds_eq_h2)[1]
     apply(auto simp add:  node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )[1]
     apply(auto simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )[1]
      apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric]
         disconnected_nodes_eq2_h disconnected_nodes_eq2_h2
         disconnected_nodes_eq2_h3)[1]
      apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1)
         local.set_disconnected_nodes_get_disconnected_nodes select_result_I2)
     apply(simp add: object_ptr_kinds_eq_h)
     by(metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M
         \<open>cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_element_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close> children_eq2_h children_eq2_h2
         children_eq2_h3 disconnected_nodes_eq2_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
         document_ptr_kinds_eq_h finite_set_in h'
         l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
         list.set_intros(2) local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
         node_ptr_kinds_commutes select_result_I2)
 
   have "CD.a_heap_is_wellformed h'"
     using \<open>CD.a_acyclic_heap h'\<close> \<open>CD.a_all_ptrs_in_heap h'\<close> \<open>CD.a_distinct_lists h'\<close>
       \<open>CD.a_owner_document_valid h'\<close>
     by(simp add: CD.a_heap_is_wellformed_def)
 
 
 
 
 
   have shadow_root_ptr_kinds_eq_h: "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: shadow_root_ptr_kinds_def)
   have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     by(auto simp add: shadow_root_ptr_kinds_def)
   have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h' = shadow_root_ptr_kinds h3"
     using object_ptr_kinds_eq_h3
     by(auto simp add: shadow_root_ptr_kinds_def)
 
 
 
   have shadow_root_eq_h: "\<And>element_ptr shadow_root_opt. element_ptr \<noteq> new_element_ptr
               \<Longrightarrow> h \<turnstile> get_shadow_root element_ptr \<rightarrow>\<^sub>r shadow_root_opt =
 h2 \<turnstile> get_shadow_root element_ptr \<rightarrow>\<^sub>r shadow_root_opt"
   proof -
     fix element_ptr shadow_root_opt
     assume "element_ptr \<noteq> new_element_ptr "
     have "\<forall>P \<in> get_shadow_root_locs element_ptr. P h h2"
       using get_shadow_root_new_element new_element_ptr h2
       using \<open>element_ptr \<noteq> new_element_ptr\<close> by blast
     then
     have "preserved (get_shadow_root element_ptr) h h2"
       using get_shadow_root_new_element[rotated, OF new_element_ptr h2]
       using get_shadow_root_reads
       by(simp add: reads_def)
     then show "h \<turnstile> get_shadow_root element_ptr \<rightarrow>\<^sub>r shadow_root_opt =
 h2 \<turnstile> get_shadow_root element_ptr \<rightarrow>\<^sub>r shadow_root_opt"
       by (simp add: preserved_def)
   qed
   have shadow_root_none: "h2 \<turnstile> get_shadow_root (new_element_ptr) \<rightarrow>\<^sub>r None"
     using new_element_ptr h2 new_element_ptr_in_heap[OF h2 new_element_ptr]
       new_element_is_element_ptr[OF new_element_ptr] new_element_no_shadow_root
     by blast
 
   have shadow_root_eq_h2:
     "\<And>ptr' children. h2 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children = h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children"
     using get_shadow_root_reads set_tag_name_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_tag_name_get_shadow_root)
   have shadow_root_eq_h3:
     "\<And>ptr' children. h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children = h' \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children"
     using get_shadow_root_reads set_disconnected_nodes_writes h'
     apply(rule reads_writes_preserved)
     using set_disconnected_nodes_get_shadow_root
     by(auto simp add: set_disconnected_nodes_get_shadow_root)
 
 
   have "a_all_ptrs_in_heap h"
     by (simp add: assms(1) local.a_all_ptrs_in_heap_def local.get_shadow_root_shadow_root_ptr_in_heap)
   then have "a_all_ptrs_in_heap h2"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h)[1]
     using returns_result_eq shadow_root_eq_h shadow_root_none by fastforce
   then have "a_all_ptrs_in_heap h3"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h2)[1]
     using shadow_root_eq_h2 by blast
   then have "a_all_ptrs_in_heap h'"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h3)[1]
     by (simp add: shadow_root_eq_h3)
 
   have "a_distinct_lists h"
     using assms(1)
     by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h2"
     apply(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h)[1]
     apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
     apply(case_tac "x = new_element_ptr")
     using shadow_root_none apply auto[1]
     using shadow_root_eq_h
     by (smt Diff_empty Diff_insert0 ElementMonad.ptr_kinds_M_ptr_kinds
         ElementMonad.ptr_kinds_ptr_kinds_M assms(1) assms(3) finite_set_in h2 insort_split
         local.get_shadow_root_ok local.shadow_root_same_host new_element_ptr new_element_ptr_not_in_heap
         option.distinct(1) returns_result_select_result select_result_I2 shadow_root_none)
   then have "a_distinct_lists h3"
     by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h2 select_result_eq[OF shadow_root_eq_h2])
   then have "a_distinct_lists h'"
     by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h3 select_result_eq[OF shadow_root_eq_h3])
 
 
   have "a_shadow_root_valid h"
     using assms(1)
     by (simp add: heap_is_wellformed_def)
   then have "a_shadow_root_valid h2"
   proof (unfold a_shadow_root_valid_def; safe)
     fix shadow_root_ptr
     assume "\<forall>shadow_root_ptr\<in>fset (shadow_root_ptr_kinds h). \<exists>host\<in>fset (element_ptr_kinds h).
 |h \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types \<and> |h \<turnstile> get_shadow_root host|\<^sub>r = Some shadow_root_ptr"
     assume "shadow_root_ptr \<in> fset (shadow_root_ptr_kinds h2)"
 
     obtain previous_host where
       "previous_host \<in> fset (element_ptr_kinds h)" and
       "|h \<turnstile> get_tag_name previous_host|\<^sub>r \<in> safe_shadow_root_element_types" and
       "|h \<turnstile> get_shadow_root previous_host|\<^sub>r = Some shadow_root_ptr"
       by (metis \<open>local.a_shadow_root_valid h\<close> \<open>shadow_root_ptr \<in> fset (shadow_root_ptr_kinds h2)\<close>
           local.a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h)
     moreover have "previous_host \<noteq> new_element_ptr"
       using calculation(1) h2 new_element_ptr new_element_ptr_not_in_heap by auto
     ultimately have "|h2 \<turnstile> get_tag_name previous_host|\<^sub>r \<in> safe_shadow_root_element_types" and
       "|h2 \<turnstile> get_shadow_root previous_host|\<^sub>r = Some shadow_root_ptr"
       using shadow_root_eq_h
        apply (simp add: tag_name_eq2_h)
       by (metis \<open>previous_host \<noteq> new_element_ptr\<close>
           \<open>|h \<turnstile> get_shadow_root previous_host|\<^sub>r = Some shadow_root_ptr\<close>
           select_result_eq shadow_root_eq_h)
     then
     show "\<exists>host\<in>fset (element_ptr_kinds h2).
 |h2 \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types \<and>
 |h2 \<turnstile> get_shadow_root host|\<^sub>r = Some shadow_root_ptr"
       by (meson \<open>previous_host \<in> fset (element_ptr_kinds h)\<close> \<open>previous_host \<noteq> new_element_ptr\<close>
           assms(3) local.get_shadow_root_ok local.get_shadow_root_ptr_in_heap notin_fset
           returns_result_select_result shadow_root_eq_h)
   qed
   then have "a_shadow_root_valid h3"
   proof (unfold a_shadow_root_valid_def; safe)
     fix shadow_root_ptr
     assume "\<forall>shadow_root_ptr\<in>fset (shadow_root_ptr_kinds h2). \<exists>host\<in>fset (element_ptr_kinds h2).
 |h2 \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types \<and>
 |h2 \<turnstile> get_shadow_root host|\<^sub>r = Some shadow_root_ptr"
     assume "shadow_root_ptr \<in> fset (shadow_root_ptr_kinds h3)"
 
     obtain previous_host where
       "previous_host \<in> fset (element_ptr_kinds h2)" and
       "|h2 \<turnstile> get_tag_name previous_host|\<^sub>r \<in> safe_shadow_root_element_types" and
       "|h2 \<turnstile> get_shadow_root previous_host|\<^sub>r = Some shadow_root_ptr"
       by (metis \<open>local.a_shadow_root_valid h2\<close> \<open>shadow_root_ptr \<in> fset (shadow_root_ptr_kinds h3)\<close>
           local.a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h2)
     moreover have "previous_host \<noteq> new_element_ptr"
       using calculation(1) h3 new_element_ptr new_element_ptr_not_in_heap
       using calculation(3) shadow_root_none by auto
     ultimately have "|h2 \<turnstile> get_tag_name previous_host|\<^sub>r \<in> safe_shadow_root_element_types" and
       "|h2 \<turnstile> get_shadow_root previous_host|\<^sub>r = Some shadow_root_ptr"
       using shadow_root_eq_h2
        apply (simp add: tag_name_eq2_h2)
       by (metis \<open>previous_host \<noteq> new_element_ptr\<close>
           \<open>|h2 \<turnstile> get_shadow_root previous_host|\<^sub>r = Some shadow_root_ptr\<close> select_result_eq
           shadow_root_eq_h)
     then
     show "\<exists>host\<in>fset (element_ptr_kinds h3).
 |h3 \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types \<and>
 |h3 \<turnstile> get_shadow_root host|\<^sub>r = Some shadow_root_ptr"
       by (smt \<open>previous_host \<in> fset (element_ptr_kinds h2)\<close> \<open>previous_host \<noteq> new_element_ptr\<close>
           \<open>type_wf h2\<close> \<open>type_wf h3\<close> element_ptr_kinds_eq_h2 finite_set_in local.get_shadow_root_ok
           returns_result_eq returns_result_select_result shadow_root_eq_h2 tag_name_eq2_h2)
   qed
   then have "a_shadow_root_valid h'"
     apply(auto simp add: a_shadow_root_valid_def element_ptr_kinds_eq_h3 shadow_root_eq_h3
         shadow_root_ptr_kinds_eq_h3 tag_name_eq2_h3)[1]
     by (smt \<open>type_wf h3\<close> finite_set_in local.get_shadow_root_ok returns_result_select_result
         select_result_I2 shadow_root_eq_h3)
 
 
 
   have "a_host_shadow_root_rel h = a_host_shadow_root_rel h2"
     apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h shadow_root_eq_h)[1]
       apply (smt assms(3) case_prod_conv h2 image_iff local.get_shadow_root_ok mem_Collect_eq
         new_element_ptr new_element_ptr_not_in_heap returns_result_select_result select_result_I2
         shadow_root_eq_h)
     using shadow_root_none apply auto[1]
     by (metis (no_types, lifting) Collect_cong assms(3) case_prodE case_prodI h2
         host_shadow_root_rel_def host_shadow_root_rel_shadow_root local.a_host_shadow_root_rel_def
         local.get_shadow_root_impl local.get_shadow_root_ok local.new_element_no_shadow_root
         new_element_ptr option.distinct(1) returns_result_select_result select_result_I2 shadow_root_eq_h)
   have "a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3"
     apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2 shadow_root_eq_h2)[1]
      apply (smt Collect_cong Shadow_DOM.a_host_shadow_root_rel_def assms(3) h2
         host_shadow_root_rel_shadow_root is_OK_returns_result_E local.get_shadow_root_impl
         local.get_shadow_root_ok local.new_element_types_preserved select_result_I2 shadow_root_eq_h2
         split_cong)
     apply (metis (no_types, lifting) Collect_cong \<open>type_wf h3\<close> element_ptr_kinds_eq_h2
         host_shadow_root_rel_def host_shadow_root_rel_shadow_root local.a_host_shadow_root_rel_def
         local.get_shadow_root_impl local.get_shadow_root_ok returns_result_select_result shadow_root_eq_h2
         split_cong)
     done
   have "a_host_shadow_root_rel h3 = a_host_shadow_root_rel h'"
     apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2 shadow_root_eq_h2)[1]
      apply (metis (no_types, lifting) Collect_cong \<open>type_wf h3\<close> case_prodE case_prodI
         element_ptr_kinds_eq_h2 host_shadow_root_rel_def host_shadow_root_rel_shadow_root
         local.a_host_shadow_root_rel_def local.get_shadow_root_impl local.get_shadow_root_ok
         returns_result_select_result shadow_root_eq_h3)
     apply (smt Collect_cong \<open>type_wf h'\<close> \<open>type_wf h2\<close> case_prodD case_prodI2 host_shadow_root_rel_def
         host_shadow_root_rel_shadow_root is_OK_returns_result_E local.a_host_shadow_root_rel_def
         local.get_shadow_root_impl local.get_shadow_root_ok select_result_I2 shadow_root_eq_h2 shadow_root_eq_h3)
     done
 
   have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   have "parent_child_rel h \<union> a_host_shadow_root_rel h =
 parent_child_rel h2 \<union> a_host_shadow_root_rel h2"
     using \<open>local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2\<close>
       \<open>parent_child_rel h = parent_child_rel h2\<close> by auto
   have "parent_child_rel h2 \<union> a_host_shadow_root_rel h2 =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3"
     using \<open>local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3\<close>
       \<open>parent_child_rel h2 = parent_child_rel h3\<close> by auto
   have "parent_child_rel h' \<union> a_host_shadow_root_rel h' =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3"
     by (simp add: \<open>local.a_host_shadow_root_rel h3 = local.a_host_shadow_root_rel h'\<close>
         \<open>parent_child_rel h3 = parent_child_rel h'\<close>)
 
   have "acyclic (parent_child_rel h3 \<union> a_host_shadow_root_rel h3)"
     using \<open>acyclic (parent_child_rel h \<union> local.a_host_shadow_root_rel h)\<close>
       \<open>parent_child_rel h \<union> local.a_host_shadow_root_rel h =
 parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2\<close>
       \<open>parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2 =
 parent_child_rel h3 \<union> local.a_host_shadow_root_rel h3\<close>
     by auto
   then have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h')"
     by(simp add: \<open>parent_child_rel h' \<union> a_host_shadow_root_rel h' =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3\<close>)
 
 
   show " heap_is_wellformed h' "
     using \<open>acyclic (parent_child_rel h' \<union> local.a_host_shadow_root_rel h')\<close>
     by(simp add: heap_is_wellformed_def CD.heap_is_wellformed_impl
         \<open>local.CD.a_heap_is_wellformed h'\<close> \<open>local.a_all_ptrs_in_heap h'\<close> \<open>local.a_distinct_lists h'\<close>
         \<open>local.a_shadow_root_valid h'\<close>)
 qed
 end
 
 interpretation i_create_element_wf?: l_create_element_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr known_ptrs type_wf
   get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
   heap_is_wellformed parent_child_rel set_tag_name set_tag_name_locs set_disconnected_nodes
   set_disconnected_nodes_locs create_element get_shadow_root get_shadow_root_locs get_tag_name
   get_tag_name_locs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs DocumentClass.known_ptr DocumentClass.type_wf
   by(auto simp add: l_create_element_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_create_element_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 
 subsubsection \<open>create\_character\_data\<close>
 
 locale l_create_character_data_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_disconnected_nodes type_wf get_disconnected_nodes get_disconnected_nodes_locs +
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs
   get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
   heap_is_wellformed parent_child_rel
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs +
   l_create_character_data\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes get_disconnected_nodes_locs
   set_disconnected_nodes set_disconnected_nodes_locs set_val set_val_locs create_character_data
   known_ptr type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   + l_new_character_data_get_disconnected_nodes
   get_disconnected_nodes get_disconnected_nodes_locs
 
 + l_set_val_get_disconnected_nodes
 type_wf set_val set_val_locs get_disconnected_nodes get_disconnected_nodes_locs
 + l_new_character_data_get_child_nodes
 type_wf known_ptr get_child_nodes get_child_nodes_locs
 + l_set_val_get_child_nodes
 type_wf set_val set_val_locs known_ptr get_child_nodes get_child_nodes_locs
 + l_set_disconnected_nodes_get_child_nodes
 set_disconnected_nodes set_disconnected_nodes_locs get_child_nodes get_child_nodes_locs
 + l_set_disconnected_nodes
 type_wf set_disconnected_nodes set_disconnected_nodes_locs
 + l_set_disconnected_nodes_get_disconnected_nodes
 type_wf get_disconnected_nodes get_disconnected_nodes_locs set_disconnected_nodes
 set_disconnected_nodes_locs
 + l_set_val_get_shadow_root type_wf set_val set_val_locs get_shadow_root get_shadow_root_locs
 + l_set_disconnected_nodes_get_shadow_root set_disconnected_nodes set_disconnected_nodes_locs
 get_shadow_root get_shadow_root_locs
 + l_new_character_data_get_tag_name
 get_tag_name get_tag_name_locs
 + l_set_val_get_tag_name type_wf set_val set_val_locs get_tag_name get_tag_name_locs
 + l_get_tag_name type_wf get_tag_name get_tag_name_locs
 + l_set_disconnected_nodes_get_tag_name type_wf set_disconnected_nodes set_disconnected_nodes_locs
 get_tag_name get_tag_name_locs
 + l_new_character_data
 type_wf
 + l_known_ptrs
 known_ptr known_ptrs
 for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
   and known_ptrs :: "(_) heap \<Rightarrow> bool"
   and type_wf :: "(_) heap \<Rightarrow> bool"
   and get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
   and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
   and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
   and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
   and set_tag_name :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog"
   and set_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
   and set_disconnected_nodes :: "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
   and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
   and create_element :: "(_) document_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
   and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
   and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
   and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
   and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
   and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and get_disconnected_document :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
   and get_disconnected_document_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and set_val :: "(_) character_data_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog"
   and set_val_locs :: "(_) character_data_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
   and create_character_data ::
   "(_) document_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) character_data_ptr) prog"
   and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_::linorder) object_ptr \<Rightarrow> bool"
   and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
 begin
 lemma create_character_data_preserves_wellformedness:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> create_character_data document_ptr text \<rightarrow>\<^sub>h h'"
     and "type_wf h"
     and "known_ptrs h"
   shows "heap_is_wellformed h'" and "type_wf h'" and "known_ptrs h'"
 proof -
   obtain new_character_data_ptr h2 h3 disc_nodes_h3 where
     new_character_data_ptr: "h \<turnstile> new_character_data \<rightarrow>\<^sub>r new_character_data_ptr" and
     h2: "h \<turnstile> new_character_data \<rightarrow>\<^sub>h h2" and
     h3: "h2 \<turnstile> set_val new_character_data_ptr text \<rightarrow>\<^sub>h h3" and
     disc_nodes_h3: "h3 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h3" and
     h': "h3 \<turnstile> set_disconnected_nodes document_ptr (cast new_character_data_ptr # disc_nodes_h3) \<rightarrow>\<^sub>h h'"
     using assms(2)
     by(auto simp add: CD.create_character_data_def
         elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF CD.get_disconnected_nodes_pure, rotated] )
   then have "h \<turnstile> create_character_data document_ptr text \<rightarrow>\<^sub>r new_character_data_ptr"
     apply(auto simp add: CD.create_character_data_def intro!: bind_returns_result_I)[1]
     apply (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)
     apply (metis is_OK_returns_heap_E is_OK_returns_result_I local.CD.get_disconnected_nodes_pure
         pure_returns_heap_eq)
     by (metis is_OK_returns_heap_I is_OK_returns_result_E old.unit.exhaust)
 
 
   have "new_character_data_ptr \<notin> set |h \<turnstile> character_data_ptr_kinds_M|\<^sub>r"
     using new_character_data_ptr CharacterDataMonad.ptr_kinds_ptr_kinds_M h2
     using new_character_data_ptr_not_in_heap by blast
   then have "cast new_character_data_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r"
     by simp
   then have "cast new_character_data_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
 
 
 
   have object_ptr_kinds_eq_h:
     "object_ptr_kinds h2 = object_ptr_kinds h |\<union>| {|cast new_character_data_ptr|}"
     using new_character_data_new_ptr h2 new_character_data_ptr by blast
   then have node_ptr_kinds_eq_h:
     "node_ptr_kinds h2 = node_ptr_kinds h |\<union>| {|cast new_character_data_ptr|}"
     apply(simp add: node_ptr_kinds_def)
     by force
   then have character_data_ptr_kinds_eq_h:
     "character_data_ptr_kinds h2 = character_data_ptr_kinds h |\<union>| {|new_character_data_ptr|}"
     apply(simp add: character_data_ptr_kinds_def)
     by force
   have element_ptr_kinds_eq_h: "element_ptr_kinds h2 = element_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)
   have document_ptr_kinds_eq_h: "document_ptr_kinds h2 = document_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: document_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF CD.set_val_writes h3])
     using CD.set_val_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
     by (auto simp add: document_ptr_kinds_def)
   have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     by(auto simp add: node_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF set_disconnected_nodes_writes h'])
     using set_disconnected_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3"
     by (auto simp add: document_ptr_kinds_def)
   have node_ptr_kinds_eq_h3: "node_ptr_kinds h' = node_ptr_kinds h3"
     using object_ptr_kinds_eq_h3
     by(auto simp add: node_ptr_kinds_def)
 
   have "known_ptr (cast new_character_data_ptr)"
     using \<open>h \<turnstile> create_character_data document_ptr text \<rightarrow>\<^sub>r new_character_data_ptr\<close>
       local.create_character_data_known_ptr by blast
   then
   have "known_ptrs h2"
     using known_ptrs_new_ptr object_ptr_kinds_eq_h \<open>known_ptrs h\<close> h2
     by blast
   then
   have "known_ptrs h3"
     using known_ptrs_preserved object_ptr_kinds_eq_h2 by blast
   then
   show "known_ptrs h'"
     using known_ptrs_preserved object_ptr_kinds_eq_h3 by blast
 
   have "document_ptr |\<in>| document_ptr_kinds h"
     using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
       CD.get_disconnected_nodes_ptr_in_heap \<open>type_wf h\<close> document_ptr_kinds_def
     by (metis is_OK_returns_result_I)
 
   have children_eq_h: "\<And>(ptr'::(_) object_ptr) children. ptr' \<noteq> cast new_character_data_ptr
                   \<Longrightarrow> h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads h2
       get_child_nodes_new_character_data[rotated, OF new_character_data_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have children_eq2_h:
     "\<And>ptr'. ptr' \<noteq> cast new_character_data_ptr
       \<Longrightarrow> |h \<turnstile> get_child_nodes ptr'|\<^sub>r = |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   have object_ptr_kinds_eq_h:
     "object_ptr_kinds h2 = object_ptr_kinds h |\<union>| {|cast new_character_data_ptr|}"
     using new_character_data_new_ptr h2 new_character_data_ptr by blast
   then have node_ptr_kinds_eq_h:
     "node_ptr_kinds h2 = node_ptr_kinds h |\<union>| {|cast new_character_data_ptr|}"
     apply(simp add: node_ptr_kinds_def)
     by force
   then have character_data_ptr_kinds_eq_h:
     "character_data_ptr_kinds h2 = character_data_ptr_kinds h |\<union>| {|new_character_data_ptr|}"
     apply(simp add: character_data_ptr_kinds_def)
     by force
   have element_ptr_kinds_eq_h: "element_ptr_kinds h2 = element_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)
   have document_ptr_kinds_eq_h: "document_ptr_kinds h2 = document_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: document_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF CD.set_val_writes h3])
     using CD.set_val_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
     by (auto simp add: document_ptr_kinds_def)
   have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     by(auto simp add: node_ptr_kinds_def)
   then have character_data_ptr_kinds_eq_h2: "character_data_ptr_kinds h3 = character_data_ptr_kinds h2"
     by(simp add: character_data_ptr_kinds_def)
   have element_ptr_kinds_eq_h2: "element_ptr_kinds h3 = element_ptr_kinds h2"
     using node_ptr_kinds_eq_h2
     by(simp add: element_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF set_disconnected_nodes_writes h'])
     using set_disconnected_nodes_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3"
     by (auto simp add: document_ptr_kinds_def)
   have node_ptr_kinds_eq_h3: "node_ptr_kinds h' = node_ptr_kinds h3"
     using object_ptr_kinds_eq_h3
     by(auto simp add: node_ptr_kinds_def)
   then have character_data_ptr_kinds_eq_h3: "character_data_ptr_kinds h' = character_data_ptr_kinds h3"
     by(simp add: character_data_ptr_kinds_def)
   have element_ptr_kinds_eq_h3: "element_ptr_kinds h' = element_ptr_kinds h3"
     using node_ptr_kinds_eq_h3
     by(simp add: element_ptr_kinds_def)
 
 
   have "document_ptr |\<in>| document_ptr_kinds h"
     using disc_nodes_h3 document_ptr_kinds_eq_h object_ptr_kinds_eq_h2
       CD.get_disconnected_nodes_ptr_in_heap \<open>type_wf h\<close> document_ptr_kinds_def
     by (metis is_OK_returns_result_I)
 
   have children_eq_h: "\<And>(ptr'::(_) object_ptr) children. ptr' \<noteq> cast new_character_data_ptr
                 \<Longrightarrow> h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads h2
       get_child_nodes_new_character_data[rotated, OF new_character_data_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have children_eq2_h: "\<And>ptr'. ptr' \<noteq> cast new_character_data_ptr
                                  \<Longrightarrow> |h \<turnstile> get_child_nodes ptr'|\<^sub>r = |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
 
   have "h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []"
     using new_character_data_ptr h2 new_character_data_ptr_in_heap[OF h2 new_character_data_ptr]
       new_character_data_is_character_data_ptr[OF new_character_data_ptr]
       new_character_data_no_child_nodes
     by blast
   have disconnected_nodes_eq_h:
     "\<And>doc_ptr disc_nodes. h \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes
                                              = h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using CD.get_disconnected_nodes_reads h2
       get_disconnected_nodes_new_character_data[OF new_character_data_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have disconnected_nodes_eq2_h:
     "\<And>doc_ptr. |h \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
   have tag_name_eq_h:
     "\<And>ptr' disc_nodes. h \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h2 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads h2
       get_tag_name_new_character_data[OF new_character_data_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have tag_name_eq2_h: "\<And>ptr'. |h \<turnstile> get_tag_name ptr'|\<^sub>r = |h2 \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
 
   have children_eq_h2:
     "\<And>ptr' children. h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads CD.set_val_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_val_get_child_nodes)
   then have children_eq2_h2:
     "\<And>ptr'. |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r = |h3 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   have disconnected_nodes_eq_h2:
     "\<And>doc_ptr disc_nodes. h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes
                                               = h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using CD.get_disconnected_nodes_reads CD.set_val_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_val_get_disconnected_nodes)
   then have disconnected_nodes_eq2_h2:
     "\<And>doc_ptr. |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
   have tag_name_eq_h2:
     "\<And>ptr' disc_nodes. h2 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads CD.set_val_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_val_get_tag_name)
   then have tag_name_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_tag_name ptr'|\<^sub>r = |h3 \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
 
   have "type_wf h2"
     using \<open>type_wf h\<close> new_character_data_types_preserved h2 by blast
   then have "type_wf h3"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF CD.set_val_writes h3]
     using  set_val_types_preserved
     by(auto simp add: reflp_def transp_def)
   then show "type_wf h'"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF set_disconnected_nodes_writes h']
     using  set_disconnected_nodes_types_preserved
     by(auto simp add: reflp_def transp_def)
 
   have children_eq_h3:
     "\<And>ptr' children. h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads set_disconnected_nodes_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: set_disconnected_nodes_get_child_nodes)
   then have children_eq2_h3:
     " \<And>ptr'. |h3 \<turnstile> get_child_nodes ptr'|\<^sub>r = |h' \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   have disconnected_nodes_eq_h3: "\<And>doc_ptr disc_nodes. document_ptr \<noteq> doc_ptr
     \<Longrightarrow> h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes
                             = h' \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using CD.get_disconnected_nodes_reads set_disconnected_nodes_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: set_disconnected_nodes_get_disconnected_nodes_different_pointers)
   then have disconnected_nodes_eq2_h3: "\<And>doc_ptr. document_ptr \<noteq> doc_ptr
              \<Longrightarrow> |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
   have tag_name_eq_h3:
     "\<And>ptr' disc_nodes. h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h' \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads set_disconnected_nodes_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: set_disconnected_nodes_get_tag_name)
   then have tag_name_eq2_h3: "\<And>ptr'. |h3 \<turnstile> get_tag_name ptr'|\<^sub>r = |h' \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
 
   have disc_nodes_document_ptr_h2: "h2 \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h3"
     using disconnected_nodes_eq_h2 disc_nodes_h3 by auto
   then have disc_nodes_document_ptr_h: "h \<turnstile> get_disconnected_nodes document_ptr \<rightarrow>\<^sub>r disc_nodes_h3"
     using disconnected_nodes_eq_h by auto
   then have "cast new_character_data_ptr \<notin> set disc_nodes_h3"
     using \<open>heap_is_wellformed h\<close> using \<open>cast new_character_data_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
       a_all_ptrs_in_heap_def heap_is_wellformed_def
     using NodeMonad.ptr_kinds_ptr_kinds_M local.heap_is_wellformed_disc_nodes_in_heap by blast
 
   have "acyclic (parent_child_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h2"
   proof(auto simp add: CD.parent_child_rel_def)[1]
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h"
       and 1: "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
     then show "a |\<in>| object_ptr_kinds h2"
       by (simp add: object_ptr_kinds_eq_h)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h"
       and 1: "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
     then show "x \<in> set |h2 \<turnstile> get_child_nodes a|\<^sub>r"
       by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
           \<open>cast new_character_data_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close> children_eq2_h)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h2"
       and 1: "x \<in> set |h2 \<turnstile> get_child_nodes a|\<^sub>r"
     then show "a |\<in>| object_ptr_kinds h"
       using object_ptr_kinds_eq_h \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>
       by(auto)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h2"
       and 1: "x \<in> set |h2 \<turnstile> get_child_nodes a|\<^sub>r"
     then show "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
       by (metis (no_types, lifting) \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>
           children_eq2_h empty_iff empty_set image_eqI select_result_I2)
   qed
   also have "\<dots> = parent_child_rel h3"
     by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
   also have "\<dots> = parent_child_rel h'"
     by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
   finally have "CD.a_acyclic_heap h'"
     by (simp add: CD.acyclic_heap_def)
 
   have "CD.a_all_ptrs_in_heap h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_all_ptrs_in_heap h2"
     apply(auto simp add: CD.a_all_ptrs_in_heap_def)[1]
     using node_ptr_kinds_eq_h \<open>cast new_character_data_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
       \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>
     apply (metis (no_types, lifting) NodeMonad.ptr_kinds_ptr_kinds_M
         \<open>parent_child_rel h = parent_child_rel h2\<close>
         children_eq2_h finite_set_in finsert_iff funion_finsert_right CD.parent_child_rel_child
         CD.parent_child_rel_parent_in_heap node_ptr_kinds_commutes object_ptr_kinds_eq_h
         select_result_I2 subsetD sup_bot.right_neutral)
     by (metis (no_types, lifting) CD.get_child_nodes_ok CD.get_child_nodes_ptr_in_heap
         \<open>h2 \<turnstile> get_child_nodes (cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_character_data_ptr) \<rightarrow>\<^sub>r []\<close> assms(3) assms(4)
         children_eq_h disconnected_nodes_eq2_h document_ptr_kinds_eq_h finite_set_in
         is_OK_returns_result_I local.known_ptrs_known_ptr node_ptr_kinds_commutes
         returns_result_select_result subset_code(1))
   then have "CD.a_all_ptrs_in_heap h3"
     by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
   then have "CD.a_all_ptrs_in_heap h'"
     by (smt character_data_ptr_kinds_commutes character_data_ptr_kinds_eq_h2 children_eq2_h3
         disc_nodes_h3 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3 h' h2
         local.CD.a_all_ptrs_in_heap_def local.set_disconnected_nodes_get_disconnected_nodes
         new_character_data_ptr new_character_data_ptr_in_heap node_ptr_kinds_eq_h3 notin_fset
         object_ptr_kinds_eq_h3 select_result_I2 set_ConsD subset_code(1))
 
   have "\<And>p. p |\<in>| object_ptr_kinds h \<Longrightarrow> cast new_character_data_ptr \<notin> set |h \<turnstile> get_child_nodes p|\<^sub>r"
     using \<open>heap_is_wellformed h\<close> \<open>cast new_character_data_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
       heap_is_wellformed_children_in_heap
     by (meson NodeMonad.ptr_kinds_ptr_kinds_M CD.a_all_ptrs_in_heap_def assms(3) assms(4) fset_mp
         fset_of_list_elem CD.get_child_nodes_ok known_ptrs_known_ptr returns_result_select_result)
   then have "\<And>p. p |\<in>| object_ptr_kinds h2 \<Longrightarrow>
 cast new_character_data_ptr \<notin> set |h2 \<turnstile> get_child_nodes p|\<^sub>r"
     using children_eq2_h
     apply(auto simp add: object_ptr_kinds_eq_h)[1]
     using \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close> apply auto[1]
     by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
         \<open>cast new_character_data_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close>)
   then have "\<And>p. p |\<in>| object_ptr_kinds h3 \<Longrightarrow>
 cast new_character_data_ptr \<notin> set |h3 \<turnstile> get_child_nodes p|\<^sub>r"
     using object_ptr_kinds_eq_h2 children_eq2_h2 by auto
   then have new_character_data_ptr_not_in_any_children:
     "\<And>p. p |\<in>| object_ptr_kinds h' \<Longrightarrow> cast new_character_data_ptr \<notin> set |h' \<turnstile> get_child_nodes p|\<^sub>r"
     using object_ptr_kinds_eq_h3 children_eq2_h3 by auto
 
   have "CD.a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_distinct_lists h2"
     using \<open>h2 \<turnstile> get_child_nodes (cast new_character_data_ptr) \<rightarrow>\<^sub>r []\<close>
     apply(auto simp add: CD.a_distinct_lists_def object_ptr_kinds_eq_h document_ptr_kinds_eq_h
         disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1]
     apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert)
     apply(case_tac "x=cast new_character_data_ptr")
     apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
     apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
     apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
     apply (metis IntI assms(1) assms(3) assms(4) empty_iff CD.get_child_nodes_ok
         local.heap_is_wellformed_one_parent local.known_ptrs_known_ptr
         returns_result_select_result)
     apply(auto simp add: children_eq2_h[symmetric] insort_split dest: distinct_concat_map_E(2))[1]
     thm children_eq2_h
 
     using \<open>CD.a_distinct_lists h\<close> \<open>type_wf h2\<close> disconnected_nodes_eq_h document_ptr_kinds_eq_h
       CD.distinct_lists_no_parent get_disconnected_nodes_ok returns_result_select_result
     by metis
   then have "CD.a_distinct_lists h3"
     by(auto simp add: CD.a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         children_eq2_h2 object_ptr_kinds_eq_h2)[1]
   then have "CD.a_distinct_lists h'"
   proof(auto simp add: CD.a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3
       object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 intro!: distinct_concat_map_I)[1]
     fix x
     assume "distinct (concat (map (\<lambda>document_ptr. |h3 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                       (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
       and "x |\<in>| document_ptr_kinds h3"
     then show "distinct |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
       using document_ptr_kinds_eq_h3 disconnected_nodes_eq_h3 h'
         set_disconnected_nodes_get_disconnected_nodes
       by (metis (no_types, hide_lams)
           \<open>cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_character_data_ptr \<notin> set disc_nodes_h3\<close> \<open>type_wf h2\<close> assms(1)
           disc_nodes_document_ptr_h disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3
           disconnected_nodes_eq_h distinct.simps(2) document_ptr_kinds_eq_h2 local.get_disconnected_nodes_ok
           local.heap_is_wellformed_disconnected_nodes_distinct returns_result_select_result select_result_I2)
   next
     fix x y xa
     assume "distinct (concat (map (\<lambda>document_ptr. |h3 \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                             (sorted_list_of_set (fset (document_ptr_kinds h3)))))"
       and "x |\<in>| document_ptr_kinds h3"
       and "y |\<in>| document_ptr_kinds h3"
       and "x \<noteq> y"
       and "xa \<in> set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
       and "xa \<in> set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r"
     moreover have "set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r \<inter> set |h3 \<turnstile> get_disconnected_nodes y|\<^sub>r = {}"
       using calculation by(auto dest: distinct_concat_map_E(1))
     ultimately show "False"
       using  NodeMonad.ptr_kinds_ptr_kinds_M
         \<open>cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>n\<^sub>o\<^sub>d\<^sub>e\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_character_data_ptr \<notin> set |h \<turnstile> node_ptr_kinds_M|\<^sub>r\<close>
 
       by (smt local.CD.a_all_ptrs_in_heap_def \<open>CD.a_all_ptrs_in_heap h\<close> disc_nodes_document_ptr_h2
           disconnected_nodes_eq2_h
           disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3 disjoint_iff_not_equal
           document_ptr_kinds_eq_h document_ptr_kinds_eq_h2 finite_set_in h'
           l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
           local.a_all_ptrs_in_heap_def local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
           select_result_I2 set_ConsD subsetD)
   next
     fix x xa xb
     assume 2: "(\<Union>x\<in>fset (object_ptr_kinds h3). set |h' \<turnstile> get_child_nodes x|\<^sub>r)
                   \<inter> (\<Union>x\<in>fset (document_ptr_kinds h3). set |h3 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 3: "xa |\<in>| object_ptr_kinds h3"
       and 4: "x \<in> set |h' \<turnstile> get_child_nodes xa|\<^sub>r"
       and 5: "xb |\<in>| document_ptr_kinds h3"
       and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     show "False"
       using disc_nodes_document_ptr_h disconnected_nodes_eq2_h3
       apply(cases "document_ptr = xb")
       apply (metis (no_types, lifting) "3" "4" "5" "6" CD.distinct_lists_no_parent
           \<open>local.CD.a_distinct_lists h2\<close> \<open>type_wf h'\<close> children_eq2_h2 children_eq2_h3
           disc_nodes_document_ptr_h2 document_ptr_kinds_eq_h3 h' local.get_disconnected_nodes_ok
           local.set_disconnected_nodes_get_disconnected_nodes new_character_data_ptr_not_in_any_children
           object_ptr_kinds_eq_h2 object_ptr_kinds_eq_h3 returns_result_eq returns_result_select_result
           set_ConsD)
       by (metis "3" "4" "5" "6" CD.distinct_lists_no_parent \<open>local.CD.a_distinct_lists h3\<close>
           \<open>type_wf h3\<close> children_eq2_h3 local.get_disconnected_nodes_ok returns_result_select_result)
   qed
 
   have "CD.a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_owner_document_valid h'"
     using disc_nodes_h3 \<open>document_ptr |\<in>| document_ptr_kinds h\<close>
     apply(simp add: CD.a_owner_document_valid_def)
     apply(simp add: object_ptr_kinds_eq_h object_ptr_kinds_eq_h3 )
     apply(simp add: object_ptr_kinds_eq_h2)
     apply(simp add: document_ptr_kinds_eq_h document_ptr_kinds_eq_h3 )
     apply(simp add: document_ptr_kinds_eq_h2)
     apply(simp add: node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )
     apply(simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )
     apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric]
         disconnected_nodes_eq2_h
         disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1]
     apply (metis (no_types, lifting) document_ptr_kinds_eq_h h' list.set_intros(1)
         local.set_disconnected_nodes_get_disconnected_nodes select_result_I2)
     apply(simp add: object_ptr_kinds_eq_h)
     by (metis (mono_tags, lifting)
         \<open>cast\<^sub>c\<^sub>h\<^sub>a\<^sub>r\<^sub>a\<^sub>c\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>d\<^sub>a\<^sub>t\<^sub>a\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_character_data_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close>
         children_eq2_h disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h finite_set_in h'
         l_ptr_kinds_M.ptr_kinds_ptr_kinds_M
         l_set_disconnected_nodes_get_disconnected_nodes.set_disconnected_nodes_get_disconnected_nodes
         list.set_intros(2) local.l_set_disconnected_nodes_get_disconnected_nodes_axioms
         object_ptr_kinds_M_def
         select_result_I2)
 
 
 
 
 
 
   have shadow_root_ptr_kinds_eq_h: "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: shadow_root_ptr_kinds_def)
   have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     by(auto simp add: shadow_root_ptr_kinds_def)
   have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h' = shadow_root_ptr_kinds h3"
     using object_ptr_kinds_eq_h3
     by(auto simp add: shadow_root_ptr_kinds_def)
 
 
 
   have shadow_root_eq_h:
     "\<And>character_data_ptr shadow_root_opt. h \<turnstile> get_shadow_root character_data_ptr \<rightarrow>\<^sub>r shadow_root_opt =
 h2 \<turnstile> get_shadow_root character_data_ptr \<rightarrow>\<^sub>r shadow_root_opt"
     using get_shadow_root_reads h2 get_shadow_root_new_character_data[rotated, OF h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     using local.get_shadow_root_locs_impl new_character_data_ptr apply blast
     using local.get_shadow_root_locs_impl new_character_data_ptr by blast
 
 
   have shadow_root_eq_h2:
     "\<And>ptr' children. h2 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children = h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children"
     using get_shadow_root_reads set_val_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_val_get_shadow_root)
   have shadow_root_eq_h3:
     "\<And>ptr' children. h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children = h' \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children"
     using get_shadow_root_reads set_disconnected_nodes_writes h'
     apply(rule reads_writes_preserved)
     using set_disconnected_nodes_get_shadow_root
     by(auto simp add: set_disconnected_nodes_get_shadow_root)
 
 
   have "a_all_ptrs_in_heap h"
     by (simp add: assms(1) local.a_all_ptrs_in_heap_def local.get_shadow_root_shadow_root_ptr_in_heap)
   then have "a_all_ptrs_in_heap h2"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h)[1]
     using returns_result_eq shadow_root_eq_h by fastforce
   then have "a_all_ptrs_in_heap h3"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h2)[1]
     using shadow_root_eq_h2 by blast
   then have "a_all_ptrs_in_heap h'"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h3)[1]
     by (simp add: shadow_root_eq_h3)
 
   have "a_distinct_lists h"
     using assms(1)
     by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h2"
     apply(auto simp add: a_distinct_lists_def character_data_ptr_kinds_eq_h)[1]
     apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
     by (metis \<open>type_wf h2\<close> assms(1) assms(3) local.get_shadow_root_ok local.shadow_root_same_host
         returns_result_select_result shadow_root_eq_h)
   then have "a_distinct_lists h3"
     by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h2
         select_result_eq[OF shadow_root_eq_h2])
   then have "a_distinct_lists h'"
     by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h3
         select_result_eq[OF shadow_root_eq_h3])
 
 
   have "a_shadow_root_valid h"
     using assms(1)
     by (simp add: heap_is_wellformed_def)
   then have "a_shadow_root_valid h2"
     by(auto simp add: a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h element_ptr_kinds_eq_h
         select_result_eq[OF shadow_root_eq_h] tag_name_eq2_h)
   then have "a_shadow_root_valid h3"
     by(auto simp add: a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h2 element_ptr_kinds_eq_h2
         select_result_eq[OF shadow_root_eq_h2] tag_name_eq2_h2)
   then have "a_shadow_root_valid h'"
     by(auto simp add: a_shadow_root_valid_def shadow_root_ptr_kinds_eq_h3 element_ptr_kinds_eq_h3
         select_result_eq[OF shadow_root_eq_h3] tag_name_eq2_h3)
 
 
 
   have "a_host_shadow_root_rel h = a_host_shadow_root_rel h2"
     by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h
         select_result_eq[OF shadow_root_eq_h])
   have "a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3"
     by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2
         select_result_eq[OF shadow_root_eq_h2])
   have "a_host_shadow_root_rel h3 = a_host_shadow_root_rel h'"
     by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h3
         select_result_eq[OF shadow_root_eq_h3])
 
   have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   have "parent_child_rel h \<union> a_host_shadow_root_rel h =
 parent_child_rel h2 \<union> a_host_shadow_root_rel h2"
     using \<open>local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2\<close>
       \<open>parent_child_rel h = parent_child_rel h2\<close> by auto
   have "parent_child_rel h2 \<union> a_host_shadow_root_rel h2 =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3"
     using \<open>local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3\<close>
       \<open>parent_child_rel h2 = parent_child_rel h3\<close> by auto
   have "parent_child_rel h' \<union> a_host_shadow_root_rel h' =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3"
     by (simp add: \<open>local.a_host_shadow_root_rel h3 = local.a_host_shadow_root_rel h'\<close>
         \<open>parent_child_rel h3 = parent_child_rel h'\<close>)
 
   have "acyclic (parent_child_rel h3 \<union> a_host_shadow_root_rel h3)"
     using \<open>acyclic (parent_child_rel h \<union> local.a_host_shadow_root_rel h)\<close>
       \<open>parent_child_rel h \<union> local.a_host_shadow_root_rel h = parent_child_rel h2 \<union>
 local.a_host_shadow_root_rel h2\<close> \<open>parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2 =
 parent_child_rel h3 \<union> local.a_host_shadow_root_rel h3\<close> by auto
   then have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h')"
     by(simp add: \<open>parent_child_rel h' \<union> a_host_shadow_root_rel h' =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3\<close>)
 
 
   have "CD.a_heap_is_wellformed h'"
     apply(simp add: CD.a_heap_is_wellformed_def)
     by (simp add: \<open>local.CD.a_acyclic_heap h'\<close> \<open>local.CD.a_all_ptrs_in_heap h'\<close>
         \<open>local.CD.a_distinct_lists h'\<close> \<open>local.CD.a_owner_document_valid h'\<close>)
 
   show "heap_is_wellformed h' "
     using \<open>acyclic (parent_child_rel h' \<union> local.a_host_shadow_root_rel h')\<close>
     by(simp add: heap_is_wellformed_def CD.heap_is_wellformed_impl
         \<open>local.CD.a_heap_is_wellformed h'\<close> \<open>local.a_all_ptrs_in_heap h'\<close> \<open>local.a_distinct_lists h'\<close>
         \<open>local.a_shadow_root_valid h'\<close>)
 qed
 end
 
 subsubsection \<open>create\_document\<close>
 
 locale l_create_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_child_nodes get_child_nodes_locs get_disconnected_nodes
   get_disconnected_nodes_locs
   get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
   heap_is_wellformed parent_child_rel
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs
   + l_new_document_get_disconnected_nodes
   get_disconnected_nodes get_disconnected_nodes_locs
   + l_create_document\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   create_document
   + l_new_document_get_child_nodes
   type_wf known_ptr get_child_nodes get_child_nodes_locs
   + l_get_tag_name type_wf get_tag_name get_tag_name_locs
   + l_new_document_get_tag_name get_tag_name get_tag_name_locs
   + l_get_disconnected_nodes\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M type_wf type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_disconnected_nodes
   get_disconnected_nodes_locs
   + l_new_document
   type_wf
   + l_known_ptrs
   known_ptr known_ptrs
   for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
     and type_wf :: "(_) heap \<Rightarrow> bool"
     and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
     and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
     and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
     and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
     and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
     and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and get_disconnected_document :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
     and get_disconnected_document_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
     and heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
     and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
     and set_val :: "(_) character_data_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_val_locs :: "(_) character_data_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and set_disconnected_nodes ::
     "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
     and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
     and create_document :: "((_) heap, exception, (_) document_ptr) prog"
     and known_ptrs :: "(_) heap \<Rightarrow> bool"
 begin
 
 lemma create_document_preserves_wellformedness:
   assumes "heap_is_wellformed h"
     and "h \<turnstile> create_document \<rightarrow>\<^sub>h h'"
     and "type_wf h"
     and "known_ptrs h"
   shows "heap_is_wellformed h'"
 proof -
   obtain new_document_ptr where
     new_document_ptr: "h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr" and
     h': "h \<turnstile> new_document \<rightarrow>\<^sub>h h'"
     using assms(2)
     apply(simp add: create_document_def)
     using new_document_ok by blast
 
   have "new_document_ptr \<notin> set |h \<turnstile> document_ptr_kinds_M|\<^sub>r"
     using new_document_ptr DocumentMonad.ptr_kinds_ptr_kinds_M
     using new_document_ptr_not_in_heap h' by blast
   then have "cast new_document_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
 
   have "new_document_ptr |\<notin>| document_ptr_kinds h"
     using new_document_ptr DocumentMonad.ptr_kinds_ptr_kinds_M
     using new_document_ptr_not_in_heap h' by blast
   then have "cast new_document_ptr |\<notin>| object_ptr_kinds h"
     by simp
 
   have object_ptr_kinds_eq: "object_ptr_kinds h' = object_ptr_kinds h |\<union>| {|cast new_document_ptr|}"
     using new_document_new_ptr h' new_document_ptr by blast
   then have node_ptr_kinds_eq: "node_ptr_kinds h' = node_ptr_kinds h"
     apply(simp add: node_ptr_kinds_def)
     by force
   then have character_data_ptr_kinds_eq_h: "character_data_ptr_kinds h' = character_data_ptr_kinds h"
     by(simp add: character_data_ptr_kinds_def)
   have element_ptr_kinds_eq_h: "element_ptr_kinds h' = element_ptr_kinds h"
     using object_ptr_kinds_eq
     by(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)
   have document_ptr_kinds_eq_h: "document_ptr_kinds h' = document_ptr_kinds h |\<union>| {|new_document_ptr|}"
     using object_ptr_kinds_eq
     apply(auto simp add: document_ptr_kinds_def)[1]
     by (metis (no_types, lifting) document_ptr_kinds_commutes document_ptr_kinds_def finsertI1
         fset.map_comp)
   have shadow_root_ptr_kinds_eq: "shadow_root_ptr_kinds h' = shadow_root_ptr_kinds h"
     using object_ptr_kinds_eq
     apply(simp add: shadow_root_ptr_kinds_def)
     by force
 
 
   have children_eq:
     "\<And>(ptr'::(_) object_ptr) children. ptr' \<noteq> cast new_document_ptr
              \<Longrightarrow> h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads h' get_child_nodes_new_document[rotated, OF new_document_ptr h']
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have children_eq2: "\<And>ptr'. ptr' \<noteq> cast new_document_ptr
                                     \<Longrightarrow> |h \<turnstile> get_child_nodes ptr'|\<^sub>r = |h' \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
 
 
   have "h' \<turnstile> get_child_nodes (cast new_document_ptr) \<rightarrow>\<^sub>r []"
     using new_document_ptr h' new_document_ptr_in_heap[OF h' new_document_ptr]
       new_document_is_document_ptr[OF new_document_ptr] new_document_no_child_nodes
     by blast
   have disconnected_nodes_eq_h:
     "\<And>doc_ptr disc_nodes. doc_ptr \<noteq> new_document_ptr
     \<Longrightarrow> h \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes =
 h' \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using CD.get_disconnected_nodes_reads h' get_disconnected_nodes_new_document_different_pointers
       new_document_ptr
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by (metis(full_types) \<open>\<And>thesis. (\<And>new_document_ptr.
              \<lbrakk>h \<turnstile> new_document \<rightarrow>\<^sub>r new_document_ptr; h \<turnstile> new_document \<rightarrow>\<^sub>h h'\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
         local.get_disconnected_nodes_new_document_different_pointers new_document_ptr)+
   then have disconnected_nodes_eq2_h: "\<And>doc_ptr. doc_ptr \<noteq> new_document_ptr
                  \<Longrightarrow> |h \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
   have "h' \<turnstile> get_disconnected_nodes new_document_ptr \<rightarrow>\<^sub>r []"
     using h' local.new_document_no_disconnected_nodes new_document_ptr by blast
 
   have "type_wf h'"
     using \<open>type_wf h\<close> new_document_types_preserved h' by blast
 
   have "acyclic (parent_child_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (auto simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h'"
   proof(auto simp add: CD.parent_child_rel_def)[1]
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h"
       and 1: "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
     then show "a |\<in>| object_ptr_kinds h'"
       by (simp add: object_ptr_kinds_eq)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h"
       and 1: "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
     then show "x \<in> set |h' \<turnstile> get_child_nodes a|\<^sub>r"
       by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
           \<open>cast new_document_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close> children_eq2)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h'"
       and 1: "x \<in> set |h' \<turnstile> get_child_nodes a|\<^sub>r"
     then show "a |\<in>| object_ptr_kinds h"
       using object_ptr_kinds_eq \<open>h' \<turnstile> get_child_nodes (cast new_document_ptr) \<rightarrow>\<^sub>r []\<close>
       by(auto)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h'"
       and 1: "x \<in> set |h' \<turnstile> get_child_nodes a|\<^sub>r"
     then show "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
       by (metis (no_types, lifting) \<open>h' \<turnstile> get_child_nodes (cast new_document_ptr) \<rightarrow>\<^sub>r []\<close>
           children_eq2 empty_iff empty_set image_eqI select_result_I2)
   qed
   finally have "CD.a_acyclic_heap h'"
     by (simp add: CD.acyclic_heap_def)
 
   have "CD.a_all_ptrs_in_heap h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def )
   then have "CD.a_all_ptrs_in_heap h'"
     apply(auto simp add: CD.a_all_ptrs_in_heap_def)[1]
     using  ObjectMonad.ptr_kinds_ptr_kinds_M
       \<open>cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close>
       \<open>parent_child_rel h = parent_child_rel h'\<close> assms(1) children_eq fset_of_list_elem
       local.heap_is_wellformed_children_in_heap CD.parent_child_rel_child
       CD.parent_child_rel_parent_in_heap node_ptr_kinds_eq
     apply (metis (no_types, lifting)
         \<open>h' \<turnstile> get_child_nodes (cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr) \<rightarrow>\<^sub>r []\<close>
         children_eq2 finite_set_in finsert_iff funion_finsert_right object_ptr_kinds_eq
         select_result_I2 subsetD sup_bot.right_neutral)
     by (metis (no_types, lifting) \<open>h' \<turnstile> get_disconnected_nodes new_document_ptr \<rightarrow>\<^sub>r []\<close> \<open>type_wf h'\<close>
         assms(1) disconnected_nodes_eq_h empty_iff empty_set local.get_disconnected_nodes_ok
         local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq returns_result_select_result
         select_result_I2)
 
   have "CD.a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_distinct_lists h'"
     using \<open>h' \<turnstile> get_disconnected_nodes new_document_ptr \<rightarrow>\<^sub>r []\<close>
       \<open>h' \<turnstile> get_child_nodes (cast new_document_ptr) \<rightarrow>\<^sub>r []\<close>
 
     apply(auto simp add: children_eq2[symmetric] CD.a_distinct_lists_def insort_split
         object_ptr_kinds_eq
         document_ptr_kinds_eq_h  disconnected_nodes_eq2_h intro!: distinct_concat_map_I)[1]
     apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert)
 
     apply(auto simp add:  dest: distinct_concat_map_E)[1]
     apply(auto simp add:  dest: distinct_concat_map_E)[1]
     using \<open>new_document_ptr |\<notin>| document_ptr_kinds h\<close>
     apply(auto simp add: distinct_insort dest: distinct_concat_map_E)[1]
     apply (metis assms(1) assms(3) disconnected_nodes_eq2_h get_disconnected_nodes_ok
         local.heap_is_wellformed_disconnected_nodes_distinct
         returns_result_select_result)
   proof -
     fix x :: "(_) document_ptr" and y :: "(_) document_ptr" and xa :: "(_) node_ptr"
     assume a1: "x \<noteq> y"
     assume a2: "x |\<in>| document_ptr_kinds h"
     assume a3: "x \<noteq> new_document_ptr"
     assume a4: "y |\<in>| document_ptr_kinds h"
     assume a5: "y \<noteq> new_document_ptr"
     assume a6: "distinct (concat (map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                               (sorted_list_of_set (fset (document_ptr_kinds h)))))"
     assume a7: "xa \<in> set |h' \<turnstile> get_disconnected_nodes x|\<^sub>r"
     assume a8: "xa \<in> set |h' \<turnstile> get_disconnected_nodes y|\<^sub>r"
     have f9: "xa \<in> set |h \<turnstile> get_disconnected_nodes x|\<^sub>r"
       using a7 a3 disconnected_nodes_eq2_h by presburger
     have f10: "xa \<in> set |h \<turnstile> get_disconnected_nodes y|\<^sub>r"
       using a8 a5 disconnected_nodes_eq2_h by presburger
     have f11: "y \<in> set (sorted_list_of_set (fset (document_ptr_kinds h)))"
       using a4 by simp
     have "x \<in> set (sorted_list_of_set (fset (document_ptr_kinds h)))"
       using a2 by simp
     then show False
       using f11 f10 f9 a6 a1 by (meson disjoint_iff_not_equal distinct_concat_map_E(1))
   next
     fix x xa xb
     assume 0: "h' \<turnstile> get_disconnected_nodes new_document_ptr \<rightarrow>\<^sub>r []"
       and 1: "h' \<turnstile> get_child_nodes (cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr) \<rightarrow>\<^sub>r []"
       and 2: "distinct (concat (map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r)
                                                   (sorted_list_of_set (fset (object_ptr_kinds h)))))"
       and 3: "distinct (concat (map (\<lambda>document_ptr. |h \<turnstile> get_disconnected_nodes document_ptr|\<^sub>r)
                                               (sorted_list_of_set (fset (document_ptr_kinds h)))))"
       and 4: "(\<Union>x\<in>fset (object_ptr_kinds h). set |h \<turnstile> get_child_nodes x|\<^sub>r)
                       \<inter> (\<Union>x\<in>fset (document_ptr_kinds h). set |h \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
       and 5: "x \<in> set |h \<turnstile> get_child_nodes xa|\<^sub>r"
       and 6: "x \<in> set |h' \<turnstile> get_disconnected_nodes xb|\<^sub>r"
       and 7: "xa |\<in>| object_ptr_kinds h"
       and 8: "xa \<noteq> cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr"
       and 9: "xb |\<in>| document_ptr_kinds h"
       and 10: "xb \<noteq> new_document_ptr"
     then show "False"
 
       by (metis \<open>CD.a_distinct_lists h\<close> assms(3) disconnected_nodes_eq2_h
           CD.distinct_lists_no_parent get_disconnected_nodes_ok
           returns_result_select_result)
   qed
 
   have "CD.a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_owner_document_valid h'"
     apply(auto simp add: CD.a_owner_document_valid_def)[1]
     by (metis \<open>cast\<^sub>d\<^sub>o\<^sub>c\<^sub>u\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_document_ptr |\<notin>| object_ptr_kinds h\<close>
         children_eq2 disconnected_nodes_eq2_h document_ptr_kinds_commutes finite_set_in funion_iff
         node_ptr_kinds_eq object_ptr_kinds_eq)
 
 
   have shadow_root_eq_h: "\<And>character_data_ptr shadow_root_opt.
 h \<turnstile> get_shadow_root character_data_ptr \<rightarrow>\<^sub>r shadow_root_opt =
 h' \<turnstile> get_shadow_root character_data_ptr \<rightarrow>\<^sub>r shadow_root_opt"
     using get_shadow_root_reads assms(2) get_shadow_root_new_document[rotated, OF h']
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     using local.get_shadow_root_locs_impl new_document_ptr apply blast
     using local.get_shadow_root_locs_impl new_document_ptr by blast
 
 
   have "a_all_ptrs_in_heap h"
     by (simp add: assms(1) local.a_all_ptrs_in_heap_def local.get_shadow_root_shadow_root_ptr_in_heap)
   then have "a_all_ptrs_in_heap h'"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq document_ptr_kinds_eq_h)[1]
     using shadow_root_eq_h by fastforce
 
   have "a_distinct_lists h"
     using assms(1)
     by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h'"
     apply(auto simp add: a_distinct_lists_def character_data_ptr_kinds_eq_h)[1]
     apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
     by (metis \<open>type_wf h'\<close> assms(1) assms(3) local.get_shadow_root_ok local.shadow_root_same_host
         returns_result_select_result shadow_root_eq_h)
 
 
   have tag_name_eq_h:
     "\<And>ptr' disc_nodes. h \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h' \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads h'
       get_tag_name_new_document[OF new_document_ptr h']
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
 
   have "a_shadow_root_valid h"
     using assms(1)
     by (simp add: heap_is_wellformed_def)
   then have "a_shadow_root_valid h'"
     using new_document_is_document_ptr[OF new_document_ptr]
     by(auto simp add: a_shadow_root_valid_def element_ptr_kinds_eq_h document_ptr_kinds_eq_h
         shadow_root_ptr_kinds_eq select_result_eq[OF shadow_root_eq_h] select_result_eq[OF tag_name_eq_h])
 
 
   have "a_host_shadow_root_rel h = a_host_shadow_root_rel h'"
     by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h
         select_result_eq[OF shadow_root_eq_h])
 
   have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   moreover
   have "parent_child_rel h \<union> a_host_shadow_root_rel h =
 parent_child_rel h' \<union> a_host_shadow_root_rel h'"
     by (simp add: \<open>local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h'\<close>
         \<open>parent_child_rel h = parent_child_rel h'\<close>)
   ultimately have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h')"
     by simp
 
   have "CD.a_heap_is_wellformed h'"
     apply(simp add: CD.a_heap_is_wellformed_def)
     by (simp add: \<open>local.CD.a_acyclic_heap h'\<close> \<open>local.CD.a_all_ptrs_in_heap h'\<close>
         \<open>local.CD.a_distinct_lists h'\<close> \<open>local.CD.a_owner_document_valid h'\<close>)
 
   show "heap_is_wellformed h'"
     using CD.heap_is_wellformed_impl \<open>acyclic (parent_child_rel h' \<union> local.a_host_shadow_root_rel h')\<close>
       \<open>local.CD.a_heap_is_wellformed h'\<close> \<open>local.a_all_ptrs_in_heap h'\<close> \<open>local.a_distinct_lists h'\<close>
       \<open>local.a_shadow_root_valid h'\<close> local.heap_is_wellformed_def by auto
 qed
 end
 
 interpretation l_create_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr type_wf DocumentClass.type_wf get_child_nodes
   get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs get_shadow_root
   get_shadow_root_locs get_tag_name get_tag_name_locs
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs heap_is_wellformed parent_child_rel set_val set_val_locs
   set_disconnected_nodes set_disconnected_nodes_locs create_document known_ptrs
   by(auto simp add: l_create_document_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 
 
 subsubsection \<open>attach\_shadow\_root\<close>
 
 locale l_attach_shadow_root_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M =
   l_get_disconnected_nodes
   type_wf get_disconnected_nodes get_disconnected_nodes_locs
   + l_heap_is_wellformed\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M
   get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
   get_shadow_root get_shadow_root_locs get_tag_name get_tag_name_locs known_ptr type_wf
   heap_is_wellformed parent_child_rel
   heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs
   + l_attach_shadow_root\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr set_shadow_root set_shadow_root_locs set_mode
   set_mode_locs attach_shadow_root type_wf get_tag_name get_tag_name_locs get_shadow_root
   get_shadow_root_locs
   + l_new_shadow_root_get_disconnected_nodes
   get_disconnected_nodes get_disconnected_nodes_locs
 
 + l_set_mode_get_disconnected_nodes
 type_wf set_mode set_mode_locs get_disconnected_nodes get_disconnected_nodes_locs
 + l_new_shadow_root_get_child_nodes
 type_wf known_ptr get_child_nodes get_child_nodes_locs
 + l_new_shadow_root_get_tag_name
 type_wf get_tag_name get_tag_name_locs
 + l_set_mode_get_child_nodes
 type_wf set_mode set_mode_locs known_ptr get_child_nodes get_child_nodes_locs
 + l_set_shadow_root_get_child_nodes
 type_wf set_shadow_root set_shadow_root_locs known_ptr get_child_nodes get_child_nodes_locs
 + l_set_shadow_root
 type_wf set_shadow_root set_shadow_root_locs
 + l_set_shadow_root_get_disconnected_nodes
 set_shadow_root set_shadow_root_locs get_disconnected_nodes get_disconnected_nodes_locs
 + l_set_mode_get_shadow_root type_wf set_mode set_mode_locs get_shadow_root get_shadow_root_locs
 + l_set_shadow_root_get_shadow_root type_wf set_shadow_root set_shadow_root_locs
 get_shadow_root get_shadow_root_locs
 + l_new_character_data_get_tag_name
 get_tag_name get_tag_name_locs
 + l_set_mode_get_tag_name type_wf set_mode set_mode_locs get_tag_name get_tag_name_locs
 + l_get_tag_name type_wf get_tag_name get_tag_name_locs
 + l_set_shadow_root_get_tag_name set_shadow_root set_shadow_root_locs get_tag_name get_tag_name_locs
 + l_new_shadow_root
 type_wf
 + l_known_ptrs
 known_ptr known_ptrs
 for known_ptr :: "(_::linorder) object_ptr \<Rightarrow> bool"
   and known_ptrs :: "(_) heap \<Rightarrow> bool"
   and type_wf :: "(_) heap \<Rightarrow> bool"
   and get_child_nodes :: "(_) object_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
   and get_child_nodes_locs :: "(_) object_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and get_disconnected_nodes :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, (_) node_ptr list) prog"
   and get_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and heap_is_wellformed :: "(_) heap \<Rightarrow> bool"
   and parent_child_rel :: "(_) heap \<Rightarrow> ((_) object_ptr \<times> (_) object_ptr) set"
   and set_tag_name :: "(_) element_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog"
   and set_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
   and set_disconnected_nodes :: "(_) document_ptr \<Rightarrow> (_) node_ptr list \<Rightarrow> ((_) heap, exception, unit) prog"
   and set_disconnected_nodes_locs :: "(_) document_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
   and create_element :: "(_) document_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
   and get_shadow_root :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, (_) shadow_root_ptr option) prog"
   and get_shadow_root_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and get_tag_name :: "(_) element_ptr \<Rightarrow> ((_) heap, exception, char list) prog"
   and get_tag_name_locs :: "(_) element_ptr \<Rightarrow> ((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
   and get_host :: "(_) shadow_root_ptr \<Rightarrow> ((_) heap, exception, (_) element_ptr) prog"
   and get_host_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and get_disconnected_document :: "(_) node_ptr \<Rightarrow> ((_) heap, exception, (_) document_ptr) prog"
   and get_disconnected_document_locs :: "((_) heap \<Rightarrow> (_) heap \<Rightarrow> bool) set"
   and set_val :: "(_) character_data_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, unit) prog"
   and set_val_locs :: "(_) character_data_ptr \<Rightarrow> ((_) heap, exception, unit) prog set"
   and create_character_data ::
   "(_) document_ptr \<Rightarrow> char list \<Rightarrow> ((_) heap, exception, (_) character_data_ptr) prog"
   and known_ptr\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_::linorder) object_ptr \<Rightarrow> bool"
   and type_wf\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M :: "(_) heap \<Rightarrow> bool"
   and set_shadow_root :: "(_) element_ptr \<Rightarrow> (_) shadow_root_ptr option \<Rightarrow> (_, unit) dom_prog"
   and set_shadow_root_locs :: "(_) element_ptr \<Rightarrow> (_, unit) dom_prog set"
   and set_mode :: "(_) shadow_root_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> (_, unit) dom_prog"
   and set_mode_locs :: "(_) shadow_root_ptr \<Rightarrow> (_, unit) dom_prog set"
   and attach_shadow_root :: "(_) element_ptr \<Rightarrow> shadow_root_mode \<Rightarrow> (_, (_) shadow_root_ptr) dom_prog"
 begin
 lemma attach_shadow_root_child_preserves:
   assumes "heap_is_wellformed h" and "type_wf h" and "known_ptrs h"
   assumes "h \<turnstile> attach_shadow_root element_ptr new_mode \<rightarrow>\<^sub>h h'"
   shows "type_wf h'" and "known_ptrs h'" and "heap_is_wellformed h'"
 proof -
   obtain h2 h3 new_shadow_root_ptr element_tag_name where
     element_tag_name: "h \<turnstile> get_tag_name element_ptr \<rightarrow>\<^sub>r element_tag_name" and
     "element_tag_name \<in> safe_shadow_root_element_types" and
     prev_shadow_root: "h \<turnstile> get_shadow_root element_ptr \<rightarrow>\<^sub>r None" and
     h2: "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h2" and
     new_shadow_root_ptr: "h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr" and
     h3: "h2 \<turnstile> set_mode new_shadow_root_ptr new_mode \<rightarrow>\<^sub>h h3" and
     h': "h3 \<turnstile> set_shadow_root element_ptr (Some new_shadow_root_ptr) \<rightarrow>\<^sub>h h'"
     using assms(4)
     by(auto simp add: attach_shadow_root_def elim!: bind_returns_heap_E
         bind_returns_heap_E2[rotated, OF get_tag_name_pure, rotated]
         bind_returns_heap_E2[rotated, OF get_shadow_root_pure, rotated] split: if_splits)
 
   have "h \<turnstile> attach_shadow_root element_ptr new_mode \<rightarrow>\<^sub>r new_shadow_root_ptr"
     thm  bind_pure_returns_result_I[OF get_tag_name_pure]
     apply(unfold attach_shadow_root_def)[1]
     using element_tag_name
     apply(rule bind_pure_returns_result_I[OF get_tag_name_pure])
     apply(rule bind_pure_returns_result_I)
     using \<open>element_tag_name \<in> safe_shadow_root_element_types\<close> apply(simp)
     using \<open>element_tag_name \<in> safe_shadow_root_element_types\<close> apply(simp)
     using prev_shadow_root
     apply(rule bind_pure_returns_result_I[OF get_shadow_root_pure])
     apply(rule bind_pure_returns_result_I)
     apply(simp)
     apply(simp)
     using h2 new_shadow_root_ptr h3 h'
     by(auto intro!: bind_returns_result_I
         intro: is_OK_returns_result_E[OF is_OK_returns_heap_I[OF h3]]
         is_OK_returns_result_E[OF is_OK_returns_heap_I[OF h']])
 
   have "new_shadow_root_ptr \<notin> set |h \<turnstile> shadow_root_ptr_kinds_M|\<^sub>r"
     using new_shadow_root_ptr ShadowRootMonad.ptr_kinds_ptr_kinds_M h2
     using new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_ptr_not_in_heap by blast
   then have "cast new_shadow_root_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r"
     by simp
 
 
 
   have object_ptr_kinds_eq_h:
     "object_ptr_kinds h2 = object_ptr_kinds h |\<union>| {|cast new_shadow_root_ptr|}"
     using new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_new_ptr h2 new_shadow_root_ptr by blast
   then have document_ptr_kinds_eq_h:
     "document_ptr_kinds h2 = document_ptr_kinds h"
     apply(simp add: document_ptr_kinds_def)
     by force
   have shadow_root_ptr_kinds_eq_h:
     "shadow_root_ptr_kinds h2 = shadow_root_ptr_kinds h |\<union>| {|new_shadow_root_ptr|}"
     using object_ptr_kinds_eq_h
     apply(simp add: shadow_root_ptr_kinds_def)
     by force
   have element_ptr_kinds_eq_h: "element_ptr_kinds h2 = element_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF set_mode_writes h3])
     using set_mode_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
     by (auto simp add: document_ptr_kinds_def)
   have shadow_root_ptr_kinds_eq_h2: "shadow_root_ptr_kinds h3 = shadow_root_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     by (auto simp add: shadow_root_ptr_kinds_def)
   have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     by(auto simp add: node_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF set_shadow_root_writes h'])
     using set_shadow_root_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3"
     by (auto simp add: document_ptr_kinds_def)
   have shadow_root_ptr_kinds_eq_h3: "shadow_root_ptr_kinds h' = shadow_root_ptr_kinds h3"
     using object_ptr_kinds_eq_h3
     by (auto simp add: shadow_root_ptr_kinds_def)
   have node_ptr_kinds_eq_h3: "node_ptr_kinds h' = node_ptr_kinds h3"
     using object_ptr_kinds_eq_h3
     by(auto simp add: node_ptr_kinds_def)
 
   have "known_ptr (cast new_shadow_root_ptr)"
     using \<open>h \<turnstile> attach_shadow_root element_ptr new_mode \<rightarrow>\<^sub>r new_shadow_root_ptr\<close>
       create_shadow_root_known_ptr by blast
   then
   have "known_ptrs h2"
     using known_ptrs_new_ptr object_ptr_kinds_eq_h \<open>known_ptrs h\<close> h2
     by blast
   then
   have "known_ptrs h3"
     using known_ptrs_preserved object_ptr_kinds_eq_h2 by blast
   then
   show "known_ptrs h'"
     using known_ptrs_preserved object_ptr_kinds_eq_h3 by blast
 
   have "element_ptr |\<in>| element_ptr_kinds h"
     by (meson \<open>h \<turnstile> attach_shadow_root element_ptr new_mode \<rightarrow>\<^sub>r new_shadow_root_ptr\<close>
         is_OK_returns_result_I local.attach_shadow_root_element_ptr_in_heap)
 
 
   have children_eq_h: "\<And>(ptr'::(_) object_ptr) children. ptr' \<noteq> cast new_shadow_root_ptr
                   \<Longrightarrow> h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads h2 get_child_nodes_new_shadow_root[rotated, OF new_shadow_root_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have children_eq2_h:
     "\<And>ptr'. ptr' \<noteq> cast new_shadow_root_ptr
       \<Longrightarrow> |h \<turnstile> get_child_nodes ptr'|\<^sub>r = |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   have object_ptr_kinds_eq_h:
     "object_ptr_kinds h2 = object_ptr_kinds h |\<union>| {|cast new_shadow_root_ptr|}"
     using new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_new_ptr h2 new_shadow_root_ptr object_ptr_kinds_eq_h by blast
   then have node_ptr_kinds_eq_h:
     "node_ptr_kinds h2 = node_ptr_kinds h"
     apply(simp add: node_ptr_kinds_def)
     by force
   then have character_data_ptr_kinds_eq_h:
     "character_data_ptr_kinds h2 = character_data_ptr_kinds h"
     apply(simp add: character_data_ptr_kinds_def)
     done
   have element_ptr_kinds_eq_h: "element_ptr_kinds h2 = element_ptr_kinds h"
     using object_ptr_kinds_eq_h
     by(auto simp add: node_ptr_kinds_def element_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h2: "object_ptr_kinds h3 = object_ptr_kinds h2"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF set_mode_writes h3])
     using set_mode_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h2: "document_ptr_kinds h3 = document_ptr_kinds h2"
     by (auto simp add: document_ptr_kinds_def)
   have node_ptr_kinds_eq_h2: "node_ptr_kinds h3 = node_ptr_kinds h2"
     using object_ptr_kinds_eq_h2
     by(auto simp add: node_ptr_kinds_def)
   then have character_data_ptr_kinds_eq_h2: "character_data_ptr_kinds h3 = character_data_ptr_kinds h2"
     by(simp add: character_data_ptr_kinds_def)
   have element_ptr_kinds_eq_h2: "element_ptr_kinds h3 = element_ptr_kinds h2"
     using node_ptr_kinds_eq_h2
     by(simp add: element_ptr_kinds_def)
 
   have object_ptr_kinds_eq_h3: "object_ptr_kinds h' = object_ptr_kinds h3"
     apply(rule writes_small_big[where P="\<lambda>h h'. object_ptr_kinds h' = object_ptr_kinds h",
           OF set_shadow_root_writes h'])
     using set_shadow_root_pointers_preserved
     by (auto simp add: reflp_def transp_def)
   then have document_ptr_kinds_eq_h3: "document_ptr_kinds h' = document_ptr_kinds h3"
     by (auto simp add: document_ptr_kinds_def)
   have node_ptr_kinds_eq_h3: "node_ptr_kinds h' = node_ptr_kinds h3"
     using object_ptr_kinds_eq_h3
     by(auto simp add: node_ptr_kinds_def)
   then have character_data_ptr_kinds_eq_h3: "character_data_ptr_kinds h' = character_data_ptr_kinds h3"
     by(simp add: character_data_ptr_kinds_def)
   have element_ptr_kinds_eq_h3: "element_ptr_kinds h' = element_ptr_kinds h3"
     using node_ptr_kinds_eq_h3
     by(simp add: element_ptr_kinds_def)
 
 
   have children_eq_h: "\<And>(ptr'::(_) object_ptr) children. ptr' \<noteq> cast new_shadow_root_ptr
                 \<Longrightarrow> h \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads h2 get_child_nodes_new_shadow_root[rotated, OF new_shadow_root_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have children_eq2_h: "\<And>ptr'. ptr' \<noteq> cast new_shadow_root_ptr
                                  \<Longrightarrow> |h \<turnstile> get_child_nodes ptr'|\<^sub>r = |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
 
   have "h2 \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []"
     using h2 local.new_shadow_root_no_child_nodes new_shadow_root_ptr by auto
 
   have disconnected_nodes_eq_h:
     "\<And>doc_ptr disc_nodes. h \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes
                                              = h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using get_disconnected_nodes_reads h2
       get_disconnected_nodes_new_shadow_root[rotated, OF h2,rotated,OF new_shadow_root_ptr]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by (metis (no_types, lifting))+
   then have disconnected_nodes_eq2_h:
     "\<And>doc_ptr. |h \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
 
   have tag_name_eq_h:
     "\<And>ptr' disc_nodes. h \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h2 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads h2
       get_tag_name_new_shadow_root[OF new_shadow_root_ptr h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     by blast+
   then have tag_name_eq2_h: "\<And>ptr'. |h \<turnstile> get_tag_name ptr'|\<^sub>r = |h2 \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
 
   have children_eq_h2:
     "\<And>ptr' children. h2 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads set_mode_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_mode_get_child_nodes)
   then have children_eq2_h2:
     "\<And>ptr'. |h2 \<turnstile> get_child_nodes ptr'|\<^sub>r = |h3 \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   have disconnected_nodes_eq_h2:
     "\<And>doc_ptr disc_nodes. h2 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes
                                               = h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using get_disconnected_nodes_reads set_mode_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_mode_get_disconnected_nodes)
   then have disconnected_nodes_eq2_h2:
     "\<And>doc_ptr. |h2 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
   have tag_name_eq_h2:
     "\<And>ptr' disc_nodes. h2 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads set_mode_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_mode_get_tag_name)
   then have tag_name_eq2_h2: "\<And>ptr'. |h2 \<turnstile> get_tag_name ptr'|\<^sub>r = |h3 \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
 
   have "type_wf h2"
     using \<open>type_wf h\<close> new_shadow_root_types_preserved h2 by blast
   then have "type_wf h3"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF set_mode_writes h3]
     using  set_mode_types_preserved
     by(auto simp add: reflp_def transp_def)
   then show "type_wf h'"
     using writes_small_big[where P="\<lambda>h h'. type_wf h \<longrightarrow> type_wf h'", OF set_shadow_root_writes h']
     using  set_shadow_root_types_preserved
     by(auto simp add: reflp_def transp_def)
 
   have children_eq_h3:
     "\<And>ptr' children. h3 \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children = h' \<turnstile> get_child_nodes ptr' \<rightarrow>\<^sub>r children"
     using CD.get_child_nodes_reads set_shadow_root_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: set_shadow_root_get_child_nodes)
   then have children_eq2_h3:
     " \<And>ptr'. |h3 \<turnstile> get_child_nodes ptr'|\<^sub>r = |h' \<turnstile> get_child_nodes ptr'|\<^sub>r"
     using select_result_eq by force
   have disconnected_nodes_eq_h3: "\<And>doc_ptr disc_nodes. h3 \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes
                             = h' \<turnstile> get_disconnected_nodes doc_ptr \<rightarrow>\<^sub>r disc_nodes"
     using get_disconnected_nodes_reads set_shadow_root_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: set_shadow_root_get_disconnected_nodes)
   then have disconnected_nodes_eq2_h3:
     "\<And>doc_ptr. |h3 \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r = |h' \<turnstile> get_disconnected_nodes doc_ptr|\<^sub>r"
     using select_result_eq by force
   have tag_name_eq_h3:
     "\<And>ptr' disc_nodes. h3 \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes
                                              = h' \<turnstile> get_tag_name ptr' \<rightarrow>\<^sub>r disc_nodes"
     using get_tag_name_reads set_shadow_root_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: set_shadow_root_get_tag_name)
   then have tag_name_eq2_h3: "\<And>ptr'. |h3 \<turnstile> get_tag_name ptr'|\<^sub>r = |h' \<turnstile> get_tag_name ptr'|\<^sub>r"
     using select_result_eq by force
 
   have "acyclic (parent_child_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def CD.acyclic_heap_def)
   also have "parent_child_rel h = parent_child_rel h2"
   proof(auto simp add: CD.parent_child_rel_def)[1]
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h"
       and 1: "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
     then show "a |\<in>| object_ptr_kinds h2"
       by (simp add: object_ptr_kinds_eq_h)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h"
       and 1: "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
     then show "x \<in> set |h2 \<turnstile> get_child_nodes a|\<^sub>r"
       by (metis ObjectMonad.ptr_kinds_ptr_kinds_M
           \<open>cast new_shadow_root_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close> children_eq2_h)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h2"
       and 1: "x \<in> set |h2 \<turnstile> get_child_nodes a|\<^sub>r"
     then show "a |\<in>| object_ptr_kinds h"
       using object_ptr_kinds_eq_h \<open>h2 \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close>
       by(auto)
   next
     fix a x
     assume 0: "a |\<in>| object_ptr_kinds h2"
       and 1: "x \<in> set |h2 \<turnstile> get_child_nodes a|\<^sub>r"
     then show "x \<in> set |h \<turnstile> get_child_nodes a|\<^sub>r"
       by (metis (no_types, lifting) \<open>h2 \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close>
           children_eq2_h empty_iff empty_set image_eqI select_result_I2)
   qed
   also have "\<dots> = parent_child_rel h3"
     by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h2 children_eq2_h2)
   also have "\<dots> = parent_child_rel h'"
     by(auto simp add: CD.parent_child_rel_def object_ptr_kinds_eq_h3 children_eq2_h3)
   finally have "CD.a_acyclic_heap h'"
     by (simp add: CD.acyclic_heap_def)
 
   have "CD.a_all_ptrs_in_heap h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_all_ptrs_in_heap h2"
     apply(auto simp add: CD.a_all_ptrs_in_heap_def)[1]
     using node_ptr_kinds_eq_h
       \<open>h2 \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close>
     apply (metis (no_types, lifting) CD.get_child_nodes_ok CD.l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms
         \<open>known_ptrs h2\<close> \<open>parent_child_rel h = parent_child_rel h2\<close> \<open>type_wf h2\<close> assms(1) assms(2)
         l_heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M.parent_child_rel_child local.known_ptrs_known_ptr
         local.parent_child_rel_child_in_heap node_ptr_kinds_commutes returns_result_select_result)
     by (metis assms(1) assms(2) disconnected_nodes_eq2_h document_ptr_kinds_eq_h
         local.get_disconnected_nodes_ok local.heap_is_wellformed_disc_nodes_in_heap node_ptr_kinds_eq_h
         returns_result_select_result)
   then have "CD.a_all_ptrs_in_heap h3"
     by (simp add: children_eq2_h2 disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h2 object_ptr_kinds_eq_h2)
   then have "CD.a_all_ptrs_in_heap h'"
     by (simp add: children_eq2_h3 disconnected_nodes_eq2_h3 document_ptr_kinds_eq_h3
         CD.a_all_ptrs_in_heap_def node_ptr_kinds_eq_h3 object_ptr_kinds_eq_h3)
 
   have "CD.a_distinct_lists h"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_distinct_lists h2"
     using \<open>h2 \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close> children_eq2_h
     apply(auto simp add: select_result_eq[OF disconnected_nodes_eq_h] CD.a_distinct_lists_def
         insort_split object_ptr_kinds_eq_h
         document_ptr_kinds_eq_h  disconnected_nodes_eq2_h intro!: distinct_concat_map_I
         dest: distinct_concat_map_E)[1]
     apply (metis distinct_sorted_list_of_set finite_fset sorted_list_of_set_insert)
     apply(auto simp add:  dest: distinct_concat_map_E)[1]
     apply(case_tac "x = cast new_shadow_root_ptr")
     using \<open>h2 \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close> children_eq2_h apply blast
     apply(case_tac "y = cast new_shadow_root_ptr")
     using \<open>h2 \<turnstile> get_child_nodes (cast new_shadow_root_ptr) \<rightarrow>\<^sub>r []\<close> children_eq2_h apply blast
   proof -
     fix x y :: "(_) object_ptr"
     fix xa :: "(_) node_ptr"
     assume a1: "distinct (concat (map (\<lambda>ptr. |h \<turnstile> get_child_nodes ptr|\<^sub>r)
 (sorted_list_of_set (fset (object_ptr_kinds h)))))"
     assume "x \<noteq> y"
     assume "xa \<in> set |h2 \<turnstile> get_child_nodes x|\<^sub>r"
     assume "xa \<in> set |h2 \<turnstile> get_child_nodes y|\<^sub>r"
     assume "x |\<in>| object_ptr_kinds h"
     assume "x \<noteq> cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr"
     assume "y |\<in>| object_ptr_kinds h"
     assume "y \<noteq> cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr"
     show False
       using distinct_concat_map_E(1)[OF a1, of x y]
       using \<open>x |\<in>| object_ptr_kinds h\<close> \<open>y |\<in>| object_ptr_kinds h\<close>
       using \<open>xa \<in> set |h2 \<turnstile> get_child_nodes x|\<^sub>r\<close> \<open>xa \<in> set |h2 \<turnstile> get_child_nodes y|\<^sub>r\<close>
       using \<open>x \<noteq> y\<close>
       by(auto simp add: children_eq2_h[OF \<open>x \<noteq> cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr\<close>]
           children_eq2_h[OF \<open>y \<noteq> cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr\<close>])
   next
     fix x :: "(_) node_ptr"
     fix xa :: "(_) object_ptr"
     fix xb :: "(_) document_ptr"
     assume "(\<Union>x\<in>fset (object_ptr_kinds h). set |h \<turnstile> get_child_nodes x|\<^sub>r) \<inter>
 (\<Union>x\<in>fset (document_ptr_kinds h). set |h2 \<turnstile> get_disconnected_nodes x|\<^sub>r) = {}"
     assume "x \<in> set |h2 \<turnstile> get_child_nodes xa|\<^sub>r"
     assume "xb |\<in>| document_ptr_kinds h"
     assume "x \<in> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r"
     assume "xa |\<in>| object_ptr_kinds h"
     assume "xa \<noteq> cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr"
     have "set |h \<turnstile> get_child_nodes xa|\<^sub>r \<inter> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r = {}"
       by (metis (no_types, lifting) CD.get_child_nodes_ok \<open>xa |\<in>| object_ptr_kinds h\<close>
           \<open>xb |\<in>| document_ptr_kinds h\<close> assms(1) assms(2) assms(3) disconnected_nodes_eq2_h
           is_OK_returns_result_E local.get_disconnected_nodes_ok
           local.heap_is_wellformed_children_disc_nodes_different local.known_ptrs_known_ptr select_result_I2)
     then
     show "False"
       using \<open>x \<in> set |h2 \<turnstile> get_child_nodes xa|\<^sub>r\<close> \<open>x \<in> set |h2 \<turnstile> get_disconnected_nodes xb|\<^sub>r\<close>
         \<open>xa \<noteq> cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr\<close> children_eq2_h by auto
   qed
 
   then have "CD.a_distinct_lists h3"
     by(auto simp add: CD.a_distinct_lists_def disconnected_nodes_eq2_h2 document_ptr_kinds_eq_h2
         children_eq2_h2 object_ptr_kinds_eq_h2)[1]
   then have "CD.a_distinct_lists h'"
     by(auto simp add: CD.a_distinct_lists_def disconnected_nodes_eq2_h3 children_eq2_h3
         object_ptr_kinds_eq_h3 document_ptr_kinds_eq_h3 intro!: distinct_concat_map_I)
 
   have "CD.a_owner_document_valid h"
     using \<open>heap_is_wellformed h\<close>  by (simp add: heap_is_wellformed_def CD.heap_is_wellformed_def)
   then have "CD.a_owner_document_valid h'"
     (* using disc_nodes_h3 \<open>document_ptr |\<in>| document_ptr_kinds h\<close> *)
     apply(simp add: CD.a_owner_document_valid_def)
     apply(simp add: object_ptr_kinds_eq_h object_ptr_kinds_eq_h3 )
     apply(simp add: object_ptr_kinds_eq_h2)
     apply(simp add: document_ptr_kinds_eq_h document_ptr_kinds_eq_h3 )
     apply(simp add: document_ptr_kinds_eq_h2)
     apply(simp add: node_ptr_kinds_eq_h node_ptr_kinds_eq_h3 )
     apply(simp add: node_ptr_kinds_eq_h2 node_ptr_kinds_eq_h )
     apply(auto simp add: children_eq2_h2[symmetric] children_eq2_h3[symmetric]
         disconnected_nodes_eq2_h
         disconnected_nodes_eq2_h2 disconnected_nodes_eq2_h3)[1]
     by (metis CD.get_child_nodes_ok CD.get_child_nodes_ptr_in_heap
         \<open>cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr \<notin> set |h \<turnstile> object_ptr_kinds_M|\<^sub>r\<close> assms(2) assms(3)
         children_eq2_h children_eq_h document_ptr_kinds_eq_h finite_set_in is_OK_returns_result_I
         l_ptr_kinds_M.ptr_kinds_ptr_kinds_M local.known_ptrs_known_ptr object_ptr_kinds_M_def
         returns_result_select_result)
 
   have shadow_root_eq_h:
     "\<And>character_data_ptr shadow_root_opt. h \<turnstile> get_shadow_root character_data_ptr \<rightarrow>\<^sub>r shadow_root_opt =
 h2 \<turnstile> get_shadow_root character_data_ptr \<rightarrow>\<^sub>r shadow_root_opt"
     using get_shadow_root_reads h2 get_shadow_root_new_shadow_root[rotated, OF h2]
     apply(auto simp add: reads_def reflp_def transp_def preserved_def)[1]
     using local.get_shadow_root_locs_impl new_shadow_root_ptr apply blast
     using local.get_shadow_root_locs_impl new_shadow_root_ptr by blast
 
 
   have shadow_root_eq_h2:
     "\<And>ptr' children. h2 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children = h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children"
     using get_shadow_root_reads set_mode_writes h3
     apply(rule reads_writes_preserved)
     by(auto simp add: set_mode_get_shadow_root)
   have shadow_root_eq_h3:
     "\<And>ptr' children. element_ptr \<noteq> ptr' \<Longrightarrow> h3 \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children =
 h' \<turnstile> get_shadow_root ptr' \<rightarrow>\<^sub>r children"
     using get_shadow_root_reads set_shadow_root_writes h'
     apply(rule reads_writes_preserved)
     by(auto simp add: set_shadow_root_get_shadow_root_different_pointers)
   have shadow_root_h3: "h' \<turnstile> get_shadow_root element_ptr \<rightarrow>\<^sub>r Some new_shadow_root_ptr"
     using \<open>type_wf h3\<close> h' local.set_shadow_root_get_shadow_root by blast
 
 
   have "a_all_ptrs_in_heap h"
     by (simp add: assms(1) local.a_all_ptrs_in_heap_def local.get_shadow_root_shadow_root_ptr_in_heap)
   then have "a_all_ptrs_in_heap h2"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h)[1]
     using returns_result_eq shadow_root_eq_h by fastforce
   then have "a_all_ptrs_in_heap h3"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h2)[1]
     using shadow_root_eq_h2 by blast
   then have "a_all_ptrs_in_heap h'"
     apply(auto simp add: a_all_ptrs_in_heap_def shadow_root_ptr_kinds_eq_h3)[1]
     apply(case_tac "shadow_root_ptr = new_shadow_root_ptr")
     using h2 new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_ptr_in_heap new_shadow_root_ptr shadow_root_ptr_kinds_eq_h2 apply blast
     using \<open>type_wf h3\<close> h' local.set_shadow_root_get_shadow_root returns_result_eq shadow_root_eq_h3
     apply fastforce
     done
 
   have "a_distinct_lists h"
     using assms(1)
     by (simp add: heap_is_wellformed_def)
   then have "a_distinct_lists h2"
     apply(auto simp add: a_distinct_lists_def character_data_ptr_kinds_eq_h)[1]
     apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
     by (metis \<open>type_wf h2\<close> assms(1) assms(2) local.get_shadow_root_ok local.shadow_root_same_host
         returns_result_select_result shadow_root_eq_h)
   then have "a_distinct_lists h3"
     by(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h2
         select_result_eq[OF shadow_root_eq_h2])
   then have "a_distinct_lists h'"
     apply(auto simp add: a_distinct_lists_def element_ptr_kinds_eq_h3
         select_result_eq[OF shadow_root_eq_h3])[1]
     apply(auto simp add: distinct_insort intro!: distinct_concat_map_I split: option.splits)[1]
     by (smt \<open>type_wf h3\<close> assms(1) assms(2) h' h2 local.get_shadow_root_ok
         local.get_shadow_root_shadow_root_ptr_in_heap local.set_shadow_root_get_shadow_root
         local.shadow_root_same_host new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_ptr_not_in_heap new_shadow_root_ptr
         returns_result_select_result select_result_I2 shadow_root_eq_h shadow_root_eq_h2 shadow_root_eq_h3)
 
 
   have "a_shadow_root_valid h"
     using assms(1)
     by (simp add: heap_is_wellformed_def)
   then
   have "a_shadow_root_valid h'"
   proof(unfold a_shadow_root_valid_def; safe)
     fix shadow_root_ptr
     assume "\<forall>shadow_root_ptr\<in>fset (shadow_root_ptr_kinds h). \<exists>host\<in>fset (element_ptr_kinds h).
 |h \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types \<and>
 |h \<turnstile> get_shadow_root host|\<^sub>r = Some shadow_root_ptr"
     assume "a_shadow_root_valid h"
     assume "shadow_root_ptr \<in> fset (shadow_root_ptr_kinds h')"
     show "\<exists>host\<in>fset (element_ptr_kinds h').
 |h' \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types \<and> |h' \<turnstile> get_shadow_root host|\<^sub>r =
 Some shadow_root_ptr"
     proof (cases "shadow_root_ptr = new_shadow_root_ptr")
       case True
       have "element_ptr \<in> fset (element_ptr_kinds h')"
         by (simp add: \<open>element_ptr |\<in>| element_ptr_kinds h\<close> element_ptr_kinds_eq_h
             element_ptr_kinds_eq_h2 element_ptr_kinds_eq_h3)
       moreover have "|h' \<turnstile> get_tag_name element_ptr|\<^sub>r \<in> safe_shadow_root_element_types"
         by (smt \<open>\<And>thesis. (\<And>h2 h3 new_shadow_root_ptr element_tag_name.
 \<lbrakk>h \<turnstile> get_tag_name element_ptr \<rightarrow>\<^sub>r element_tag_name;
 element_tag_name \<in> safe_shadow_root_element_types;
 h \<turnstile> get_shadow_root element_ptr \<rightarrow>\<^sub>r None; h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>h h2;
 h \<turnstile> new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M \<rightarrow>\<^sub>r new_shadow_root_ptr; h2 \<turnstile> set_mode new_shadow_root_ptr new_mode \<rightarrow>\<^sub>h h3;
 h3 \<turnstile> set_shadow_root element_ptr (Some new_shadow_root_ptr) \<rightarrow>\<^sub>h h'\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
             select_result_I2 tag_name_eq2_h tag_name_eq2_h2 tag_name_eq2_h3)
       moreover have "|h' \<turnstile> get_shadow_root element_ptr|\<^sub>r = Some shadow_root_ptr"
         using shadow_root_h3
         by (simp add: True)
       ultimately
       show ?thesis
         by meson
     next
       case False
       then obtain host where host: "host \<in> fset (element_ptr_kinds h)" and
         "|h \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types" and
         "|h \<turnstile> get_shadow_root host|\<^sub>r = Some shadow_root_ptr"
         using \<open>shadow_root_ptr \<in> fset (shadow_root_ptr_kinds h')\<close>
         using \<open>\<forall>shadow_root_ptr\<in>fset (shadow_root_ptr_kinds h). \<exists>host\<in>fset (element_ptr_kinds h).
 |h \<turnstile> get_tag_name host|\<^sub>r \<in> safe_shadow_root_element_types \<and>
 |h \<turnstile> get_shadow_root host|\<^sub>r = Some shadow_root_ptr\<close>
         apply(simp add: shadow_root_ptr_kinds_eq_h3 shadow_root_ptr_kinds_eq_h2
             shadow_root_ptr_kinds_eq_h)
         by (meson finite_set_in)
       moreover have "host \<noteq> element_ptr"
         using calculation(3) prev_shadow_root by auto
       ultimately show ?thesis
         using element_ptr_kinds_eq_h3 element_ptr_kinds_eq_h2 element_ptr_kinds_eq_h
         by (smt \<open>type_wf h'\<close> assms(2) finite_set_in local.get_shadow_root_ok returns_result_eq
             returns_result_select_result shadow_root_eq_h shadow_root_eq_h2 shadow_root_eq_h3 tag_name_eq2_h
             tag_name_eq2_h2 tag_name_eq2_h3)
     qed
   qed
 
 
   have "a_host_shadow_root_rel h = a_host_shadow_root_rel h2"
     by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h
         select_result_eq[OF shadow_root_eq_h])
   have "a_host_shadow_root_rel h2 = a_host_shadow_root_rel h3"
     by(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h2
         select_result_eq[OF shadow_root_eq_h2])
   have "a_host_shadow_root_rel h' = {(cast element_ptr, cast new_shadow_root_ptr)} \<union>
 a_host_shadow_root_rel h3"
     apply(auto simp add: a_host_shadow_root_rel_def element_ptr_kinds_eq_h3 )[1]
     apply(case_tac "element_ptr \<noteq> aa")
     using select_result_eq[OF shadow_root_eq_h3] apply (simp add: image_iff)
     using select_result_eq[OF shadow_root_eq_h3]
     apply (metis (no_types, lifting)
         \<open>local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2\<close>
         \<open>local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3\<close> \<open>type_wf h3\<close>
         host_shadow_root_rel_def local.get_shadow_root_impl local.get_shadow_root_ok
         option.distinct(1) prev_shadow_root returns_result_select_result)
     apply (metis (mono_tags, lifting) \<open>\<And>ptr'. (\<And>x. element_ptr \<noteq> ptr') \<Longrightarrow>
 |h3 \<turnstile> get_shadow_root ptr'|\<^sub>r = |h' \<turnstile> get_shadow_root ptr'|\<^sub>r\<close> case_prod_conv image_iff
         is_OK_returns_result_I mem_Collect_eq option.inject returns_result_eq
         returns_result_select_result shadow_root_h3)
     using element_ptr_kinds_eq_h3 local.get_shadow_root_ptr_in_heap shadow_root_h3 apply fastforce
     using Shadow_DOM.a_host_shadow_root_rel_def \<open>\<And>ptr'. (\<And>x. element_ptr \<noteq> ptr') \<Longrightarrow>
 |h3 \<turnstile> get_shadow_root ptr'|\<^sub>r = |h' \<turnstile> get_shadow_root ptr'|\<^sub>r\<close> \<open>type_wf h3\<close> case_prodE case_prodI
         host_shadow_root_rel_shadow_root image_iff local.get_shadow_root_impl local.get_shadow_root_ok
         mem_Collect_eq option.discI prev_shadow_root returns_result_select_result select_result_I2
         shadow_root_eq_h shadow_root_eq_h2
     apply(auto)[1]
     by (smt case_prodI mem_Collect_eq option.distinct(1) pair_imageI returns_result_eq returns_result_select_result)
   have "acyclic (parent_child_rel h \<union> a_host_shadow_root_rel h)"
     using \<open>heap_is_wellformed h\<close>
     by (simp add: heap_is_wellformed_def)
   have "parent_child_rel h \<union> a_host_shadow_root_rel h =
 parent_child_rel h2 \<union> a_host_shadow_root_rel h2"
     using \<open>local.a_host_shadow_root_rel h = local.a_host_shadow_root_rel h2\<close>
       \<open>parent_child_rel h = parent_child_rel h2\<close> by auto
   have "parent_child_rel h2 \<union> a_host_shadow_root_rel h2 =
 parent_child_rel h3 \<union> a_host_shadow_root_rel h3"
     using \<open>local.a_host_shadow_root_rel h2 = local.a_host_shadow_root_rel h3\<close>
       \<open>parent_child_rel h2 = parent_child_rel h3\<close> by auto
   have "parent_child_rel h' \<union> a_host_shadow_root_rel h' =
 {(cast element_ptr, cast new_shadow_root_ptr)} \<union> parent_child_rel h3 \<union> a_host_shadow_root_rel h3"
     by (simp add: \<open>local.a_host_shadow_root_rel h' =
 {(cast\<^sub>e\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r element_ptr, cast\<^sub>s\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>r\<^sub>o\<^sub>o\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r\<^sub>2\<^sub>o\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t\<^sub>_\<^sub>p\<^sub>t\<^sub>r new_shadow_root_ptr)} \<union>
 local.a_host_shadow_root_rel h3\<close> \<open>parent_child_rel h3 = parent_child_rel h'\<close>)
 
   have "\<And>a b. (a, b) \<in> parent_child_rel h3 \<Longrightarrow> a \<noteq> cast new_shadow_root_ptr"
     using CD.parent_child_rel_parent_in_heap \<open>parent_child_rel h = parent_child_rel h2\<close>
       \<open>parent_child_rel h2 = parent_child_rel h3\<close> document_ptr_kinds_commutes
     by (metis h2 new\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>R\<^sub>o\<^sub>o\<^sub>t_M_ptr_not_in_heap new_shadow_root_ptr shadow_root_ptr_kinds_commutes)
   moreover
   have "\<And>a b. (a, b) \<in> a_host_shadow_root_rel h3 \<Longrightarrow> a \<noteq> cast new_shadow_root_ptr"
     using shadow_root_eq_h2
     by(auto simp add: a_host_shadow_root_rel_def)
   moreover
   have "cast new_shadow_root_ptr \<notin> {x. (x, cast element_ptr) \<in> (parent_child_rel h3 \<union>
 a_host_shadow_root_rel h3)\<^sup>*}"
     by (metis (no_types, lifting) UnE calculation(1) calculation(2)
         cast_shadow_root_ptr_not_node_ptr(1) converse_rtranclE mem_Collect_eq)
   moreover
   have "acyclic (parent_child_rel h3 \<union> a_host_shadow_root_rel h3)"
     using \<open>acyclic (parent_child_rel h \<union> local.a_host_shadow_root_rel h)\<close>
       \<open>parent_child_rel h \<union> local.a_host_shadow_root_rel h =
 parent_child_rel h2 \<union> local.a_host_shadow_root_rel h2\<close> \<open>parent_child_rel h2 \<union>
 local.a_host_shadow_root_rel h2 = parent_child_rel h3 \<union> local.a_host_shadow_root_rel h3\<close>
     by auto
   ultimately have "acyclic (parent_child_rel h' \<union> a_host_shadow_root_rel h')"
     by(simp add: \<open>parent_child_rel h' \<union> a_host_shadow_root_rel h' =
 {(cast element_ptr, cast new_shadow_root_ptr)} \<union> parent_child_rel h3 \<union>
 a_host_shadow_root_rel h3\<close>)
 
   have "CD.a_heap_is_wellformed h'"
     apply(simp add: CD.a_heap_is_wellformed_def)
     by (simp add: \<open>local.CD.a_acyclic_heap h'\<close> \<open>local.CD.a_all_ptrs_in_heap h'\<close>
         \<open>local.CD.a_distinct_lists h'\<close> \<open>local.CD.a_owner_document_valid h'\<close>)
 
   show "heap_is_wellformed h' "
     using \<open>acyclic (parent_child_rel h' \<union> local.a_host_shadow_root_rel h')\<close>
     by(simp add: heap_is_wellformed_def CD.heap_is_wellformed_impl \<open>local.CD.a_heap_is_wellformed h'\<close>
         \<open>local.a_all_ptrs_in_heap h'\<close> \<open>local.a_distinct_lists h'\<close> \<open>local.a_shadow_root_valid h'\<close>)
 qed
 end
 
 interpretation l_attach_shadow_root_wf?: l_attach_shadow_root_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M known_ptr known_ptrs type_wf
   get_child_nodes get_child_nodes_locs get_disconnected_nodes get_disconnected_nodes_locs
   heap_is_wellformed parent_child_rel set_tag_name set_tag_name_locs set_disconnected_nodes
   set_disconnected_nodes_locs create_element get_shadow_root get_shadow_root_locs get_tag_name
   get_tag_name_locs heap_is_wellformed\<^sub>C\<^sub>o\<^sub>r\<^sub>e\<^sub>_\<^sub>D\<^sub>O\<^sub>M get_host get_host_locs get_disconnected_document
   get_disconnected_document_locs set_val set_val_locs create_character_data DocumentClass.known_ptr
   DocumentClass.type_wf set_shadow_root set_shadow_root_locs set_mode set_mode_locs attach_shadow_root
   by(auto simp add: l_attach_shadow_root_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_def instances)
 declare l_attach_shadow_root_wf\<^sub>S\<^sub>h\<^sub>a\<^sub>d\<^sub>o\<^sub>w\<^sub>_\<^sub>D\<^sub>O\<^sub>M_axioms [instances]
 
 end